diff options
| author | Ben Elliston <bje@redhat.com> | 2000-07-28 04:11:52 +0000 |
|---|---|---|
| committer | Ben Elliston <bje@redhat.com> | 2000-07-28 04:11:52 +0000 |
| commit | 824bbc4849b364faa16054cecc940ab214b42379 (patch) | |
| tree | 0eed8e22c55cbee8df3bad491c15b10f52652213 | |
| parent | 418d8e2e61a27d428f363b110a52dd88361ff6d7 (diff) | |
| download | gdb-cgen-1-0.tar.gz | |
CGEN 1.0 importcgen-1-0
100 files changed, 62008 insertions, 0 deletions
diff --git a/cgen/AUTHORS b/cgen/AUTHORS new file mode 100644 index 00000000000..c0b497b4543 --- /dev/null +++ b/cgen/AUTHORS @@ -0,0 +1 @@ +CGEN was originally written by Doug Evans <devans@cygnus.com>. diff --git a/cgen/COPYING.CGEN b/cgen/COPYING.CGEN new file mode 100644 index 00000000000..b64876fa992 --- /dev/null +++ b/cgen/COPYING.CGEN @@ -0,0 +1,44 @@ +CGEN - a Cpu tools GENerator +Copyright 2000 Red Hat, Inc. + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +This program is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this software; see the file COPYING. If not, write to the +Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA +02111-1307 USA + +As a special exception, Red Hat gives unlimited permission to copy, +distribute and modify the code that is the output of CGEN. You need +not follow the terms of the GNU General Public License when using or +distributing such code, even though portions of the text of CGEN +appear in them. The GNU General Public License (GPL) does govern all +other use of the material that constitutes the CGEN program. + +Certain portions of the CGEN source text are designed to be copied (in +certain cases, depending on the input) into the output of CGEN. We +call these the "data" portions. CPU description files are, for the +purposes of this copyright, deemed "data". The rest of the CGEN +source text consists of comments plus executable code that decides +which of the data portions to output in any given case. We call these +comments and executable code the "non-data" portions. CGEN never +copies any of the non-data portions into its output. + +This special exception to the GPL applies to versions of CGEN released +by Red Hat. When you make and distribute a modified version of CGEN, +you may extend this special exception to the GPL to apply to your +modified version as well, *unless* your modified version has the +potential to copy into its output some of the text that was the +non-data portion of the version that you started with. (In other +words, unless your change moves or copies text from the non-data +portions to the data portions.) If your modification has such +potential, you must delete any notice of this special exception to the +GPL from your modified version. diff --git a/cgen/ChangeLog b/cgen/ChangeLog new file mode 100644 index 00000000000..8f7c9449f0d --- /dev/null +++ b/cgen/ChangeLog @@ -0,0 +1,4263 @@ +2000-07-25 Ben Elliston <bje@redhat.com> + + * doc/credits.texi (Credits): Add Frank Eigler. + +2000-07-24 Dave Brolley <brolley@redhat.com> + + * opc-itab.scm (gen-insn-opcode-table): Initialize the first element + fully. + * desc.scm (gen-attr-table-defn): Initialize all elements fully. + (<keyword>): Initialize all elements fully. + * desc-cpu.scm (-gen-isa-table-defns): Initialize the last element + fully. + (-gen-mach-table-defns): Ditto. + (-gen-ifld-defns): Ditto. + (-gen-operand-table): Ditto. + (-gen-insn-table): Ditto. + (-gen-cpu-open): Nothing to do for the mach table. + +2000-07-13 Ben Elliston <bje@redhat.com> + + * doc/version.texi (UPDATED): Update. + +2000-07-05 Ben Elliston <bje@redhat.com> + + * configure.in (AC_PATH_PROG): Remove. + * configure: Regenerate. + * Makefile.am (GUILE): Locate guile dynamically. + * Makefile.in: Regenerate. + * doc/Makefile.in: Likewise. + +2000-07-03 Ben Elliston <bje@redhat.com> + + * desc-cpu.scm (cgen-desc.c): Include "libiberty.h". + * opc-itab.scm (cgen-opc.c): Likewise. + +2000-06-28 Frank Ch. Eigler <fche@redhat.com> + + * rtl.scm (-rtx-traverse-locals): Correct call to `symbol?' for + guile 1.4 compatibility. + (rtx-env-dump): Comment out buggy display calls. + +2000-06-15 matthew green <mrg@redhat.com> + + * opc-itab.scm (-gen-ifmt-table-1): Add extra braces to pacify GCC. + +2000-06-14 Frank Ch. Eigler <fche@redhat.com> + + * Makefile.in: Regenerated. + + * desc-cpu.scm (gen-ifld-decls): Exclude derived ifields. + (gen-ifld-defns): Ditto. + * pgmr-tools.scm (pgmr-pretty-print-insn-format): Ditto. + * rtl.c (rtl-finish!): Ditto. + * opc-itab.scm (-gen-ifield-decls): Ditto. + * opcodes.scm (gen-switch): Exclude derived operands. + * operand.scm (op-iflds-used): Expand derived operands. + (hw-index-derived): New dummy function to create dummy object. + (-derived-operand-parse): Fix mode arg passed to <derived-operand> + constructor. Set object's hw-name and index fields. + (-anyof-merge-subchoices): Set instance object's index also. + (-anyof-name): New helper function. + (anyof-merge-semantics): Correct replacement of operand names in + anyof instance. + (op-ifield): Tolerate derived-operands and their funny indices better. + * ifield.scm (ifld-known-values): Expand derived ifields. + (non-multi-ifields, non-derived-ifields): New utility functions. + (ifld-decode-mode): Tolerate objects with unbound decode field. + * iformat.scm (compute-insn-length): Expand derived ifields. + (compute-insn-base-mask): Ditto. + * insn.scm (insn-base-ifields): Remove. + (<insn>): Add iflds-values entry to cache ifld-base-ifields values. + (insn-value): Call ifld-base-ifields and ifld-constant? instead. + * mach.scm (arch-analyze-insns!): Exclude multi-insns. + * sem-frags.scm (sim-sfrag-analyze-insns!): Ditto. + (-frag-test-data): Ditto. + * sim-decode.scm (cgen-decode.h, cgen-decode.cxx): Ditto. + * utils-sim.scm (op-extract?): Handle derived operands. + + * gas-test.scm (cgen-build.sh): Quote '*' chars printed by objdump. + * semantics.scm (-build-operand!): Handle 'DFLT case during parsing. + * hardware.scm (hardware-for-mode): New function. + + * insn.scm (filter-harmlessly-ambiguous-insns): New function for + cleaning up decode tables. + (mask-superset?): Little helper function for above. + * decode.scm (-build-decode-table-entry): Call it. + (-opcode-slots): Add some more tracing. + * arm.cpu: Disable decode-splits construct due to implementation + conflict with `filter-harmlessly-ambiguous-insns' + + * decode.scm (-population-top-few): New function for better decode + bit generation. Includes minor helper functions. + (decode-get-best-bits): Call it instead. + (OLDdecode-get-best-bits): Renamed previous version of above. + + +2000-06-13 Ben Elliston <bje@redhat.com> + + * configure.in: Use AC_EXEEXT with Cygnus mode. Remove AC_ARG_WITH + for the Guile library directory. + * configure: Regenerate. + * Makefile.in, doc/Makefile.in: Regenerate. + + * Makefile.in, doc/Makefile.in: Regenerate. + * configure.in: Remove unnecessary tests. Move to version 1.0. + * acconfig.h, config.in: Remove. + * configure, aclocal.m4: Regenerate. + * doc/stamp-vti, doc/version.texi: Likewise. + * AUTHORS: New file. + +2000-06-07 Ben Elliston <bje@redhat.com> + + * fixup.scm (symbol-bound?): Reduce debugging output. + +2000-06-02 matthew green <mrg@redhat.com> + + * insn.scm (insn-base-ifields): Returns all the instruction fields for + a given instruction, replacing derived fields with their subfields. + (insn-value): Use `insn-base-ifields' to find all constant values. + (multi-insn-instantiate!): Comment some debug messages. + +2000-06-01 Ben Elliston <bje@redhat.com> + + * doc/rtl.texi (Expressions): Document a hazard with the choice of + symbol names used in a (c-call ..) rtx. + + * sim-test.scm (build-test-set): Return (()) for an instruction + with no operands, so it too is included in the generated test set. + +2000-05-31 Ben Elliston <bje@redhat.com> + + * Makefile.am (gas-test): Ensure $(ISA) is not empty. + (sim-test): Likewise. + * Makefile.in: Regenerate. + +2000-05-30 Frank Ch. Eigler <fche@redhat.com> + + * read.scm (-cgen): In debugging mode (-b), ask guile for untruncated + stack traceback, in an order that resembles gdb's `bt'. + +2000-05-24 Frank Ch. Eigler <fche@redhat.com> + + * desc-cpu.scm (-gen-hash-defines): Use ifmt-ifields again. + * opc-itab.scm (-gen-ifmt-table-1): Ditto. + * gas-test.scm (gas-test-analyze!, cgen-build.sh): Filter out + multi insns. + * ifield.scm (multi-ifield): Define workable field-mask and field-value + virtual functions. + (ifld-base-ifields): New routine to replace ifmt-expanded-ifields. + * iformat.scm (ifmt-expanded-ifields): Gone. + (ifields-base-ifields): New function. Call ifld-base-ifields for real + work. + (-ifmt-lookup-ifmt!): Use it to expand derived/multi combos in new + ifmt entries. + + * opcodes.scm (multi-ifield gen-extract): Correct spacing in generated + code. + +2000-05-19 Frank Ch. Eigler <fche@redhat.com> + + * utils-gen.scm (gen-multi-ifld-extract): Fix decode hook for sim. + +2000-05-18 Frank Ch. Eigler <fche@redhat.com> + + * ifield.scm (-multi-ifield-parse): Add encode/decode args. + (-multi-ifield-read): Parse them. + (define-full-multi-ifield): Pass #f/#f as defaults for them. + * opcodes.scm (multi-ifield gen-insert): Add encode hook. + (multi-ifield gen-extract): Add decode hook. + * utils-gen.scm (gen-multi-ifld-extract): Add decode hook for sim. + + * insn.scm (syntax-break-out): More correctly handle \-escaped + syntax characters. + (syntax-make-elements): Ditto. + * opc-itab.scm (compute-syntax): Ditto. + + +2000-05-17 Ben Elliston <bje@redhat.com> + + * gas-test.scm (cgen-build.sh): Log the correct script filename. + +2000-05-15 Frank Ch. Eigler <fche@redhat.com> + + * gas-test.scm (build-test-set): Return (()) for an instruction + with no operands, so it too is included in the generated test set. + +2000-05-15 Frank Ch. Eigler <fche@redhat.com> + + * desc-cpu.scm (-gen-hash-defines): Define CGEN_ACTUAL_MAX values for + IFMT_OPERANDS and SYNTAX_BYTES. + + +2000-05-15 Frank Ch. Eigler <fche@redhat.com> + + * sim.scm (with-any-profile?): New function. + * utils-sim.scm (-sfmt-contents): Use above instead of `with-profile?' + to decide whether or not to include profiling counters. + +2000-05-10 Frank Ch. Eigler <fche@redhat.com> + + Fuller derived-operand support for opcodes. + * insn.scm (non-multi-insns): New filter to oppose `multi-insns'. + * desc-cpu.scm (-define-hash-defines): Compute CGEN_MAX_SYNTAX_BYTES. + Correctly compute ..._IFMT_OPERANDS. Omit useless ..._INSN_OPERANDS. + (gen-operand-table): Omit derived- and anyof- operands from table. + (gen-insn-table): Omit multi-insns from table. + * iformat.scm (ifmt-expanded-fields): New function to expand + subfields of derived-ifields. + (ifmt-compute!): Ignore remaining multi-insns. + * mach.scm (isa-min-insn-bitsize, isa-max-insn-bitsize): Ignore + multi-insns. + * opc-itab.scm (-gen-ifmt-table-1): Use ifmt-expanded-ifields. + (-gen-insn-enum, -gen-insn-opcode-table): Ignore multi-insns. + * opcodes.scm (derived-operand): Define abort()ing gen-insert, + gen-extract, gen-fget, gen-fset, gen-parse, gen-print functions. + (gen-switch): Omit anyof-operands. + * operand.scm (-anyof-syntax): New function. + (-anyof-merge-syntax): Call it. + * utils.scm (collect): New idiomatic function. + +2000-05-10 Ben Elliston <bje@redhat.com> + + * m68k.cpu: New file (work in progress). + +2000-05-05 Frank Ch. Eigler <fche@redhat.com> + + * Makefile.am (all-local): New target. Create stamp-cgen. + * Makefile.in: Regenerated. + * doc/Makefile.in: Regenerated. + +2000-04-26 Frank Ch. Eigler <fche@redhat.com> + + * operand.scm (-operand-g/setter-syntax): Correct off-by-one error. + (-operand-parse-setter): Ditto. + * utils-sim.scm (needed-iflds): Store ifield (index) in argbuf, even + for CACHE-ADDR operands. + + +2000-04-23 matthew green <mrg@redhat.com> + + * m32r.cpu: Fix a typo. + +Fri Apr 21 22:18:48 2000 Jim Wilson <wilson@cygnus.com> + + * ia64.cpu (define-model): Change merced to Itanium. + (f-qp): Change quilifying to qualifying. + (movbr_ph, movbr_pvec): Delete. + (I-I21): Delete uses of movbr_ph and movbr_pvec. + +2000-04-07 Ben Elliston <bje@redhat.com> + + * doc/porting.texi (Building a simulator test suite): Clarify + where generated test cases are placed. + +2000-04-07 Ben Elliston <bje@redhat.com> + + * Makefile.am (gas-test): Remove dependency on `cgen'. + (sim-test): Ditto. + * Makefile.in: Regenerate. + +2000-04-04 Frank Ch. Eigler <fche@redhat.com> + + * hardware.scm (<hw-pc> parse): Allow user to set type for pc register. + * mode.scm (mode-finish!): Add placeholder code for mach-dependent + type reconfiguration. + * utils-sim.scm (-sfmt-contents): Add profile-counters only if + with-profile?. + +2000-03-30 Ben Elliston <bje@redhat.com> + + * doc/rtl.texi (Enumerated constants): Add concept index entries. + +2000-03-24 Ben Elliston <bje@redhat.com> + + * Makefile.am (stamp-cgen): Reinstate target. + * Makefile.in: Regenerate. + +2000-03-22 Ben Elliston <bje@redhat.com> + + * slib/ppfile.scm: Remove; unused. + * slib/defmacex.scm: Likewise. + +2000-03-21 Ben Elliston <bje@redhat.com> + + * doc/internals.texi (Source file overview): Document. + + * Makefile.am (GUILEDIR): Remove. + (CGEN): Ditto. Callers use $(GUILE) instead. + (GUILEFLAGS): Ditto. + (CGENFILES): Ditto. + (APPDESCFILES): Ditto. + (OPCODESFILES): Ditto. + (SIMFILES): Ditto. + (pkgdata_SCRIPTS): Ditto. + (stamp-cgen): Remove target. + * Makefile.in: Regenerate. + + * configure.in: Remove header and library tests. + * configure: Regenerate. + * config.in: Likewise. + +2000-03-20 Ben Elliston <bje@redhat.com> + + * read.scm: Cease loading "hob-sup.scm". + * utils.scm: Inherit the fastcall family of procedures (for now). + * hob-sup.scm: Remove. + +2000-03-20 Ben Elliston <bje@redhat.com> + + * configure.in (AC_OUTPUT): Do not emit .gdbinit. + * configure: Regenerate. + * gdbinit.in: Remove. + +2000-03-17 Ben Elliston <bje@redhat.com> + + * Makefile.am (CGEN): Use guile, not cgen. + (CGENCFLAGS, LIBIBERTY, INCLUDES): Remove. + (bin_PROGRAMS, cgen_SOURCES): Likewise. + (CGENFILES): Fold CGEN_HOB_INPUT_FILES and CGEN_NOHOB_FILES. + (HOBBIT_INPUT_FILES, HOBBIT_OUTPUT_FILE): Remove. + (HOB_OBJS): Likewise. + (CGEN_HOB_SRC, CGEN_HOB_OBJ): Likewise. + (CGENOBJS): Likewise. + (cgen_DEPENDENCIES, cgen_LDFLAGS, cgen_LDADD): Likewise. + (hobbit, hobbit.o, hobbit.c): Remove targets. + (cos.o, cgen.o, cgen-gh.o, hob-sup.o): Likewise. + (CLEANFILES): Update. + * acconfig.h (WITH_HOBBIT): Remove. + * configure.in: Do not test for 3 arg scm_make_vector. Remove + option --with-cgen-hobbit. + * cos.h, cos.c, hob-main.c, hob-sup.c, hob-sup.h, hob.sh: Remove. + * cgen-gh.h, cgen-gh.c, cgen-hob.scm, cgen.c: Likewise. + * hobbit.c, hobbit.h, hobbit.scm: Likewise. + * hobscmif.h, hobslib.scm, scmhob.h: Likewise. + * Makefile.in: Regenerate. + * config.in: Likewise. + * aclocal.m4: Likewise. + * configure: Likewise. + * README (Hobbit support): Remove. + * doc/internals.texi (Conventions): Do not mention Hobbit. + * doc/porting.texi (Supported Guile versions): Likewise. + +2000-03-16 Frank Ch. Eigler <fche@redhat.com> + + * mipscom.cpu (break, syscall, define-trap): Make these non-cti + insns. + * sid-cpu.scm (-gen-sem-switch-engine): Adjust calling & + callback convention to new sid sidutil::basic_cpu code. + (-gen-sfrag-engine-fn): Ditto. + * sid.scm (-create-virtual-insns!): Ditto. + (-hw-gen-set-quiet-pc): Mark delay slot execution specially in pbb + mode. + (cxmake-skip): Implement properly for pbb mode. + +2000-03-03 Ben Elliston <bje@redhat.com> + + * doc/internals.texi: New file. + +2000-02-29 Ben Elliston <bje@redhat.com> + + * doc/rtl.texi (Derived operands): Remove unnecessary footnote. + * doc/porting.texi: Formatting tweaks. + +2000-02-25 Nick Clifton <nickc@cygnus.com> + + * desc-cpu.scm (*_cgen_cpu_open): Initialise signed_overflow_ok_p + field. + +Thu Feb 24 14:09:01 2000 Doug Evans <devans@seba.cygnus.com> + + * operand.scm (<anyof-operand>,make!): Initialize mode-name, not + mode. + +2000-02-23 Andrew Haley <aph@cygnus.com> + + * m32r.cpu (pcmpbz): Make pcmpbz a special (i.e. hidden) + instruction. + +2000-02-24 Ben Elliston <bje@redhat.com> + + * doc/rtl.texi (Derived operands): Add some cindex entries. + +2000-02-23 Ben Elliston <bje@redhat.com> + + * ia32.cpu (dndo): Move general purpose macro from here .. + * simplify.inc (dndo): .. to here. + +2000-02-18 Frank Ch. Eigler <fche@redhat.com> + + * arm.cpu (h-tbit): Add c-call setter function. + (h-mbits): Ditto. + +2000-02-17 Frank Ch. Eigler <fche@redhat.com> + + * sem-frags.scm (-frag-hash-compute!): Add appstuff arg for traversal. + (-frag-cost-compute!): Ditto. + * utils.scm (copyright-cygnus): Add Y2K. + * sid-cpu.scm (@prefix@_pbb_run): Add unsigned& argument. + +2000-01-25 Nick Clifton <nickc@cygnus.com> + + * desc-cpu.scm (@arch@_cgen_cpu_open): Add code to initialise + flags field of the CGEN_CPU_TABLE structure. + +Sun Dec 12 14:20:36 1999 Doug Evans <devans@seba.cygnus.com> + + * operand.scm (<anyof-instance>): Renamed from <anyof-value>. + All references updated. + +Tue Nov 30 11:06:22 1999 Doug Evans <devans@seba.cygnus.com> + + * ia32.cpu: Rewrite addressing mode support. + + * ifield.scm (<ifield>): New member `follows'. + (ifld-known-values): New proc. + (<ifield>): New method set-word-offset!. + (ifld-set-word-offset!): New proc. + (ifld-new-word-offset): New proc. + (<ifield>): New method next-word. + (<multi-ifield>): New method next-word. + (ifld-next-word): New proc. + (ifld-precedes?): New proc. + (-ifield-parse): New args word-offset,word-length,follows. + All callers updated. Handle CISC-style vs RISC-style ifields. + (-ifield-read): Recognize word-offset,word-length,follows specs. + (-ifld-parse-follows): New proc. + (-multi-ifield-make-default-insert): New proc. + (-multi-ifield-make-default-extract): New proc. + (-multi-ifield-parse): Provide default values for insert,extract + handlers if not specified. + (<derived-ifield>): New class. + (derived-ifield?): New predicate. + (ifld-derived-operand?): New predicate. + (f-anyof): New global. + (ifld-anyof?,ifld-anyof-operand?): New predicates. + (f-derived,ifld-derived?): Delete. + (ifield-builtin!): Delete init of f-derived. Init f-anyof. + * insn.scm (-sub-insn-ifields): New proc. + (-sub-insn-make!): New proc. + (multi-insn-instantiate!): Provide initial implementation. + (-insn-parse): If insn contains "anyof" operands, create a + <multi-insn> object instead of a plain <insn>. + (-parse-insn-format-symbol): Rewrite derived operand handling. + Add anyof operand handling. + (-parse-insn-format-ifield-spec): Rewrite. + (-parse-insn-format-operand-spec): Delete. + (-parse-insn-format-list): Delete support for `(operand value)'. + (anyof-operand-format?): Replaces derived-operand-format?. + * operand.scm (-operand-parse-getter): Improve error messages. + (-operand-parse-setter): Ditto. + (<derived-operand>): New members args,syntax,base-ifield,encoding, + ifield-assertion. + (<anyof-operand>): Change baseclass from <derived-operand> to + <operand>. Delete member values. New members base-ifield,choices. + (anyof-operand?): New predicate. + (-derived-parse-encoding,-derived-parse-ifield-assertion): New procs. + (-derived-operand-parse): Rewrite. + (-derived-operand-read): Rewrite. + (-anyof-parse-choice): New proc. + (-anyof-operand-parse): Rewrite. + (-anyof-operand-read,define-anyof-operand): New procs. + (<anyof-value>): Rewrite. + (-anyof-initial-known): New proc. + (anyof-satisfies-assertions?): New proc. + (-anyof-merge-syntax,-anyof-merge-encoding): New procs. + (-anyof-merge-getter,-anyof-merge-setter): New procs. + (-anyof-merge-semantics,-anyof-merge-ifield-assertion): New procs. + (-anyof-merge-subchoices,-anyof-all-subchoices): New procs. + (-anyof-value-from-derived): New proc. + (-anyof-all-choices-1,anyof-all-choices): New procs. + (operand-init!): Create define-anyof-operand reader command. + + * insn (syntax-break-out): Take syntax as argument instead of insn. + All callers updated. + (syntax-make): Move here, from ???. + + * types.scm (<bitrange>): Rename accessors from bitrange:foo to + bitrange-foo. All uses updated. + (bitrange-next-word): New proc. + + * semantics.scm (-solve-expr-fn,rtx-solve): New procs. + + * rtl.scm (rtx-canonicalize): Provide initial implementation. + (rtx-make-const,rtx-make-enum): New procs. + (rtx-arg1,rtx-arg2): Renamed from -rtx-arg[12]. All callers updated. + (rtx-mem-addr,rtx-mem-sel): New procs. + (rtx-change-address): New proc. + (rtx-make-ifield,rtx-make-operand,rtx-make-local): New proc. + (rtx-make-set,rtx-single-set?): New procs. + (rtx-combine): New proc. + + * rtl.scm (rtx-traverse): New arg `appstuff'. All callers updated. + (rtx-traverse-with-locals): Ditto. + (-rtx-traverse,-rtx-traverse-*): Ditto. + + * rtl.scm (define-subr): New proc. + (rtl-init!): Create reader command `define-subr'. + + * cos.c (_object_mi_p): Ensure argument is an object. + (indent): New function. + (_object_print_elms): Add pretty-printing support. + (_object_print): Ditto. + + * hobbit.scm (*reckless-s->c-fun-table*): Add fastcall7. + (*floats-s->c-fun-table*): Ditto. + * hobbit.c,hobbit.h: Rebuild. + * hob-sup.c (fastcall7): New proc. + * hob-sup.h (fastcall7): Declare. + * hob-sup.scm (fastcall7): New macro. + + * mach.scm (<arch>): New member subr-list. + (current-subr-list,current-subr-add!,current-subr-lookup): New procs. + (arch-finish!): Reverse recorded subr list. + + * read.scm (debug-env): New global. + (debug-var-names,debug-var,debug-repl-env): New procs. + (debug-repl): Rewrite. New arg `env-list'. All callers updated. + (debug-quit): Renamed from `continue'. + + * simplify.inc (dsmf): New pmacro. + + * utils.scm (plus-scan): New proc. + (split-bits): Rewrite. + (split-value): New proc. + +1999-10-13 Doug Evans <devans@casey.cygnus.com> + + * doc/Makefile.am (DOCFILES): Add notes.texi. + * doc/Makefile.in: Rebuild. + +1999-10-11 Doug Evans <devans@casey.cygnus.com> + + * ifield.scm (ifld-derived?): New proc. + (f-derived): New global. + (ifield-builtin!): Create ifield f-derived. + (<multi-insn>): New class. + (multi-insn?): New predicate. + (multi-insn-instantiate!): New proc. + (-insn-parse): Create <multi-insn> objects for insns with derived + ifields. + (-parse-insn-format-symbol): Handle derived ifields. + (-parse-insn-format-ifield-spec): New proc. + (-parse-insn-format-operand-spec): New proc. + (-parse-insn-format-list): Simplify. + (-parse-insn-format): No longer allow (ifield-object value) spec. + (derived-operand-format?): New proc. + (insn-alias?): New proc. + (non-alias-insns): Rewrite. + (insn-real?): Renamed from real-insn?, all callers updated. + (virutal-insns): Rewrite. + (multi-insns): New proc. + * mach.scm (arch-analyze-insns!): Instantiate multi-insns if present. + * operand.scm (op-ifield): Renamed from op:ifield, all callers updated. + Return #f if operand doesn't have an index or if index is not an + ifield. + (hw-index-anyof): New proc. + (-operand-parse): Allow integer indices. + (<derived-operand>): New class. + (derived-operand?): New predicate. + (<anyof-operand>): New class. + (<anyof-value>): New class. + (-anyof-parse-value,-anyof-operand-parse): New procs. + (-derived-operand-parse,-derived-operand-read): New procs. + (define-derived-operand,define-full-derived-operand): New procs. + (operand-init!): New reader command define-derived-operand. + + * utils.scm (list-take): Handle negative amount. + (element?): Rewrite. + +1999-10-10 Doug Evans <devans@casey.cygnus.com> + + * dev.scm: quick-utils.scm renamed to ~/.cgenrc. + +1999-10-04 Richard Henderson <rth@cygnus.com> + + * ia64.cpu: Checkpoint. + +1999-09-29 Doug Evans <devans@casey.cygnus.com> + + * sim-cpu.scm (-gen-semantic-fn-table): Virtual insns are always valid. + + * sim.scm (sim-finish!,x-invalid): Always set pc. Set vpc based on + default-insn-bitsize. Pass vpc to sim_engine_invalid_insn. + +Wed Sep 29 14:39:39 1999 Dave Brolley <brolley@cygnus.com> + + * sim.scm (sim-finish!): Don't call sim_io_error for invalid insn. Use + PC returned by sim_engine_invalid_insn. + +1999-09-28 Doug Evans <devans@casey.cygnus.com> + + * ia32.cpu: New file. + +1999-09-25 Doug Evans <devans@casey.cygnus.com> + + * utils.scm (bit-set?): Fix off by one error. + + * rtl-c.scm (s-sequence): Fix non-void-mode result output. + + * rtl.scm (hw): Check for valid hardware element before trying to + get its mode. + + * arm.cpu (arm7f cpu): Renamed from arm. All users updated. + * arm7.cpu (bx): Fix name of target address operand in assembler spec. + (*): arm_compute_operand2_foo renamed to compute_operand2_foo. + * thumb.cpu (*): arm_compute_operand2_foo renamed to + compute_operand2_foo. + + + * rtl-c.scm (<rtl-c-eval-state>): New member output-language. + (estate-output-language-c?,estate-output-language-c++?): New procs. + (<rtl-c-eval-state>,vmake!): Handle #:output-language. + (estate-make-for-normal-rtl-c++): New proc. + (rtl-c++-parsed,rtl-c++): New proc. + (s-c-call): Invoke cpu class method if c++. + (join): Use s-c-raw-call. + + * rtl-c.scm (subword): Don't pass current_cpu to SUBWORD. + (nop): Rewrite. + + * rtl-c.scm (delay): Mark the sequence as #:delay'd. + * rtl.scm (<eval-state>): New member `modifiers'. + (<eval-state>,vmake!): Handle #:modifiers. + (estate-with-modifiers): New proc. + + * rtl.scm (rtx-side-effects?): New proc. + (rtx-canonical-bool): Don't change expr if it has side effects. + * semantics.scm (-simplify-expr-fn): Handle exprs with side-effects + better. + +1999-09-23 Doug Evans <devans@casey.cygnus.com> + + * sim.scm (gen-scache-type): Fix typo in last patch. + +Tue Sep 21 17:12:55 1999 Dave Brolley <brolley@cygnus.com> + + * sim.scm (gen-scache-type): Add last_insn_p flag for parallel support. + +1999-09-05 Doug Evans <devans@casey.cygnus.com> + + + * decode.scm (decode-build-table): Delete args startbit,index-list. + All callers updated. + * utils-sim.scm (gen-decoder): Delete args startbit,index-list. + All callers updated. + * sim-decode.scm (-gen-decode-fn): Always pass 0 for startbit + to decode-get-best-bits. + + * hardware.scm (hw-bits): New proc. + (-hw-parse): New arg layout. All callers updated. + (define-full-hardware): New arg layout. All callers updated. + (-hw-validate-layout): New proc. + (-hw-create-[gs]etter-from-layout): New procs. + (<hw-register>,parse!): Handle layout spec. + * types.scm (type-bits): New proc. + + * sem-frags.scm (-frag-cost-compute!): Fix calculation of + UNARY, BINARY, TRINARY rtxs. + + * attr.scm (<enum-attribute>,parse-value): Allow strings. + * enum.scm (parse-enum-vals): Use reverse! instead of reverse. + Support '- as "unused spot" indicator. + +1999-09-03 Doug Evans <devans@casey.cygnus.com> + + * pgmr-tools.scm (pgmr-pretty-print-insn-format): Fix typo. + +1999-09-02 Doug Evans <devans@casey.cygnus.com> + + * rtx-funcs.scm (subword): Fix mode spec of `value'. + + * rtl.scm (-rtx-traverse-operands): Fix debugging message + construction. + (tstate-make): New arg `depth'. All callers updated. + (tstate-depth,tstate-set-depth!): New procs. + (tstate-incr-depth!,tstate-decr-depth!): New procs. + (-rtx-traverse-operands): Indent debugging output by traversal depth. + (-rtx-traverse): Ditto. Keep track of traversal depth. + +1999-09-01 Doug Evans <devans@casey.cygnus.com> + + * sim-decode.scm (-gen-decoder+supporting cast): Move to utils-sim.scm. + * utils-sim.scm: Decoder generator support moved here. + (-decode-equiv-entries?,-decode-sort-entries): New procs. + (-gen-decoder-switch): Sort entries for more fall-throughs. + + * Makefile.am (gas-test,sim-test): Specify ISA when invoking cgen. + * Makefile.in: Rebuild. + * sim-test.scm (build-sim-testcase): Add logging message. + * dev.scm (cload): Recognize SIM-TEST application. + (load-stest): Set APPLICATION to SIM-TEST. + + * desc-cpu.scm (-gen-hash-defines): Add \n to output. + + * ifield.scm (-ifield-parse): Allow bit numbers up to 127. + * mach.scm (-isa-parse): Allow insn bitsizes from 8 to 128. + * mode.scm (mode-make-int,mode-make-uint): Allow values up to 64 bits. + + * insn.scm (syntax-break-out): Handle ${foo}. + +Sun Aug 29 11:11:15 1999 Doug Evans <devans@canuck.cygnus.com> + + * Makefile.am (noinst_PROGRAMS,noinst_LIBRARIES): Delete. + (bin_PROGRAMS): Define. + (CGEN_HOB_INPUT_FILES): Remove $(srcdir)/. + (cgen-hob.c): Prepend $(srcdir)/ here. + (APPDESCFILES,OPCODESFILES,SIMFILES,pkgdata_SCRIPTS): Define. + (libcpu_a_SOURCES): Delete. + (cgen_DEPENDENCIES,cgen_LDADD): Rewrite. + (CGEN_HOB_OBJ,CGENOBJS): New variables. + * configure.in (LIBS): Replace -Wl,-rpath with -R. + Add AC_CHECK_LIB(guile,main). + * Makefile.in: Rebuild. + * doc/Makefile.in: Rebuild. + * aclocal.m4: Rebuild. + * config.in: Rebuild. + * configure: Rebuild. + +1999-08-28 Doug Evans <devans@casey.cygnus.com> + + Rename rtx functions from name: to name, accept optional leading + modifier and mode. + VM -> VOID, DM -> DFLT, use DFLT instead of VM for default mode. + * attr.scm (-attr-eval): Update. + * hardware.scm (hw-mode-ok?): Rename arg mode to new-mode-name. + (<hw-register>,mode-ok?): Disallow VOID. + (<hw-immediate>,mode-ok?): Disallow VOID. + (<hw-address>,mode-ok?): Disallow VOID. + * mode.scm (mode-name?): New proc. + (VOID): Renamed from VM. + (DFLT): Renamed from DM. + (mode-builtin!): Update. + * opcodes.scm (<ifield>,gen-insert): Update. + (<ifield>,gen-extract): Update. + (<multi-ifield>,gen-insert,gen-extract): Update. + * operand.scm (op:mode): Update. + (<pc>,make!): Update. + (op:new-mode): Update. + (-operand-read): Update. + * rtl.scm (-rtx-valid-types): Add OPTIONS, EXPLNUMMODE, + NONVOIDMODE, DFLTMODE. Rename VMMODE to VOIDMODE. + (def-rtx-dual-mode,define-rtx-dual-mode): Delete. + (-rtx-lazy-sem-mode): Renamed from -rtx-mode. All callers updated. + (rtx-make): Call -rtx-munge-mode&options. + (rtx accessors): Rewrite. + (rtx-pretty-name): Update. + (-rtx-traverse-*): Update. + (-rtx-traverse-explnummode,-rtx-traverse-nonvoidmode): New procs. + (-rtx-traverse-voidmode,-rtx-traverse-dfltmode): New procs. + (-rtx-make-traverse-table): Update. + (-rtx-traverse-operands): Update. + (-rtx-option?,-rtx-option-list?): New procs. + (-rtx-munge-mode&options): New proc. + (-rtx-traverse-expr): Call -rtx-munge-mode&options. + (-rtx-traverse): Update. + (rtx-traverse,rtx-traverse-with-locals,rtx-compile): Update. + (rtx-compile-time-constant?): Update. + (rtx-true?,rtx-false?,rtx-true,rtx-false): Update. + (rtx-value): Update. + (hw,reg,mem): Renamed from foo:. Update. All callers updated. + * rtx-funcs.scm (*): Update. + * rtl-c.scm (rtl-c-get): Update. + (rtl-c-set-quiet,rtl-c-set-trace): Update. + (s-c-call,s-c-raw-call): Update. + (s-boolifop,s-convop,s-if,s-cond): Update. + (s-case-vm,-gen-non-vm-case-test,s-case): Update. + (-par-replace-set-dests,-par-replace-set-srcs): Update. + (s-parallel,s-sequence): Update. + (rtl-c-build-table): Update. + * sem-frags.scm (-frag-hash-compute!): Update. + (-frag-cost-compute!): Improperly handle unary,binary,trinary ops + for temporary bug compatibility with previous version. + (-frag-expr-locals,-frag-expr-stmts): Update. + (-frag-compute-desired-frags,-frag-pick-best): Update. + * semantics.scm (-simplify-expr-fn): Update. + (rtx-simplify): Update. + (-rtx-ref-type): Update. Account for modifiers. + (-build-operand!,-build-reg-operand!,-build-mem-operand!): Update. + (-build-ifield-operand!): Update. + (-build-known-values): Update. + (semantic-compile): Update. + (-gen-reg-access-defns): Update. + (gen-semantic-code,-gen-sem-case): Update. + (-gen-sfrag-code,-gen-sfrag-case): Update. + * sim-cpu (gen-semantic-code): Update. + * sim.scm (<hw-pc>,gen-write,cxmake-skip): Update. + (<hw-register>,gen-write,gen-set-macro,cxmake-get-raw): Update. + (-hw-cxmake-get): Update. + (<hw-memory>,cxmake-get,gen-set-quiet,gen-write): Update. + (<hw-index>,cxmake-get): Update. + (<operand>,gen-type,gen-read,cxmake-get): Update. + (<operand>,gen-set-quiet,gen-set-trace): Update. + (<pc>,cxmake-get): Update. + (sim-finish!): Update. + * utils-gen.scm (-gen-ifld-extract-base): Update. + (-gen-ifld-extract-beyond): Update. + (gen-multi-ifld-extract): Update. + * *.cpu: Update. + * simplify.inc: Update. + +1999-08-20 Doug Evans <devans@casey.cygnus.com> + + * sim.scm (-op-gen-queued-write): Fix memory address calculation. + Prefix queue function name with sim_ instead of @cpu@_. + + * sim.scm (-with-parallel-only?): New global. + (option-init!): Initialize it. + (option-set!): Set it. + (with-parallel-only?): New proc. + * sim-decode.scm (-gen-decode-insn-globals): Don't include parallel + and writeback markers if with-parallel-only. + (-gen-idesc-init-fn): Update. + * sim-cpu.scm (cgen-cpu.h): Don't generate struct parexec if + with-generic-write. + +Wed Aug 18 15:04:30 1999 Doug Evans <devans@canuck.cygnus.com> + + * sim-cpu.scm (-gen-semantic-fn-table): Handle unsupported insns + with the invalid insn handler. + + * utils.scm (list-maybe-ref): New proc. + + * mach.scm (-isa-parse): Signal error if isa wasn't specified in + define-arch. + (-mach-parse): Signal error if mach wasn't specified in define-arch. + + * i960.cpu (test*-*): Delete `expr' arg. + (test-op,branch-op): Update. + +1999-08-09 Doug Evans <devans@casey.cygnus.com> + + * sim.scm (gen-reg-getter-fn,gen-reg-setter-fn): New procs. + (gen-reg-access-decl): Replace `name' arg with `hw'. All callers + updated. + (gen-reg-access-defn): Ditto. + (-gen-hw-addr): Rewrite. + (-op-gen-queued-write): Rewrite. + * sim-cpu.scm (-gen-cpu-reg-access-decls): + (-gen-scache-semantic-fn): Handle with-generic-write. + (-gen-no-scache-semantic-fn): Ditto. + +1999-08-08 Doug Evans <devans@casey.cygnus.com> + + * utils-gen.scm (gen-define-ifmt-ifields): Tweak output. + + * sim.scm (-with-generic-write?): New global. + (option-init!): Initialize it. + (option-set!): Set it. + (with-generic-write?): New proc. + (-gen-hw-addr): New proc. + (-op-gen-queued-write): New proc. + (-op-gen-set-{quiet,trace}-parallel): Use it if with-generic-write?. + + * sim-cpu.scm (-gen-hardware-types): Output code with parallel support + turned off. + (-gen-sem-switch): Preserve existing with-parallel? value. + (-gen-sem-parallel-switch): Ditto. + (-gen-write-case): Add /indent support. + (cgen-write.c): Rewrite. + + * utils.scm (-current-print-state): New global. + (make-print-state): New proc. + (pstate-indent,pstate-set-indent!): New procs. + (pstate-cmd?,pstate-cmd-do): New procs. + (/indent): New global. + (/indent-set,/indent-add): New procs. + (string-write): Set -current-print-state. + (-string-write): New arg pstate, all callers updated. + Handle print-state commands. + (-string-list-flatten): New proc. + (string-list->string): Use it. + + * sim-cpu.scm (-gen-sem-fn-name): Move here from sim-decode.scm. + (-gen-sem-fn-table-entry): New proc. + (-gen-semantic-fn-table): New proc. + (-gen-scache-semantic-fn): Make fn static. + (-gen-no-scache-semantic-fn): Ditto. + (cgen-semantics.c): Define macro SEM_FN_NAME. + * sim-decode.scm (-gen-decode-insn-globals): Delete FMT,TYPE,IDX, + FAST,FULL. Update @cpu@_insn_sem contents. + (-gen-semf-fn-name): Delete. + (-gen-sem-fn-decls): Delete. + (-gen-idesc-decls): Output prototypes of @cpu@_sem_init_idesc_table, + @cpu@_semf_init_idesc_table. + (-gen-idesc-init-fn): Update. Don't initialize pointers to semantic + handlers here. + (cgen-decode.h): Print sfmt enum. + * utils-gen.scm (gen-sfmt-enum-decl): New proc. + + * iformat.scm (sfmt-build): Rename sformats from fmt-foo to sfmt-foo. + (ifmt-compute!): Ditto. + * sim-decode.scm (-gen-decoder-switch): Ditto. + + * insn.scm (insn-virtual?): New proc. + + * enum.scm (gen-enum-decl): Speed up, build string as list and then + convert to string. + * mach.scm (<arch>): attr-list is now a pair of lists. + (current-attr-list): Rewrite. + (current-attr-add!,current-attr-lookup): Rewrite. + * sim.scm (gen-cpu-insn-enum-decl): Replace append with append!. + +1999-08-06 Richard Henderson <rth@cygnus.com> + + * ia64.cpu: Initial checkpoint. + +1999-08-06 Doug Evans <devans@casey.cygnus.com> + + * pmacros.scm (-pmacro-apply): Fix definition, takes only 1 arg. + (pmacros-init!): Update .apply help string. + +1999-08-03 Doug Evans <devans@casey.cygnus.com> + + * sim.scm (-hw-gen-set-quiet-pc): Update call to SEM_BRANCH_VIA_CACHE. + (<hw-pc>,cxmake-skip): New method. + (<pc>,cxmake-skip): New method. + (-gen-argbuf-fields-union): Add branch_target to `chain' member. + (gen-argbuf-type): New member `skip_count'. + (sim-finish!): Update calls to @cpu@_pbb_cti_chain. + * utils-cgen.scm (atlist-cti?): Don't include SKIP-CTI insns. + + * utils-sim.scm: New file. + * dev.scm (load-sim): Load it. + (load-sid): Load it. + * cgen-sid.scm: Load it. + * cgen-sim.scm: Load it. + * iformat.scm (<sformat>): New member sbuf, not initialized by + default make. + * rtx-funcs.scm (skip): Rewrite. + * rtl-c.scm (skip): Rewrite. + * m32r.cpu (sc,snc): Update `skip' usage. + * mode.scm (mode-real-mode): New proc. + * sem-frags.scm (-frag-split-by-sbuf): Rename from -frag-split-by-sfmt. + Distinguish fragments by the <sformat-abuf> they use. + * sim.scm (gen-profile-index-type): Delete. + (ifield argbuf support): Move to utils-sim.scm and sim-decode.scm. + (-gen-ifld-decoded-val): Delete, use gen-extracted-ifld-value instead. + (hardware argbuf support): Move to utils-sim.scm and sim-decode.scm. + (operand argbuf support): Move to utils-sim.scm and sim-decode.scm. + (-gen-argbuf-elm): Rewrite. + (-gen-argbuf-hw-elm): Delete. + (-gen-argbuf-fields-union): Generate structs for each sbuf instead + of each sfmt. + (-sim-sformat-argbuf-list,-sim-insns-analyzed?): New globals. + (sim-init!): Initialize them. + (sim-analyze-insns!): Set them. + (current-sbuf-list): New proc. + * sim-cpu.scm (-gen-no-scache-semantic-fn): Update calls to + gen-sfmt-op-argbuf-defns,gen-sfmt-op-argbuf-assigns. + * sim-model.scm (-gen-model-insn-fn): Ditto. + * sim-decode.scm (-gen-extract-decls): Delete. + (-gen-record-argbuf-ifld,-gen-trace-argbuf-ifld): New procs. + (<hardware-base>,gen-extract,gen-trace-extract): Move here from + sim.scm. + (<hw-register,gen-extract,gen-trace-extract): Ditto. + (<hw-address,gen-extract,gen-trace-extract): Ditto. + (-gen-op-extract,-gen-op-trace-extract): New procs. + (gen-sfmt-op-argbuf-defns,gen-sfmt-op-argbuf-assigns): Rename from + gen-sfmt-argvars-foo and rewrite. + (-gen-record-args): Rewrite. + (-gen-extract-case): Tweak. + + * cgen-gh.c (gh_putc,gh_puts): New functions. + * cgen-gh.h (gh_putc,gh_puts): Declare them. + * cos.c (_object_print_elms,_object_print): Use them. + * hob-sup.c (fastcall_print): Use them. + * configure.in: Check for scm_gen_puts, scm_puts. + * config.in: Rebuild. + * configure: Rebuild. + * aclocal.m4: Rebuild. + * Makefile.in: Rebuild. + + * dev.scm (load-opc): Use load instead of maybe-load. + (load-gtest,load-sim,load-stest): Ditto. + (load-sid): Ditto. + +1999-07-23 Doug Evans <devans@casey.cygnus.com> + + +1999-07-22 Doug Evans <devans@casey.cygnus.com> + + * cos.c (cos_init): Protect _make_x_symbol from garbage collection. + + * read.scm: Load sem-frags.scm. + * sem-frags.scm (*): Lots rewritten. + * arm.cpu (arm isa): Enable decode-splits. + * arm7.cpu (multiply insns): Rename result to mul-result. + + Rename decode-specialize to decode-split. + * decode.scm (*): Update. + * insn.scm (*): Update. + * mach.scm (*): Update. + +1999-07-19 Doug Evans <devans@casey.cygnus.com> + + Record objects as a smob. + * cos.c (scm_tc16_object): New static global. + (cos_init): Initialize it. + (OBJECT_P,OBJECT_ELEMENTS,OBJECT_CLASS_DESC): Update macros. + (OBJECT_CLASS,OBJECT_ELEMENT_OFFSET): Update. + (_object_tag): Delete. + (_object_make_smob): New function. + (_object_make_x,_object_make_with_values_x): Rewrite. + (_object_elements,_object_class_desc): Rewrite. + (_object_copy,object_p): Rewrite. + (_object_specialize): Rewrite. + (_object_print_elms,_object_print): New functions. + (object_smob): New static global. + (default_make_x): Use OBJECT_ELEMENT_OFFSET instead of magic number. + + * cos.c (_make_x_symbol): New static global. + (object_make): Use it. + (cos_init): Initialize it. + +1999-07-16 Doug Evans <devans@casey.cygnus.com> + + * frv.opc (CGEN_DIS_HASH_SIZE): Change to 128. + (CGEN_DIS_HASH): Hash on f-op ifield value. + +1999-07-15 Doug Evans <devans@casey.cygnus.com> + + * rtl-c.scm (ifield): Back out last patch, use estate-ifield-var? + instead to determine whether to use FLD macro. + (<rtl-c-eval-state>): New member ifield-var?. + (<rtl-c-eval-state>,vmake!): Recognize #:ifield-var?. + * utils-gen.scm (-gen-ifld-extract-base): Specify #:ifield-var? #f. + (-gen-ifld-extract-beyond,gen-multi-ifld-extract): Ditto. + + * rtl.scm (rtx-sequence-assq-locals): New proc. + + * cos.scm (-object-error): Don't crash on non-objects. + + * Makefile.am (CLEANFILES): Add hobbit. + * Makefile.in: Rebuild. + + * rtl-c.scm (s-c-call): Delete unnecessary code. + +1999-07-14 Doug Evans <devans@casey.cygnus.com> + + * rtl-c.scm (ifield): Always reference value via `FLD'. + + * cos.c (elm_bound_p): Return problem SCM boolean values. + + * utils-cgen.scm (display-argv): New proc. + * cgen-opc.scm (cgen): Call it. + * cgen-sim.scm (cgen): Ditto. + * cgen-gas.scm (cgen): Ditto. + * cgen-stest.scm (cgen): Ditto. + +1999-07-05 Doug Evans <devans@casey.cygnus.com> + + * opc-asmdis.scm (-gen-parse-switch): New local var `junk'. + * opc-ibld.scm (-gen-insert-switch): Initialize result to NULL. + (-gen-extract-switch): Initialize result to 1. + * opcodes.scm (gen-ifield-default-type): New proc. + (gen-ifield-value-decl): Renamed from gen-ifield-type. All callers + updated. + (<hw-index>,gen-insert): Handle non-ifield indices. + (<hw-index>,gen-extract): Ditto. + (<hw-asm>,gen-parse): Ditto. + (<hw-asm>,gen-print): Ditto. + (<keyword>,gen-parse): Ditto. + (<keyword>,gen-print): Ditto. + (<operand>,gen-fget): Ditto. + (<operand>,gen-fset): Ditto. + + * sim.scm (-gen-hw-index-raw): Handle scalar indices. + (-gen-hw-index): Ditto. + + * sem-frags.scm: New file. + + * attr.scm (attr-parse): Add better checking of input. + + * hardware.scm (-hw-parse-getter): Renamed from -hw-parse-get. + All uses updated. + (-hw-parse-setter): Renamed from -hw-parse-set. All uses updated. + + * ifield.scm (ifld-nil?): New proc. + + * operand.scm (<operand>): New members getter,setter. + (<operand>,make!): New args getter,setter. All uses updated. + (op:getter,op:setter): New procs. + (<hw-index>,field-start): Return 0 for non-ifield indices. + (<hw-index>,field-length): Return 0 for non-ifield indices. + (-operand-parse-getter,-operand-parse-setter): New procs. + (-operand-parse): New args getter,setter. All callers updated. + Always use hw-index-scalar for scalar operands. + (-operand-read): Handle getter,setter. + (define-full-operand): New args getter,setter. All uses updated. + * semantics.scm (-build-ifield-operand!): Update. + (-build-index-of-operand!): Update. + * sim.scm (<operand>,cxmake-get): If operand has getter, use it. + * simplify.inc (define-normal-operand): Update. + + * rtl.scm (abs,sqrt,cos,sin,min,max,umin,umax): New rtx fns. + * rtl-c.scm (s-unop): Indirect fp ops through fpu op vector. + (s-binop,s-cmpop,s-convop): Ditto. + (abs,sqrt,cos,sin,min,max,umin,umax): New rtx fns. + * sparc.cpu (insn-fmt2): Add FPOPS1,FPOPS2. + (fcc-tests): New insn-enum. + (fcc-value): Rename from fcc-type. + * sparcfpu.cpu: New file. All fp support moved here. + + * rtl.scm (<rtx-func>): New member class. + (rtx-class-*?): New procs. + (def-rtx-node): New arg class. All callers updated. + (def-rtx-syntax-node,def-rtx-operand-node,def-rtx-dual-node): Ditto. + * rtx-funcs.scm (*): Specify class. + + * utils-cgen.scm (context-make-reader): New proc. + + * utils.scm (assert-fail-msg): New variable. + (assert): Use it. + (list-drop,list-tail-drop): New procs. + +1999-06-22 Doug Evans <devans@casey.cygnus.com> + + * desc-cpu.scm (-gen-hash-defines): Restore generation of + CGEN_MIN_INSN_SIZE deleted on March 22. + + * ifield.scm (<ifield>,needed-iflds): New method. + (<multi-ifield>,needed-iflds): New method. + (ifld-needed-iflds): New proc. + (multi-ifield?): New proc. + * iformat.scm (<sfmt>): Delete member ifmt. New members length,iflds. + (-sfmt-search-key): Include insn length in key. + (-sfmt-order-iflds,-sfmt-used-iflds): New procs. + (<fmt-desc>): Delete members ifmt-key,sfmt-key. New member used-iflds. + (-ifmt-lookup-ifmt!): Compute key here. + (-ifmt-lookup-sfmt!): Compute key here. Delete arg ifmt. + All callers updated. + (ifmt-build): Delete arg desc. New args search-key,iflds. + All callers updated. + (sfmt-build): Delete args desc,ifmt. New args search-key,cti?, + in-ops,out-ops,sorted-used-iflds. All callers updated. + * minsn.scm (minsn-make-alias): Use insn-set-ifmt!. Update call + to ifmt-build. + * operand.scm (op-iflds-used): New proc. + * utils-gen.scm (gen-ifld-type): Move here from sim.scm + and sim-cpu.scm. + (gen-ifld-extract-decl,-gen-ifld-extract-base): Ditto. + (-gen-extract-word,-gen-ifld-extract-beyond): Ditto. + (gen-ifld-extract,gen-multi-ifld-extract): Ditto. + (gen-extracted-ifld-value): Ditto. + (-extract-chunk-specs): Ditto. + (gen-define-ifields,gen-define-ifmt-ifields): Ditto. + (-extract-chunk,-gen-extract-beyond-var-list): Ditto. + (gen-extract-ifields,gen-extract-ifmt-ifields): Ditto. + (-extract-insert-subfields): New function. + * sim.scm (gen-record-argbuf-ifld): Renamed from gen-ifld-extract. + (gen-record-argvar-ifld): Renamed from gen-ifld-extract-argvar. + * sim-cpu.scm (-gen-extract-ifmt-macro): Replace calls to + gen-define-ifields with gen-define-ifmt-ifields. Ditto for + gen-extract-foo. + (-gen-no-scache-semantic-fn): Ditto. + (-gen-sem-case): Ditto. + (-gen-read-case): Update calls to gen-define-ifields, + gen-extract-ifields. + * sim-decode.scm (-gen-record-args): Update. + (-gen-sfmt-argvars-assigns): Update. + (-gen-extract-case): Update. + * sim-model.scm (-gen-model-insn-fn): Replace calls to + gen-define-ifields with gen-define-ifmt-ifields. Ditto for + gen-extract-foo. + +1999-06-18 Doug Evans <devans@casey.cygnus.com> + + + * rtl.scm (-rtx-traverse): Output symbol shortcuts in source form, + (operand name) not (operand object), (local name) not (local object). + (rtx-traverse-with-locals): New proc. + (-compile-expr-fn): New proc. + (rtx-compile): Rewrite. + * rtl-c.scm (rtl-c-get): Handle operand/local names for src arg. + (rtl-c-set-quiet): Don't accept operand/local names for dest arg. + (rtl-c-set-trace): Ditto. + (operand define-fn): Recognize operand name argument. + (local define-fn): Recognize sequence temp name argument. + * rtx-funcs.scm (operand): Argument is operand name, not object, + so call current-op-lookup. + (local): Similarily, so call rtx-temp-lookup. + + * rtl.scm (rtx-field?): Use rtx-name instead of car. + (rtx-operand?): Ditto. + (rtx-pretty-name): Ditto. + (rtx-local-obj): Flag symbol argument as an error. + (rtx-local-name): New proc. + (rtx-sequence-locals,rtx-sequence-exprs): New procs. + + * rtl.scm (-rtx-traverse-operands): Fix debugging output of arg-types. + + * read.scm (debug-repl): Renamed from -debug-repl. All callers + updated. + + * arm7.cpu (do-word/byte-store): Use (trunc: QI rd) rather than + (and: QI rd #xff). + + * hobbit.scm (*reckless-s->c-fun-table*): Add fastcall4, fastcall6. + (*floats-s->c-fun-table*): Ditto. + * hobbit.c,hobbit.h: Rebuild. + * rtl.scm (-rtx-traverse-expr): Use fastcall6. + * semantics.scm (rtx-simplify): Use /fastcall-make. + + * iformat.scm (-sfmt-search-key): Don't include memory modes. + + * insn.scm (<insn>): Delete members condition, compiled-condition. + (<insn>,make!): Update + (<insn> getters,setters): Update. + (-insn-parse,insn-read,define-full-insn): Update. + * minsn.scm (minsn-make-alias): Update. + * iformat.scm (ifmt-analyze): Delete insn-condition reference. + (ifmt-compute!): Ditto. + * sim.scm (sim-finish!): Update. + * simplify.inc: (define-normal-insn): Update. + + * iformat.scm (-ifmt-lookup-ifmt!): Use insn-set-ifmt!. + (-ifmt-lookup-sfmt!): Use insn-set-sfmt!. + (ifmt-compute!): Ditto. + +1999-06-16 Doug Evans <devans@casey.cygnus.com> + + * minsn.scm (minsn-compute-iflds): Print better error message for + missing ifields. + +1999-06-12 Doug Evans <devans@casey.cygnus.com> + + * rtl.scm (tstate->estate): Don't copy over expr-fn. + + * Makefile.am (HOBFLAGS): New variable. + (cgen-hob.c): Use it. + (hobbit.c): Use it. + (libcpu_a_SOURCES): Add hob-sup.c. + (hob-sup.o): New rule. + * Makefile.in: Rebuild. + * cgen.c: #include hob-sup.h. + (cgen_init_c): Call hobbit_init_support. + * hobbit.scm (*fastcall-make*,*c-symbol*): New variables. + (*special-scm->c-functions*): Add them. + (display-c-expression): Handle *c-symbol*. + (*reckless-s->c-fun-table*): Add *fastcall-make*, fastcall5. + (*floats-s->c-fun-table*): Ditto. + (normalize): Recognize /fastcall-make. + (normalize-fastcall-make): New proc. + * hobbit.c,hobbit.h: Rebuild. + * hob-sup.scm: New file. + * hob-sup.c: New file. + * hob-sup.h: New file. + * read.scm: Load hob-sup.scm. + * rtl.scm (-rtx-name-list): New variable. + (rtx-name-list): New proc. + (rtx-lookup): Try symbol first. + (def-rtx-node): Add name to -rtx-name-list. + (def-rtx-syntax-node,def-rtx-operand-node,def-rtx-macro-node): Ditto. + (-rtx-traverse-anymode): New proc. + (-rtx-traverse-{emode,intmode,floatmode,nummode,vmmode}): New procs. + (-rtx-traverse-{rtx,setrtx,testrtx,condrtx,casertx}): New procs. + (-rtx-traverse-{locals,env,attrs,symbol,string,number}): New procs. + (-rtx-traverse-{symornum,object}): New procs. + (-rtx-make-traverse-table): Rewrite. + (-rtx-traverse-operands): Rewrite arg-types handling. + Handle #f result of traverser. + (-rtx-traverse): Renamed from -rtx-traverse-normal. + Move debug handling here. + (-rtx-traverse-debug): Delete. + (rtl-finish!): Change -rtx-traverse-table into list of handlers + for each rtx. + * semantics.scm (semantic-compile:process-expr!): Fix call to + -rtx-traverse. + * utils.scm (map1-improper): New proc. + +1999-06-08 Doug Evans <devans@casey.cygnus.com> + + * arm.sim (h-tbit): Replace FUN-ACCESS with FUN-SET. + (h-mbits): Ditto. + +1999-06-07 Doug Evans <devans@casey.cygnus.com> + + * thumb.cpu (dnti): Delete timing spec. + (all insn): Update. + + * arm.cpu (arm isa): New fields condition, setup-semantics. + (thumb isa): New field setup-semantics. + (h-gr): Add attribute CACHE-ADDR. + * arm7.cpu (dnai): Delete condition. + (eval-cond): Delete. + + * mach.scm (<isa>): New member setup-semantics. + (-isa-parse-setup-semantics): New proc. + (-isa-parse): New arg setup-semantics. + (-isa-read): Recognize setup-semantics. + + * utils-cgen.scm (obj-set-name!): New proc. + + * attr.scm (-attr-eval): Rewrite calls to rtx-simplify/rtx-compile. + * iformat.scm (ifmt-analyze): Pass `insn' to semantic-compile, + semantic-attrs. + (ifmt-compute!): Delete arg `arch'. Result is list of iformats, + sformats. + * mach.scm (arch-analyze-insns!): Update call to ifmt-compute!. + * rtl-c.scm (rtl-c-get): Use DM for default mode instead of VM. + Avoid infinite loop when rtx-eval-with-estate leaves expr alone. + (attr): Rewrite test for insn owner. + (member): New rtx function. + * rtl.scm (rtx-* accessors): Define as cxr directly rather than + as separate function. + (rtx-ifield?,rtx-ifield-name): New procs. + (rtx-operand-obj): Rewrite. + (rtx-operand-name): New proc. + (rtx-cmp-op-mode,rtx-cmp-op-arg): New procs. + (rtx-number-list-values,rtx-member-value,rtx-member-set): New procs. + (tstate-make): New args owner, known. All callers updated. + (tstate-known-lookup): New proc. + (rtx-traverse): New arg owner. All callers updated. + (rtx-make-bool): New proc. + (rtl-find-ifields): Rewrite. + (rtx-simplify,rtx-simplify-eq-attr-{insn,mach}): Moved to ... + * semantics.scm: ... here. + (rtx-const-equal,rtx-const-list-equal): New procs. + (-build-known-values): New proc. + (semantic-compile): New arg `insn'. Call rtx-simplify. + (semantic-attrs): Ditto. + * rtx-funcs.scm (member,number-list): New rtx functions. + + * attr.scm (attr-remove-meta-attrs-alist): Delete leading '-' in name. + Rewrite. Delete arg `all-attrs'. All callers updated. + (attr-remove-meta-attrs): Delete leading '-' in name. All callers + updated. + * utils-cgen.scm (gen-bool-attrs): Remove meta attrs. + + * decode.scm (subdtable-add): Handle `expr' entries. + (exprtable-entry-make): Use vector. Record ifields refered to by expr. + (exprtable-entry-*): Update. + (exprtable-entry-iflds): New proc. + (exprentry-cost): New proc. + (exprtable-sort,-gen-exprtable-name): New procs. + (exprtable-make): New arg `name'. All callers updated. use vector. + (exprtable-*): Update. + (-build-decode-table-entry): Don't issue collision warning if all are + specialized insns. Sort exprtable entries before building table. + + * read.scm (-reader-process-expanded-1): Move pretty printing of + input to logging level 4. + + * utils.scm (string-list->string): New proc. + + * insn.scm (<insn>): Define setters for ifield-assertion, condition, + semantics. + (insn-read): Delete leading '-' in name. All callers updated. + (real-insn?): New proc. + (real-insns): Rewrite. + (insn-has-ifield?): New proc. + (insn-builtin!): Create insn attribute SPECIALIZED. + + * mach.scm (<arch>): Delete member app-data. + (current-raw-insn-list): New proc. + (insn-list-car,insn-list-splice!): New procs. + (<decode-specialize>): New class. + (-isa-parse-decode-specialize): New proc. + (-isa-parse-decode-specializes): New proc. + (<isa>): New members `condition', `decode-specializes'. + (-isa-parse-condition): New proc. + (-isa-parse): New args condition, decode-specializes. + (-isa-read): Recognize condition, decode-specializes. + (-isa-add-decode-specialize!): New proc. + (modify-isa): New proc. + (isa-conditional-exec?,state-conditional-exec?): New procs. + (arch-init!): New reader command `modify-isa'. + + * mode.scm (mode-class-signed?,mode-class-unsigned?): New procs. + (mode-signed,mode-unsigned?): New procs. + +Thu Jun 3 16:00:40 1999 Doug Evans <devans@canuck.cygnus.com> + + * types.scm (<array>): New method get-shape. + * hardware.scm (<hardware-base>): Forward get-shape,get-num-elms + onto type. + (hw-shape,hw-num-elms): New procs. + * sim.scm (<hw-register>,gen-profile-index-type): Use "unsigned short" + if there's more than 255 registers. + + * hardware.scm (-hw-parse): Flag as error CACHE-ADDR specified + with get/set specs. + +1999-05-10 Ben Elliston <bje@cygnus.com> + + * arm7.cpu: Remove coprocessor related fields, operands and insn + definitions for now. Take the undefined instruction trap instead. + (ldmda-wb): New instruction. + (ldmib-wb): Likewise. + (ldmdb-wb): Likewise. + (stmdb-wb): Likewise. + (stmib-wb): Likewise. + (stmda-wb): Likewise. + +1999-05-08 Doug Evans <devans@casey.cygnus.com> + + + * utils-cgen.scm (keyword-list->arg-list): Fix call to substring, + hobbit can't handle optional third arg. + +1999-05-07 Doug Evans <devans@casey.cygnus.com> + + * arm.cpu (h-tbit): Delete set spec. + (h-mbits): Don't call arm_mbits_set in set spec. + * arm.sim: New file. + * hardware.scm (modify-hardware): New proc. + (hardware-init!): Add modify-hardware command. + * utils-cgen.scm (keyword-list?): New proc. + (keyword-list->arg-list,arg-list-validate-name): New procs. + (arg-list-check-no-args,arg-list-symbol-arg): New procs. + + * arm7.cpu (eval-cond): Pass pc to @cpu@_eval_cond handler. + + + * attr.scm (obj-prepend-atlist!): New proc. + + * opc-opinst.scm (cgen-opinst.c): Analyze instructions if necessary. + + * sim.scm (<operand>,profilable?): Use op:type. + +1999-05-04 Doug Evans <devans@casey.cygnus.com> + + * utils.scm (find-index,find): Be more stack friendly. + + * arm7.cpu (arith-imm-op): Compute pc before setting cpsr. + (bic-imm): Ditto. + +1999-05-01 Doug Evans <devans@casey.cygnus.com> + + * arm.cpu (h-gr-usr): New hardware element. + (h-gr-fiq,h-gr-svc,h-gr-abt,h-gr-irq,h-gr-und): New hardware elements. + (arm-mode): New keyword. + (h-mbits): Add set spec. + (h-spsr): Implement get/set specs. + + * read.scm: Load slib/pp.scm, slib/genwrite.scm. + (-reader-process-expanded-1): Pretty print logging output. + + + * utils-cgen.scm (context-error): Accept variable number of + trailing args. + + * rtx-funcs.scm (error:): New rtx function. + * rtl-c.scm (s-case-vm): New proc. + (-gen-non-vm-case-get,s-case-non-vm): New procs. + (s-case): Simplify, handle non-VM result. + (error:): New rtx function. + +1999-04-30 Doug Evans <devans@casey.cygnus.com> + + * arm.cpu (h-pc): Add set spec to zero bottom bits. + (test-hi,test-ls): Fix cbit handling. + (shift-type,h-operand2-shifttype): Move here ... + * arm7.cpu: ... from here. + (set-cond,set-cond-maybe,dnix): Delete, unused. + (set-zn-flags,set-logical-cc,set-add-flags,set-sub-flags): Move ... + * arm.cpu: ... to here. + * thumb.cpu (cmp,alu-cmp): Use set-sub-flags. + (alu-cmn): Use set-add-flags. + (alu-tst): Use set-zn-flags. + (alu-cmp): Use set-sub-flags. + (lsl,lsr,asr): Set condition codes. + (add,addi,sub,subi,mov,addi8,subi8): Ditto. + (alu-op): Split into three: alu-logical-op,alu-arith-op, + alu-shift-op. + (hireg-op): Split sem-fn into lo-dest-sem-fn,hi-dest-sem-fn. + All callers updated. + (sub-sp): Rename from add-sp-neg. + (f-lbwl-offset): Delete. + (f-lbwl-hi,f-lbwl-lo): New ifields. + (lbwl-hi,lbwl-lo): Update. + (bl-hi): Add 4 to pc. + (push-reg,pop-reg): Simplify. + (push,push-lr): Push registers in correct order. + (pop,pop-pc): Pop registers in correct order. + (save-reg-inc,load-reg-inc): Simplify. + (ldmia): Save registers in correct order. + +1999-04-30 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (f-op-hdt): Remove; unused. + (f-ror-imm8-value,f-ror-imm-rotate): New fields. + (f-ror-imm8): New multi-ifield. + (f-operand2-bit7): Remove; use the generic `f-bit7' instead. All + callers updated. + (f-uimm12): New field. + (ror-imm8): New operand. + (uimm12): Likewise. + (hdt-offset8): Reinstate operand. + (offset4-hi,offset4-lo): Remove. + (set-cond): Remove macro; unused. + (set-cond-maybe): Likewise. + (load-word/byte): Use uimm12 operand for a true 12-bit immediate. + (store-word/byte): Likewise. + (load-halfword): Use hdt-offset8 multifield operand instead of two + 4-bit operands that are explicitly combined by semantic code. + (do-halfword-store): Bug fix. Set address when not preindexing. + (store-halfword): Also use hdt-offset8 operand. + (arith-op): Avoid clobbering source registers when one of them is + the destination register. + (arith-imm-op): Likewise. + (tst-imm): Use ror-imm8 operand. Handle special case of rot 0. + (teq-imm): Likewise. + (ldm-p): Rename to ldmdb. + (stm-pw): Rename to stmdb-wb. + (multi-action): New macro; test reg-list bits and execute a + semantic fn if the bit is set. + (ldmda,ldmib,ldmia,ldmia-wb,ldmdb): New multiple load insns. + (stmdb,stmib,stmia,stmia-wb,stmda,stmdb-wb): Store insns. + (all insns): Use dnai entries for simplicity rather than dni. + (*): Use short-form of (const ..). + +1999-04-29 Doug Evans <devans@casey.cygnus.com> + + * rtl.scm (<rtx-func>): Rename member type to style. Rename + member eval to evaluator. + (rtx-foo accessors): Rename from rtx:foo. All callers updated. + (tstate-make): Delete arg op-fn. All callers updated. + (tstate-op-fn,tstate-set-op-fn!): Delete. + (rtx-traverse): Delete op-fn arg. All callers updated. + * semantics.scm (-simplify-for-compilation-process-expr): New proc, + split out of -simplify-for-compilation. + + * Makefile.am (CGEN_NONHOB_FILES,CGENFILES): New variables. + (cgen_DEPENDENCIES): Add stamp-cgen. + (stamp-cgen): New rule. + * Makefile.in: Rebuild. + + * rtl-c.scm (enum:): Define emitter for. + * rtl.scm (rtx-constant?): Rename from rtx-const? and check for + enums as well. + (rtx-constant-value,rtx-enum-value): New procs. + (-rtx-traverse-normal): Expand enum-value to (enum enum-value). + (rtx-compile-time-constant?): Return #t for enums. + (rtx-true?,rtx-false?): Handle enums. + (rtx-simplify-eq-attr-mach): Use rtx-true,rtx-false instead of + building result by hand. + (rtx-simplify-eq-attr-insn): Ditto. + * rtx-funcs.scm (enum:,enum): New rtx functions. + + * mach.scm (<arch>): New members insns-analyzed?, semantics-analyzed?, + aliases-analyzed?. + (arch-analyze-insns!): New proc. + * opcodes.scm (opcodes-analyze!): Call arch-analyze-insns! instead + of calling ifmt-compute! directly. + * sim.scm (-sim-insns-analyzed?): Delete. + (sim-analyze!): Call arch-analyze-insns! instead of calling + ifmt-compute! directly. + + * utils.scm (string-take-with-filler): New proc. + (string-take): Use it. + + * pgmr-tools.scm: New file. + * read.scm: Load it. + * insn.scm (pretty-print-insn-format): Move to pgmr.scm. + + * insn.scm (insn-base-mask): Renamed from insn:mask. + All callers updated. + (insn-base-mask-length): Renamed from insn:mask-length. + All callers updated. + (insn-foo): Renamed from insn:foo. All callers updated. + * minsn.scm (minsn-foo): Renamed from minsn:foo. All callers updated. + * iformat.scm (compute-insn-base-mask-length): Renamed from + compute-insn-mask-length. All callers updated. + (compute-insn-base-mask): Renamed from compute-insn-mask. + All callers updated. + + * enum.scm (-enum-parse-prefix): New proc. + (<enum>,make!): Don't parse enum values here. + (-enum-parse): Do it here. Call -enum-parse-prefix. + (define-full-insn-enum): Ditto. + (enum-vals-upcase): New proc. + * hardware.scm (define-keyword): Make enum prefix uppercase. + * hobscmif.h (CHAR_LOWERP,CHAR_UPPERP,CHAR_WHITEP): New macros. + + * ifield.scm (<ifield>,field-mask): Allow container to be #f. + (<ifield>,field-extract): New method. + (<multi-ifield>,field-extract): New method. + (ifld-extract): New proc. + * opcodes.scm (ifld-insert-fn-name): Renamed from ifld-insert. + (ifld-extract-fn-name): Renamed from ifld-extract. + + * ifield.scm (ifld-new-value): Renamed from ifield-make. + All callers updated. + + * ifield.scm (ifld-lsb0?): New proc. + (sort-ifield-list): New arg up?. All callers updated. + * iformat.scm (compute-insn-mask): Get lsb0? flag from argument, + rather than global state. + +1999-04-27 Doug Evans <devans@casey.cygnus.com> + + * insn.scm (pretty-print-insn-format): New proc. + + * Makefile.in: Rebuild. + * aclocal.m4: Rebuild + * configure: Rebuild. + +Mon Apr 26 10:30:18 1999 Doug Evans <devans@canuck.cygnus.com> + + * configure.in (AM_INIT_AUTOMAKE): Update version to 0.7.2. + * configure: Rebuild. + * aclocal.m4: Rebuild. + * Makefile.in: Rebuild. + * doc/Makefile.in: Rebuild. + * doc/version.texi: Rebuild. + +1999-04-25 Doug Evans <devans@casey.cygnus.com> + + * utils.scm (bits->bools): New proc. + +1999-04-23 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (ldrsh-pu): Remove. + (do-halfword-load): New pmacro. + (load-halfword): Likewise. + (do-halfword-store): Likewise. + (store-halfword): Likewise. + (strh-*): New instructions. + (ldrsb-*): Likewise. + (ldrh-*): Likewise. + (ldrsh-*): Likewise. + +1999-04-22 Doug Evans <devans@casey.cygnus.com> + + * ifield.scm (ifld-constant?): Delete special handling of RESERVED + fields. + + * arm7.cpu (do-word/byte-store): Fix typo. + +1999-04-22 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (do-word/byte-load): Handle cases where the destination + register is the program counter (R15). + + * arm7.cpu (do-word/byte-store,store-word/byte): New pmacros. + (str-*): Implement using store-word-byte. Remove older versions. + (bic): Use the `inv' rtx for obtaining bitwise complements. + (bic-imm): Likewise. + (mvn): Likewise. + (mvn-imm): Likewise. + (store-indev-reg): Remove crufty pmacro. + (load-indiv-reg): Likewise. + (ldm-p): Reverse the order of register processing for decrement. + (stm-p): Likewise. + (stbi): Remove; handled by the str-* insns. + +1999-04-21 Doug Evans <devans@casey.cygnus.com> + + * thumb.cpu (cmp): Fix carry bit computation. + (alu-cmp): Ditto. + +1999-04-20 Doug Evans <devans@casey.cygnus.com> + + * arm.cpu (h-tbit): Specify set spec. + (h-cpsr): Ditto. + * arm7.cpu (bx): Don't call C routine, just set h-tbit. + (set-sub-flags): Interpret "carry bit" as a borrow. + (all sub/cmp insns): Carry bit is actually a borrow bit. + * thumb.cpu (bx-rs,bx-hs): Don't call C routine, just set h-tbit. + (add-carry,sub-carry,thumb-neg,thumb-bic,thumb-inv): Delete. Use + .pmacro instead. + (hireg-add,hireg-cmp,hireg-move): Ditto. + + * read.scm (-CGEN-VERSION): Change version to 0.7.2. + (-CGEN-LANG-VERSION): Ditto. + +1999-04-18 Doug Evans <devans@casey.cygnus.com> + + * pmacros.scm (-pmacro-make): New arg `default-values', + all callers updated. + (-pmacro-default-values): New proc. + (-pmacro-process-keyworded-args): New proc. + (-pmacro-process-args): New proc. + (-pmacro-invoke): Process arguments before expanding macro. + (-pmacro-get-arg-spec,-pmacro-get-default-values): New procs. + (define-pmacro): Handle default values specified in arg list. + * rtl.scm (rtx-alu-op-mode,rtx-alu-op-arg): New procs. + (rtx-boolif-op-arg[01]): New procs. + (rtx-true,rtx-false,rtx-canonical-bool): New procs. + (rtx-simplify): Handle not,orif,andif. + * semantics.scm (-simplify-for-compilation): Simplify not,orif,andif. + * utils.scm (alist-copy): New proc. + * arm7.cpu (do-word/byte-load,load-word/byte): New pmacros. + (ldr*): Rewrite. + (swi): Explicitly set pc. + + * thumb.cpu (bx-rs,bx-hs): Reverse test for switch to arm mode. + +1999-04-17 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (ldr-pu): Do not add 8 to R15; the step() method + correctly adjusts the program counter now. + + * arm7.cpu (f-halfword?): Rename from `f-hdt-halfword?'. + (f-signed?): Rename from `f-hdt-signed?'. + (f-offset4-hi): Rename from `h-hdt-off4-ms'. + (f-offset4-lo): Rename from `h-hdt-off4-ls'. + (f-hdt-offset8): Use new field names. + (ldr): Use `imm12' field, not `offset12', since we do our own + address arithmetic. + (str, str-*): Likewise. + (ldu-*): Remove most; better not implemented than broken. + (ldrh*): Likewise. + (ldrsh-pu): New insn. + (stri): Likewise. + (stri-p): Likewise. + (stbi): Likewise. + (ldm-p): Likewise; replace (load-indiv-reg) version. + +1999-04-15 Doug Evans <devans@casey.cygnus.com> + + * arm.cpu (h-pc): Delete VIRTUAL attribute, get/set specs. + * arm7.cpu (*): Fix mode of result of arm_compute_carry_out_*. + (*): Explicitly specify mode in c-call. + (logical-op): Recognize sets of h-gr[15] as sets of pc. + (arith-op): Ditto. + (and-imm,orr-imm,xor-imm,mov-imm,bic-imm,mvn-imm): Ditto. + (arith-imm-op): New pmacro. + (add-imm,adc-imm,sub-imm,sbc-imm,rsb-imm,rsc-imm): Use it. + * thumb.cpu (bx-rs,bx-hs): Rewrite. + +1999-04-14 Doug Evans <devans@casey.cygnus.com> + + * rtl.scm (rtx-simplify-eq-attr-insn): Fix call to context-error. + + * rtl.scm (rtl-find-ifields): Implement. + + * utils-gen.scm: New file. + * read.scm: Load it. + * desc.scm: Move generic attribute code to utils-gen.scm. + * Makefile.am (CGEN_HOB_INPUT_FILES): Add it. + * Makefile.in: Rebuild. + + * arm7.cpu (R15-OFFSET): New attribute. + (dnai): New pmacro. + (logical-op): Delete arg `result?'. All callers updated. Use dnai. + Delete use of eval-cond (dnai specifies it). Specify R15-OFFSET of 12 + for reg-shift version. + (arith-op): Ditto. + (data processing insns): Reorganize. Use dnai. + + * attr.scm (attr-kind): New proc. + (attr-list-enum-list): Rewrite. + (-attr-sort): Split result into two lists, bools and non-bools. + (current-attr-list-for): Update. + + * thumb.cpu (bx-rs): Rename @cpu@_do_bx to @prefix@_do_bx. + (bx-hs): Ditto. + (swi): Rename @cpu@_swi to @prefix@_swi. + + * decode.scm (-build-decode-table-entry): Remove heuristic for + distinguishing insns, and use insn ifield-assertion specs. + + * desc-cpu.scm (gen-A-attr-mask): Simplify. + (gen-ifld-defns): Boolean attributes begin at number 0 now. + (gen-hw-table-defns,gen-operand-table,gen-insn-table): Ditto. + * opc-itab.scm (-gen-macro-insn-table): Ditto. + * utils-cgen.scm (gen-attr-enum-decl): Change type arg to prefix, + all callers updated. + (gen-attr-name): New proc + (gen-attr-mask): Use it. Boolean attributes start at 0 now. + (gen-obj-attr-defn): Delete num_nonbools count. + + * iformat.scm (ifmt-analyze): Handle insn-condition. + (ifmt-compute!): Ditto. + * insn.scm (<insn>): Specify default value for condition, + post-cond-trap,compiled-condition,compiled-semantics. + (<insn>,make!): New arg condition. + (<insn>): Add getters for condition,compiled-condition. + (-insn-parse): New arg condition, all callers updated. + (-insn-read): Recognize condition spec. + (define-full-insn): New arg condition. + * minsn.scm (minsn-make-alias): Update call to (make <insn> ...). + * semantics.scm (semantic-compile): Change arg sem-code to + sem-code-list. + (semantic-attrs): Ditto. + * sim.scm (sim-finish!): Update calls to define-full-insn. + * simplify.inc (define-normal-insn): Update call to define-full-insn. + +Tue Apr 13 17:04:34 1999 Doug Evans <devans@canuck.cygnus.com> + + * Makefile.am (sim-cpu): Allow specification of ISA. + * Makefile.in: Rebuild. + +Sun Apr 11 00:37:56 1999 Jim Wilson <wilson@cygnus.com> + + * i960.cpu (sll-expr, srl-expr, sra-expr): Handle large shift counts. + +1999-04-10 Doug Evans <devans@casey.cygnus.com> + + * sparccom.cpu (check-fp-enable): Wrap TRAP32_FP_DIS in c-code. + + * arm.cpu (gr-names): Put pc first so it gets prefered in disassembly. + + * attr.scm (atlist?): New proc. + (-attr-eval): Rewrite. + (attr-parse): New proc. + (atlist-parse): Use it. + + * decode.scm (exprtable-entry-make): New proc. + (exprtable-entry-insn,exprtable-entry-expr): New procs. + (exprtable-make,exprtable-insns): New procs. + + * hardware.scm (hw-mode-ok?): Delete argument `set?'. + All uses updated. + (hardware-builtin!): Make h-memory a vector. + + * iformat.scm (ifmt-ifields): Renamed from ifmt-fields. + All callers updated. + (ifmt-analyze): Use csem-* accessors on result of semantic-compile. + + * insn.scm (<insn>). Rename ifld-assertions to ifield-assertion. + All uses updated. + (-insn-parse): Set semantics to #f if not specified. + (define-insn,define-full-insn): Take out code that ignores ALIAS's + if simulator. + (-parse-insn-format): Recognize `=' iformat spec. + + * mach.scm (isa-min-insn-bitsize): Ignore ALIAS's. + (isa-max-insn-bitsize): Ditto. + + * opcodes.scm (<ifield>,gen-insert): Call rtl-c instead of + rtl-c-with-alist. + (<ifield>,gen-extract): Ditto. + (<multi-ifield>,gen-insert,gen-extract): Ditto. + * sim-cpu.scm (gen-semantic-code): Rewrite. + * sim.scm (-gen-ifld-extract-base): Call rtl-c instead of + rtl-c-with-alist. + (-gen-ifld-extract-beyond): Ditto. + (<multi-ifield>,gen-ifld-extract): Ditto. + (<hw-register>,gen-get-macro,gen-set-macro): Ditto. + (<*>,cxmake-get,gen-set-quiet,gen-set-trace,gen-write): Update to new + rtl evaluation code. + (op:read): Build an <eval-state> to pass to gen-read. + (op:write): Build an <eval-state> to pass to gen-write. + (op:record-profile): Build an <eval-state> to pass to + gen-record-profile. + + * operand.scm (<operand>): Give `selector' default value of #f. + Give `num' default value of -1. Give `cond?' default value of #f. + (op:new-mode): Delete arg `set?', all uses updated. + + * read.scm (reader-error): Handle #f return from port-filename. + (-init-parse-cpu!): Call rtl-c-init!. + (reader-install-builtin!): Call rtl-builtin!. + + * rtl-c.scm: New file. + * semantics.scm: New file. + * read.scm: Load them. + * rtl.scm: C generation moved to rtl-c.scm. Semantic analysis moved + to semantics.scm. + (<rtx-func>): Delete members syntax?,macro,c,expr. New members + type,eval,num. + (rtx-lookup): Renamed from -rtx-func-lookup. All callers updated. + (-rtx-num-text,-rtx-max-num): New globals. + (def-rtx-operand-node,define-rtx-operand-node): New procs. + (-rtx-macro-lookup): New proc. + (rtx-lvalue-mode-name): Renamed from rtx-expr-mode-name. + (rtx-env-stack-empty?,rtx-env-stack-head): New procs. + (rtx-env-var-list,rtx-env-empty-stack,rtx-env-init-stack1): New procs. + (rtx-env-make,rtx-env-empty?,rtx-env-make-locals): New procs. + (rtx-env-push,rtx-temp-lookup,-rtx-closure-make): New procs. + (rtx-make,rtx-kind?,rtx-const?,rtx-const-value,rtx-symbol-name, + rtx-operand?,rtx-operand-obj,rtx-local?,rtx-local-obj, rtx-xop-obj, + rtx-index-of-value,rtx-if-mode,rtx-if-test,rtx-if-then,rtx-if-else, + rtx-eq-attr-owner,rtx-eq-attr-attr,rtx-eq-attr-value): New procs. + (rtx-pretty-name): New proc. + (-rtx-traverser-table,-rtx-make-traverse-table): New procs. + (rtx-traverse-*): Rewrite rtx traversing. + (rtx-eval-*): Rewrite rtx evaluation. + (rtx-compile): New proc. + (rtx-simplify): New proc. + (rtx-simply-eq-attr-mach,rtx-simplify-eq-attr-insn): New procs. + * rtx-funcs.scm: C generation moved to rtl-c.scm. + (ifield,index-of): Rewrite. + (name): Renamed from `operand:'. + (operand,xop,local): New rtx's. + (current-insn): Rewrite. + * Makefile.am (CGEN_HOB_INPUT_FILES): Add rtl-c.scm, semantics.scm. + (cgen-hob.h): Remove rule for. + (cgen-hob.o): Depend on cgen-hob.c only. + * Makefile.in: Rebuild. + + * utils-cgen.scm (vmake): New proc. + (<context>): New class. + (context-make-prefix,context-error): New procs. + +Fri Apr 9 19:26:28 1999 Jim Wilson <wilson@cygnus.com> + + * i960.cpu: Add some ??? comments. + (xnor, ornot): New instructions. + (*): Delete obsolete COND-CTI and UNCOND-CTI attributes. + +1999-04-08 Doug Evans <devans@casey.cygnus.com> + + * cos.scm (-object-error): Print better error message. + + * pmacros.scm (-pmacro-env-make): Renamed from -env-make. + (-pmacro-env-ref): Renamed from -env-ref. + +1999-03-31 Doug Evans <devans@casey.cygnus.com> + + * hardware.scm (<hw-pc>,parse!): Allow get/set specs. + (h-pc): Delete. + (hardware-builtin!): Delete h-pc builtin. + * arm.cpu (h-pc): Define. + (h-gr): Delete get,set specs. Make array of 16 regs again. + * arm7.cpu (set-logical-cc-maybe): Delete. + (set-zn-flags,set-add-flags,set-sub-flags): New macros. + (data processing insns): Rewrite. + * m32r.cpu (h-pc): Define. + * fr30.cpu (h-pc): Define. + * i960.cpu (h-pc): Define. + * sparc.cpu (h-pc): Define. + + * rtl.scm (-rtx-traverse-operands): Add some error checking to LOCALS. + (s-parallel): Replace do {...} while (0) with {...}. + (s-sequence): Ditto. + + +1999-03-30 Doug Evans <devans@casey.cygnus.com> + + * sparccom.cpu (arith-cc-binop): New args s32-set-flags,s64-set-flags. + All callers updated. + (arith-carry-cc-binop): New arg set-flags. All callers updated. + + + * read.scm (-reader-process-expanded-1): New proc. + (-reader-process-expanded): Call it to catch nested begin's. + (reader-process): Move `begin' handling to -reader-process-expanded. + + * insn.scm (-insn-read): Fix name of `format' spec. + + * pmacros.scm (.pmacro): New builtin. + (scan-symbol): If procedure macro, return macro rather than its symbol. + (check-macro): Don't do lookup, instead check if (car expr) is + macro object. + (scan-list): Handle .pmacro. + (scan): No longer re-examine text for another macro invocation. + (-pmacro-build-lambda): New proc. + (define-pmacro): Rewrite. If defining one pmacro to be an alias of + another, fetch the other's value (rather than doing it during + expansion). + +1999-03-27 Doug Evans <devans@casey.cygnus.com> + + * Makefile.am (CGEN_HOB_INPUT_FILES): Add decode.scm. + * Makefile.in: Rebuild. + + * decode.scm (decode-get-best-bits): Use memq instead of element?. + (-fill-slot!): Simplify. + (-build-slots): Simplify. + + * sim-decode.scm: Replace computed goto decoder/extractor with plain + switch's. + +1999-03-26 Doug Evans <devans@casey.cygnus.com> + + * sim-decode.scm: Clean up pass. Move decoder computation into ... + * decode.scm: ... here. New file. + * read.scm: Load decode.scm. + + * arm.cpu (arm710 model): Add u-exec function unit. + (h-gr): Delete CACHE-ADDR for now. Make array of 15, not 16 regs. + Add get/set specs to redirect reg 15 to h-pc. + (h-*): Indicate for both ARM and THUMB isas. + (cbit,nbit,vbit,zbit): Ditto. + (h-ibit,h-fbit,h-tbit,h-mbits): New hardware elements. + (h-cpsr): Make virtual. Add get/set specs. + (h-spsr-fiq,h-spsr-svc,h-spsr-abt,h-spsr-irq,h-spsr-und): New hw. + (h-spsr): New virtual reg. + * arm7.cpu (shift-type): New explicitly defined keyword. + (h-operand2-shifttype): Use it. + (set-logical-cc-maybe): Delete carry-out arg. New args arg1,arg2. + All callers updated. Don't set cbit. + (logical-op): Add rm to ifield list. Change case to case:. Use + shift-type enum as case choices. Set cbit. + (and,orr,eor,add-imm): Uncomment out. + (undefined): Temporarily comment out. + * thumb.scm (mov,cmp,addi8,subi8,str-sprel,ldr-sprel): s/rd/bit10-rd/. + (lda-pc,lda-sp): Ditto. + (ldr-pc): Rename from ldr. + (cbranch): Mark insns as being thumb insns. + + * attr.scm (<bitset-attribute>,parse-value): Recognize strings. + + + * insn.scm (<insn>,iflds): Renamed from flds. All uses updated. + (<insn>,ifld-assertions): New member. + (<insn>,make!): New arg ifld-assertions, all callers updated. + (<insn> accessors): Change insn:foo to insn-foo. All callers updated. + (insn:fields): Delete. + (-insn-parse): New arg ifld-assertions. All callers updated. + (-insn-read,define-insn): New procs. + (define-full-insn): New arg ifld-assertions. All callers updated. + (insn-init!): New comment define-insn. + + * model.scm (-model-parse): Ensure at least one unit specified. + + * rtl.scm (-rtx-traverse-operands): Recognize environments. + (<c-expr-temp>,get-name): New method. + (-rtx-make-current-closure,s-closure): New proc. + (hw:): Wrap rtx indices in a closure. + (-gen-case-prefix): New proc. + (s-case): Simplify. + * rtx-funcs.scm (case:): Fix call to s-case. + (closure): New rtx func. + + * hardware.scm (<hardware-base>): New member isas-cache. + (<hardware-base>,get-isas): New method. + (hardware-builtin): Indicate for all isas. + * ifield.scm (-ifield-parse): Only keep if isa+mach are kept. + * mach.scm (current-arch-mach-name-list): Return list of names. + (current-isa-mach-name-list): Ditto. + (define-arch): Install builtin objects here. + * read.scm (keep-atlist?): Only keep if both mach and isa are + being kept. + (keep-mach-atlist?): New proc. + (keep-isa-multiple?,current-keep-isa-name-list): New proc. + (reader-install-builtin!): Renamed from -install-builtin!. + * sim.scm (sim-finish!): Specify isa of added x-* virtual insns. + +1999-03-22 Doug Evans <devans@casey.cygnus.com> + + * thumb.cpu (cpu,mach,model): Delete. + (dntf): New pmacro. Use it for all field definitions. + (dntop): New pmacro. Use it for all operand definitions. + (asr): Correct field list. + (add,addi,sub,subi,add-sp,add-sp-neg): Ditto. + + * utils-cgen.scm (define-getters): New macro to simplify + writing class accessors. + (define-setters): Ditto. + (sanitize): Recognize isa elements. + + * sim-decode.scm (-gen-decode-switch): Ditto. + + * sim-arch.scm (-regs-for-access-fns): Delete. + (-biggest-reg-mode,-gen-arch-reg-access-decls): Delete. + (-gen-arch-reg-access-defns): Delete. + + * sim-cpu.scm (*): Replace cpu:liw-insns with state-liw-insns, + cpu:parallel-insns with state-parallel-insns, cpu:parallel-exec? + with state-parallel=exec?. + (cgen-*): Call sim-analyze-insns! here. + * sim-decode.scm (cgen-*): Ditto. + * sim-model.scm (cgen-*): Ditto. + * sim.scm (-sim-insns-analyzed): New global variable. + (sim-init!): Reset it. + (sim-analyze-insns!): Renamed from sim-analyze!. Keep track if we've + already done the analysis. + + * sim-model.scm (-gen-mach-defns): Add mach attribute number to + MACH struct. + + * arm.cpu: Only include arm7.cpu,thumb.cpu if necessary. + (arm arch): Update isa spec. + (arm,thumb isas): Define. + (arm7 cpu): default-insn-bitsize,base-insn-bitsize moved to isas. + (arm7tdmi mach): Add isa spec. + * arm7.cpu (*): Replace subreg: with subword:. Remove unnecessary + `const' on word number. + * fr30.cpu (fr30 arch): Update isa spec. + (fr30 isa): Define. + (fr30bf cpu): default-insn-bitsize,base-insn-bitsize,decode-assist, + moved to isa spec. + * i960.cpu (i960 arch): Update isa spec. + (i960 isa): Define. + (i960base cpu): default-insn-bitsize,base-insn-bitsize,decode-assist, + liw-insns,parallel-insns moved to isas spec. + * m32r.cpu (m32r arch): Update isas spec. + (m32r isa): Define. + (m32rbf cpu): default-insn-bitsize,base-insn-bitsize,decode-assist, + liw-insns,parallel-insns moved to isa spec. + * sparc.cpu (sparc arch): Update isas spec. + (sparc isa): Define. + * sparc32.cpu (sparc32 cpu): default-insn-bitsize,base-insn-bitsize, + decode-assist moved to isa spec. + * sparc64.cpu (sparc64 cpu): Ditto. + * sparccom.cpu (trap insns): Correct mode of result of c-call:. + * desc-cpu.scm (-gen-isa-table-defns): New proc. + (-gen-mach-table-defns): Output mach table. + (-gen-hash-defines): Delete insn size macros, except for + CGEN_MAX_INSN_SIZE. + (-cgen-cpu-open): Rewrite cpu_open handling. Take stdarg list of args. + (cgen-desc.h): Define MAX_ISAS. + (cgen-desc.c): Include stdarg.h. Call -gen-isa-table-defns. + * mach.scm (<arch>): Rename arch-data to data. New member isa-list. + (arch-* accessors): Renamed from arch:*. All callers updated. + (current-arch-isa-name-list): New proc. + (-arch-parse-isas): Renamed from -arch-parse-isa. + (def-isa-attr!): Rewrite. + (<iframe>): New class. + (<itype>): New class. + (<isa>): Rewrite. + (isa-min-insn-bitsize,isa-max-insn-bitsize): New procs. + (isa-integral-insn?,isa-parallel-exec?): New procs. + (-isa-parse,-isa-read,define-isa): New proc. + (<cpu>): Members default-insn-bitsize,base-insn-bitsize,decode-assist, + liw-insns moved to <isa>. + (cpu-* accessors): Renamed from cpu:*. All callers updated. + (-cpu-parse,-cpu-read): Update. + (state-*): Renamed from state:*. All callers updated. + (state-default-insn-bitsize,state-base-insn-bitsize): Use isa spec, + not cpu. + (state-parallel-insns,state-parallel-exec?,state-liw-insns): New procs. + (state-decode-assist): New proc. + (<derived-arch-data>): Delete min-insn-bitsize,max-insn-bitsize. + (-adata-set-derived!): Rewrite. + (adata-integral-insn?): Renamed from adata:integral-insn?. All + callers updated. + (arch-init!): Add define-isa command. + * read.scm (<reader>): Default keep-isa member to (all). + (reader-* accessors): Renamed from reader:*. All callers updated. + (-keep-isa-set!): Call string->symbol on isa name list. + (keep-isa-validate!): Rewrite. + (current-isa): New proc. + (keep-isa?): Recognize "all". + (-init-parse-cpu!): New arg keep-isa. All callers updated. + Call -keep-isa-set!. + (cmd-if): Recognize keep-isa?. + (cpu-load): New arg keep-isa. All callers updated. + (-opt-spec-update): New proc. + (common-arguments): First arg is string, not symbol. + (-cgen): Call -opt-spec-update. Rewrite argument parsing. + + * rtl.scm (rtx-get): Default mode of string arg is INT. + + * rtl.scm (s-subword): Renamed from s-subreg. All uses updated. + + * rtx-funcs.scm (join:): Pass cpu to handler. + + * configure.in (guile_include_dir): Delete. + * configure: Rebuild. + * Makefile.in: Rebuild. + * doc/Makefile.in: Rebuild. + + +1999-03-22 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (ldri-p): New instruction. + (swi): Do not vector through 0x8 yet--there is nothing there. + (addi): Reinstate. + (movi): Likewise. + (all): Use (const x) in subreg expressions. + +1999-03-19 Ben Elliston <bje@cygnus.com> + + * arm7.cpu (smull): Use operand field `rs', not `mul-rn'. Thinko. + (smlal): Likewise. + +1999-03-17 Doug Evans <devans@casey.cygnus.com> + + * fr30.cpu (define-arch): Specify "forced" default-alignment. + * mach.scm (-parse-alignment): Recognize "forced" alignment. + * sim-cpu.scm (-extract-chunk-specs): New proc. + (gen-define-fields): Use it. + (-extract-chunk): New proc. + (-gen-extract-beyond-var-list): Use it. + (gen-extract-fields): Simplify. + + Port to guile 1.3.1. + * Makefile.am (GUILEINCDIR,GUILELDFLAGS,GUILELDADD): Delete. + (LIBIBERTY): New var. + (HOB_OBJS): Add cgen-gh.o. + (hobbit): Delete $(CFLAGS) from link, add $(LIBS) $(LIBIBERTY). + * Makefile.in: Rebuild. + * acconfig.h: Add HAVE_3_ARG_SCM_MAKE_VECTOR. + * config.in: Rebuild. + * configure.in: Add checks for libdl, libreadline, libnsl, libsocket, + libncurses, libtermcap. + Add checks for needed functions in guile 1.2 not in guile 1.3, + and vice versa. Add test for 3 argument scm_make_vector. + * configure: Rebuild. + * cgen-gh.c (scm_list_length,scm_list_append,scm_list_reverse): Provide + definitions if guile doesn't have them. + (gh_make_vector,gh_length,gh_vector_set_x,gh_vector_ref): + (cgh_vector): Replace gh_vector with gh_make_vector. Replace gh_vset + with gh_vector_set_x. + (cgh_qsort): Replace gh_list_length with gh_length. + * cgen-gh.h: Add decls for added functions. + (cgh_qsort): Don't declare if IN_HOBBIT. + * cos.c: Include config.h. Replace gh_vref with gh_vector_ref, + gh_vset with gh_vector_set_x, gh_list_length with gh_length, + scm_make_vector with gh_make_vector. + * cos.scm: Use vector-length instead of length on vectors. + * dev.scm (cload): Make varargs proc with keyword/value args. + * hobscmif.h: Include config.h, cgen-gh.h. Undef make_vector and + provide version that works with guile 1.2 or 1.3. + Include private copy of scmhob.h. + * scmhob.h: New file. Keep our own copy for now. + +Tue Mar 16 13:22:01 1999 Doug Evans <devans@canuck.cygnus.com> + + * rtl.scm (-rtx-traverse-error): Ensure expression is output in + plain text. + (-rtx-traverse-operands): Dump cx temp stack if debugging. + (-cx-temp-dump-stack): Pretty up output. + + * arm.cpu: comment out thumb.cpu until isa support ready. + * arm7.cpu (bl): Replace lr with (reg h-gr 14). + (f-imm12,f-offset24,swi,undef): Fix thinko, add `const'. + * thumb.cpu (h-gr-t,h-lr-t,h-sp-t,dnti,h-hiregs): s/MACH/ISA/. + + +1999-03-11 Doug Evans <devans@casey.cygnus.com> + + * hardware.scm (<hw-immediate>,mode-ok?): Ensure result is boolean. + (<hw-address>,mode-ok?): unsigned/signed are compatible. + + * operand (op:new-mode): Improve error message. + + * arm.cpu: Move arm isa into arm7.cpu. Include arm7.cpu, thumb.cpu. + * arm7.cpu: New file. + +1999-03-12 Ben Elliston <bje@cygnus.com> + + * arm.cpu: Lots of minor fixes after desk checking. + +1999-03-11 Doug Evans <devans@casey.cygnus.com> + + * thumb.cpu: snapshot of current work + + * rtl.scm (rtx-get): Tweak error message. + +1999-03-10 Doug Evans <devans@casey.cygnus.com> + + * Makefile.am (cos.o,cgen.o,cgen-gh.o): Fix dependencies. + * Makefile.in: Rebuild. + + * cos.c (cos_vector_copy): New function. + (_object_copy): Use it. + + * mode.scm (mode:eq?): Clean up. + * rtl.scm (cx-new-mode): Copy attributes. + (rtx-get): Don't make copy if <c-expr> with identical mode. + + * fr30.cpu (define-arch): Delete default-insn-word-bitsize, + add new isas spec. + (gr-names): h-gr register names moved here. + (h-gr): Update. + (cr-names): h-cr register names moved here. + (h-cr): update. + (dr-names): h-dr register names moved here. + (h-dr): update. + (h-ps): Replace FUN-ACCESS attribute with get/set specs. + (h-sbit,h-ccr,h-scr,h-ilm): Ditto. + * i960.cpu (define-arch): Delete default-insn-word-bitsize, + add new isas spec. + * m32r.cpu (define-arch): Delete default-insn-word-bitsize, + add new isas spec. + (gr-names): h-gr register names moved here. + (h-gr): Update. + (cr-names): h-cr register names moved here. + (h-cr): update. + (h-accum): Replace FUN-ACCESS attribute with get/set specs. + (h-accums,h-psw): Ditto. + * sparc.cpu (define-arch): Delete default-insn-word-bitsize, + add new isas spec. + (gr-names): h-gr register names moved here. + (h-gr-indices): Delete. + (sparc32 h-gr): Update. Replace FUN-ACCESS with get/set specs. + (sparc64 h-gr): Ditto. + (h-y): Add get/set specs. + (fp regs): Rewrite. + (fp operands): Rewrite. + * sparc32.cpu (h-psr): Replace FUN-ACCESS with get/set specs. + (h-tbr,h-cwp,h-wim): Ditto. + * sparc64.cpu (h-fpsr): Add get/set specs. + * sparccom.cpu (ldd-reg+reg): Load value all at once. + (fp-ld-op): New arg `dest', all callers updated. + (*): Replace `make-di' with `join'. + + + * sim-arch.scm (-regs-for-access-fns): New proc. + (-biggest-reg-mode): New proc. + (-gen-arch-reg-access-decls,-gen-arch-reg-access-defns): Rewrite. + * sim-cpu.scm (-gen-hardware-types): Output get/set handlers for + virtual regs separately. + (-gen-cpu-reg-access-defns): Replace fun-access? with new + get/set specs. + (gen-semantic-code): Save/restore rtl generator state. + (cgen-cpu.h): Call rtl-gen-init!. + (cgen-cpu.c): Ditto. #include cgen-ops.h. + * sim-model.scm: mach:cpu renamed to mach-cpu. mach:bfd-name + renamed to mach-bfd-name. + * sim.scm (-gen-ifld-extract-base): Update call to rtx-c-with-alist. + (-gen-ifld-extract-beyond): Ditto. + (<multi-ifield>,gen-ifld-extract): Ditto. + (<scalar>,gen-sym-get-macro): Update call to gen-get-macro. + (<scalar>,gen-sym-set-macro): Update call to gen-set-macro. + (all gen-read,gen-write,cxmake-get,gen-set-* methods): New arg + `gstate'. + (hw-fun-access?): Delete. + (-hw-gen-set-quiet-pc): New arg `gstate'. + (<hw-register>,gen-get-macro): Rewrite. + (<hw-register>,gen-set-macro): Rewrite. + (-hw-gen-fun-get,-hw-gen-fun-set): Delete. + (-hw-cxmake-get): New arg `gstate'. Rewrite. + (<hw-register>,cxmake-get-raw): New method. + (-hw-gen-set-quiet): New arg `gstate'. Rewrite. + (<hw-register>,gen-set-quiet-raw): New method. + (-gen-hw-index-raw): Update call to rtx-c. Update cxmake-get + invocation. + (-gen-hw-index): Ditto. + (<hw-index>): New arg `gstate'. + (-gen-hw-selector): Update call to rtx-c. + (<pc>): New arg `gstate'. + (op:read): Update gen-read invocation. + (op:write): Update gen-write invocation. + (<operand>,cxmake-get): Handle raw-reg. + (-op-gen-set-quiet,-op-gen-set-quiet-parallel): New arg `gstate'. + (-op-gen-set-trace,-op-gen-set-trace-parallel): Ditto. + (<operand>,gen-set-quiet): Handle raw-reg. + (<operand>,gen-set-trace): Handle raw-reg. + (-gen-mach-data): mach:cpu renamed to mach-cpu. + + * desc-cpu.scm (gen-operand-decls): Take nub of operands for + cgen_operand_type enum. + (gen-operand-table): Add operand type enum. Replace pointer to + hardware element with its enum. Null terminate table. + (-gen-cpu-open): Add new `isa' argument to @arch@_cgen_cpu_open. + Build operand table. + * ifield.scm (-ifield-parse): Recognize ISA attribute. + * mach.scm (<arch-data>): New member `isas'. + (adata-isas): New accessor. + (<isa>): New class. + (isa-default-insn-word-bitsize): New accessor. + (isa-enum): New proc. + (current-arch-default-insn-word-bitsize): Delete. + (current-isa-list,current-isa-lookup): New procs. + (-arch-parse-isa): New proc. + (-arch-parse): Rewrite. + (-arch-read): Recognize `isas'. Delete `default-insn-word-bitsize'. + (define-arch): Define ISA attribute. + (def-isa-attr!,isa-supports?): New procs. + (<mach>): New member `isas'. + (mach-isas): New accessor. + (-mach-parse): New arg `isas', all callers updated. + (-mach-read): Recognize `isas'. + (arch-finish!): Rewrite. + * opc-ibld.scm (-gen-fget-switch): Add `cd' arg to + @arch@_cgen_get_{int,vma}_operand. + (-gen-fset-switch): Add `cd' arg to @arch@_cgen_set_{int,vma}_operand. + * opc-opinst.scm (-gen-operand-instance): Output operand enum instead + of pointer to table entry. + * opcodes.scm (gen-switch): Handle multiply defined operands. + * operand.scm (op-sort): New proc. + + * hardware.scm (<hardware-base>): Rename getters/setters to get/set. + (hw-getter,hw-setter): Renamed from hw-getters,hw-setter. + (hw-enum): Accept symbol argument. + (hardware-builtin!): Delete attribute FUN-ACCESS. + * ifield.scm (ifld-encode-mode,ifld-decode-mode): New procs. + + * attr.scm (atlist-source-form): New proc. + (attr-builtin!): New attr `PRIVATE'. + * desc.scm (<keyword>,gen-defn): Make keyword entry table static. + * desc-cpu.scm (-gen-hw-defn): Only output index and value tables + if they have `PRIVATE' attribute. + (gen-hw-table-defns): Output definitions of explicitly defined + keyword tables. + * hardware.scm (<keyword>): New member print-name. Rename member + `value' to `values', all uses updated. + (kw-mode,kw-print-name,kw-prefix,kw-values): New procs. + (keyword-parse): Rewrite. + (-keyword-read): New proc. + (define-keyword): New proc. + (-hw-parse-keyword): New proc. + (-hw-parse-indices): Rewrite keyword handling, support new index spec + `extern-keyword'. + (-hw-parse-values): Ditto. + (-hw-parse-get,-hw-parse-set): Rewrite. + (hardware-init!): Add new comment define-keyword. + * mach.scm (<arch>): New member `kw-list'. + (arch:kw-list,arch_set-kw-list!): New accessors. + (current-kw-list,current-kw-add!,current-kw-lookup): New procs. + + * hardware.scm (<hw-register>,mode-ok?): Rewrite. + * mode.scm (mode-class-integral?): New proc. + (mode-class-float?,mode-class-numeric?): New procs. + (mode-integral?,mode-float?,mode-numeric?): New procs. + (mode-compatible?): New proc. + * opcodes.scm (<ifield>,gen-insert): Update alist arg to + rtx-c-with-alist. + (<ifield>,gen-extract): Ditto. + * rtl.scm (-rtl-simulator?,-rtx-current-obj): Delete. + (<gstate>): New class. + (gstate-simulator?,gstate-set-simulator?!): New accessors. + (gstate-context,gstate-set-context!): New accessors. + (gstate-macro?,gstate-set-macro?!): New accessors. + (gstate-make,gstate-copy): New procs. + (-rtl-current-gstate): New global. + (current-gstate-simulator?): New proc. + (current-gstate-context,current-gstate-macro?): New procs. + (current-gstate,current-gstate-set!): New procs. + (rtl-gen-init!): Rewrite. + (-rtx-valid-types): Add INTMODE, FLOATMODE, NUMMODE. + (tstate-make): New arg `gstate', all callers updated. + (tstate-set-expr-fn!,tstate-set-op-fn!): New accessors. + (tstate-set-cond?!,tstate-set?,tstate-set-set?!): New accessors. + (tstate-gstate,tstate-set-gstate!): New accessors. + (tstate-copy): New proc. + (tstate-new-cond?,tstate-new-set?): Rewrite. + (-rtx-traverse-operands): Handle INTMODE, FLOATMODE, NUMMODE. + (rtx-traverse): New arg `gstate', all callers updated. + (rtx-strdump): New proc. + (-simplify-for-compilation): New arg `gstate', all callers updated. + (semantic-in-out-operands): Ditto. + (semantic-attrs): Ditto. + (rtx-eval): Rewrite. New arg `gstate', all callers updated. + (rtx-eval-with-temps,rtx-eval-with-alist): Ditto. + (rtx-value): Rewrite. + (<c-expr>,gen-name): New method. + (<c-expr>,gen-set-quiet): New arg `gstate', all callers updated. + (<c-expr>,gen-set-trace): New arg `gstate', all callers updated. + (cx-new-mode): New proc. + (-rtx-c-with-tstate): New proc. + (rtx-c,rtx-c-with-temps,rtx-c-with-alist): New arg `gstate', all + callers updated. + (-rtx-mode): Rewrite. + (-rtx-mode-compatible?): New proc. + (<c-expr-temp>): New member `value'. + (cx-temp:value): New accessor. + (<c-expr-temp>,make!): Override default method. + (<c-expr-temp>,cxmake-get): Rewrite. + (<c-expr-temp>,gen-set-quiet): Rewrite. + (<c-expr-temp>,gen-set-trace): Rewrite. + (gen-temp-defs): Use cx-temp:value. + (record-temp!): New arg value, all callers updated. + (cx-temp:cx:make): Delete. + (-cx-temp-dump-stack): New proc. + (rtx-get): New arg `gstate', all callers updated. Do mode + compatibility checks. Ensure result has specified mode. + (rtx-set-quiet): New arg `gstate', all callers updated. + (rtx-set-trace): Ditto. + (s-c-call): New arg `tstate', all callers updated. + (s-c-raw-call): Ditto. + (s-unop,s-binop,s-binop-with-with,s-shop,s-boolifop,s-convop): Ditto. + (s-cmpop,s-if,e-if): Ditto. + (s-subreg): New proc. + (-par-new-temp!): New proc. + (-par-next-temp!): Rewrite. + (-par-replace-set-dests): Use -par-new-temp!. + (s-parallel): Rewrite temp handling. Use -rtx-c-with-state. + (s-sequence): Use -rtx-c-with-state. + * rtx-funcs.scm (*): Update. + (raw-reg:): New rtx function. + (make-di): Delete. + (join:,subreg:): New rtx functions. + + * insn.scm (<insn>): New members pre-cond-trap, condition, + post-cond-trap, compiled-condition. + + * insn.scm (syntax-break-out): Replace eval with current-op-lookup. + + * opcodes.scm (<pc>,cxmake-get): New arg `selector'. + + * utils-cgen.scm (parse-symbol): New proc. + (parse-string): New proc. + (gen-get-macro,gen-set-macro): New arg `index-args'. + (gen-set-macro2): Ditto. Enclose code in do { } while (0). + Prepend \ to newlines. + + * utils.scm (alist-remove-duplicates): Delete. + + +1999-03-05 Ben Elliston <bje@cygnus.com> + + * arm.cpu: New file. + +1999-03-03 Doug Evans <devans@casey.cygnus.com> + + * Makefile.am (CGEN_HOB_INPUT_FILES): Add hardware.scm. + * Makefile.in: Rebuild. + + * attr.scm (<integer-attribute>,parse-value-def): Tweak. + (-attr-parse): Validate default value. + + * read.scm (-CGEN-VERSION): Change to 0.7.1. + (-CGEN-LANG-VERSION): Ditto. + (-keep-all-machs): Renamed from -keep-all, all uses updated. + (<reader>): New member keep-isa plus accessors. + (-keep-isa-set!,keep-isa-validate!): New procs. + (keep-isa?,keep-isa-atlist?,keep-isa-obj?): New procs. + (common-arguments): New variable. + (cgen-usage,getarg,catch-with-backtrace,option-arg): New procs. + (-debug-repl,continue): New procs. + (-cgen,cgen): New procs. + * cgen-gas.scm: Rewrite. + * cgen-opc.scm: Rewrite. + * cgen-sim.scm: Rewrite. + * cgen-stest.scm: Rewrite. + + * gas-test.scm (gas-test-init!): Call opcodes-init!. + (gas-test-finish!): Call opcodes-finish!. + (gas-test-analyze!): Call opcodes-analyze!. + (<hw-asm>): New method test-data. + (<operand>,testdata): Rewrite. + * sim-test.scm (sim-test-init!): Call opcodes-init!. + (sim-test-finish!): Call opcodes-finish!. + (sim-test-analyze!): Call opcodes-analyze!. + (<hw-asm>): New method test-data. + (<operand>,testdata): Rewrite. + +1999-03-01 Doug Evans <devans@casey.cygnus.com> + + * fixup.scm (reverse!): Define if missing. + * *.scm: Use reverse! instead of list-reverse!. + + * utils.scm (leading-id-char?): New proc. + (id-char?): Rewrite. + (chars-until-delimiter): New proc. + * opc-itab.scm (extract-syntax-operands): Rewrite. + (strip-mnemonic): Rewrite. + (compute-syntax): Rewrite. + + * pmacros.scm (-pmacro-substr): New proc. + (pmacros-init!): Add builtin .substr. + +1999-02-26 Doug Evans <devans@casey.cygnus.com> + + * thumb.cpu: New file. + +1999-02-24 Doug Evans <devans@casey.cygnus.com> + + * Makefile.am (CGENCFLAGS): New variable. + (WITH_HOBBIT): Use automake conditional. + (CGEN_HOB_SRC): New variable. + (libcpu_a_SOURCES): Use $(CGEN_HOB_SRC). + (*.o): Compile with CGENCFLAGS. + (cgen-hob.c): Simplify. + (cgen-nohob.c): New rule. + (hobbit): Renamed from hob.x. + (CLEANFILES): Add cgen-nohob.c. + * Makefile.in: Rebuild. + * doc/Makefile.in: Rebuild. + * configure.in (AM_INIT_AUTOMAKE): Update CGEN version to 0.7.1. + (WITH_HOBBIT): Use AM_CONDITIONAL. + * configure: Rebuild. + * aclocal.m4: Rebuild. + + * sim-arch.scm (-gen-arch-reg-access-defns): Replace string-map + with string-write-map. + + * sim-cpu.scm (hw-need-storage?): New proc. + (-gen-hardware-types): Use it. + (gen-parallel-exec-elm): Call op-save-index?. + + * sim-decode.scm (cgen-decode.c): Call rtl-gen-init!. + + * sim.scm (-gen-ifld-extract-base): Use mode:class instead of + UNSIGNED attribute. + (-gen-ifld-extract-beyond): Ditto. + (<integer>): Delete all references. + (<sim-hardware>): Delete. + (hw-profilable?): New proc. + (<hardware-base>): New methods gen-get-macro,gen-set-macro. + (<hw-register>): Rename method get-index-mode to save-index?. + (<hw-register>): New methods gen-get-macro,gen-set-macro. + (<hw-register>,gen-sym-decl): Make virtual. + (<hw-memory>,gen-sym-decl): Make virtual. + (<hw-memory>): Rename method get-index-mode to save-index?. + (<hw-address>,gen-sym-decl): Make virtual. + (<operand>): New method save-index?. + (sim-init!): Delete calls to sim-hw-init!,sim-hw-init-parsers!. + + * opc-itab.scm (opc-{parse,insert,extract,print}-handlers): opc- + prefix added. All uses updated. + + * opc-opinst.scm (-gen-operand-instance): Output hw enum value + rather than pointer to table entry. + + * opcodes.scm: Remove all attribute support, lives in desc.scm. + Remove all hw-asm,op-asm support. + (-gen-parse-number,-gen-parse-address): New procs. + (<keyword>,gen-parse): Redo function name computation. + (<keyword>,gen-print): Ditto. + (<operand>,gen-function-name): Rewrite. + (<operand>,gen-fget,gen-fset,gen-parse,gen-print): Ditto. + (opcodes-init!): Delete call to add-parser!. + + * desc-cpu.scm (gen-hw-decls): Rename enum hw_type to cgen_hw_type. + Define enum using hardware semantic name. + (-gen-hw-decl,-gen-hw-defn): New procs. + (gen-hw-table-decls): Use -gen-hw-decl. + (gen-hw-table-defns): Use -gen-hw-defn. Rewrite generation of + CGEN_HW_ENTRY structs. + (gen-operand-table): Output hw's enum, not pointer to table entry. + (-gen-cpu-open): Build table of selected hardware elements. + + * desc.scm (-hw-asm-specs,-parse-hw-asm): Delete. + (<hardware> support): Delete. + (<hw-asm>): Delete, moved to hardware.scm. + (normal-hw-asm,hw-asm:parse,hw-asm:print): Delete. + (<hw-asm>,gen-table-entry): New method. + (<hw-asm>,parse!): Delete. + (<keyword>,gen-table-entry): New method. + (<keyword>,parse!): Delete. + (<hw-{register,memory,immediate,address}>): Delete forwarding methods + for gen-decl,gen-defn,gen-ref,gen-init. + (desc-init!): Don't create parser for operand asm specs. + + * attr.scm (attr-builtin!): Delete UNSIGNED attribute. + * ifield.scm (<ifield>): New member `mode'. + (<ifield>,make!): New arg `mode'. + (ifld-mode): Rewrite. + (ifld-hw-type): Rewrite. + (<ifield>,min-value): Rewrite. + (<ifield>,max-value): Rewrite. + (-ifield-parse): New arg `mode'. + (-ifield-read): Update. + (define-full-ifield): New arg `mode'. + (define-full-multi-ifield): Ditto. + (-multi-ifield-parse): Ditto. + (-multi-ifield-read): Update. + (define-full-multi-ifield): New arg `mode'. + (ifield-builtin!): Update definition of f-nil. + * simplify.inc (define-normal-ifield): Update call to + define-full-ifield. + (define-normal-multi-ifield): Update call to define-full-multi-ifield. + (define-normal-hardware): Delete arg asm. New args indices, values, + handlers. Update call to define-full-hardware. + (define-simple-hardware,dsh): New pmacros. + (define-normal-operand): Update call to define-full-operand. + * fr30.cpu (f-*): Delete UNSIGNED attribute. Default is now UNSIGNED. + Specify INT/UINT mode instead. + (h-gr,h-cr): Use "indices" instead of "asm". + (h-dr,h-ps): Update keyword syntax. + (h-r13,h-r14,h-r15): Ditto. + (h-nbit,h-zbit,h-vbit,h-cbit): Use dsh instead of dnh. + (h-d0bit,h-d1bit,h-ibit,h-sbit,h-tbit,h-ccr,h-scr,h-ilm): Ditto. + (m4): Fix typo on HASH-PREFIX. Use "handlers" instead of "asm". + (reglist_low_ld,reglist_hi_ld,reglist_low_st,reglist_hi_st): Ditto. + * i960.cpu (f-*): Delete UNSIGNED attribute. Default is now UNSIGNED. + Specify INT/UINT mode instead. + (h-gr): Use "indices" instead of "asm". + (h-cc): Update keyword syntax. + * m32r.cpu (f-*): Delete UNSIGNED attribute. Default is now UNSIGNED. + Specify INT/UINT mode instead. + (h-hi16,h-slo16,h-ulo16): Update. + (h-gr,h-cr): Use "indices" instead of "asm". + (h-accum,h-cond,h-psw,h-bpsw,h-bbpsw,h-lock): Use dsh instead of dnh. + (h-accums): Update keyword syntax. + (hash,hi16,slo16,ulo16): Use "indices" instead of "asm". + * sparc.cpu (f-*): Delete UNSIGNED attribute. Default is now UNSIGNED. + Specify INT/UINT mode instead. + (h-gr-indices): New pmacro. + (h-gr32,h-gr64): Split up from h-gr. + (h-a): Update type spec. Use values instead of asm spec. + (h-icc-[cnvz],h-xcc-[cnvz]): Use dsh instead of dnh. + (h-y,h-annul-p): Ditto. + (h-asr): Update keyword spec. + (h-lo10,h-lo13,h-hi22): Update. + (get-freg-spec,set-freg-spec): New pmacros. + (h-fr32,h-fr64): Split up from h-fr. + (rdd): Comment out get/set specs. + (lo10,lo13,hi22): Use "handlers" instead of "asm". + * sparc32.cpu (h-psr): Use dsh instead of dnh. + (h-s,h-ps,h-pil,h-et,h-tbr,h-cwp,h-ag,h-ec,h-ef,h-fsr): Ditto. + * sparc64.cpu (f-*): Delete UNSIGNED attribute. Default is now + UNSIGNED. Specify INT/UINT mode instead. + (h-*): Use dsh instead of dnh where appropriate. + (h-ixcc): Update type spec. Use "values" instead of "asm". + (h-p,h-membarmask): Ditto. + (membarmask): Use "handlers" instead of "asm". + + * hardware.scm (<hardware-base>): New member sem-name,type,indices, + values,handlers,getters,setters plus accessors. + (hw-mode-ok?,hw-default-mode): New procs. + (<hardware-base>): Rename method new-mode to mode-ok? + (<hardware-base>): New method get-index-mode. + (hw-index-mode): New proc. + (pc?): Delete, moved to operand.scm. + (address?): New proc. + (<hardware>): Delete. + (<hw-asm>): Definition moved here from desc.scm. + (keyword-parse): New proc. + (hardware-parsers): Delete. + (-parse-hw-type,-parse-hw-asm,-parse-hw-profile): Delete. + (-hw-parse-indices,-hw-parse-values,-hw-parse-handlers): New procs. + (-hw-parse-get,-hw-parse-set): New procs. + (-hw-parse): Delete args aasm,profile,extra. New args semantic-name, + indices,values,handlers,get,set. Rewrite. + (-hw-read-extra): Delete. + (-hw-read): Update. + (define-hardware): Don't add object if not selected. + (define-full-hardware): Ditto. + (current-hw-sem-lookup,current-hw-sem-lookup-1): New procs. + (<hw-register>): Member `type' moved to baseclass. Delete member + hw-asm. + (<hw-register>,parse!): Rewrite. + (<hw-register>): Delete methods get-rank,get-mode. + (<hw-register>): Method new-mode renamed to mode-ok? + (<hw-register>): New method get-index-mode. + (<hw-pc>,parse!): Rewrite. + (<hw-memory>): Member `type' moved to baseclass. Delete member hw-asm. + (<hw-memory>,parse!): Rewrite. + (<hw-memory>): Delete methods get-rank,get-mode. + (<hw-memory>): Method new-mode renamed to mode-ok? + (<hw-memory>): New method get-index-mode. + (<hw-immediate>): Member `type' moved to baseclass. Delete member + hw-asm. + (<hw-immediate>,parse!): Rewrite. + (<hw-immediate>): Delete methods get-rank,get-mode. + (<hw-immediate>): Method new-mode renamed to mode-ok? + (<hw-address>): Delete member hw-asm. + (<hw-address>,parse!): Rewrite. + (<hw-address>): Delete methods get-rank,get-mode. + (<hw-address>): Method new-mode renamed to mode-ok? + (hw-profilable?): Delete. + (hardware-init!): Delete hardware-parsers reference. + Update argument specs of command define-full-hardware. + (hardware-builtin!): Update definitions of hardware builtins. + * operand.scm (<operand>): New members hw-name,mode-name. + Delete member op-asm. New member handlers. + (<operand>,make!): Update. + (op:hw-name,op:mode-name,op:handlers): New procs. + (op:type): Rewrite. + (op:mode): Rewrite. + (<operand>): New method get-index-mode. + (<pc>,make!): Update. + (op:new-mode): Rewrite. + (operand-parsers): Delete. + (-operand-parse): Rewrite. Return #f if insn not selected. + (-op-read-extra): Delete. + (-operand-read): Update. + (define-operand,define-full-operand): Update. + (operand-init!): Delete operand-parsers reference. + Update syntax of define-full-operand command. + + * insn.scm (-insn-parse): Rewrite. Return #f if insn not selected. + (define-full-insn): Update. + * minsn.scm (-minsn-parse): Rewrite. Return #f if insn not selected. + (define-full-minsn): Update. + + * mode.scm (<mode>): New member class. + (mode:class): New proc. + (mode?): Rewrite. + (-mode-parse): New arg class. + (define-full-mode): Update. + (mode-find): Rewrite. + (mode-make-int,mode-make-uint): New procs. + (mode-init!): Update syntax of define-full-mode command. + (mode-builtin!): Update definitions of builtin modes. + + * model.scm (<profile>): Delete. + + * read.scm (keep-atlist?): New proc. + (keep-multiple?): New proc. + (<parser-list>): Delete. + (add-parser!,parse-spec!): Delete. + + * rtl.scm (def-rtx-node): Prepend arg *tstate* to all handlers. + (def-rtx-syntax-node): Ditto. + (-rtx-traverse-debug?): New variable. + (tstate-make): New proc. + (tstate-expr-fn,tstate-op-fn,tstate-cond?,tstate-set?): New procs. + (tstate-new-cond?,tstate-new-set?): New procs. + (-rtx-traverse-normal): Delete args cond?,expr-fn,op-fn. New arg + tstate. All callers updated. + (-rtx-traverse-expr,-rtx-traverse-debug): Ditto. + (-rtx-traverse-list,-rtx-traverse-operands): Ditto. + (-build-operand!): Replace arg cond? with tstate. + (-build-reg-operand!,-build-mem-operand!): Ditto. + (-build-index-of-operand!): Update making of <operand> object. + (s-ifield): New arg tstate. All callers updated. + (hw:): New arg tstate. All callers updated. Replace call to + current-hw-lookup with current-hw-sem-lookup-1. + (s-index-of): New arg tstate. All callers updated. + (reg:,mem:): Ditto. + (-rtx-use-sem-fn?): New proc. + (s-unop,s-binop,s-shop): Use it. Only use semantic mode when using + semantic cover fns. + (s-convop): Only use semantic mode when using semantic cover fns. + (s-cmpop): Call -rtx-use-sem-fn?. + (s-cond,s-case): New arg tstate. All callers updated. + (s-parallel,s-sequence): Ditto. + + * rtx-funcs.scm (set,set-quiet:): Use SETRTX to mark the set dest. + + * types.scm (<scalar>): Rewrite implementation. + (<integer>): Delete. + (parse-type): Rewrite. + + * utils-cgen.scm (parse-handlers): New proc. + + * utils.scm (!=): New proc. + +Tue Feb 23 12:10:29 1999 Doug Evans <devans@canuck.cygnus.com> + + * pmacros.scm (-pmacro-expand): Fix typo. + +1999-02-12 Doug Evans <devans@casey.cygnus.com> + + * pmacros.scm (-pmacro-hex,-pmacro-upcase,-pmacro-downcase): New procs. + (pmacros-init!): Install builtins .hex, .upcase, .downcase. + * i960.cpu (build-hex2): New pmacro. + (insn-opcode): Simplify. + (insn-opcode2): Ditto. + + * cgen-sim.scm (catch-with-backtrace): Comment out debugging printf. + * cgen-stest.scm (catch-with-backtrace): Ditto. + +1999-02-11 Doug Evans <devans@casey.cygnus.com> + + * pmacros.scm (-pmacro-lookup): Renamed from -pmacro-ref. + All callers updated. + (-pmacro-invoke): New proc. + (-pmacro-sym,-pmacro-str): New procs. + (-pmacro-iota,-pmacro-map,-pmacro-apply): New procs. + (pmacros-init!): Install builtins .iota, .map, .apply. + * sparc.cpu (cc-tests): Add CC_NZ,CC_Z,CC_GEU,CC_LU aliases. + (h-fr): Simplify register name spec. + * sparc64.cpu (cond-move-1): New arg mnemonic. All callers updated. + * utils.scm (num-args-ok?): New proc. + +1999-02-10 Doug Evans <devans@casey.cygnus.com> + + * pmacros.scm (-pmacro-error): New proc. + (-pmacro-expand): Use it. + (-pmacro-splice): New proc. + (pmacros-init!): Install new builtin .splice. + + * sparc.cpu: Include sparc64.cpu when appropriate. + (f-mmask,f-simm11): Moved to sparc64.cpu. + (insn-fmt2): Add FLUSH,FLUSHW,IMPDEP1,IMPDEP2,MEMBAR,MOVCC. + (ANNUL attribute): Delete. + (test-* pmacros): New arg cc, all callers updated. + (uncond-br-sem,cond-br-sem): New arg cc, all callers updated. + * sparc32.cpu (atom-op): Moved to sparccom.cpu and renamed to + atomic-opc. + (ldstub,swap): Moved to sparccom.cpu. + * sparc64.cpu: Add more insns. + +1999-02-09 Doug Evans <devans@casey.cygnus.com> + + * sim-cpu.scm (cgen-semantics.c): Replace CGEN_INSN_ATTR with + CGEN_ATTR_VALUE. + (cgen-sem-switch.c): Ditto. + * sim-decode.scm (-gen-idesc-decls): struct idesc definition + moved to cgen-engine.h. + (-gen-insn-sem-type): Delete, struct insn_sem mvoed to cgen-engine.h. + (-gen-idesc-init-fn,init_idesc): Lookup insn table via descriptor, not + global. Cache attributes and insn length in IDESC. + * sim-model.scm (-gen-cpu-defns): Generate new func @cpu@_prepare_run. + @cpu@_opcode renamed to @cpu@_get_idata. + (-gen-mach-defns,@mach@_init_cpu): Don't initialize IDESC table here, + done later underneath sim_resume. + (@mach@_mach): Record @cpu@_prepare_run. + * sim.scm (<hardware-base>,cxmake-get): New arg selector, all callers + updated. + (-hw-gen-set-quiet-pc): Ditto. + (-hw-cxmake-get,-hw-gen-set-quiet): Ditto. + (<hw-memory>,cxmake-get,gen-set-quiet): Ditto. + (<hw-addr>,cxmake-get): Ditto. + (<hw-iaddr>,cxmake-get): Ditto. + (<pc>,cxmake-get): Ditto. + (<operand>,cxmake-get,gen-set-quiet,gen-set-trace): Ditto. + (-op-gen-set-quiet,-op-gen-set-quiet-parallel): Ditto. + (-op-gen-set-trace,-op-gen-set-trace-parallel): Ditto. + (<hw-pc>,gen-write): Use hw-selector-default. + (<hw-register>,gen-write): Ditto. + (<hw-memory>,gen-write): Ditto. + (-gen-hw-index-raw,-gen-hw-index): Handle selector. + (-gen-hw-selector): New proc. + + * desc.scm: New file. + * desc-cpu.scm: New file. + * opcodes.scm: Split up into several smaller files. + * opc-asmdis.scm: New file. + * opc-ibld.scm: New file. + * opc-itab.scm: New file. + * opc-opinst.scm: New file. + * Makefile.am (desc): New target. + (opcodes): Update args to cgen-opc.scm. + * Makefile.in: Rebuild. + * aclocal.m4: Rebuild. + * config.in: Rebuild. + * configure.in: Update arg to AC_INIT. + Update version number to 0.7.0. Change AM_EXEEXT to AC_EXEEXT. + Update AC_PREREG arg to 2.13. Change AM_PROG_INSTALL to + AC_PROG_INSTALL. + * configure: Rebuild. + * cgen-gas.scm: Update files to load. + * cgen-opc.scm: Ditto. Reorganize option letters. + * cgen-sim.scm: Update files to load. + * cgen-stest.scm: Ditto. + * dev.scm (cload): New app "DESC". + (load-opc): Update files to load. + (load-gtest,load-sim,load-stest): Ditto. + + * attr.scm (bool-attr?): New proc. + (attr-list-enum-list): New proc. + (-attr-sort): Rewrite. + (attr-builtin!): Give ALIAS attribute a fixed index. + * utils-cgen.scm (gen-attr-enum-decl): Call attr-list-enum-list to + calculate attribute enum list. + (gen-attr-mask): Subtract CGEN_ATTR_BOOL_OFFSET from attribute's enum. + + * insn.scm (-insn-parse): Renamed from parse-insn. + + * hardware.scm (-hw-parse): New arg errtxt, all callers updated. + (-hw-read): Ditto. + + * mode.scm (-mode-parse): Renamed from parse-mode. + + * operand.scm (<operand>): New member `selector'. + (<operand>,make!): Use default selector. + (hw-selector-default): New variable. + (hw-selector-default?): New proc. + + * pmacros.scm (pmacros-init!): New proc. + (-pmacro-{make,name,arg-spec,transformer,comment}): New procs. + (-env-set!): Delete. + (-pmacro-expand): New proc apply-macro. + Use it in scan-list,scan. Scan list first, then see if macro + invocation. + (define-pmacro): Rewrite. + * read.scm (-init-parse-cpu!): Call utils-init!,parse-init!. + + * rtl.scm (-simplify-for-compilation): Ensure at least one mach + selected if (current-mach) seen. + (rtx?): Renamed from rtx-uneval?, all callers updated. + (<c-expr>,gen-set-quiet,gen-set-trace): New arg selector, all callers + updated. + (<c-expr-temp>,cxmake-get,gen-set-quiet,gen-set-trace): New arg + selector, all callers updated. + (hw:): New arg selector, all callers updated. Delete old comments + and code. + (reg:,mem:): Handle selectors + * rtx-funcs.scm (reg:): Handle selectors. + + * read.scm: Renamed from cpu.scm. + (<command>): New class. + (<reader>): New member commands. + (reader-add-command!): New proc. + (reader-lookup-command): New proc. + (reader-error,-reader-process-expanded,reader-process): New procs. + (reader-read-file!): New proc. + (include): Call reader-read-file!. + (cmd-if): New proc. + (cpu-load): Call reader-read-file!. + * utils.scm (num-args): New proc. + * simplify.inc: New file. + * *.scm: Delete def-foo procs. Rewrite define-foo/define-full-foo + procs. Move define-normal-foo procs (and abbreviated forms) to + simplify.inc. Install define-foo/define-full-foo commands in foo-init! + routines. + * fr30.cpu: Include simplify.inc. + * fr30.opc: CGEN_OPCODE_DESC renamed to CGEN_CPU_DESC. + * i960.cpu: Include simplify.inc. + * m32r.cpu: Include simplify.inc. + * m32r.opc: CGEN_OPCODE_DESC renamed to CGEN_CPU_DESC. + (CGEN_PRINT_NORMAL): Use CGEN_BOOL_ATTR. + * sparc.cpu: Include simplify.inc. + * sparc.opc: CGEN_OPCODE_DESC renamed to CGEN_CPU_DESC. + * utils-cgen.scm (parse-error): Moved to read.scm. + (sanitize): Rewrite. + (utils-init!): New proc. + +1999-02-02 Doug Evans <devans@casey.cygnus.com> + + * sparc.cpu: New file. + * sparc32.cpu: New file. + * sparc64.cpu: New file. + * sparccom.cpu: New file. + * sparc.opc: New file. + +1999-01-27 Frank Eigler <fche@cygnus.com> + + * utils.scm (gen-copyright): New proc. + +1999-01-27 Doug Evans <devans@casey.cygnus.com> + + Parameterize rtl parsing, rather than having lots of little handlers. + * rtl.scm (<rtx-func>): New members arg-types,arg-modes. + Delete member traverse. + (rtx:set-traverse!): Delete. + (-rtx-valid-types,-rtx-valid-matches): New variables. + (-rtx-func-lookup): Take symbol or <rtx-func> object as argument + instead of expression. All callers updated. + (def-rtx-node): New args arg-types,arg-modes. + (def-rtx-syntax-node): Ditto. + (def-rtx-dual-mode): Ditto. + (-rtx-macro-expand-list): Renamed from -rtx-macro-maybe-expand-list. + All callers updated. + (-rtx-macro-expand): Renamed from -rtx-macro-maybe-expand. + All callers updated. + (rtx-macro-expand): New proc. + (-rtx-traverse-check-args): Delete. + (-rtx-traverse-normal): Call -rtx-traverse-expr rather than calling + an rtx specific traverser. + (-rtx-any-mode?,-rtx-symornum?): New procs. + (-rtx-traverse-rtx-list,-rtx-traverse-error): New proc. + (-rtx-traverse-no-mode): Delete. + (-rtx-traverse-syntax-expr,-rtx-traverse-syntax-no-mode): Delete. + (-rtx-traverse-operands): Rewrite. + (-rtx-traverse-expr): Rewrite. + (rtx-traverse): Don't expand macros here, leave for caller to do. + (rtx-simplify): Delete. + (rtx-compile-time-constant?): Rewrite. Handle FALSE/TRUE for boolean + attributes. + (rtx-true?,rtx-false?): Ditto. + (-rtx-ref-type): Set dest is operand 1 now. + (-simplify-for-compilation): New proc. + (semantic-in-out-operands): Recognize regno as an alias for index-of. + Expand macros before calling rtx-traverse. Sort operands by name + to avoid unnecessary semantic formats. + (semantic-attrs): New proc. + (rtx-uneval?): Handle (<rtx-func> ...). + (s-boolifop): Delete arg mode. All callers updated. + * rtx-funcs.scm (all non-macros): Add arg-type and arg-mode specs. + (eq-attr): New arg obj. + (eq-attr:): Delete. + * m32r.cpu (rach): Update calls to andif. + + * minsn.scm (-minsn-parse-expansion): Renamed from + parse-minsn-expansion. + (-minsn-parse): Renamed from parse-minsn. + (-minsn-read): Renamed from read-minsn. + (def-minsn): Don't check APPLICATION here. + (def-full-minsn): New proc. + (define-macro-insn): Check APPLICATION here. Expand macros. + (define-normal-macro-insn): Ditto. + + * utils.scm (word-value): New arg start-lsb?. + (word-mask,word-extract): Ditto. + (split-bits,powers-of-2): Use integer-expt instead of expt. + (bit-set?): Handle 32 bit values (which are bignums). + (cg-logand,cg-logxor): New functions. + * ifield.scm (<ifield>,field-mask): Update call to word-mask. + (<ifield>,field-value): Update call to word-value. + (<ifield>,min-value): Use integer-expt instead of expt. + (<ifield>,max-value): Ditto. + + * hardware.scm (<hw-register>,new-mode): Rename local mode to cur-mode. + + * insn.scm (def-full-insn): Discard ALIAS insns if simulator. + + Compute raw instruction format in addition to semantic based format. + * iformat.scm: Delete members cti?,sem-in-ops,sem-out-ops. + (<iformat> accessors): Rename accessors to ifmt-*. + (<sformat>): New class. + (fmt-enum): Renamed from fmt:enum. + (-ifmt-search-key): Rewrite. + (-sfmt-search-key): New proc. + (ifmt-analyze): Rename arg include-sem-operands? to compute-sformat? + Compute iformat and sformat search keys. + (ifmt-build): Update. + (sfmt-build): New proc. + (-ifmt-lookup-ifmt!,-ifmt-lookup-sfmt!): New procs. + (ifmt-compute!): Compute instruction format <iformat> based on + instruction fields alone. Compute new semantic format <sformat> + based on instruction fields and semantic information. + (ifmt:lookup): Delete. + * mach.scm (<arch>): New member sfmt-list, plus accessors. + (current-sfmt-list): New proc. + * insn.scm (<insn>): Rename member fmt-tmp to tmp. + Rename member fmt to ifmt. New members fmt-desc, sfmt. + (insn-length,insn-length-bytes): Update. + (insn:mask-length,insn:mask): Update. + (insn-lookup-op): Update. + * gas-test.scm (gas-test-analyze!): Update. + (gen-gas-test): Ditto. + * sim-test.scm (sim-test-analyze!): Update. + (gen-sim-test): Ditto. + * opcodes.scm (gen-operand-instance-table): Update. + (gen-operand-instance-ref): Ditto. + (max-operand-instances): Use heuristic if semantics not parsed. + (ifmt-opcode-operands): Renamed from fmt-opcode-operands. + (opcodes-analyze!): Only scan semantics of building operand instance + tables. + * sim-cpu.scm (*) Update calls to <iformat>/<sformat> accessors. + (-gen-extract-ifmt-macro): Renamed from -gen-extract-fmt-macro. + * sim-decode.scm (*) Update calls to <iformat>/<sformat> accessors. + (gen-sfmt-argvars-defns): Renamed from gen-ifmt-argvars-defns. + (gen-sfmt-argvars-assigns): Renamed from gen-ifmt-argvars-assigns. + * sim-model.scm (*) Update calls to <iformat>/<sformat> accessors. + * sim.scm (*) Update calls to <iformat>/<sformat> accessors. + + * sim-decode.scm (usable-decode-bit?): Rename from decode-bit? + New arg lsb0? All callers updated. + (decode-bits): New arg lsb0?. All callers updated. + (opcode-slots): Update call to bit-set?. Call integer-expt instead + of expt. + (-gen-decode-bits): New arg lsb0?. All callers updated. + (build-slots): Call integer-expt instead of expt. + (build-decode-table-entry): Handle crossing word boundaries better. + (-gen-decode-switch): New arg lsb0?. All callers updated. + (-gen-extract-decls): Rename decode format entry from ifmt to sfmt. + + * enum.scm (define-enum): Rewrite. + (define-normal-enum): Ditto. + (def-full-insn-enum): New proc. + (define-normal-insn-enum): Rewrite. + + * attr.scm (<bitset-attribute>,gen-value-for-defn): Ensure result is + valid C. + (<{integer,enum}-attribute>,gen-value-for-defn): Ditto. + + + * Makefile.am (opcodes,sim-arch,sim-cpu): New targets. + (CLEANFILES): Add tmp-*. + * Makefile.in: Rebuild. + + * doc/Makefile.am: New file. + * doc/Makefile.in: New file. + * doc/cgen.texi: New file. + * Makefile.am (SUBDIRS): Define. + * Makefile.in: Rebuild. + * configure.in: Create doc/Makefile. + * configure: Rebuild. + +1999-01-18 Doug Evans <devans@casey.cygnus.com> + + * insn.scm (insn:syn): Delete. + +1999-01-15 Doug Evans <devans@casey.cygnus.com> + + * fr30.cpu (model fr30-1): Add state variables load-regs, + load-regs-pending. Delete h-gr. Clean up operand names of all units. + * m32r.cpu (model m32r/d): Clean up operand names of u-exec. + (model m32rx): Ditto. + (addi): Simplify function unit usage spec. + (ld-plus): Rewrite operand names in function unit usage spec. + (mvtachi,mvtachi-a,mvtaclo,mvtaclo-a,st-plus,st-minus): Ditto. + * sim.scm (<unit>,gen-profile-code): Redo how operand names are + overridden. Allow operand to appear in input and output spec. + (<insn>,gen-profile-code): string-append -> string-list. + + * ifield.scm (define-ifield): Call pmacro-expand. + (define-full-ifield,define-normal-ifield): Ditto. + (define-multi-ifield,define-normal-multi-ifield): Ditto. + + * sim.scm (gen-argbuf-type): Keep leading part of ARGBUF same for + with-scache and without-scache cases. + +1999-01-14 Doug Evans <devans@casey.cygnus.com> + + * fr30.cpu (fr30-1): Add state variable h-gr. + Add units u-cti, u-load, u-store, u-ldm, u-stm. + (all insns): First pass at providing cycle counts. + * sim.scm (<unit>,gen-profile-code): Only check for output operands + when initializing unit output operands, ditto for input operands. + + * insn.scm (insn-length,insn-length-bytes): New procs. + * mach.scm (-adata-set-derived!): Use them. + * sim-cpu.scm (-gen-sem-case): Ditto. + + * sim-cpu.scm (-gen-trace-record-type): PCADDR->IADDR. + (-gen-write-case): Ditto. + (gen-semantic-fn): Ditto. Split into two: + -gen-scache-semantic-fn and -gen-no-scache-semantic-fn. Fix bitrot + in non-scache case. + (-gen-all-semantic-fns): Renamed from -gen-all-semantics. Handle + scache/no-scache appropriately. All callers updated. + (-gen-sem-case): PCADDR->IADDR. + * sim.scm (gen-argbuf-type): PCADDR->IADDR. + + * sim-decode.scm (*): Replace string-append,string-map with + string-list,string-list-map where the result is sufficiently large. + (-gen-decode-insn-table): Go back to simple version for non-scache + case: just record IDESC in decoder tables and leave field extraction + to the caller. + (-gen-decode-switch): Ditto. + (-gen-decode-fn): Ditto. + (-gen-extract-decls): Only emit format enum if with-scache?. + * sim-model.scm (-gen-model-insn-fn): Extract ifields here in + non-scache case. + (-gen-model-insn-fns): Don't emit model fns for virtual insns. + (-gen-insn-timing): Ditto. + * sim.scm (gen-argbuf-type): Only output sem_fields union in + with-scache case. + + * sim.scm (-hw-gen-fun-get): Use GET_<H-NAME> macro. + (-hw-gen-fun-set): Use SET_<H-NAME> macro. + +1999-01-12 Doug Evans <devans@casey.cygnus.com> + + * cpu.scm (keep-mach-validate!): New proc. + (include): New proc. + + * mach.scm (current-arch-mach-name-list): New proc. + (-parse-arch-machs): Always return canonical form. + (def-arch): Validate user specified machs to be kept. + (def-mach-attr!): Simplify. + + * opcodes.scm (-opcodes-build-operand-instance-table?): New global. + (option-init!): Initialize it. + (option-set!): Set it. + (gen-insn-table-entry): Emit 0 for operand instance ref if not + output operand instance tables. + (cgen-opc.in): Only output operand instance tables if asked to. + + * sim.scm (option-init!,option-set!): Clarify returned value. + + * sim.scm (gen-mach-bfd-name): Move from here. + * utils-cgen.scm: To here. + +1999-01-11 Doug Evans <devans@casey.cygnus.com> + + * fr30.cpu (ilm): Fix comment field. + (cond-branch): Remove explicit setting of COND-CTI, let cgen + compute it. + + * rtl.scm (rtx-simplify,rtx-compile-time-constant?): New procs. + (rtx-true?, rtx-false?): New procs. + * rtx-funcs.scm (annul): Rename vpc to pc. + (-rtx-traverse-if): Improve determination of whether then/else parts + are conditionally executed. + + * sim.scm (-gen-argbuf-fields-union): Move definition of union to + outer level. + (gen-argbuf-type): Simplify generated definition (big sem_fields + union moved outside). + +1999-01-11 Ben Elliston <bje@cygnus.com> + + * doc/porting.texi: New file. + + * doc/intro.texi: New file. + (Layout): Use @example to insert preformatted ASCII text (such as + diagrams). @code is inappropriate here. + +1999-01-06 Doug Evans <devans@casey.cygnus.com> + + * ifield.scm (-multi-ifield-read): Fix handling of insert/extract. + + * m32r.opc (print_hash): Cast dis_info. + + * sim-cpu.scm (-gen-hardware-types): Sanitize get/set macros. + * sim.scm (<sim-hardware>,make!): Emit a comment for user-written + get/set macros. + +1999-01-05 Doug Evans <devans@casey.cygnus.com> + + * i960.cpu (f-br-disp): Remove RELOC attribute. + (f-ctrl-disp): Ditto. + (callx-disp): set-quiet -> set for (reg h-gr 2). + (callx-indirect,callx-indirect-offset): Ditto. + + * Makefile.am (gas-test): Fix dependencies. + * Makefile.in: Rebuild. + * cgen-gas.asm: File creation args are -<uppercase-letter>. + * gas-test.scm (break-out-syntax,make-file-name): Delete. + (gas-test-analyze!): Use syntax-break-out. + * sim-test.scm (break-out-syntax,make-file-name): Delete. + (sim-test-analyze!): Use syntax-break-out. + (cgen-build.sh): Use gen-file-name. + (cgen-allinsn.exp): Compute and pass all machs to run_sim_test. + * insn.scm (syntax-break-out): New proc. + * utils.scm (gen-file-name): New proc. + + * fixup.scm (nil,<?,<=?,>?): Delete. + + * utils.scm (count-true): Rewrite. + + * slib/sort.scm: Move sort.scm to slib directory. + * cpu.scm: Update. + + * iformat.scm (ifmt-compute!): Record empty format. + + * rtl.scm (semantic-in-out-operands): Simplify by moving several + internal procs outside. Handle expression register numbers. + Handle index-of. + + * rtx-funcs.scm (annul): Rename new_pc to vpc. + + * sim-cpu.scm (-gen-cpu-reg-access-defns): Define access fns for + every register. + (-gen-write-case): Pass vpc to SEM_BRANCH_FINI. + (gen-semantic-fn,-gen-sem-case): Ditto. + (cgen-cpu.c): Define WANT_CPU to @cpu@. + (cgen-semantics.c): Ditto. + * sim-decode.scm (-gen-extract-decls): Handle non-with-scache case. + (gen-ifmt-argvars-defns): New proc. + (gen-ifmt-argvars-assigns): New proc. + (-gen-all-extractors): Delete FMT_EMPTY case, now handled like others. + (-gen-decode-fn): Handle non-with-scache case. + (cgen-decode.c): Define WANT_CPU to @cpu@. + * sim-models.scm (-gen-mach-defns): Emit bfd name. + (cgen-model.c): Define WANT_CPU to @cpu@. + * sim.scm (gen-ifld-extract-argvar): New proc. + (<sim-hardware>,make!): Don't emit [GS]ET_H_FOO macros for elements + with FUN-ACCESS specified. + (hw-fun-access?): New proc, as <hardware-base>:fun-access? method. + (<hw-register>,gen-extract): New arg local?. + (<hw-address>,gen-extract): Ditto. + (-hw-cxmake-get): Handle non-with-scache case. + (-hw-gen-set-quiet): Ditto. + (<hw-address>,cxmake-get): Handle non-with-scache case. + (gen-op-extract-argvar): New proc. + (<operand>,gen-record-profile): Rewrite. + (<operand>,gen-profile-code): Rewrite. + (<unit>,gen-profile-code): Use -gen-argfld-ref. + (gen-argbuf-fields-union): New proc. + (gen-argbuf-type): Use it. Handle non-scache case. + + * *.scm: class:foo procs renamed to class-foo. + * attr.scm (<attribute>): New member `for'. + (-attr-parse): New first value in list for default if + none specified. + (non-bool-attr-list,attr:add!): Delete. + (def-attr): Use current-attr-add!. + (atlist-attr-value-no-default): New proc. + (attr-lookup-default): Handle boolean attributes. + (gen-attr-enum): New proc. + (-attr-remove-meta-attrs-alist): New proc. + (attr-nub): New proc. + (current-attr-list-for): New proc. + (current-{ifld,hw,op,insn}-attr-list): New procs. + (attr-builtin!): New proc. + * cpu.scm (keep-obj?): Rewrite. + (-init-parse-cpu!): Call arch-init!. + (-install-builtin!): Call {attr,mode,ifield,insn}-builtin!. + (-finish-parse-cpu!): Call arch-finish!. + * enum.scm (enum-list,enum:add,enum:lookup): Delete. + (def-enum,def-full-enum): Use current-enum-add!. + (gen-obj-list-enums): New proc. + * hardware.scm (hw:add!,hw:lookup): Delete. + (def-hardware,def-hardware-ext): Use current-hw-add!. + (hw:std-attrs,hw:attr-list): Delete. + (hardware-builtin!): Define builtin hardware attributes. + * ifield.scm (ifld:add!,ifld:lookup): Delete. + (def-ifield,def-full-ifield): Use current-ifld-add!. + (ifld:std-attrs,ifld:attr-list): Delete. + (ifield-builtin!): New proc. + * insn.scm (insn:add!,insn:lookup): Delete. + (def-full-insn): Use current-insn-add!. + (insn:std-attrs): Delete. + (insn-builtin!): New proc. + * mach.scm (<arch>): New members attr-list,enum-list,op-list, + minsn-list. + (<arch-data>): New member machs. + (current-attr-list,current-enum-list): New procs. + (current-op-list,current-minsn-list): New procs. + (current-{attr,enum,ifld,op,hw,insn,minsn,cpu,mach,model}-add!): Ditto. + (current-{attr,enum,ifld,op,hw,insn,minsn,cpu,mach,model}-lookup): + Ditto. + (-parse-arch-machs): New proc. + (-arch-parse): New arg machs, all callers updated. + (-arch-read): Handle machs spec. + (def-arch): Define MACH attribute here. + (mach-init!,mach-finish!): Not here. + (cpu:add!,cpu:lookup): Delete. + (def-cpu): Use current-cpu-add!. + (<mach>): New member bfd-name. + (-mach-parse): New arg bfd-name, all callers updated. + (-mach-read): Handle bfd-name spec. + (mach:add!,mach:lookup): Delete. + (def-mach): Use current-mach-add!. + (def-mach-attr!): New proc. + (arch-init!): New proc. + (arch-finish!): New proc. Reverse all object lists here. + * minsn.scm (minsn-list,minsn-add!,minsn:lookup): Delete. + (def-minsn): Use current-minsn-add!. Ignore minsn if mach not kept. + (define-normal-macro-insn): Ignore minsn if mach not kept. + * mode.scm (mode-builtin!): New proc. + * model.scm (model:add!,model:lookup): Delete. + (def-model): Use current-model-add!. + * opcodes.scm (insn:attr-list): Delete. + (attr-bool-gen-decl,attr-bool-gen-defn): New procs. + (gen-attr-table-defn): Emit value for default. + (gen-attr-table-defns): Emit bool_attr. Emit ifield attr table. + (op:attr-list): Delete. + (gen-operand-decls,gen-insn-decls): New proc. + (compute-insn-attr-list): Delete. + (cgen-opc.h): Reorganize and simplify. + * operand.scm (-operand-list,operand-list,op:add,op:lookup): Delete. + (def-operand,def-full-operand): Use current-op-add!. + (op:std-attrs): Delete. + (operand-enum): Delete. + (operand-builtin!): Define builtin operand attrs. + * utils-cgen.scm (sanitize): Update calls to lookup procs. + (gen-attr-enum-decl): Use gen-obj-list-enums. + (gen-obj-attr-defn): Renamed from gen-attr-defn, all callers updated. + Rewrite. + * fr30.cpu (define-arch): Add machs spec. + (f-i4): SIGNED attribute -> !UNSIGNED. + (f-disp8,f-disp9,f-disp10,f-s10,f-rel9,f-rel12): Ditto. + (HASH-PREFIX): Define operand attribute. + (NOT-IN-DELAY-SLOT): Define insn attribute. + * i960.cpu (define-arch): Add machs spec. + * m32r.cpu (define-arch): Add machs spec. + (h-hi16): Remove UNSIGNED,SIGN-OPT attributes. + (HASH-PREFIX): Define operand attribute. + (FILL-SLOT): Define insn attribute. + +Thu Dec 17 17:15:06 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (stilm): Correct mask for and operation. + +1998-12-17 Doug Evans <devans@casey.cygnus.com> + + * sim-test.scm (cgen-build.sh): Use `mach' to specify machs, not `cpu'. + Replace START/EXIT with start/pass. + (gen-sim-test): Delete ".text". + +Wed Dec 16 16:16:39 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (cond-branch): Conditional branches not allowed in delay slots. + +Tue Dec 15 17:30:01 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu: Add NOT-IN-DELAY-SLOT as appropriate. + (h-sbit): Make it FUN-ACCESS. + (h-gr): Reorder so that general regs are always printed by number. + +1998-12-14 James E Wilson <wilson@wilson-pc.cygnus.com> + + * i960.cpu (flushreg): Use nop. + +1998-12-14 Doug Evans <devans@casey.cygnus.com> + + * m32r.cpu (default-alignment): Specify. + * mach.scm (<arch-data>): New member default-alignment. + (adata:default-alignment): New proc. + (current-arch-default-alignment): New proc. + (-arch-parse): New arg default-alignment. + (parse-alignment): New proc. + (-arch-read): Handle default-alignment spec. + + * rtx-funcs.scm (attr:): Pass attr-name through gen-c-symbol. + + * insn.scm (f-%): Delete. + * sim-cpu.scm (gen-define-fields): Delete support for f-%. Can + be readded if proved useful. + (gen-extract-fields): Ditto. Use gen-ifetch. + * sim.scm (<hw-memory>,cxmake-get): Pass pc to GETMEM*. + (<hw-memory>,gen-set-quiet): Pass pc to SETMEM*. + +Mon Dec 14 16:20:59 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (div2): Set zbit properly when remainder not zero. + +1998-12-14 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu: Remove stub macros. + (div1): Shift bits from mdl into mdh. Don't use addc/subc. + (div2): Don't use addc/subc. + +1998-12-11 Doug Evans <devans@casey.cygnus.com> + + * utils-cgen.scm (gen-obj-sanitize): Only catch spelling errors + if opcodes. + +Thu Dec 10 18:37:34 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (div0s,div0u,div1,div2,div3,div4s): Implemented. + +Thu Dec 10 12:28:53 1998 Doug Evans <devans@canuck.cygnus.com> + + * cpu.scm (keep-all?): New proc. + (assert-keep-all): Use it. + * opcodes.scm (gen-ifmt-table-1): Use gen-obj-sanitize. + * utils-cgen.scm (gen-obj-sanitize): Handle macro-insns. + Check for spelling errors. + +1998-12-09 Doug Evans <devans@casey.cygnus.com> + + * rtl.scm (s-convop): Call -rtx-sem-mode. + +Tue Dec 8 10:58:38 1998 Doug Evans <devans@canuck.cygnus.com> + + * hardware.scm (-parse-hw-type): parse! no longer returns a result. + (-parse-hw-profile): Ditto. + (<hw-register>, parse!): Return `void' result. + (<hw-pc>, parse!): Ditto. + (<hw-memory>, parse!): Ditto. + (<hw-immediate>, parse!): Ditto. + (<hw-address>, parse!): Ditto. + + * ifield.scm (-ifield-parse): Validate encode/decode fields. + (-ifld-parse-encode-decode): New proc. + (-ifld-parse-encode,-ifld-parse-decode): New proc. + (-multi-ifield-parse): Set encode/decode to #f. + (ifld:decode-mode): New proc. + * utils.scm (nub): Rewrite. + * operand.scm (op-nub): Rewrite. + * sim.scm (<ifield>, gen-type): Rewrite. + (-gen-ifld-argbuf-defn): New proc. + (gen-ifld-extract,gen-ifld-trace-extract): New procs. + (<sim-hardware>): Forward gen-trace-extract onto `type'. + Ditto for needed-iflds. gen-argbuf-defn renamed from gen-argbuf-elm. + (<hardware-base>): New method needed-iflds. gen-argbuf-defn + renamed from gen-argbuf-elm, return "". Rewrite gen-extract. + New method gen-trace-extract. + (<hw-register>): New method needed-iflds. gen-argbuf-defn renamed + from gen-argbuf-elm, return "" if not caching register address. + Rewrite gen-extract. New method gen-trace-extract. + (<hw-address>): New methods needed-iflds, gen-argbuf-defn, + gen-extract, gen-trace-extract, cxmake-get. + (<hw-iaddress>): New method cxmake-get. + (op-needed-iflds): New proc. + (<operand>): Delete methods gen-argbuf-elm, gen-extract. + (-gen-op-argbuf-defn): New proc. + (gen-op-extract): Renamed from op:extract. + (gen-op-trace-extract): Renamed from op:trace-extract. + (fmt-extractable-operands): Renamed from fmt-semantic-operands + and rewritten. + (gen-argbuf-elm): Rewrite. + * sim-decode.scm (-gen-record-args): Update. + + * sim.scm (c-cpu-macro): Renamed from cpu-deref. All uses changed. + + * pmacros.scm (-pmacro-expand): Handle procedural macros in + argument position. Flag symbolic macros in function position as + an error. + (define-pmacro): Handle quoting in definition of symbolic macros. + (pmacro-trace): Call -pmacro-expand, not -pmacro-ref. + +Tue Dec 8 13:06:44 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.opc (parse_register_list): Account for reverse masks + for load and store. + (print_register_list): Ditto. + (parse_low_register_list_ld): New function. + (parse_hi_register_list_ld): New function. + (parse_low_register_list_st): New function. + (parse_hi_register_list_st): New function. + (print_hi_register_list_ld): New function. + (print_hi_register_list_st): New function. + (print_low_register_list_ld): New function. + (print_low_register_list_st): New function. + * fr30.cpu (ldr15dr): Implement workaround. + (ldm0,ldm1,stm0,stm1): Implemented. + +1998-12-08 Doug Evans <devans@casey.cygnus.com> + + * configure.in: Rename --with-hobbit to --with-cgen-hobbit. + * configure: Regenerate. + * Makefile.am (WITH_HOBBIT): Update. + (cgen-hob.c): Remove Makefile dependency. + (cgen.o): Depend on cgen-gh.h, config.h. + * Makefile.in: Regenerate. + * aclocal.m4: Regenerate. + +1998-12-07 James E Wilson <wilson@wilson-pc.cygnus.com> + + * i960.cpu, i960.opc: New files. + +Mon Dec 7 14:30:24 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.opc (parse_register_number): New function. + (parse_register_list): New function. + (parse_low_register_list): Use parse_register_list. + (parse_hi_register_list): Use parse_register_list. + * fr30.cpu (sth): Fix assembler syntax. Implement more + insns. + +Fri Dec 4 16:07:13 1998 Doug Evans <devans@canuck.cygnus.com> + + * sim-cpu.scm (cgen-sem-switch.c): Update definition of TRACE_RESULT. + * sim-decode.scm (-gen-record-args): Update call to TRACE_EXTRACT. + * sim.scm (-op-gen-set-trace): Update call to TRACE_RESULT. + (-op-gen-set-trace-parallel): Ditto. + (gen-argbuf-type): New ARGBUF members trace_p,profile_p; + + * fr30.cpu (call,calld): Fix setting of pc. + (f-op5): Fix start bit number. + +Fri Dec 4 17:06:28 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (st): Fix operand ordering. Implement more + insns. + +Thu Dec 3 23:59:40 1998 Doug Evans <devans@canuck.cygnus.com> + + * ifield.scm (ifld:mode,ifld:hw-type): New procs. + * iformat.scm (fmt-opcode-operands): Move to opcodes.scm. + (fmt-semantic-operands): Move to sim.scm. + * opcodes.scm (fmt-opcode-operands): Moved here from iformat.scm. + * operand.scm (<hw-index>): New member `name'. All builders updated. + (<hw-index>): New method get-name. + (op-profilable?): Moved to sim.scm. + (op-nub): New proc. + * sim.scm (fmt-semantic-operands): Moved here from iformat.scm. + (op-profilable?): Moved here from operand.scm. + (gen-extract-type): Delete. + (c-argfld-macro): Renamed from c-ifield-macro. All uses updated. + (-gen-argfld-ref): New proc. + (-gen-ifld-argfld-name): New proc. + (gen-ifld-argfld-ref): Renamed from -gen-ifld-ref. All uses updated. + (-gen-ifld-decoded-val): Renamed from -gen-ifld-raw-val. + (-gen-hw-index-argfld-name,-gen-hw-index-argfld-ref): New procs. + (<hardware-base>): Delete method gen-extract-type. New method + gen-argbuf-elm. + (<hw-register): Ditto. Update method gen-extract. + (<operand>, method gen-argbuf-elm): Rewrite. + * rtl.scm (semantic-in-out-operands): Handle (ifield f-name). + (s-cmpop): Fix handling of eq,ne for unsigned modes. + * rtx-funcs.scm (eq,ne,lt,le,gt,ge,ltu,leu,gtu,geu): Update. + + * sim-decode.scm (-gen-record-args): Tweak. + + * sim.scm (gen-argbuf-elm): Handle case of all constant opcode fields. + +Thu Dec 3 14:23:27 1998 Dave Brolley <brolley@cygnus.com> + + * doc/porting: Fix typo: gas->sim. + * fr30.opc (print_m4): New function. + * fr30.cpu: Implemented many insns. + +Thu Dec 3 00:03:16 1998 Doug Evans <devans@canuck.cygnus.com> + + * rtl.scm (build-reg-operand!): Remove redundant setting of hw-name. + + * fr30.cpu (f-rel9): Delete RELOC attribute. + (f-rel12): Add PCREL-ADDR attribute. + (label9): Make an h-iaddr, not h-uint. Delete asm print spec. + (label12): Delete PCREL-ADDR attribute. Make an h-iaddr, not h-sint. + * fr30.opc (print_label9): Delete. + + * iformat.scm (ifmt-analyze): Check attributes derived from semantic + code for CTI indicators. + * insn.scm (insn-cti?): Simplify. + * utils-cgen.scm (atlist:cti?): New proc. + +1998-11-30 Doug Evans <devans@casey.cygnus.com> + + * fr30.cpu (arch): default-insn-bitsize -> default-insn-word-bitsize. + (f-i20-4,f-i20-16,f-i20): New fields. + (i20): New operand. + (ldi8): Implement. + (ldi20): New insn. + (ldi32m): Delete. + (jmpd): Implement. + * fr30.opc (CGEN_DIS_HASH_SIZE,CGEN_DIS_HASH): Define in opc.h. + * m32r.cpu (arch): default-insn-bitsize -> default-insn-word-bitsize. + * mach.scm (arch-data): Ditto. + (current-arch-default-insn-word-bitsize): Renamed from + current-arch-default-insn-bitsize [ya, that's a pretty long name]. + (-arch-read): Update. + + * hardware.scm (hw:attr-list): Move here ... + * opcodes.scm: ... from here. + + * ifield.scm (fld:bitrange): Delete. + (fld:word-offset,fld:word-length): New procs. + (ifield?): Use class-instance. + (<ifield>, method field-start): Rewrite. + (ifld:enum): New proc. + (<ifield>, methods field-mask,field-value): Rewrite. + (-ifield-parse): Rewrite. + (<multi-ifield> support): Rewrite. + (ifld-beyond-base?): Rewrite. + (ifld:std-attrs): New variable. + (ifld:attr-list): New proc. + * iformat.scm (-compute-insn-mask): Rewrite. + * insn.scm (-parse-insn-format): New arg errtxt, all callers updated. + Simplify. + (-parse-insn-format-symbol,-parse-insn-format-list): New procs. + * opcodes.scm (<hardware>): No longer forward gen-insert,gen-extract + onto type. + (<operand>): Ditto. Forward onto index instead. + (gen-ifld-decls,gen-ifld-defns): New procs. + (ifld:insert,ifld:extract): New procs. + (<ifield>): New methods gen-insert, gen-extract. + (<multi-ifield>): Ditto. + (<hw-index>): Forward gen-insert,gen-extract onto value. + (<hw-asm>): Delete insert/extract support. + (<hw-register,hw-memory,hw-immediate>): Ditto. + (gen-hash-defines): Use string-list. + Define CGEN_MAX_IFMT_OPERANDS. + (gen-switch): Use string-list,string-list-map. + (gen-fget-switch,gen-fset-switch): Use string-list. + (gen-parse-switch,gen-insert-switch): Ditto. + (gen-extract-switch,gen-print-switch): Ditto. + (gen-insert-switch,gen-extract-switch): New local `total_length'. + (gen-ifmt-table-1,gen-ifmt-table): New procs. + (gen-ifmt-entry): Renamed from gen-iformat-entry, rewrite. + (gen-ivalue-entry): New proc. + (gen-insn-table-entry): Use string-list. Update iformat,ivalue + computation. Use 0 for operand ref table if ALIAS insn. + (gen-minsn-table-entry): Use string-list. + (gen-macro-insn-table): Temporarily emit format tables for ALIAS insns. + (gen-opcode-open): Record address of ifield table. + (cgen-opc.h): Call gen-ifld-decls. + (cgen-opc.in): Call gen-ifld-defns, gen-ifmt-table. + * types.scm (<bitrange>): New members word-offset,word-length. + Delete member total-length. Delete methods start,mask,value. + (bitrange:word-offset,bitrange:word-length): New procs. + * sim-cpu.scm (gen-define-fields): Simplify. + (gen-extract-fields): Simplify. + * sim.scm (<ifield>, gen-ifld-extract): Rewrite. + (<ifield>): New methods gen-ifld-extract-decl. + Delete method gen-ifld-extract-beyond. + (<multi-ifield>): New methods gen-ifld-extract-decl. + (<multi-ifield>, method gen-ifld-extract): Implement. + (-gen-ifld-extract-base,-gen-ifld-extract-beyond): New procs. + (gen-ifld-exttact,gen-ifld-extract-beyond): Delete. + + * rtl.scm (-rtx-traverse-no-mode): Process operands. + (-rtx-traverse-syntax-no-mode): New proc. + (semantic-in-out-operands): Watch for `delay' and add DELAY-SLOT attr. + (s-ifield): New proc. + (s-shop): Don't prepend `unsigned' for unsigned modes. + * rtx-funcs.scm (ifield): New rtx function. + (ref,symbol): Use standard -rtx-traverse-syntax-no-mode. + (delay): New rtx function. + * insn.scm (insn:std-attrs): Add DELAY-SLOT. + + * cos.scm (-elm-make-method-getter): Fix typo. + + * utils.scm (backslash): Handle lists of strings. + +Thu Nov 26 11:47:29 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (f-rel9): Correct for pc+2. + (label9): Use print_label9. + * fr30.opc (print_label9): New function. + +Tue Nov 24 11:19:35 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu: Change $r13,$r14,$r15 to uppercase. + * fr30.opc (parse_low_register_list): Renamed. + (parse_hi_register_list): Renamed. + (print_hi_register_list): Renamed. + (print_low_register_list): Renamed. + +Mon Nov 23 18:26:36 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (f-rel9): Now a pc relative offset. + +1998-11-23 Doug Evans <devans@casey.cygnus.com> + + * opcodes.scm (op-asm): Move to here, from operands.scm. + (<op-asm>, method parse!): Validate arguments. + (<operand>, method gen-function-name): Fix thinko. + * operand.scm (<operand>, method make!): Don't set op-asm here. + * utils.scm (list-elements-ok?): New proc. + + * opcodes.scm: Clean up pass. + +1998-11-20 Doug Evans <devans@tobor.to.cygnus.com> + + * fr30.cpu (int): Defer saving of ps,pc and setting ibit,sbit to + the fr30_int function. + (h-cr): Remove PROFILE,CACHE-ADDR attributes. + (h-dr): Add FUN-ACCESS attribute. + +1998-11-20 James E Wilson <wilson@wilson-pc.cygnus.com> + + * sim-model.scm (-gen-mach-defns): Use gen-sym instead of obj:name + for C symbol for models array. + +Thu Nov 19 15:57:45 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.opc (parse_reglist_low): New function. + (parse_reglist_hi): New function. + (print_reglist_low): New function. + (print_reglist_hi): New function. + * fr30.cpu: Finish remaining insn stubs. + +1998-11-19 Doug Evans <devans@tobor.to.cygnus.com> + + * sim.scm (-gen-extract-word): Handle fields shorter than entire word. + + * fr30.cpu (ldi32m): Don't use for disassembly. + +Wed Nov 18 21:34:41 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (int): Implement it. + +1998-11-18 Doug Evans <devans@casey.cygnus.com> + + * rtx-funcs.scm (nop): Fix C code. + + * rtl.scm (semantic-in-out-operands): Fix setting of sem-attrs. + + * fr30.cpu (f-i32): New ifield. + (i32): New operand. + (ldi32): New insn. + (ldi32m): New macro insn. + (inte): Provide simple version for now. + + * sim-arch.scm: New file. + * sim.scm: Move architecture support generation to sim-arch.scm. + * cgen-sim.scm: Load sim-arch.scm. + * dev.scm: Ditto. + + * hardware.scm (pc?) New proc. + (class <hardware-base>): Rewrite method 'pc?. + (class <hardware>): Forward 'pc? to the hardware type. + (class <hw-pc>): New method 'pc?. + + Add support for variable length ISAs. + * ifield.scm (ifld-beyond-base?): New proc. + * m32r.cpu: Remove integral-insn? spec. + * mach.scm (arch:derived,arch:set-derived!): New procs. + (arch:app-data,arch:set-app-data!): New procs. + (class <arch>): New members derived, app-data. + (class <cpu>): Delete member integral-insn?. + (cpu:integral-insn?): Delete. + (-cpu-parse): Delete arg integral-insn?. All callers updated. + (-cpu-read): Delete integral-insn? support. + (state:decode-assist): Delete. + (state:int-insn?): Delete. + (<derived-arch-data>): New class. + (-adata-set-derived!): New proc. + (mach-finish!): Call it. + * opcodes.scm (<hw-asm>, method gen-extract): Pass pc to C handler. + (gen-operand-instance): Add COND_REF support. + (gen-operand-instance-table): Ditto. + (gen-hash-defines): Update. + (gen-extract-switch): Update type of `insn_value' arg. + (gen-opcode-open): Update type of `value' arg of dis_hash_insn. + * rtl.scm (-rtx-ref-type): Renamed from -rtx-set?. All callers + updated. + (semantic-in-out-operands): Compute UNCOND-CTI,COND-CTI from rtl. + * sim-cpu.scm (gen-define-fields): Create vars to hold insn value + beyond the base insn (for large insns). + (-gen-extract-beyond-var-list): New proc. + (gen-extract-fields): Handle large insns. + (-gen-write-case): Update sem_arg computation. + Update initial vpc computation. + (gen-semantic-fn): Ditto. Update type of `insn'. + (-gen-sem-case): Update sem_arg computation. + Update initial vpc computation. + * sim.scm (<ifield>, gen-ifld-extract): Renamed from `extract'. + (-gen-extract-word): New proc. + (<ifield>): New method gen-ifld-extract-beyond. + (gen-ifld-extract-beyond): New proc. + * types.scm (bitrange-overlap?): New proc. + + * utils.scm (bits->bytes): New proc. + (bytes->bits): New proc. + + Move extraction support into decoder. + * sim-cpu.scm (-gen-record-args,-gen-record-profile-args, + -gen-extractor,-gen-all-extractors,cgen-extract.c): Move extraction + support to sim-decode.scm. + * sim-decode.scm (-gen-decode-insn-table): Change decoder data to + be array of IDESC,FMT entries. Make the array const. + (-gen-gcc-label-table): Make array const. + (-gen-decode-switch): Branch to extraction code after insn has been + identified. + (-gen-decode-insn-globals): Delete extract handler from + @cpu@_insn_sem. + (gen-decode-fn): Add extraction support. + (-gen-sem-fn-decls): Delete extraction fn decls. + (-gen-idesc-decls): Update @cpu@_decode decl. + (-gen-idesc-init-fn): Delete extraction support. + (-gen-extract-decls): New proc. + + * sim-cpu.scm (cgen-sem-switch.c): Update switch test. + (sim-finish!): Surround pbb only code with #if WITH_SCACHE_PBB. + + * sim-decode.scm (build-decode-table-entry): New arg invalid insn. + All callers updated. + (table-entry:make): Record insn value as insn object, not name. + All uses updated. + + * hobbit.scm (path_basename): Renamed from `basename' to avoid + collision with C function. + (path_dirname): Similarily. + * hobbit.c,hobbit.h: Rebuild. + +Wed Nov 18 11:26:17 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu (dir2r15-predec-stub): Reference to R15 must be indirect. + +Mon Nov 16 19:19:50 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu: Implement more instruction stubs. + +Thu Nov 12 19:20:28 1998 Dave Brolley <brolley@cygnus.com> + + * fr30.cpu: Implement more instruction stubs. + +Tue Nov 10 10:53:55 1998 Doug Evans <devans@canuck.cygnus.com> + + * rtl.scm (-rtx-expr-mode-name): Handle sequence locals. + + * rtx-funcs.scm (zflag:,zflag,nflag:,nflag): New rtx fns. + + * operand.scm (<pc>, method make!): FAKE renamed to SEM-ONLY. + (op:std-attrs): Ditto. + * opcodes.scm (gen-operand-instance): Ditto. + (gen-switch): Ditto. + * m32r.cpu (condbit,accum): Update. + * fr30.cpu (nbit,vbit,zbit,cbit): Update. + +Mon Nov 9 14:30:51 1998 Doug Evans <devans@seba.cygnus.com> + + * enum.scm (-enum-read): Fix typo. + + * iformat.scm (-ifmt-search-key): Simplify a little. + +Mon Nov 9 12:07:56 1998 Dave Brolley <brolley@cygnus.com> + + * doc/porting: semantics.c -> sem.c. + * Makefile.in: Regenerate. + * fr30.cpu (add): Change ADD to add. Add more registers and set + status bits on 'add' instruction. + +Fri Nov 6 18:15:05 1998 James E Wilson <wilson@wilson-pc.cygnus.com> + + * sim.scm (-gen-arch-model-decls): Default MAX_UNITS to 1 instead + of 0. + +Fri Nov 6 17:43:16 1998 Doug Evans <devans@seba.cygnus.com> + + * minsn.scm (minsn:enum): Update, call current-arch-name. + + * pmacros.scm (-pmacro-expand): Make `cep' a variable. + + * Makefile.am (CGEN_HOB_INPUT_FILES): Add pmacros.scm,enum.scm, + mach.scm,model.scm,types.scm,ifield.scm,minsn.scm. + (ARCH,CGEN,CGENFLAGS): New variables. + (gas-test,sim-test): New rules. + * Makefile.in: Rebuild. + * configure.in (arch): Define. + * configure: Rebuild. + + * cgen-hob.scm (*UNSPECIFIED*): Renamed from UNSPECIFIED. + * All .scm files: Ditto. + + * dev.scm: Fix gas-test call to cpu-load. + * gas-test.scm: Clean up pass to remove bit-rot. + * sim-test.scm: Ditto. + + * enum.scm (read-enum): Fix typo in `vals' handling. + + * hardware.scm (-parse-hw-type): Fix typo. + (parse-hardware): Rename `asm' to `aasm' to avoid GCC reserved word. + (def-hardware,define-normal-hardware): Ditto. + + * hobbit.scm (*case-sensitive-flag*): New configuration variable. + (display-var): Use it. + * hobbit.c: Rebuild. + * hobbit.h: Rebuild. + + * ifield.scm (-ifield-read): Rename local `length' to `length-' to + avoid hobbit problem. + * mach.scm (-cpu-read): Rename local `parallel-insns' to + `parallel-insns-' to avoid hobbit problem. + +Fri Nov 6 17:19:12 1998 Doug Evans <devans@canuck.cygnus.com> + + * m32r.opc (parse_hi16): Fix call to cgen_parse_address. + (parse_slo16,parse_ulo16): Ditto. + * opcodes.scm (<hw-address>, method gen-parse): Ditto. + +Thu Nov 5 13:04:53 1998 Doug Evans <devans@canuck.cygnus.com> + + * Makefile.am (GUILELDFLAGS,GUILELDADD): New variables. + (cgen_LDFLAGS,cgen_LDADD,hob.x): Use them. + * Makefile.in: Rebuild. + * insn.scm (define-normal-insn): Expand pmacros. + * mode.scm (<mode>): New member `host?'. All uses updated. + (mode:host?): New proc. + * rtl.scm (define-rtx-node): Make a syntax proc, not a macro. + (define-rtx-syntax-node,define-rtx-macro-node): Ditto. + (define-rtx-dual-mode): Ditto. + (s-index-of): New proc. + (s-unop): Use plain C for host mode operations. + (s-binop,s-shop,s-boolifop,s-cmpop): Ditto. + * rtx-funcs.scm (index-of): New rtx function. + * sim.scm (<hw-index>): New method cxmake-get. + +Wed Nov 4 23:58:08 1998 Doug Evans <devans@seba.cygnus.com> + + * sim-cpu.scm (-gen-engine-decls): Delete. + +Wed Nov 4 18:40:47 1998 Dave Brolley <brolley@cygnus.com> + + * doc/rtl (Example): Correct Typo. + * doc/porting: Add 'make dep' step to opcodes port instructions. + * fr30.opc: New file. + * fr30.cpu: New file. + +Wed Oct 28 13:36:15 1998 Doug Evans <devans@canuck.cygnus.com> + + * configure.in: Handle guile $exec_prefix = $prefix/foo. + * Makefile.am (GUILEINCDIR): New variable. + (INCLUDES): Use it. + * configure: Regenerate. + * Makefile.in: Ditto. + * aclocal.m4: Ditto. + +Mon Oct 19 13:19:34 1998 Doug Evans <devans@seba.cygnus.com> + + * sim-cpu.scm (cgen-extract.c): Delete #include cpu-sim.h + (cgen-semantics.c): Ditto. + * sim-decode.scm (cgen-decode.c): Delete #include cpu-sim.h,cpu-opc.h. + * sim-model.scm (cgen-model.c): Ditto. + * sim.scm (cgen-arch.h): Delete #include @arch@-opc.h. + (cgen-arch.c): Delete #include cpu-sim.h,cpu-opc.h. + + * opcodes.scm (read-cpu.opc): Handle empty file. + + * cos.scm (-elm-make-method-setter): Fix typo. + + * cpu.scm (-init-parse-cpu!): Call types-init!. + (-finish-parse-cpu!): Call types-finish!. + * ifield.scm (<ifield>): Delete members start,length. + New member bitrange. + (<ifield>, methods field-start,field-length): Update. + (fld:start): New arg insn-len. All callers updated. + (<ifield>, methods field-mask,field-value): Update. + (-ifield-parse): Update. + (ifield-init!): Update. + * iformat.scm (compute-insn-length): Simplify. + (compute-insn-mask): Update. + * insn.scm (insn:value): Update. + * mach.scm (<arch-data>): New members default-insn-bitsize,insn-lsb0?. + (current-arch-default-insn-bitsize): New proc. + (current-arch-insn-lsb0?): New proc. + (-arch-parse,-arch-read): Update. + (<cpu>): New member file-transform. + (-cpu-parse,-cpu-read): Update. + * opcodes.scm (<hw-asm>, method gen-extract): Pass ex_info to handler. + (gen-hash-defines): Define CGEN_INSN_LSB0_P. + (CGEN_INT_INSN_P): Renamed from CGEN_INT_INSN. + (gen-insert-switch): Update args of @arch@_cgen_insert_operand. + (gen-extract-switch): Update args of @arch@_cgen_extract_operand. + (gen-opcode-open): Set CGEN_OPCODE_INSN_ENDIAN. + * operand.scm (op:start): Update call to field-start method. + * sim-decode.scm (opcode-slots): New arg lsb0?. + (fill-slot!,build-slots): Ditto. + (build-decode-table-entry,build-decode-table-guts): Ditto. + (gen-decoder-table,gen-decoder-switch,gen-decoder): Ditto. + (gen-decode-fn): Ditto. + (cgen-decode.c): Update call to gen-decode-fn. + * sim.scm (gen-argbuf-type): Move `semantic' to cpu specific part. + (-gen-cpu-header,-gen-cpuall-includes): New procs. + (cgen-cpuall.h): Call -gen-cpuall-includes. + * types.scm (<bitrange>): New class. + (types-init!,types-finish!): New procs. + * utils-cgen.scm (parse-number): New proc. + (parse-boolean): New proc. + * utils.scm (word-value): Renamed from shift-bits, rewrite. + (word-mask): Rewrite. + * m32r.cpu (define-arch): New fields default-insn-bitsize,insn-lsb0?. + (m32rxf): New field `file-transform'. + * m32r.opc (my_print_insn): print_int_insn -> print_insn. + + * hobbit.h: Fix include file name. + +Fri Oct 9 16:58:10 1998 Doug Evans <devans@seba.cygnus.com> + + * slib: New directory of slib files used by cgen/hobbit. + * hobbit.scm: New file. + * hobbit.c: New file. + * hobbit.h: New file. + * hobscmif.h: New file. + * hob-main.c: New file. + * hobslib.scm: New file. + * hob.sh: New file. + * Makefile.am: Add support for compiling hobbit, and using compiled + version of hobbit to compile cgen. + * Makefile.in: Regenerate. + * configure.in: Support --with-hobbit. + * configure: Regenerate. + * acconfig.h (WITH_HOBBIT): Add. + * config.in: Regenerate. + + * rtl.scm: New file, was cdl-c.scm. + Definition of rtx funcs moved to rtx-funcs.scm. + (semantic-in-out-operands): Rewrite to compute object form of + semantic code. + * rtx-funcs.scm: New file. + + * cgen-gh.c: #include "config.h". + (gh_cadddr,gh_cddddr): New fns. + (cgh_vector_to_list): New fn. + (cgh_map1,cgh_map2,cgh_map1_fn2): Rewrite. + (cgh_init): Prefix qsort procs with "cgh-". + * cgen-gh.h (gh_cadddr,gh_cddddr,cgh_vector_to_list): Declare. + * cgen.c: #include "config.h". + + * attr.scm (bitset-attr?): New proc. + (<bitset-attribute>, method parse-value): Value syntax changed from + (val1 val2 ...) to val1,val2,.... + (<bitset-attribute>): New method gen-value. + (<integer-attribute>): New method gen-value. + (<enum-attribute>): New method gen-value. + * cpu.scm: Disable debugging evaluator if (not (defined? 'DEBUG-EVAL)). + (<reader>): New class. + (CURRENT-ARCH,CURRENT-READER): New globals. + (keep-mach?): Move here from mach.scm. + * mach.scm (arch,arch-comment,arch-default-mach): Delete. + (<arch>): New class. + (<arch-data>): New class. + (<cpu>): Make subclass of <ident>. + (*ENDIAN* variables): Delete. + (process-state-vars): Delete. + (mach-finish!): Add `base' value to MACH attribute. + * hardware.scm (<hardware>): Make subclass of <ident>. + (hw:std-attrs): New global. + (hw-profilable?): New proc. + * ifield.scm (<ifield>): Make subclass of <ident>. + (sort-ifield-list): Move here from iformat.scm. + * iformat.scm (<iformat>): Renamed from <insn-format>. + Make subclass of <ident>. + (-ifmt-search-key): Include cti? in categorization of formats. + (ifmt-analyze): Compile semantics (turn to object form). + * insn.scm (<insn>): Make subclass of <ident>. + New member compiled-semantics. + (insn:std-attrs): Add SKIP-CTI, VIRTUAL. + * mode.scm (<mode>): Make subclass of <ident>. + (UBI): Delete. + * model.scm (<unit>): Make subclass of <ident>. + New members inputs,outputs. + (<model>): Make subclass of <ident>. New member state. + (-unit-parse): Parse inputs,outputs. + (<iunit>): New class. + (-insn-timing-parse-model): New proc. + (parse-insn-timing): Function unit spec rewritten. + * operand.scm (<operand>): Make subclass of <ident>. + New members sem-name,num,cond? New method gen-pretty-name. + (hw-index-scalar): New global. + (op-nub-hw): Move here from rtl.scm. + (op:lookup-sem-name,op-profilable?): New procs. + * pmacros.scm: Rewrite to pass through hobbit. + * utils-cgen.scm (gen-attr-defn): Simplify using new gen-value method. + * utils.scm (logit): Make a macro. + (bit-set?): Rewrite. + (high-part): Rewrite. + + * m32r.cpu (define-arch): Move to top of file. + (cpu family m32rbf): Renamed from m32rb. + (model m32r/d): Function unit spec rewritten. + (all insns): Ditto. Replace UBI with BI. + + * opcodes.scm (gen-attr-table-decls): Declare + @arch@_cgen_hw_attr_table. + (gen-attr-table-defns): Generate hw attribute table. + + * sim-cpu.scm (-gen-engine-decls): New proc. + (-gen-model-decls): New proc. + (gen-parallel-exec-type): Add new member `written' to struct parexec. + (-gen-record-args): Add SEM_BRANCH_INIT_EXTRACT if cti insn. + (-gen-record-profile-args): Simplify. + (-gen-parallel-sem-case): Delete. + (gen-semantic-fn): Emit SEM_BRANCH_{INIT,FINI} if cti insn. + New local `written'. Delete profiling code. + (-gen-sem-case): Ditto. + (-uncond-written-mask,-any-cond-written?): New procs. + (cgen-sem-switch.c): Include duplicates of insns that can be executed + parallelly or serially, and write-back handlers for all parallel insns. + * sim-decode.scm (-gen-decode-insn-globals): Add parallel write-back + support to initialization of struct insn_sem. + (-gen-idesc-decls): Add parallel write-back support to struct idesc. + (-gen-insn-sem-type): Add parallel write-back support to struct + insn_sem. + (-gen-idesc-init-fn): Add support for virtual insns. + Add parallel write-back support. + * sim-model.scm (gen-model-profile-fn): Delete + (-gen-model-fn-decls): New proc. + (-gen-model-insn-fn,-gen-model-insn-fns): New procs. + (-gen-model-init-fn): New proc. + (-gen-mach-defns): Initialize insn-name lookup and fast/full engine_fn + members in @mach@_init_cpu. + (cgen-model.c): Generate model handlers for each insn. + * sim.scm (gen-define-field-macro): Cti insns handled differently. + (<hw-pc>): New method gen-write. + (<hw-register>, method gen-write): New arg `mode'. + (<hw-register>): Delete method gen-record-profile!. + New method gen-profile-index-type. + (<hw-memory>, method gen-write): New arg `mode'. + (<hw-address>, method gen-extract): Delete. + (<hw-address>, method gen-write): New arg `mode'. + (<hw-index>, method get-write-index): Rewrite. + (<pc>, method cxmake-get-direct): Delete. + (<pc>): New method cxmake-get. Comment out methods + gen-set-quiet,gen-set-trace. + (<operand>): New methods gen-argbuf-elm,gen-profile-argbuf-elm, + gen-profile-index-type,gen-profile-code. + Delete method gen-pretty-name. Rewrite method gen-write. + Delete method cxmake-get-direct. + (-op-gen-set-trace): Update `written'. + (-op-gen-set-trace-parallel): Ditto. + (-gen-hw-index-raw,-gen-hw-index): Handle strings. + (gen-cpu-insn-enum-decl): Add extra entries for parallel + insns and their write-back handlers. + (insn-op-lookup): New proc. + (<unit>): New method gen-profile-code. + (<iunit>): New method gen-profile-code. + (gen-argbuf-elm): Add profiling elements. + (gen-argbuf-type): Define cti insns separately in their own struct. + Add member `addr_cache' to this struct. Add entries for pbb virtual + insns. Move semantic entries here from struct scache. + Delete everything from struct scache except argbuf. + (<insn>, method gen-profile-locals): Rewrite. + (<insn>, method gen-profile-code): Rewrite. + (sim-finish!): Create virtual pbb insns. + +Tue Sep 15 15:22:02 1998 Doug Evans <devans@canuck.cygnus.com> + + * m32r.cpu (h-cr): Add bbpc,bbpsw. + (h-sm,h-bsm,h-ie,h-bie,h-bcond,h-bpc): Delete. + (h-psw,h-bpsw,h-bbpsw): Define. + (rte,trap): Handle bbpc,bbpsw. + * opcodes.scm (max-operand-instances): Fix typo. + * sim.scm (<hardware-base>, method 'fun-access?): Don't force virtual + hardware elements to be fun-access. + (-hw-gen-fun-get,-hw-gen-fun-set): Fix handling of scalars. + +Wed Sep 9 15:28:55 1998 Doug Evans <devans@canuck.cygnus.com> + + * m32r.cpu (trap): Pass `pc' to m32r_trap. + +Mon Aug 10 14:29:33 1998 Doug Evans <devans@canuck.cygnus.com> + + * opcodes.scm (gen-insn-table-entry): Comment out generation of cdx. + +Mon Aug 3 11:51:04 1998 Doug Evans <devans@seba.cygnus.com> + + * m32r.cpu (cpu m32rb): Renamed from m32r to distinguish from + architecture name. + (mach m32r): Update. + + * mach.scm (mach:supports?): New proc. + * sim-cpu.scm (gen-cpu-reg-access-{decls,defns}): Renamed from + gen-reg-access-{decls,defns}. + * sim.scm (gen-reg-access-{decl,defn}): New procs. + (gen-mach-bfd-name): New proc. + (gen-arch-reg-access-{decls,defns}): New procs. + (cgen-arch.[ch]): Output register access cover fns. + + * hardware.scm (hardware-builtin!): Set print handlers for + h-addr,h-iaddr. + * m32r.opc (parse_hash,parse_hi16,parse_slo16,parse_ulo16): New arg + `od'. + (CGEN_PRINT_NORMAL,print_hash): Ditto. + (my_print_insn): Ditto. Delete args buf, buflen. + * opcodes.scm: Pass `od' (opcode-descriptor) to all C handlers. + (-hw-asm-specs): Add `handlers' spec. + (-parse-hw-asm): Lookup class at runtime. If no asm-spec, use + `normal-hw-asm'. + (<hw-asm>): Renamed from <opval>. New elements parse,insert,extract, + print. + (<hw-asm>, gen-insert,gen-extract,gen-print): Use them. + (<hw-asm>, parse!): New method. + (gen-insn-table-entry): Print semantics. + (gen-opcode-open): Renamed from gen-opcode-table. + + * utils.scm (string-write): No longer a macro. + (-string-write): Handle procedure args. + * opcodes.scm: Update all calls to string-write. + * sim-cpu.scm: Ditto. + * sim-decode.scm: Ditto. + * sim-model.scm: Ditto. + * sim.scm: Ditto. + +Fri Jul 31 14:40:38 1998 Doug Evans <devans@seba.cygnus.com> + + * opcodes.scm (cgen-ibd.h,gen-extra-ibd.h): New procs. + (-gen-insn-builders,-gen-insn-builder): New procs. + +Fri Jul 24 11:38:59 1998 Doug Evans <devans@canuck.cygnus.com> + + * opcodes.scm (gen-syntax-entry): Fix bracketing for -Wall. + (gen-opcode-table): Properly terminate comment. + +Tue Jul 21 10:51:42 1998 Doug Evans <devans@seba.cygnus.com> + + * Version 0.6.0. + Clean up pass over everything, so starting fresh. diff --git a/cgen/INSTALL b/cgen/INSTALL new file mode 100644 index 00000000000..b42a17ac464 --- /dev/null +++ b/cgen/INSTALL @@ -0,0 +1,182 @@ +Basic Installation +================== + + These are generic installation instructions. + + The `configure' shell script attempts to guess correct values for +various system-dependent variables used during compilation. It uses +those values to create a `Makefile' in each directory of the package. +It may also create one or more `.h' files containing system-dependent +definitions. Finally, it creates a shell script `config.status' that +you can run in the future to recreate the current configuration, a file +`config.cache' that saves the results of its tests to speed up +reconfiguring, and a file `config.log' containing compiler output +(useful mainly for debugging `configure'). + + If you need to do unusual things to compile the package, please try +to figure out how `configure' could check whether to do them, and mail +diffs or instructions to the address given in the `README' so they can +be considered for the next release. If at some point `config.cache' +contains results you don't want to keep, you may remove or edit it. + + The file `configure.in' is used to create `configure' by a program +called `autoconf'. You only need `configure.in' if you want to change +it or regenerate `configure' using a newer version of `autoconf'. + +The simplest way to compile this package is: + + 1. `cd' to the directory containing the package's source code and type + `./configure' to configure the package for your system. If you're + using `csh' on an old version of System V, you might need to type + `sh ./configure' instead to prevent `csh' from trying to execute + `configure' itself. + + Running `configure' takes awhile. While running, it prints some + messages telling which features it is checking for. + + 2. Type `make' to compile the package. + + 3. Optionally, type `make check' to run any self-tests that come with + the package. + + 4. Type `make install' to install the programs and any data files and + documentation. + + 5. You can remove the program binaries and object files from the + source code directory by typing `make clean'. To also remove the + files that `configure' created (so you can compile the package for + a different kind of computer), type `make distclean'. There is + also a `make maintainer-clean' target, but that is intended mainly + for the package's developers. If you use it, you may have to get + all sorts of other programs in order to regenerate files that came + with the distribution. + +Compilers and Options +===================== + + Some systems require unusual options for compilation or linking that +the `configure' script does not know about. You can give `configure' +initial values for variables by setting them in the environment. Using +a Bourne-compatible shell, you can do that on the command line like +this: + CC=c89 CFLAGS=-O2 LIBS=-lposix ./configure + +Or on systems that have the `env' program, you can do it like this: + env CPPFLAGS=-I/usr/local/include LDFLAGS=-s ./configure + +Compiling For Multiple Architectures +==================================== + + You can compile the package for more than one kind of computer at the +same time, by placing the object files for each architecture in their +own directory. To do this, you must use a version of `make' that +supports the `VPATH' variable, such as GNU `make'. `cd' to the +directory where you want the object files and executables to go and run +the `configure' script. `configure' automatically checks for the +source code in the directory that `configure' is in and in `..'. + + If you have to use a `make' that does not supports the `VPATH' +variable, you have to compile the package for one architecture at a time +in the source code directory. After you have installed the package for +one architecture, use `make distclean' before reconfiguring for another +architecture. + +Installation Names +================== + + By default, `make install' will install the package's files in +`/usr/local/bin', `/usr/local/man', etc. You can specify an +installation prefix other than `/usr/local' by giving `configure' the +option `--prefix=PATH'. + + You can specify separate installation prefixes for +architecture-specific files and architecture-independent files. If you +give `configure' the option `--exec-prefix=PATH', the package will use +PATH as the prefix for installing programs and libraries. +Documentation and other data files will still use the regular prefix. + + In addition, if you use an unusual directory layout you can give +options like `--bindir=PATH' to specify different values for particular +kinds of files. Run `configure --help' for a list of the directories +you can set and what kinds of files go in them. + + If the package supports it, you can cause programs to be installed +with an extra prefix or suffix on their names by giving `configure' the +option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'. + +Optional Features +================= + + Some packages pay attention to `--enable-FEATURE' options to +`configure', where FEATURE indicates an optional part of the package. +They may also pay attention to `--with-PACKAGE' options, where PACKAGE +is something like `gnu-as' or `x' (for the X Window System). The +`README' should mention any `--enable-' and `--with-' options that the +package recognizes. + + For packages that use the X Window System, `configure' can usually +find the X include and library files automatically, but if it doesn't, +you can use the `configure' options `--x-includes=DIR' and +`--x-libraries=DIR' to specify their locations. + +Specifying the System Type +========================== + + There may be some features `configure' can not figure out +automatically, but needs to determine by the type of host the package +will run on. Usually `configure' can figure that out, but if it prints +a message saying it can not guess the host type, give it the +`--host=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name with three fields: + CPU-COMPANY-SYSTEM + +See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the host type. + + If you are building compiler tools for cross-compiling, you can also +use the `--target=TYPE' option to select the type of system they will +produce code for and the `--build=TYPE' option to select the type of +system on which you are compiling the package. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Operation Controls +================== + + `configure' recognizes the following options to control how it +operates. + +`--cache-file=FILE' + Use and save the results of the tests in FILE instead of + `./config.cache'. Set FILE to `/dev/null' to disable caching, for + debugging `configure'. + +`--help' + Print a summary of the options to `configure', and exit. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--version' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`configure' also accepts some other, not widely useful, options. diff --git a/cgen/Makefile.am b/cgen/Makefile.am new file mode 100644 index 00000000000..53f3fea0bba --- /dev/null +++ b/cgen/Makefile.am @@ -0,0 +1,124 @@ +# Process this file with "automake --cygnus Makefile" to generate Makefile.in + +AUTOMAKE_OPTIONS = cygnus + +SUBDIRS = doc + +GUILE = `if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi` +CGENFLAGS = -v +ARCH = @arch@ + +# Applications depend on stamp-cgen to tell them when .scm files have +# been changed (so files need to be regenerated). +# ??? Application specific files are kept with cgen for now, but may +# eventually go with the app. stamp-cgen might still be useful to track +# app-independent files. + +all-local: stamp-cgen + +stamp-cgen: $(CGENFILES) + rm -f stamp-cgen + echo timestamp > stamp-cgen + +# Phony targets to run each of the applications, +# though most of these are for development purposes only. +# When actually building the toolchain, the Makefile in the appropriate +# directory will run cgen. + +# Build the basic description support. +# We just stuff them in tmp-* files. +# Usage: make desc ARCH=<arch> OPTIONS="<option list>" + +.PHONY: desc +# FIXME: needs more dependencies +desc: desc.scm + rm -f tmp-desc.h tmp-desc.c tmp-opinst.c + $(GUILE) -s $(srcdir)/cgen-opc.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -m all -a $(ARCH) \ + -H tmp-desc.h -C tmp-desc.c + +# Build the opcodes files. +# We just stuff them in tmp-* files. +# Usage: make opcodes ARCH=<arch> OPTIONS="<option list>" + +.PHONY: opcodes +# FIXME: needs more dependencies +opcodes: opcodes.scm + rm -f tmp-opc.h tmp-itab.c + rm -f tmp-asm.in tmp-dis.in tmp-ibld.h tmp-ibld.in + $(GUILE) -s $(srcdir)/cgen-opc.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS) opinst" \ + -m all -a $(ARCH) \ + -O tmp-opc.h -P tmp-opc.c -Q tmp-opinst.c \ + -B tmp-ibld.h -L tmp-ibld.in \ + -A tmp-asm.in -D tmp-dis.in + +# Build the simulator files. +# We just stuff them in tmp-* files. +# Usage: make sim-arch ARCH=<arch> OPTIONS="<option list>" +# make sim-cpu ARCH=<arch> ISA="<isa>" MACHS="<mach list>" \ +# OPTIONS="<option list>" + +.PHONY: sim-arch sim-cpu +# FIXME: needs more dependencies +sim-arch: sim.scm + rm -f tmp-arch.h tmp-arch.c tmp-cpuall.h + $(GUILE) -s $(srcdir)/cgen-sim.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -m all -a $(ARCH) \ + -A tmp-arch.h -B tmp-arch.c -N tmp-cpuall.h +sim-cpu: sim.scm + rm -f tmp-cpu.h tmp-cpu.c tmp-decode.h tmp-decode.c + rm -f tmp-model.c tmp-sem.c tmp-sem-switch.c + $(GUILE) -s $(srcdir)/cgen-sim.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -i "$(ISA)" -m "$(MACHS)" -a $(ARCH) \ + -C tmp-cpu.h -U tmp-cpu.c \ + -T tmp-decode.h -D tmp-decode.c \ + -M tmp-model.c \ + -S tmp-semantics.c -X tmp-sem-switch.c + +# Build GAS testcase generator. + +.PHONY: gas-test +gas-test: gas-test.scm cgen-gas.scm + @if test -z "$(ISA)" ; then \ + echo "ISA not specified!" ;\ + exit 1 ;\ + fi + $(GUILE) -s $(srcdir)/cgen-gas.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -m all \ + -i $(ISA) \ + -a $(ARCH) \ + -B gas-build.sh \ + -E gas-allinsn.exp + +# Build simulator testcase generator. + +.PHONY: sim-test +sim-test: sim-test.scm cgen-stest.scm + @if test -z "$(ISA)" ; then \ + echo "ISA not specified!" ;\ + exit 1 ;\ + fi + $(GUILE) -s $(srcdir)/cgen-stest.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -m all \ + -i $(ISA) \ + -a $(ARCH) \ + -B sim-build.sh \ + -E sim-allinsn.exp + +CLEANFILES = tmp-* diff --git a/cgen/Makefile.in b/cgen/Makefile.in new file mode 100644 index 00000000000..e42cf2e6517 --- /dev/null +++ b/cgen/Makefile.in @@ -0,0 +1,449 @@ +# Makefile.in generated automatically by automake 1.4 from Makefile.am + +# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +# Process this file with "automake --cygnus Makefile" to generate Makefile.in + + +SHELL = @SHELL@ + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = @bindir@ +sbindir = @sbindir@ +libexecdir = @libexecdir@ +datadir = @datadir@ +sysconfdir = @sysconfdir@ +sharedstatedir = @sharedstatedir@ +localstatedir = @localstatedir@ +libdir = @libdir@ +infodir = @infodir@ +mandir = @mandir@ +includedir = @includedir@ +oldincludedir = /usr/include + +DESTDIR = + +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ + +top_builddir = . + +ACLOCAL = @ACLOCAL@ +AUTOCONF = @AUTOCONF@ +AUTOMAKE = @AUTOMAKE@ +AUTOHEADER = @AUTOHEADER@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS) +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +transform = @program_transform_name@ + +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_alias = @build_alias@ +build_triplet = @build@ +host_alias = @host_alias@ +host_triplet = @host@ +target_alias = @target_alias@ +target_triplet = @target@ +EXEEXT = @EXEEXT@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +PACKAGE = @PACKAGE@ +VERSION = @VERSION@ +arch = @arch@ + +AUTOMAKE_OPTIONS = cygnus + +SUBDIRS = doc + +GUILE = `if test -f ../guile/libguile/guile ; then echo ../guile/libguile/guile; else echo guile ; fi` +CGENFLAGS = -v +ARCH = @arch@ + +CLEANFILES = tmp-* +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs +CONFIG_CLEAN_FILES = +DIST_COMMON = README AUTHORS COPYING ChangeLog INSTALL Makefile.am \ +Makefile.in NEWS aclocal.m4 configure configure.in + + +DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) + +TAR = gtar +GZIP_ENV = --best +all: all-redirect +.SUFFIXES: +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) + cd $(top_srcdir) && $(AUTOMAKE) --cygnus Makefile + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) \ + && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status + +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ configure.in + cd $(srcdir) && $(ACLOCAL) + +config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + $(SHELL) ./config.status --recheck +$(srcdir)/configure: @MAINTAINER_MODE_TRUE@$(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES) + cd $(srcdir) && $(AUTOCONF) + +# This directory's subdirectories are mostly independent; you can cd +# into them and run `make' without going through this Makefile. +# To change the values of `make' variables: instead of editing Makefiles, +# (1) if the variable is set in `config.status', edit `config.status' +# (which will cause the Makefiles to be regenerated when you run `make'); +# (2) otherwise, pass the desired values on the `make' command line. + +@SET_MAKE@ + +all-recursive install-data-recursive install-exec-recursive \ +installdirs-recursive install-recursive uninstall-recursive install-info-recursive \ +check-recursive installcheck-recursive info-recursive dvi-recursive: + @set fnord $(MAKEFLAGS); amf=$$2; \ + dot_seen=no; \ + target=`echo $@ | sed s/-recursive//`; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + dot_seen=yes; \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ + done; \ + if test "$$dot_seen" = "no"; then \ + $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \ + fi; test -z "$$fail" + +mostlyclean-recursive clean-recursive distclean-recursive \ +maintainer-clean-recursive: + @set fnord $(MAKEFLAGS); amf=$$2; \ + dot_seen=no; \ + rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \ + rev="$$subdir $$rev"; \ + test "$$subdir" = "." && dot_seen=yes; \ + done; \ + test "$$dot_seen" = "no" && rev=". $$rev"; \ + target=`echo $@ | sed s/-recursive//`; \ + for subdir in $$rev; do \ + echo "Making $$target in $$subdir"; \ + if test "$$subdir" = "."; then \ + local_target="$$target-am"; \ + else \ + local_target="$$target"; \ + fi; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \ + || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \ + done && test -z "$$fail" +tags-recursive: + list='$(SUBDIRS)'; for subdir in $$list; do \ + test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \ + done + +tags: TAGS + +ID: $(HEADERS) $(SOURCES) $(LISP) + list='$(SOURCES) $(HEADERS)'; \ + unique=`for i in $$list; do echo $$i; done | \ + awk ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + here=`pwd` && cd $(srcdir) \ + && mkid -f$$here/ID $$unique $(LISP) + +TAGS: tags-recursive $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP) + tags=; \ + here=`pwd`; \ + list='$(SUBDIRS)'; for subdir in $$list; do \ + if test "$$subdir" = .; then :; else \ + test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \ + fi; \ + done; \ + list='$(SOURCES) $(HEADERS)'; \ + unique=`for i in $$list; do echo $$i; done | \ + awk ' { files[$$0] = 1; } \ + END { for (i in files) print i; }'`; \ + test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \ + || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS) + +mostlyclean-tags: + +clean-tags: + +distclean-tags: + -rm -f TAGS ID + +maintainer-clean-tags: + +distdir = $(PACKAGE)-$(VERSION) +top_distdir = $(distdir) + +# This target untars the dist file and tries a VPATH configuration. Then +# it guarantees that the distribution is self-contained by making another +# tarfile. +distcheck: dist + -rm -rf $(distdir) + GZIP=$(GZIP_ENV) $(TAR) zxf $(distdir).tar.gz + mkdir $(distdir)/=build + mkdir $(distdir)/=inst + dc_install_base=`cd $(distdir)/=inst && pwd`; \ + cd $(distdir)/=build \ + && ../configure --srcdir=.. --prefix=$$dc_install_base \ + && $(MAKE) $(AM_MAKEFLAGS) \ + && $(MAKE) $(AM_MAKEFLAGS) dvi \ + && $(MAKE) $(AM_MAKEFLAGS) check \ + && $(MAKE) $(AM_MAKEFLAGS) install \ + && $(MAKE) $(AM_MAKEFLAGS) installcheck \ + && $(MAKE) $(AM_MAKEFLAGS) dist + -rm -rf $(distdir) + @banner="$(distdir).tar.gz is ready for distribution"; \ + dashes=`echo "$$banner" | sed s/./=/g`; \ + echo "$$dashes"; \ + echo "$$banner"; \ + echo "$$dashes" +dist: distdir + -chmod -R a+r $(distdir) + GZIP=$(GZIP_ENV) $(TAR) chozf $(distdir).tar.gz $(distdir) + -rm -rf $(distdir) +dist-all: distdir + -chmod -R a+r $(distdir) + GZIP=$(GZIP_ENV) $(TAR) chozf $(distdir).tar.gz $(distdir) + -rm -rf $(distdir) +distdir: $(DISTFILES) + -rm -rf $(distdir) + mkdir $(distdir) + -chmod 777 $(distdir) + @for file in $(DISTFILES); do \ + if test -f $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + cp -pr $$d/$$file $(distdir)/$$file; \ + else \ + test -f $(distdir)/$$file \ + || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ + || cp -p $$d/$$file $(distdir)/$$file || :; \ + fi; \ + done + for subdir in $(SUBDIRS); do \ + if test "$$subdir" = .; then :; else \ + test -d $(distdir)/$$subdir \ + || mkdir $(distdir)/$$subdir \ + || exit 1; \ + chmod 777 $(distdir)/$$subdir; \ + (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(distdir) distdir=../$(distdir)/$$subdir distdir) \ + || exit 1; \ + fi; \ + done +info-am: +info: info-recursive +dvi-am: +dvi: dvi-recursive +check-am: +check: check-recursive +installcheck-am: +installcheck: installcheck-recursive +install-info-am: +install-info: install-info-recursive +install-exec-am: +install-exec: install-exec-recursive + +install-data-am: +install-data: install-data-recursive + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am +install: install-recursive +uninstall-am: +uninstall: uninstall-recursive +all-am: Makefile all-local +all-redirect: all-recursive +install-strip: + $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install +installdirs: installdirs-recursive +installdirs-am: + + +mostlyclean-generic: + +clean-generic: + -test -z "$(CLEANFILES)" || rm -f $(CLEANFILES) + +distclean-generic: + -rm -f Makefile $(CONFIG_CLEAN_FILES) + -rm -f config.cache config.log stamp-h stamp-h[0-9]* + +maintainer-clean-generic: +mostlyclean-am: mostlyclean-tags mostlyclean-generic + +mostlyclean: mostlyclean-recursive + +clean-am: clean-tags clean-generic mostlyclean-am + +clean: clean-recursive + +distclean-am: distclean-tags distclean-generic clean-am + +distclean: distclean-recursive + -rm -f config.status + +maintainer-clean-am: maintainer-clean-tags maintainer-clean-generic \ + distclean-am + @echo "This command is intended for maintainers to use;" + @echo "it deletes files that may require special tools to rebuild." + +maintainer-clean: maintainer-clean-recursive + -rm -f config.status + +.PHONY: install-data-recursive uninstall-data-recursive \ +install-exec-recursive uninstall-exec-recursive installdirs-recursive \ +uninstalldirs-recursive all-recursive check-recursive \ +installcheck-recursive info-recursive dvi-recursive \ +mostlyclean-recursive distclean-recursive clean-recursive \ +maintainer-clean-recursive tags tags-recursive mostlyclean-tags \ +distclean-tags clean-tags maintainer-clean-tags distdir info-am info \ +dvi-am dvi check check-am installcheck-am installcheck install-info-am \ +install-info install-exec-am install-exec install-data-am install-data \ +install-am install uninstall-am uninstall all-local all-redirect all-am \ +all installdirs-am installdirs mostlyclean-generic distclean-generic \ +clean-generic maintainer-clean-generic clean mostlyclean distclean \ +maintainer-clean + + +# Applications depend on stamp-cgen to tell them when .scm files have +# been changed (so files need to be regenerated). +# ??? Application specific files are kept with cgen for now, but may +# eventually go with the app. stamp-cgen might still be useful to track +# app-independent files. + +all-local: stamp-cgen + +stamp-cgen: $(CGENFILES) + rm -f stamp-cgen + echo timestamp > stamp-cgen + +# Phony targets to run each of the applications, +# though most of these are for development purposes only. +# When actually building the toolchain, the Makefile in the appropriate +# directory will run cgen. + +# Build the basic description support. +# We just stuff them in tmp-* files. +# Usage: make desc ARCH=<arch> OPTIONS="<option list>" + +.PHONY: desc +# FIXME: needs more dependencies +desc: desc.scm + rm -f tmp-desc.h tmp-desc.c tmp-opinst.c + $(GUILE) -s $(srcdir)/cgen-opc.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -m all -a $(ARCH) \ + -H tmp-desc.h -C tmp-desc.c + +# Build the opcodes files. +# We just stuff them in tmp-* files. +# Usage: make opcodes ARCH=<arch> OPTIONS="<option list>" + +.PHONY: opcodes +# FIXME: needs more dependencies +opcodes: opcodes.scm + rm -f tmp-opc.h tmp-itab.c + rm -f tmp-asm.in tmp-dis.in tmp-ibld.h tmp-ibld.in + $(GUILE) -s $(srcdir)/cgen-opc.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS) opinst" \ + -m all -a $(ARCH) \ + -O tmp-opc.h -P tmp-opc.c -Q tmp-opinst.c \ + -B tmp-ibld.h -L tmp-ibld.in \ + -A tmp-asm.in -D tmp-dis.in + +# Build the simulator files. +# We just stuff them in tmp-* files. +# Usage: make sim-arch ARCH=<arch> OPTIONS="<option list>" +# make sim-cpu ARCH=<arch> ISA="<isa>" MACHS="<mach list>" \ +# OPTIONS="<option list>" + +.PHONY: sim-arch sim-cpu +# FIXME: needs more dependencies +sim-arch: sim.scm + rm -f tmp-arch.h tmp-arch.c tmp-cpuall.h + $(GUILE) -s $(srcdir)/cgen-sim.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -m all -a $(ARCH) \ + -A tmp-arch.h -B tmp-arch.c -N tmp-cpuall.h +sim-cpu: sim.scm + rm -f tmp-cpu.h tmp-cpu.c tmp-decode.h tmp-decode.c + rm -f tmp-model.c tmp-sem.c tmp-sem-switch.c + $(GUILE) -s $(srcdir)/cgen-sim.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -f "$(OPTIONS)" \ + -i "$(ISA)" -m "$(MACHS)" -a $(ARCH) \ + -C tmp-cpu.h -U tmp-cpu.c \ + -T tmp-decode.h -D tmp-decode.c \ + -M tmp-model.c \ + -S tmp-semantics.c -X tmp-sem-switch.c + +# Build GAS testcase generator. + +.PHONY: gas-test +gas-test: gas-test.scm cgen-gas.scm + @if test -z "$(ISA)" ; then \ + echo "ISA not specified!" ;\ + exit 1 ;\ + fi + $(GUILE) -s $(srcdir)/cgen-gas.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -m all \ + -i $(ISA) \ + -a $(ARCH) \ + -B gas-build.sh \ + -E gas-allinsn.exp + +# Build simulator testcase generator. + +.PHONY: sim-test +sim-test: sim-test.scm cgen-stest.scm + @if test -z "$(ISA)" ; then \ + echo "ISA not specified!" ;\ + exit 1 ;\ + fi + $(GUILE) -s $(srcdir)/cgen-stest.scm \ + -s $(srcdir) \ + $(CGENFLAGS) \ + -m all \ + -i $(ISA) \ + -a $(ARCH) \ + -B sim-build.sh \ + -E sim-allinsn.exp + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/cgen/NEWS b/cgen/NEWS new file mode 100644 index 00000000000..f9c9060ac00 --- /dev/null +++ b/cgen/NEWS @@ -0,0 +1,3 @@ +News for CGEN Version 0.7.3 + +Prepping for public release. diff --git a/cgen/README b/cgen/README new file mode 100644 index 00000000000..d826225b522 --- /dev/null +++ b/cgen/README @@ -0,0 +1,191 @@ +This is the README for CGEN 0.7.1 + +If you just want to read up on cgen, I suggest going directly to the +doc directory, and in particular doc/intro.texi. + +What is it? +=========== + +In a nutshell, CGEN is a project to provide a uniform framework for doing +binutils and simulator ports without explicitly closing any doors on anything +else one might want to do with the cpu description (i.e. application +independence). The "cpu description" as defined here includes anything useful. +To this end CGEN is a very open-ended and ambitious project. + +The core of CGEN is a cpu description file and code to slurp it in and +build a database describing the cpu. From this the Binutils opcodes table +can be generated for example, as well as an ISA simulator decoder/executor. + +CGEN is not a new idea. Other GNU ports have done this (e.g. `sh' in its +early days). However, the idea never really "caught on". CGEN was started +because I think it should be. + +CGEN is short for "Cpu tools GENerator". It's not a very good name. +I'm not very good at picking names. An early version of the name was +"GENCPU"! So give me a better one. + +Copyright +========= + +CGEN is Copyright 2000 Red Hat, Inc. + +The full text of the copyright for CGEN is contained in the file +COPYING.CGEN. The copyright of CGEN uses the Autoconf copyright +as a guide. The intent is to have CGEN under a GNU-style copyright but +place no restrictions on the output of CGEN. + +Installation +============ + +CGEN 0.7.1 can be used with GNU Binutils snapshots as of ?????? +and GNU GDB snapshots as of ??????. +GNU Binutils/GDB users will never "use" CGEN. The generated sources +are shipped with GNU Binutils/GDB releases. +Binutils/GDB developers wishing to use CGEN must configure Binutils/GDB with +--enable-cgen-maint. This will add the necessary dependencies to +opcodes/Makefile and sim/<arch>/Makefile for the supported processors, which +at this point is M32R and FR30. + +CGEN uses Guile so Guile must be installed. +Guile 1.2 and 1.3 are supported. +2) + +Source Layout +============= + +CGEN sources are divided into several categories: + +- documentation +- code to read .cpu files +- opcode table generator +- gas testsuite generator +- simulator generator +- misc support scripts +- cpu specific files +- C support code + +File naming rules: + +1) The top level script for each application shall be named cgen-<appl>.scm. + No other files shall be named cgen-*.scm. +2) Files implementing a particular class (or related collection of classes) + shall be named <class-name>.scm, or a reasonable abbreviation thereof. +3) CPU description files shall be named <arch>.cpu. + [it should go without saying that no other files shall be named <arch>.cpu] +4) CPU opcode support files shall be named <arch>.opc. + [it should go without saying that no other files shall be named <arch>.opc] + +??? May wish to change (1) to <appl>-cgen.scm so that each application's +files will be collected together in `ls' output by the <appl>- prefix. + +documentation +------------- + +doc/cgen.texi - top level .texi file, includes the others +doc/rtl.texi - cpu description language (based on GCC's RTL) +doc/intro.texi - global overview of cgen +doc/opcodes.texi - opcode table usage of cgen +doc/porting.texi - porting guide for new ports +doc/sim.texi - simulator usage of cgen +doc/credits.texi - inspiration and contributors + +code to read .cpu files +----------------------- + +These files provide the basic support for reading in .cpu files. They contain +no application specific code (and ideally as little C generating code as +possible too), they are intended to be application independent. Applications +(e.g. the opcode table generator and the simulator support generator) are +built on top of these files. + +attr.scm - attribute support +read.scm - top level script for .cpu file reading +enum.scm - enum support +hardware.scm - hardware description reader +ifield.scm - instruction field reader +iformat.scm - computes instruction formats +insn.scm - instruction description reader +mach.scm - architecture/cpu/machine reader +minsn.scm - macro-instruction description reader +mode.scm - mode support +model.scm - model reader +operand.scm - instruction operand reader +rtl.scm - basic rtl support +rtx-funcs.scm - defines all standard rtx functions +types.scm - type system + +opcode table generator +--------------------- + +cgen-opc.scm - top level script to generate the opcode table + support +opcodes.scm - opcode table generator +opc-asmdis.scm +opc-ibld.scm +opc-itab.scm +opc-opinst.scm + +Additional support lives in the opcodes directory. + +opcodes/cgen-ibld.in - input file for <arch>-ibld.c +opcodes/cgen-asm.in - input file for <arch>-asm.c +opcodes/cgen-dis.in - input file for <arch>-dis.c +opcodes/cgen-opc.c - architecture independent opcode table support +opcodes/cgen-asm.c - architecture independent assembler support +opcodes/cgen-dis.c - architecture independent disassembler support +opcodes/cgen.sh - shell script invoked by opcodes/Makefile to build + <arch>-opc.h, <arch>-opc.c, <arch>-asm.c, <arch>-dis.c. + +The header file that defines the interface to the opcodes table is +include/opcode/cgen.h. + +gas testsuite generator +----------------------- + +cgen-gas.scm - top level script to generate gas testcases +gas-test.scm - generate gas testcases + +simulator generator +------------------- + +cgen-sim.scm - top level script to generate simulator files +sim-arch.scm - generator for architecture-wide support files +sim-cpu.scm - generator for cpu specific simulator files +sim-decode.scm - decoder generator +sim-model.scm - generates model support +sim.scm - interface between simulator generator and cpu database + +Additional support lives in sim/common/cgen-*.[ch]. +Architectures specific files live in sim/<arch>. + +misc. support scripts +--------------------- + +dev.scm - top level script for doing interactive development +fixup.scm - munges the Scheme environment to make it suit us + [Guile is/was still in flux] +cos.scm - OOP implementation +pmacros.scm - preprocessor-style macro package +profile.scm - Guile profiling tool [eventually wish to move this to + Guile distribution when finished] +sort.scm - sort routine, from slib +utils-cgen.scm - various utilities specific to cgen +utils.scm - generic Scheme utilities [non cgen specific] + +cpu specific files +------------------ + +<arch>.cpu - <arch> description file +<arch>.opc - <arch> opcode support + +null.cpu - minimal .cpu file for debugging purposes + +C version of cgen +----------------- + +Makefile.am, Makefile.in - automake stuff +acconfig.h,aclocal.m4,config.in,stamp-h.in - autoconf stuff +configure.in,configure - autoconf stuff +gdbinit.in - source for .gdbinit file +cgen.c - main() +cgen-gh.[ch] - additional functionality to Guile's gh interface +cos.[ch] - C implementation of cgen object system diff --git a/cgen/aclocal.m4 b/cgen/aclocal.m4 new file mode 100644 index 00000000000..f5379a5be03 --- /dev/null +++ b/cgen/aclocal.m4 @@ -0,0 +1,137 @@ +dnl aclocal.m4 generated automatically by aclocal 1.4 + +dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl This program is distributed in the hope that it will be useful, +dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without +dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A +dnl PARTICULAR PURPOSE. + +# Do all the work for Automake. This macro actually does too much -- +# some checks are only needed if your package does certain things. +# But this isn't really a big deal. + +# serial 1 + +dnl Usage: +dnl AM_INIT_AUTOMAKE(package,version, [no-define]) + +AC_DEFUN(AM_INIT_AUTOMAKE, +[AC_REQUIRE([AC_PROG_INSTALL]) +PACKAGE=[$1] +AC_SUBST(PACKAGE) +VERSION=[$2] +AC_SUBST(VERSION) +dnl test to see if srcdir already configured +if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then + AC_MSG_ERROR([source directory already configured; run "make distclean" there first]) +fi +ifelse([$3],, +AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package]) +AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package])) +AC_REQUIRE([AM_SANITY_CHECK]) +AC_REQUIRE([AC_ARG_PROGRAM]) +dnl FIXME This is truly gross. +missing_dir=`cd $ac_aux_dir && pwd` +AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir) +AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir) +AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir) +AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir) +AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir) +AC_REQUIRE([AC_PROG_MAKE_SET])]) + +# +# Check to make sure that the build environment is sane. +# + +AC_DEFUN(AM_SANITY_CHECK, +[AC_MSG_CHECKING([whether build environment is sane]) +# Just in case +sleep 1 +echo timestamp > conftestfile +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null` + if test "[$]*" = "X"; then + # -L didn't work. + set X `ls -t $srcdir/configure conftestfile` + fi + if test "[$]*" != "X $srcdir/configure conftestfile" \ + && test "[$]*" != "X conftestfile $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken +alias in your environment]) + fi + + test "[$]2" = conftestfile + ) +then + # Ok. + : +else + AC_MSG_ERROR([newly created file is older than distributed files! +Check your system clock]) +fi +rm -f conftest* +AC_MSG_RESULT(yes)]) + +dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY) +dnl The program must properly implement --version. +AC_DEFUN(AM_MISSING_PROG, +[AC_MSG_CHECKING(for working $2) +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if ($2 --version) < /dev/null > /dev/null 2>&1; then + $1=$2 + AC_MSG_RESULT(found) +else + $1="$3/missing $2" + AC_MSG_RESULT(missing) +fi +AC_SUBST($1)]) + +# Add --enable-maintainer-mode option to configure. +# From Jim Meyering + +# serial 1 + +AC_DEFUN(AM_MAINTAINER_MODE, +[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles]) + dnl maintainer-mode is disabled by default + AC_ARG_ENABLE(maintainer-mode, +[ --enable-maintainer-mode enable make rules and dependencies not useful + (and sometimes confusing) to the casual installer], + USE_MAINTAINER_MODE=$enableval, + USE_MAINTAINER_MODE=no) + AC_MSG_RESULT($USE_MAINTAINER_MODE) + AM_CONDITIONAL(MAINTAINER_MODE, test $USE_MAINTAINER_MODE = yes) + MAINT=$MAINTAINER_MODE_TRUE + AC_SUBST(MAINT)dnl +] +) + +# Define a conditional. + +AC_DEFUN(AM_CONDITIONAL, +[AC_SUBST($1_TRUE) +AC_SUBST($1_FALSE) +if $2; then + $1_TRUE= + $1_FALSE='#' +else + $1_TRUE='#' + $1_FALSE= +fi]) + diff --git a/cgen/arm.cpu b/cgen/arm.cpu new file mode 100644 index 00000000000..9d1344a0ad8 --- /dev/null +++ b/cgen/arm.cpu @@ -0,0 +1,404 @@ +; ARM CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +(include "simplify.inc") + +(define-arch + (name arm) + (comment "Advanced RISC Machines (ARM)") + (insn-lsb0? #t) + (machs arm7tdmi) + (isas arm thumb) +) + +; ??? There should be an official rtx to do this. Until then. +(define-pmacro (invalid-insn) + (c-call BI "invalid_insn" pc) ; FIXME: Not VOID to workaround codegen bug. +) + +(define-isa + (name arm) + (comment "ARM instruction set (32 bit insns)") + (base-insn-bitsize 32) + ; FIXME: wip. `f-cond' is currently defined in arm7.cpu. + (condition f-cond + ; `cond-code' is the extracted value of `f-cond' + ; FIXME: wip +; (case BI cond-code +; ((COND_EQ) (reg h-zbit)) +; ((COND_NE) (not (reg h-zbit))) +; ((COND_CS) (reg h-cbit)) +; ((COND_CC) (not (reg h-cbit))) +; ((COND_MI) (reg h-nbit)) +; ((COND_PL) (not (reg h-zbit))) +; ((COND_VS) (reg h-vbit)) +; ((COND_VC) (not (reg h-vbit))) +; ((COND_HI) (and (reg h-cbit) (not (reg h-zbit)))) +; ((COND_LS) (not (or (reg h-cbit) (reg h-zbit)))) +; ((COND_GE) (eq (reg h-zbit) (reg h-vbit))) +; ((COND_LT) (ne (reg h-nbit) (reg h-vbit))) +; ((COND_GT) (and (not (reg h-zbit)) +; (eq (reg h-nbit) (reg h-vbit)))) +; ((COND_LE) (or (reg h-zbit) +; (ne (reg h-nbit) (reg h-vbit)))) +; ((COND_AL) 1) +; (else (sequence BI () (invalid-insn) 1)))) + (c-call BI "eval_cond" cond-code pc)) + (decode-assist (27 26 25 24 23 22 21)) + ; We can lengthen pbb's by breaking insns that set h-gr into those that set + ; h-gr[15] (the pc), and those that don't. + ; Other analysis of the isa will benefit from this, so this is recorded here + ; rather than in a simulator specific file. +;; (decode-splits +;; ; split insns with field f-rd into f-rd == 15, f-rd != 15 +;; ; ??? To be made more general in time. +;; (f-rd ; split on values of this field +;; () ; no extra constraints +;; ((no-pc-dest (.iota 15)) (pc-dest 15)) ; list of splits +;; ) +;; ) + (setup-semantics (set-quiet (reg h-gr 15) (add pc (attr (current-insn) R15-OFFSET)))) +) + +(define-isa + (name thumb) + (comment "ARM Thumb instruction set (16 bit insns)") + (base-insn-bitsize 16) + (decode-assist (15 14 13 12 11 10 9 8)) + (setup-semantics (set-quiet (reg h-gr 15) (add pc 4))) +) + +(define-cpu + (name arm7f) + (comment "ARM7") + (endian either) + (word-bitsize 32) +) + +(define-mach + (name arm7tdmi) + (comment "ARM 7TDMI core") + (cpu arm7f) + (isas arm thumb) +) + +(define-model + (name arm710) + (comment "ARM 710 microprocessor") + (mach arm7tdmi) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () () () ()) +) + +; Hardware. + +; The program counter is actually reg 15. +; But ... [there's always a "But ..." :-(] when referenced in instructions +; the value is either 8 or 12 beyond the address of the instruction in +; ARM mode and 4 beyond in Thumb mode. +; To handle this the program counter is treated as a separate register +; and r15 is set to the appropriate offset before executing each instruction. +; This seems like the simplest and most efficient way to handle this. + +(define-hardware + (name h-pc) + (comment "ARM program counter (h-gr reg 15)") + (attrs PC (ISA arm,thumb)) + (type pc) + ; In ARM mode the bottom two bits read as zero. + ; In Thumb mode the bottom bit reads as zero. + ; This can be handled during gets, sets, or both. + ; Handling this in sets seems best ('tis handled in only one place and the + ; stored value is always correct - assuming all out-of-band sets are ok). + ; ??? Might be possible to optimize out the test of tbit. Later. + (set (newval) + (if (reg h-tbit) + (set (raw-reg SI h-pc) (and newval -2)) + (set (raw-reg SI h-pc) (and newval -4)))) +) + +(define-keyword + (name gr-names) + (print-name h-gr) + (values (pc 15) ; put this first so it is prefered over r15 + (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15) + (sp 13) (lr 14)) +) + +(define-hardware + (name h-gr) + (comment "General purpose registers") + (attrs (ISA arm,thumb) CACHE-ADDR) + (type register SI (16)) + (indices extern-keyword gr-names) +) + +; Banked versions of h-gr. +; h-gr is always "active". When a mode switch happens, the copies in h-gr +; are copied to their holding buffers, and new values are switched in. +; ??? The non-user-mode versions of these registers have special names which +; are just(?) aliases for the normal names. + +(define-hardware + (name h-gr-usr) + (comment "user/system mode r8-r14 holding buffer") + (attrs (ISA arm,thumb)) + (type register SI (7)) +) +(define-hardware + (name h-gr-fiq) + (comment "fiq mode r8-r14 regs") + (attrs (ISA arm,thumb)) + (type register SI (7)) +) +(define-hardware + (name h-gr-svc) + (comment "supervisor mode r13-r14 regs") + (attrs (ISA arm,thumb)) + (type register SI (2)) +) +(define-hardware + (name h-gr-abt) + (comment "abort mode r13-r14 regs") + (attrs (ISA arm,thumb)) + (type register SI (2)) +) +(define-hardware + (name h-gr-irq) + (comment "irq mode r13-r14 regs") + (attrs (ISA arm,thumb)) + (type register SI (2)) +) +(define-hardware + (name h-gr-und) + (comment "undefined mode r13-r14 regs") + (attrs (ISA arm,thumb)) + (type register SI (2)) +) + +; The condition code bits. + +(dsh h-cbit "carry bit" ((ISA arm,thumb)) (register BI)) +(dsh h-nbit "negative bit" ((ISA arm,thumb)) (register BI)) +(dsh h-vbit "overflow bit" ((ISA arm,thumb)) (register BI)) +(dsh h-zbit "zerobit" ((ISA arm,thumb)) (register BI)) + +(dnop cbit "carry bit" ((ISA arm,thumb)) h-cbit f-nil) +(dnop nbit "negative bit" ((ISA arm,thumb)) h-nbit f-nil) +(dnop vbit "overflow bit" ((ISA arm,thumb)) h-vbit f-nil) +(dnop zbit "zero bit" ((ISA arm,thumb)) h-zbit f-nil) + +; The CPSR (current program status register). + +(dsh h-ibit "irq disable bit" ((ISA arm,thumb)) (register BI)) +(dsh h-fbit "fiq disable bit" ((ISA arm,thumb)) (register BI)) + +(define-hardware + (name h-tbit) + (comment "thumb bit") + (attrs (ISA arm,thumb)) + (type register BI) + (set (newval) + (sequence () + (c-call VOID "arm_tbit_set" newval))) +) + +(define-keyword + (name arm-mode) + (comment "arm cpu states") + (values (User #x10) + (FIQ #x11) + (IRQ #x12) + (Supervisor #x13) + (Abort #x17) + (Undefined #x1b) + (System #x1f) + ) +) + +(define-hardware + (name h-mbits) + (comment "m4,m3,m2,m1,m0") + (attrs (ISA arm,thumb)) + (type register (UINT 5)) + (set (newval) + (sequence () + ; processor goes into an undefined state if bad value, + ; so do something similar + (case VOID newval + ((ARM-MODE-User ARM-MODE-FIQ ARM-MODE-IRQ + ARM-MODE-Supervisor ARM-MODE-Abort + ARM-MODE-Undefined ARM-MODE-System) + (nop)) + (else (error VOID "bad value for M4-M0"))) + (c-call VOID "arm_mbits_set" newval))) +) + +(define-hardware + (name h-cpsr) + (comment "Current Program Status Register") + (attrs VIRTUAL (ISA arm,thumb)) + (type register SI) ; One CPSR register. + (get () + ; ??? 'twould be nice if one `or' would do + (or SI (sll (zext SI (reg BI h-nbit)) (const 31)) + (or SI (sll (zext SI (reg BI h-zbit)) (const 30)) + (or SI (sll (zext SI (reg BI h-cbit)) (const 29)) + (or SI (sll (zext SI (reg BI h-vbit)) (const 28)) + (or SI (sll (zext SI (reg BI h-ibit)) (const 7)) + (or SI (sll (zext SI (reg BI h-fbit)) (const 6)) + (or SI (sll (zext SI (reg BI h-tbit)) (const 5)) + (reg UINT h-mbits))))))))) + (set (newval) + (sequence () + ; FIXME: Processor enters undefined state if software changes + ; tbit, so we should do something similar. + (set (reg h-nbit) (ne (and newval #x80000000) 0)) + (set (reg h-zbit) (ne (and newval #x40000000) 0)) + (set (reg h-cbit) (ne (and newval #x20000000) 0)) + (set (reg h-vbit) (ne (and newval #x10000000) 0)) + ; FIXME: user mode is not permitted to change ibit/fbit! + (set (reg h-ibit) (ne (and newval #x00000080) 0)) + (set (reg h-fbit) (ne (and newval #x00000040) 0)) + (set (reg h-tbit) (ne (and newval #x00000020) 0)) + (set (reg h-mbits) (and newval #x1f)))) +) + +(define-hardware + (name h-spsr-fiq) + (comment "Saved Process Status Register during FIQ") + (attrs (ISA arm,thumb)) + (type register SI) +) +(define-hardware + (name h-spsr-svc) + (comment "Saved Process Status Register during SVC") + (attrs (ISA arm,thumb)) + (type register SI) +) +(define-hardware + (name h-spsr-abt) + (comment "Saved Process Status Register during Abort") + (attrs (ISA arm,thumb)) + (type register SI) +) +(define-hardware + (name h-spsr-irq) + (comment "Saved Process Status Register during IRQ") + (attrs (ISA arm,thumb)) + (type register SI) +) +(define-hardware + (name h-spsr-und) + (comment "Saved Process Status Register during Undefined") + (attrs (ISA arm,thumb)) + (type register SI) +) + +; Virtual version of spsr to access real one based on current mode. + +(define-hardware + (name h-spsr) + (comment "virtual spsr") + (attrs VIRTUAL (ISA arm,thumb)) + (type register SI) + (get () + (case SI (reg h-mbits) + ((ARM-MODE-User) (error SI "can't read spsr in user mode")) + ((ARM-MODE-FIQ) (reg h-spsr-fiq)) + ((ARM-MODE-IRQ) (reg h-spsr-irq)) + ((ARM-MODE-Supervisor) (reg h-spsr-svc)) + ((ARM-MODE-Abort) (reg h-spsr-abt)) + ((ARM-MODE-Undefined) (reg h-spsr-und)) + ((ARM-MODE-System) (error SI "can't read spsr in system mode")) + (else (error SI "can't read spsr, invalid mode")))) + (set (newval) + (case VOID (reg h-mbits) + ((ARM-MODE-User) (error VOID "can't set spsr in user mode")) + ((ARM-MODE-FIQ) (set (reg h-spsr-fiq) newval)) + ((ARM-MODE-IRQ) (set (reg h-spsr-irq) newval)) + ((ARM-MODE-Supervisor) (set (reg h-spsr-svc) newval)) + ((ARM-MODE-Abort) (set (reg h-spsr-abt) newval)) + ((ARM-MODE-Undefined) (set (reg h-spsr-und) newval)) + ((ARM-MODE-System) (error VOID "can't set spsr in system mode")) + (else (error VOID "can't set spsr, invalid mode")))) +) + +; Explicitly define the shift types so they can be used in semantics +; (enums are created for them). + +(define-keyword + (name shift-type) + (comment "operand 2 shift type") + (prefix "") + (values (lsl 0) (asl 0) (lsr 1) (asr 2) (ror 3)) +) + +(define-hardware + (name h-operand2-shifttype) + (comment "operand2 shift type") + (type immediate (UINT 2)) + (values extern-keyword shift-type) +) + +; Utility macros for setting the condition codes. + +(define-pmacro (set-zn-flags result) + (sequence () + (set zbit (zflag WI result)) + (set nbit (nflag WI result))) +) + +; Logical operation flag handling: +; cbit is set to the carry out of a shift operation if present +; nbit is set to the sign bit +; vbit is not affected +; zflag is set to indicate whether the result was zero or not + +(define-pmacro (set-logical-cc result carry-out) + (sequence () + (set-zn-flags result) + (set cbit carry-out)) +) + +(define-pmacro (set-add-flags arg1 arg2 carry) + (sequence ((SI result)) + (set result (addc arg1 arg2 carry)) + (set-zn-flags result) + (set cbit (add-cflag arg1 arg2 carry)) + (set vbit (add-oflag arg1 arg2 carry))) +) + +(define-pmacro (set-sub-flags arg1 arg2 borrow) + (sequence ((SI result)) + (set result (subc arg1 arg2 (not borrow))) + (set-zn-flags result) + (set cbit (not (sub-cflag arg1 arg2 (not borrow)))) + (set vbit (sub-oflag arg1 arg2 (not borrow)))) +) + +; Utility macros for testing the condition codes. + +(define-pmacro (test-ne) (not zbit)) +(define-pmacro (test-eq) zbit) +(define-pmacro (test-gt) (not (or zbit (xor nbit vbit)))) +(define-pmacro (test-le) (or zbit (xor nbit vbit))) +(define-pmacro (test-ge) (not (xor nbit vbit))) +(define-pmacro (test-lt) (xor nbit vbit)) +(define-pmacro (test-hi) (and cbit (not zbit))) +(define-pmacro (test-ls) (or (not cbit) zbit)) +(define-pmacro (test-cc) (not cbit)) +(define-pmacro (test-cs) cbit) +(define-pmacro (test-pl) (not nbit)) +(define-pmacro (test-mi) nbit) +(define-pmacro (test-vc) (not vbit)) +(define-pmacro (test-vs) vbit) + +(if (keep-isa? (arm)) + (include "arm7.cpu")) +(if (keep-isa? (thumb)) + (include "thumb.cpu")) diff --git a/cgen/arm.sim b/cgen/arm.sim new file mode 100644 index 00000000000..673e8e1a3ea --- /dev/null +++ b/cgen/arm.sim @@ -0,0 +1,39 @@ +; ARM CPU simulator support. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; N.B. +; - The format of this file is *extremely* wip! +; - This isn't intended to be simulator independent, it is an application +; specific file and not all simulator apps are equivalent. +; - This file is loaded after all the .cpu files are loaded. + +; ??? The application (e.g. simulator) may wish to do further processing when +; the tbit is set. For a C++ simulator what one would want to do is override +; the "set" method. That presumes there's a "set" method to override and +; that all affected code uses it. There are several to accomplish this. +; The first way to accomplish this is to have all code always +; access hardware elements through their get/set methods. Perhaps ok, +; but also maybe overkill. The second is to specify those that use get/set +; methods. One could do this for elements that have get/set specs, but this +; requires the .cpu file to get it right (and to change when it isn't). +; A variant of the second is to move this info to an application specific +; file (much like what .opc files are although even they have the problem of +; requiring collaboration with the .cpu file. -- to be fixed!). +; The solution taken here is the latter. + +; The h-tbit and h-mbits registers need extra processing when they are set. +; This is done by specifying the FUN-SET attribute, which causes all machine +; generated references to go through the `set' access method. +; Oh no, not FUN-ACCESS again! :-) + +(modify-hardware + (name h-tbit) + (add-attrs FUN-SET) +) + +(modify-hardware + (name h-mbits) + (add-attrs FUN-SET) +) diff --git a/cgen/arm7.cpu b/cgen/arm7.cpu new file mode 100644 index 00000000000..19b8d5fdc51 --- /dev/null +++ b/cgen/arm7.cpu @@ -0,0 +1,1995 @@ +; ARM7 CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; This file is included by arm.cpu. +; +; ??? The name of this file may be confusing. +; +; Every entry in this file belongs to the "arm" isa. +; Things are simple since that is the default, but it is something to +; keep in mind. + +(define-attr + (type integer) + (name R15-OFFSET) + (comment "offset in pc value at time of use") + (default 8) +) + +(dnf f-cond "Condition code" () 31 4) + +(dnf f-op2 "Opcode (2 bits)" () 27 2) +(dnf f-op3 "Opcode (3 bits)" () 27 3) +(dnf f-op4 "Opcode (4 bits)" () 27 4) +(dnf f-op5 "Opcode (5 bits)" () 27 5) +(dnf f-op6 "Opcode (6 bits)" () 27 6) +(dnf f-op24 "Opcode (24 bits)" () 27 24) + +(dnf f-op-alu "Arith/logic opcode" () 24 4) +(dnf f-op-mul "Sub-opcode for MUL" () 7 4) +(dnf f-op-swap1 "Sub-opcode for SWP" () 21 2) +(dnf f-op-swap2 "Sub-opcode for SWP" () 11 8) +(dnf f-op-mrs1 "Sub-opcode for MRS" () 21 6) +(dnf f-op-mrs2 "Sub-opcode for MRS" () 11 12) +(dnf f-op-msr1 "Sub-opcode for MSR" () 21 10) +(dnf f-op-msr2 "Sub-opcode for MSR" () 11 8) + +(dnf f-rn "Rn" () 19 4) +(dnf f-rd "Rd" () 15 4) +(dnf f-rm "Rm" () 3 4) +(dnf f-preindex? "Pre/post indexing" () 24 1) +(dnf f-set-cc? "Set condition codes?" () 20 1) +(dnf f-imm? "Immediate?" () 25 1) +(dnf f-byte-qty? "Byte sized transfer?" () 22 1) + +; Extra fields needed for the Data Processing/PSR Transfer class. + +(dnf f-ror-imm8-value "8 bit value to be rotated" () 7 8) +(dnf f-ror-imm8-rotate "Rotate amount" () 11 4) + +(dnmf f-ror-imm8 "8 bit rotated immediate" () UINT + (f-ror-imm8-value f-ror-imm8-rotate) + ; insert + (c-call SI "arm_encode_imm12" (ifield f-ror-imm8)) + ; extract + (sequence () + (set (ifield f-ror-imm8) + (ror WI (ifield f-ror-imm8-value) + (mul 2 (ifield f-ror-imm8-rotate)))) + ) +) + +(df f-imm12 "Immediate (12 bit)" () 11 12 UINT + ((value pc) (c-call SI "arm_encode_imm12" value)) + ((value pc) + (ror WI (and WI value #xFF) + (mul 2 (srl WI (and WI value #xF00) 8)))) +) + +; These two are for a register operand2 (i=0). +(dnf f-operand2-reg? "Operand2 reg indicator" () 4 1) +(dnf f-operand2-shifttype "Operand2 shift type" () 6 2) + +(dnf f-operand2-shiftimm "Operand2 shift amount (imm)" () 11 5) +(dnf f-operand2-shiftreg "Operand2 shift amount (reg)" () 11 4) + +; Extra fields needed for the Transfer instruction classes. + +(dnf f-up-down "Base register direction" () 23 1) +(dnf f-write-back? "Write back?" () 21 1) +(dnf f-load? "Load or store?" () 20 1) + +; Extra fields needed for the Single Data Transfer instruction class. + +(df f-offset12 "Offset" (PCREL-ADDR) 11 12 INT + ((value pc) (sra WI (sub WI value 2))) + ((value pc) (add WI (sll WI value 2) pc))) + +(dnf f-uimm12 "Unsigned immediate (12 bit)" () 11 12) + +; Extra fields needed for the Branch and Exchange instruction class. + +(dnf f-bx-rn "Rn for branch/exchg" () 3 4) + +; Extra fields needed for the Halfword Data Transfer instruction class. + +(dnf f-halfword? "Halfword transfer?" () 5 1) +(dnf f-signed? "Signed transfer?" () 6 1) +(dnf f-offset4-hi "High nybble" () 11 4) +(dnf f-offset4-lo "Low nybble" () 3 4) + +; Extra fields needed for the PSR Transfer instructions. + +(dnf f-psr "PSR selector" () 22 1) + +; Miscellaneous single bit fields. + +(dnf f-bit4 "Bit 4" () 4 1) +(dnf f-bit7 "Bit 7" () 7 1) +(dnf f-bit22 "Bit 22" () 22 1) + +(define-multi-ifield + (name f-hdt-offset8) + (comment "Immediate offset for halfword and signed data transfers") + (attrs) + (mode UINT) + (subfields f-offset4-hi f-offset4-lo) + (insert (sequence () + (set (ifield f-offset4-hi) + (and (srl (ifield f-hdt-offset8) 4) #xF)) + (set (ifield f-offset4-lo) + (and (ifield f-hdt-offset8) #xF)))) + (extract (set (ifield f-hdt-offset8) + (or (sll (ifield f-offset4-hi) 4) + (ifield f-offset4-lo)))) +) + +; Extra fields needed for the Multiply instruction class. + +(dnf f-acc? "Accumulate?" () 21 1) +(dnf f-mul-rd "Rd for multiply" () 19 4) +(dnf f-mul-rn "Rn for multiply" () 15 4) +(dnf f-rs "Rs" () 11 4) +(dnf f-unsigned? "Unsigned multiply?" () 22 1) + +; Extra fields needed for the Multiply Long instruction class. + +(dnf f-rdhi "Rd (high)" () 19 4) +(dnf f-rdlo "Rd (low)" () 15 4) +(dnf f-mull-rn "Rn for long multiply" () 11 4) + +; Extra fields needed for the Branch instruction class. + +(dnf f-branch-link? "Branch and link?" () 24 1) +(df f-offset24 "Branch offset" (PCREL-ADDR) 23 24 INT + ((value pc) (sra WI (sub WI value (add pc 8)) 2)) + ((value pc) (add WI (sll WI value 2) (add pc 8))) +) + +; Extra fields needed for the Block Data Transfer instruction class. + +(dnf f-reg-list "Register list" () 15 16) +(dnf f-load-psr? "Load PSR?" () 22 1) + +; Extra fields needed for the SWI instruction. + +(dnf f-swi-comment "User-defined operand" () 23 24) + +; Extra fields needed for the undefined instruction. + +(dnf f-undef-dont1 "Don't care" (RESERVED) 24 20) +(dnf f-undef-dont2 "Don't care" (RESERVED) 3 4) + +; Enumerated constants. + +(define-normal-insn-enum cond-codes "condition codes" () COND_ f-cond + ("EQ" "NE" "CS" "CC" "MI" "PL" "VS" "VC" "HI" "LS" "GE" "LT" "GT" "LE" "AL") +) + +(define-normal-insn-enum al-opcode "Arith/logic opcode enums" () OP_ f-op-alu + ("AND" "EOR" "SUB" "RSB" "ADD" "ADC" "SBC" "RSC" "TST" "TEQ" "CMP" "CMN" + "ORR" "MOV" "BIC" "MVN") +) + +(define-normal-insn-enum psr-dests "PSR transfer destinations" () PSR_ + f-psr ("CURRENT" "SAVED") +) + +; Instruction operands. + +(dnop cond "Condition code" () h-uint f-cond) +(dnop rn "Rn" () h-gr f-rn) +(dnop rd "Rd" () h-gr f-rd) +(dnop rm "Rm" () h-gr f-rm) +(dnop rs "Rs" () h-gr f-rs) +(dnop imm? "Immediate constant?" () h-uint f-imm?) +(dnop set-cc? "Set condition codes" () h-uint f-set-cc?) + +(dnop ror-imm8 "Rotated immediate (8 bits)" () h-uint f-ror-imm8) +(dnop imm12 "Immediate" () h-uint f-imm12) +(dnop uimm12 "Unsigned immediate (12 bits)" () h-uint f-uimm12) + +(dnop operand2-shifttype "Operand 2 shift type" () + h-operand2-shifttype f-operand2-shifttype) +(dnop operand2-shiftimm "Operand 2 shift immediate" () + h-uint f-operand2-shiftimm) +(dnop operand2-shiftreg "Operand 2 shift reg" () + h-gr f-operand2-shiftreg) + +(dnop reglist "Register list" () h-uint f-reg-list) +(dnop bx-rn "Source register (BX insn)" () h-gr f-bx-rn) +(dnop mul-rd "Destination register (MUL insns)" () h-gr f-mul-rd) +(dnop mul-rn "Source register (MUL insns)" () h-gr f-mul-rn) +(dnop rdhi "Rd (high) for long multiply" () h-gr f-rdhi) +(dnop rdlo "Rd (low) for long multiply" () h-gr f-rdlo) + +(dnop offset12 "Offset (12 bits)" () h-addr f-offset12) +(dnop offset24 "Branch offset (24 bits)" () h-iaddr f-offset24) +(dnop hdt-offset8 "Split offset (8 bits)" () h-addr f-hdt-offset8) + +(dnop swi-comment "Argument to swi" () h-uint f-swi-comment) + +(dnop undef-dont1 "Don't care" () h-uint f-undef-dont1) +(dnop undef-dont2 "Don't care" () h-uint f-undef-dont2) + +; Useful macros. + +; Same as dni but leave out timing. +; dnai - define-normal-arm-insn + +(define-pmacro (dnai xname xcomment xattrs xsyntax xformat xsemantics) + (define-insn + (name xname) + (comment xcomment) + (.splice attrs (.unsplice xattrs)) + (syntax xsyntax) + (format xformat) + (semantics xsemantics) + ) +) + +; Branch insns. + +(dnai b "Branch" + () + "b$cond $offset24" + (+ cond (f-op3 5) (f-branch-link? 0) offset24) + (set pc offset24) +) + +(dnai bl "Branch and link" + () + "bl$cond $offset24" + (+ cond (f-op3 5) (f-branch-link? 1) offset24) + (sequence () + (set (reg h-gr 14) (and (add pc 4) -4)) + (set pc offset24)) +) + +(dnai bx "Branch and exchange" + () + "bx$cond ${bx-rn}" + (+ cond (f-op24 #x12FFF1) bx-rn) + (sequence () + (set pc (and bx-rn #xfffffffe)) + (if (and bx-rn 1) + (set (reg h-tbit) 1))) +) + +; Load word/byte insns. + +(define-pmacro (do-word/byte-load byte? preindex? writeback? up? offset-expr) + (sequence ((SI addr) (SI offset)) + (set offset offset-expr) + (if preindex? + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset))) + (set addr rn)) + ; If writeback in postindexing case -> do transfer + ; in non-priviledged mode. + ; FIXME: still need to handle non-word-aligned addresses + (if (andif (not preindex?) writeback?) + (if byte? + ; FIXME: specify "non-priviledged mode" `selector' + (if (eq f-rd 15) + (set pc (zext SI (mem QI addr))) + (set rd (zext SI (mem QI addr)))) + ; !byte + (if (eq f-rd 15) + (set pc (mem SI addr)) + (set rd (mem SI addr)))) + ; else + (if byte? + (if (eq f-rd 15) + (set pc (zext SI (mem QI addr))) + (set rd (zext SI (mem QI addr)))) + ; !byte + (if (eq f-rd 15) + (set pc (mem SI addr)) + (set rd (mem SI addr))))) + (if (not preindex?) + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset)))) + (if (orif (not preindex?) + (andif preindex? writeback?)) + (set rn addr)) + ) +) + +(define-pmacro (load-word/byte name comment size-char t-char + byte? preindex? writeback? up?) + (begin + (dnai (.sym name -imm-offset) + (.str comment ", immediate offset") + () + ; ??? Enhancement to compute offset syntax based on args? + (.str "ldr${cond}" size-char t-char " $rd,???") + (+ cond (f-op2 1) + (f-imm? 0) (f-preindex? preindex?) (f-up-down up?) + (f-byte-qty? byte?) (f-write-back? writeback?) + (f-load? 1) rn rd uimm12) + (do-word/byte-load byte? preindex? writeback? up? uimm12) + ) + (dnai (.sym name -reg-offset) + (.str comment ", register offset") + () + (.str "ldr${cond}" size-char t-char " $rd,???") + (+ cond (f-op2 1) + (f-imm? 1) (f-preindex? preindex?) (f-up-down up?) + (f-byte-qty? byte?) (f-write-back? writeback?) + (f-load? 1) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (do-word/byte-load byte? preindex? writeback? up? + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + ) + ) +) + +(load-word/byte #:name ldr-post-dec + #:comment "Load word (postindex, decrement)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 0 #:writeback? 0 #:up? 0) + +(load-word/byte #:name ldr-post-inc + #:comment "Load word (postindex, increment)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 0 #:writeback? 0 #:up? 1) + +(load-word/byte #:name ldr-post-dec-nonpriv + #:comment "Load word (postindex, decrement, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 0 #:preindex? 0 #:writeback? 1 #:up? 0) + +(load-word/byte #:name ldr-post-inc-nonpriv + #:comment "Load word (postindex, increment, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 0 #:preindex? 0 #:writeback? 1 #:up? 1) + +(load-word/byte #:name ldr-pre-dec + #:comment "Load word (preindex, decrement)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 0 #:up? 0) + +(load-word/byte #:name ldr-pre-inc + #:comment "Load word (preindex, increment)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 0 #:up? 1) + +(load-word/byte #:name ldr-pre-dec-wb + #:comment "Load word (preindex, decrement, writeback)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 1 #:up? 0) + +(load-word/byte #:name ldr-pre-inc-wb + #:comment "Load word (preindex, increment, writeback)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 1 #:up? 1) + +(load-word/byte #:name ldrb-post-dec + #:comment "Load byte (postindex, decrement)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 0 #:writeback? 0 #:up? 0) + +(load-word/byte #:name ldrb-post-inc + #:comment "Load byte (postindex, increment)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 0 #:writeback? 0 #:up? 1) + +(load-word/byte #:name ldrb-post-dec-nonpriv + #:comment "Load byte (postindex, decrement, nonpriv)" + #:size-char "b" #:t-char "t" + #:byte? 1 #:preindex? 0 #:writeback? 1 #:up? 0) + +(load-word/byte #:name ldrb-post-inc-nonpriv + #:comment "Load byte (postindex, increment, nonpriv)" + #:size-char "b" #:t-char "t" + #:byte? 1 #:preindex? 0 #:writeback? 1 #:up? 1) + +(load-word/byte #:name ldrb-pre-dec + #:comment "Load byte (preindex, decrement)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 0 #:up? 0) + +(load-word/byte #:name ldrb-pre-inc + #:comment "Load byte (preindex, increment)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 0 #:up? 1) + +(load-word/byte #:name ldrb-pre-dec-wb + #:comment "Load byte (preindex, decrement, writeback)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 1 #:up? 0) + +(load-word/byte #:name ldrb-pre-inc-wb + #:comment "Load byte (preindex, increment, writeback)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 1 #:up? 1) + +; Store word/byte insns. + +(define-pmacro (do-word/byte-store byte? preindex? writeback? up? offset-expr) + (sequence ((SI addr) (SI offset)) + (set offset offset-expr) + (if preindex? + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset))) + (set addr rn)) + ; If writeback in postindexing case -> do transfer + ; in non-priviledged mode. + ; FIXME: still need to handle non-word-aligned addresses + (if (andif (not preindex?) writeback?) + (if byte? + ; FIXME: specify "non-priviliged mode" `selector' + (set (mem QI addr) (trunc QI rd)) + (set (mem SI addr) rd)) + (if byte? + (set (mem QI addr) (trunc QI rd)) + (set (mem SI addr) rd))) + (if (not preindex?) + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset)))) + (if (orif (not preindex?) + (andif preindex? writeback?)) + (set rn addr)) + ) +) + +(define-pmacro (store-word/byte name comment size-char t-char + byte? preindex? writeback? up?) + (begin + (dnai (.sym name -imm-offset) + (.str comment ", immediate offset") + () + (.str "ldr${cond}" size-char t-char " $rd,???") + (+ cond (f-op2 1) + (f-imm? 0) (f-preindex? preindex?) (f-up-down up?) + (f-byte-qty? byte?) (f-write-back? writeback?) + (f-load? 0) rn rd uimm12) + (do-word/byte-store byte? preindex? writeback? up? uimm12) + ) + + (dnai (.sym name -reg-offset) + (.str comment ", register offset") + () + (.str "str${cond}" size-char t-char " $rd,???") + (+ cond (f-op2 1) + (f-imm? 1) (f-preindex? preindex?) (f-up-down up?) + (f-byte-qty? byte?) (f-write-back? writeback?) + (f-load? 0) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (do-word/byte-store byte? preindex? writeback? up? + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + ) + ) +) + +(store-word/byte #:name str-post-dec + #:comment "Store word (postindex, decrement)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 0 #:writeback? 0 #:up? 0) + +(store-word/byte #:name str-post-inc + #:comment "Store word (postindex, increment)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 0 #:writeback? 0 #:up? 1) + +(store-word/byte #:name str-post-dec-nonpriv + #:comment "Store word (postindex, decrement, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 0 #:preindex? 0 #:writeback? 1 #:up? 0) + +(store-word/byte #:name str-post-inc-nonpriv + #:comment "Store word (postindex, increment, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 0 #:preindex? 0 #:writeback? 1 #:up? 1) + +(store-word/byte #:name str-pre-dec + #:comment "Store word (preindex, decrement)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 0 #:up? 0) + +(store-word/byte #:name str-pre-inc + #:comment "Store word (preindex, increment)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 0 #:up? 1) + +(store-word/byte #:name str-pre-dec-wb + #:comment "Store word (preindex, decrement, writeback)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 1 #:up? 0) + +(store-word/byte #:name str-pre-inc-wb + #:comment "Store word (preindex, increment, writeback)" + #:size-char "" #:t-char "" + #:byte? 0 #:preindex? 1 #:writeback? 1 #:up? 1) + +(store-word/byte #:name strb-post-dec + #:comment "Store byte (postindex, decrement)" + #:size-char "b" #:t-char "" + #:byte? 1 #:preindex? 0 #:writeback? 0 #:up? 0) + +(store-word/byte #:name strb-post-inc + #:comment "Store byte (postindex, increment)" + #:size-char "" #:t-char "" + #:byte? 1 #:preindex? 0 #:writeback? 0 #:up? 1) + +(store-word/byte #:name strb-post-dec-nonpriv + #:comment "Store byte (postindex, decrement, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 1 #:preindex? 0 #:writeback? 1 #:up? 0) + +(store-word/byte #:name strb-post-inc-nonpriv + #:comment "Store byte (postindex, increment, nonpriv)" + #:size-char "" #:t-char "t" + #:byte? 1 #:preindex? 0 #:writeback? 1 #:up? 1) + +(store-word/byte #:name strb-pre-dec + #:comment "Store byte (preindex, decrement)" + #:size-char "" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 0 #:up? 0) + +(store-word/byte #:name strb-pre-inc + #:comment "Store byte (preindex, increment)" + #:size-char "" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 0 #:up? 1) + +(store-word/byte #:name strb-pre-dec-wb + #:comment "Store byte (preindex, decrement, writeback)" + #:size-char "" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 1 #:up? 0) + +(store-word/byte #:name strb-pre-inc-wb + #:comment "Store byte (preindex, increment, writeback)" + #:size-char "" #:t-char "" + #:byte? 1 #:preindex? 1 #:writeback? 1 #:up? 1) + +; Halfword and signed load insns. + +(define-pmacro (do-halfword-load preindex? up? writeback? signed? + halfword? offset-expr) + (sequence ((SI addr) (SI offset)) + (set offset offset-expr) + + ; Handle pre-increment. + (if preindex? + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset))) + (set addr rn)) + + ; Do the transfer; sign extend the result. + (if halfword? + (if signed? + (if (eq f-rd 15) + (set pc (ext SI (mem HI addr))) + (set rd (ext SI (mem HI addr)))) + (if (eq f-rd 15) + (set pc (zext SI (mem HI addr))) + (set rd (zext SI (mem HI addr))))) + (if (eq f-rd 15) + (set pc (ext SI (mem QI addr))) + (set rd (ext SI (mem QI addr))))) + + (if (not preindex?) + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset)))) + + ; Write back the modified base register. + (if (orif (not preindex?) + (andif preindex? writeback?)) + (set rn addr)) + ) +) + +(define-pmacro (load-halfword name comment preindex? up? writeback? + signed? halfword?) + (begin + (dnai (.sym name -imm-offset) + (.str comment ", immediate offset") + () + (.str "FIXME") + (+ cond (f-op3 0) (f-preindex? preindex?) (f-up-down up?) + (f-bit22 1) (f-write-back? writeback?) (f-load? 1) + rn rd (f-bit7 1) (f-signed? signed?) (f-halfword? halfword?) + (f-bit4 1) hdt-offset8) + (do-halfword-load preindex? up? writeback? signed? halfword? hdt-offset8) + ) + (dnai (.sym name -reg-offset) + (.str comment ", register offset") + () + (.str "FIXME") + (+ cond (f-op3 0) (f-preindex? preindex?) (f-up-down up?) + (f-bit22 0) (f-write-back? writeback?) (f-load? 1) + rn rd (f-offset4-hi 0) (f-bit7 1) (f-signed? signed?) + (f-halfword? halfword?) (f-bit4 1) rm) + (do-halfword-load preindex? up? writeback? signed? halfword? rm) + ) + ) +) + +(define-pmacro (do-halfword-store preindex? up? writeback? offset-expr) + (sequence ((SI addr) (SI offset)) + (set offset offset-expr) + + ; Handle pre-increment. + (if preindex? + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset))) + (set addr rn)) + + ; Do the transfer; unsigned halfwords only. + (set (mem HI addr) (trunc HI rd)) + + (if (not preindex?) + (if up? + (set addr (add rn offset)) + (set addr (sub rn offset)))) + + (if (orif (not preindex?) + (andif preindex? writeback?)) + (set rn addr)) + ) +) + +(define-pmacro (store-halfword name comment preindex? up? writeback?) + (begin + (dnai (.sym name -imm-offset) + (.str comment ", immediate offset") + () + (.str "FIXME") + (+ cond (f-op3 0) (f-preindex? preindex?) (f-up-down up?) + (f-bit22 1) (f-write-back? writeback?) (f-load? 0) + rn rd (f-bit7 1) (f-signed? 0) (f-halfword? 1) + (f-bit4 1) hdt-offset8) + (do-halfword-store preindex? up? writeback? hdt-offset8) + ) + (dnai (.sym name -reg-offset) + (.str comment ", register offset") + () + (.str "FIXME") + (+ cond (f-op3 0) (f-preindex? preindex?) (f-up-down up?) + (f-bit22 0) (f-write-back? writeback?) (f-load? 0) + rn rd (f-offset4-hi 0) (f-bit7 1) (f-signed? 0) + (f-halfword? 1) (f-bit4 1) rm) + (do-halfword-store preindex? up? writeback? rm) + ) + ) +) + +(store-halfword #:name strh-pre-dec + #:comment "Store halfword (predecrement)" + #:preindex? 1 #:up? 0 #:writeback? 0) + +(store-halfword #:name strh-pre-inc + #:comment "Store halfword (preincrement)" + #:preindex? 1 #:up? 1 #:writeback? 0) + +(store-halfword #:name strh-pre-dec-wb + #:comment "Store halfword (predec, writeback)" + #:preindex? 1 #:up? 0 #:writeback? 1) + +(store-halfword #:name strh-pre-inc-wb + #:comment "Store halfword (preinc, writeback)" + #:preindex? 1 #:up? 1 #:writeback? 1) + +(store-halfword #:name strh-post-dec + #:comment "Store halfword (postdecrement)" + #:preindex? 0 #:up? 0 #:writeback? 0) + +(store-halfword #:name strh-post-inc + #:comment "Store halfword (postindex, increment)" + #:preindex? 0 #:up? 1 #:writeback? 0) + + +(load-halfword #:name ldrsb-pre-dec + #:comment "Load signed byte (predecrement)" + #:preindex? 1 #:up? 0 #:writeback? 0 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrsb-pre-inc + #:comment "Load signed byte (preincrement)" + #:preindex? 1 #:up? 1 #:writeback? 0 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrsb-pre-dec-wb + #:comment "Load signed byte (predec, writeback)" + #:preindex? 1 #:up? 0 #:writeback? 1 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrsb-pre-inc-wb + #:comment "Load signed byte (preinc, writeback)" + #:preindex? 1 #:up? 1 #:writeback? 1 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrsb-post-dec + #:comment "Load signed byte (postdecrement)" + #:preindex? 0 #:up? 0 #:writeback? 0 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrsb-post-inc + #:comment "Load signed byte (postindex, increment)" + #:preindex? 0 #:up? 1 #:writeback? 0 + #:signed? 1 #:halfword? 0) + +(load-halfword #:name ldrh-pre-dec + #:comment "Load halfword (predecrement)" + #:preindex? 1 #:up? 0 #:writeback? 0 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrh-pre-inc + #:comment "Load halfword (preincrement)" + #:preindex? 1 #:up? 1 #:writeback? 0 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrh-pre-dec-wb + #:comment "Load halfword (predec, writeback)" + #:preindex? 1 #:up? 0 #:writeback? 1 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrh-pre-inc-wb + #:comment "Load halfword (preinc, writeback)" + #:preindex? 1 #:up? 1 #:writeback? 1 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrh-post-dec + #:comment "Load halfword (postdecrement)" + #:preindex? 0 #:up? 0 #:writeback? 0 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrh-post-inc + #:comment "Load halfword (postincrement)" + #:preindex? 0 #:up? 1 #:writeback? 0 + #:signed? 0 #:halfword? 1) + +(load-halfword #:name ldrsh-pre-dec + #:comment "Load signed halfword (predecrement)" + #:preindex? 1 #:up? 0 #:writeback? 0 + #:signed? 1 #:halfword? 1) + +(load-halfword #:name ldrsh-pre-inc + #:comment "Load signed halfword (preincrement)" + #:preindex? 1 #:up? 1 #:writeback? 0 + #:signed? 1 #:halfword? 1) + +(load-halfword #:name ldrsh-pre-dec-wb + #:comment "Load signed halfword (predec, writeback)" + #:preindex? 1 #:up? 0 #:writeback? 1 + #:signed? 1 #:halfword? 1) + +(load-halfword #:name ldrsh-pre-inc-wb + #:comment "Load signed halfword (preinc, writeback)" + #:preindex? 1 #:up? 1 #:writeback? 1 + #:signed? 1 #:halfword? 1) + +(load-halfword #:name ldrsh-post-dec + #:comment "Load signed halfword (postdecrement)" + #:preindex? 0 #:up? 0 #:writeback? 0 + #:signed? 1 #:halfword? 1) + +(load-halfword #:name ldrsh-post-inc + #:comment "Load signed halfword (postincrement)" + #:preindex? 0 #:up? 1 #:writeback? 0 + #:signed? 1 #:halfword? 1) + +; Multiply instructions. + +(define-pmacro (set-mul-cond-maybe result) + (if set-cc? + (sequence () + ; vbit is not affected + ; cbit is set to a meaningless value, we just ignore it + (set zbit (zflag WI result)) + (set nbit (nflag WI result)))) +) + +(define-pmacro (set-muldi-cond-maybe result) + (if set-cc? + (sequence () + ; vbit,cbit are set to meaningless values, we just ignore them + (set zbit (zflag DI result)) + (set nbit (nflag DI result)))) +) + +(dnai mul "Multiply" + () + "mul$cond${set-cc?} ${mul-rd},$rm,$rs" + (+ cond (f-op6 0) (f-acc? 0) set-cc? mul-rd mul-rn rs (f-op-mul 9) rm) + (sequence ((WI result)) + (set result (mul rm rs)) + (set mul-rd result) + (set-mul-cond-maybe result)) +) + +(dnai mla "Multiply and accumulate" + () + "mla$cond${set-cc?} ${mul-rd},$rm,$rs,${mul-rn}" + (+ cond (f-op6 0) (f-acc? 1) set-cc? mul-rd mul-rn rs (f-op-mul 9) rm) + (sequence ((WI result)) + (set mul-rd (add (mul rm rs) mul-rn)) + (set-mul-cond-maybe result)) +) + +(dnai umull "Multiply long (unsigned)" + () + "umull$cond${set-cc?} $rdlo,$rdhi,$rm,$rs" + (+ cond (f-op5 1) (f-unsigned? 0) (f-acc? 0) set-cc? rdhi rdlo rs (f-op-mul 9) rm) + (sequence ((DI mul-result) (SI hi) (SI lo)) + (set mul-result (mul (zext DI rs) (zext DI rm))) + (set rdhi (subword SI mul-result 0)) + (set rdlo (subword SI mul-result 1)) + (set-muldi-cond-maybe mul-result)) +) + +(dnai umlal "Multiply long and accumulate (unsigned)" + () + "umlal$cond${set-cc?} $rdlo,$rdhi,$rm,$rs" + (+ cond (f-op5 1) (f-unsigned? 0) (f-acc? 1) set-cc? rdhi rdlo rs (f-op-mul 9) rm) + (sequence ((DI mul-result) (SI hi) (SI lo)) + (set mul-result (join DI SI rdhi rdlo)) + (set mul-result + (add (mul (zext DI rs) (zext DI rm)) mul-result)) + (set rdhi (subword SI mul-result 0)) + (set rdlo (subword SI mul-result 1)) + (set-muldi-cond-maybe mul-result)) +) + +(dnai smull "Multiply long (signed)" + () + "smull$cond${set-cc?} $rdlo,$rdhi,$rm,$rs" + (+ cond (f-op5 1) (f-unsigned? 1) (f-acc? 0) set-cc? rdhi rdlo rs + (f-op-mul 9) rm) + (sequence ((DI mul-result) (SI hi) (SI lo)) + (set mul-result (mul (ext DI rs) (ext DI rm))) + (set rdhi (subword SI mul-result 0)) + (set rdlo (subword SI mul-result 1)) + (set-muldi-cond-maybe mul-result)) +) + +(dnai smlal "Multiply long and accumulate (signed)" + () + "smlal$cond${set-cc?} $rdlo,$rdhi,$rm,$rs" + (+ cond (f-op5 1) (f-unsigned? 1) (f-acc? 1) set-cc? rdhi rdlo rs + (f-op-mul 9) rm) + (sequence ((DI mul-result) (SI hi) (SI lo)) + (set mul-result (join DI SI rdhi rdlo)) + (set mul-result + (add (mul (ext DI rs) (ext DI rm)) mul-result)) + (set rdhi (subword SI mul-result 0)) + (set rdlo (subword SI mul-result 1)) + (set-muldi-cond-maybe mul-result)) +) + +(dnai swp "Swap word" + () + "swp$cond $rd,$rm,[$rn]" + (+ cond (f-op5 2) (f-byte-qty? 0) (f-op-swap1 #b00) rn rd + (f-op-swap2 9) rm) + (sequence ((WI temp)) + (set temp (mem WI rn)) ; read contents of swap address + (set (mem WI rn) rm) ; write rm to the swap address + (set rd temp)) ; store old swap contents in rd +) + +(dnai swpb "Swap byte" + () + "swpb${cond}b $rd,$rm,[$rn]" + (+ cond (f-op5 2) (f-byte-qty? 1) (f-op-swap1 #b00) rn rd + (f-op-swap2 #b00001001) rm) + (sequence ((WI temp)) + (set temp (mem QI rn)) ; read contents of swap address + (set (mem QI rn) rm) ; write rm to the swap address + (set rd temp)) ; store old swap contents in rd +) + +(dnai swi "Software interrupt" + () + "swi$cond ${swi-comment}" + (+ cond (f-op4 #xF) swi-comment) + ; Take the software trap. Jump to the vector held in + ; 0x8. User code retrieves the comment field itself (see the + ; SWI instruction description in the ARM 7TDMI data sheet). + ; FIXME: more state change than this occurs + ;(set pc (mem WI 8))) + (set pc (c-call SI "arm_swi" pc swi-comment)) +) + +; Data processing [sic] instructions with a register for operand2. +; The immediate operand2 case is handled separately. +; +; FIXME: 'twould be nice to split up each semantic element into +; shifttype, set-cc/no-set-cc, set-pc,no-set-pc cases. +; This is something that could be done as an optimization or extension, +; without having to change this code [which would have general utility]. +; +; FIXME: assembler syntaxes don't take into account unary vs binary vs +; no-result. Later. + +; Logical operation semantic code. +; +; Flag handling if rd != pc: +; cbit is set to the carry out of a shift operation if present +; nbit is set to the sign bit +; vbit is not affected +; zflag is set to indicate whether the result was zero or not +; +; Flag handling if rd = pc: +; cpsr is set from spsr +; N.B. The pc must be set before setting cpsr as the registers that go into +; computing the new value of pc may change when cpsr is set (new register +; bank may get installed). + +; Logical operation, with a result. + +(define-pmacro (logical-op mnemonic comment-text opcode semantic-fn) + (begin + (dnai + (.sym mnemonic -reg/imm-shift) + (.str comment-text " immediate shift") + () + (.str mnemonic "$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}") + (+ cond (f-op2 0) (f-imm? 0) opcode set-cc? rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rm + operand2-shifttype operand2-shiftimm cbit)) + (set result (semantic-fn rn operand2)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-logical-cc result carry-out))))) + ) + (dnai + (.sym mnemonic -reg/reg-shift) + (.str comment-text " register shift") + ((R15-OFFSET 12)) + (.str mnemonic "$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}") + (+ cond (f-op2 0) (f-imm? 0) opcode set-cc? rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (set carry-out + (c-call BI "compute_carry_out_regshift" rm + operand2-shifttype operand2-shiftreg cbit)) + (set result (semantic-fn rn operand2)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-logical-cc result carry-out))))) + ) + ) +) + +; Arithmetic operation semantic code. +; +; Flag handling if rd != pc: +; cbit is set to the carry out of the ALU +; N.B. For subtraction, the "carry" bit is actually a "borrow" bit. +; nbit is set to the sign bit +; vbit is set to indicate if an overflow occured +; zbit is set to indicate whether the result was zero or not +; +; Flag handling if rd = pc: +; cpsr is set from spsr + +; Arithmetic operation, with a result. + +(define-pmacro (arith-op mnemonic comment-text opcode semantic-fn set-flags) + (begin + (dnai + (.sym mnemonic -reg/imm-shift) + (.str comment-text " immediate shift") + () + (.str mnemonic "$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}") + (+ cond (f-op2 0) (f-imm? 0) opcode set-cc? rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2) (SI result) (SI temp-op1) (SI temp-op2)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (set temp-op1 rn) + (set temp-op2 operand2) + (set result (semantic-fn rn operand2 cbit)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-flags temp-op1 temp-op2 cbit))))) + ) + (dnai + (.sym mnemonic -reg/reg-shift) + (.str comment-text " register shift") + ((R15-OFFSET 12)) + (.str mnemonic "$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}") + (+ cond (f-op2 0) (f-imm? 0) opcode set-cc? rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2) (SI result) (SI temp-op1) (SI temp-op2)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (set temp-op1 rn) + (set temp-op2 operand2) + (set result (semantic-fn rn operand2 cbit)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-flags temp-op1 temp-op2 cbit))))) + ) + ) +) + +; Arithmetic operation, with a result and immediate operand. + +(define-pmacro (arith-imm-op mnemonic comment-text opcode semantic-fn set-flags) + (dnai (.sym mnemonic -imm) + (.str comment-text " immediate") + () + (.str mnemonic "$cond${set-cc?} $rd,$rn,$imm12") + (+ cond (f-op2 0) (f-imm? 1) opcode set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (semantic-fn rn imm12 cbit)) + (if (eq f-rd 15) + (sequence () + (if set-cc? + (set (reg h-cpsr) (reg h-spsr))) + (set pc result)) + (sequence () + (if set-cc? + (set-flags rn imm12 cbit)) + (set rd result)))) + ) +) + +; Logical data processing insns. + +(logical-op and "Bitwise AND" OP_AND and) + +(dnai and-imm "Bitwise AND immediate" () + "and$cond${set-cc?} $rd,$rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_AND set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (and rn imm12)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +(logical-op orr "Bitwise OR" OP_ORR or) + +(dnai orr-imm "Bitwise OR immediate" () + "orr$cond${set-cc?} $rd,$rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_ORR set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (or rn imm12)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +(logical-op eor "Exclusive OR" OP_EOR xor) + +(dnai eor-imm "Exclusive OR immediate" () + "eor$cond${set-cc?} $rd,$rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_EOR set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (xor rn imm12)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +(logical-op mov "Move" OP_MOV (.pmacro (arg1 arg2) arg2)) + +(dnai mov-imm "Move immediate" () + "mov$cond${set-cc?} $rd,$imm12" + ; rn is ignored + (+ cond (f-op2 0) (f-imm? 1) OP_MOV set-cc? rn rd imm12) + (sequence ((SI result)) + (set result imm12) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +(logical-op bic "Bit clear" OP_BIC (.pmacro (arg1 arg2) (and arg1 (inv arg2)))) + +(dnai bic-imm "Bit clear immediate" () + "bic$cond${set-cc?} $rd,$rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_BIC set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (and rn (inv imm12))) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +(logical-op mvn "Move negate" OP_MVN (.pmacro (arg1 arg2) (inv arg2))) + +(dnai mvn-imm "Move (logical) negate immediate" () + "mvn$cond${set-cc?} $rd,$imm12" + ; rn is ignored + (+ cond (f-op2 0) (f-imm? 1) OP_MVN set-cc? rn rd imm12) + (sequence ((SI result)) + (set result (inv imm12)) + (if (eq f-rd 15) + (sequence () + (set pc result) + (if set-cc? + (set (reg h-cpsr) (reg h-spsr)))) + (sequence () + (set rd result) + (if set-cc? + (set-zn-flags result))))) +) + +; Arithmetic data processing insns. + +(arith-op add "Add" OP_ADD + (.pmacro (arg1 arg2 carry) (add arg1 arg2)) + (.pmacro (arg1 arg2 carry) (set-add-flags arg1 arg2 0)) +) + +(arith-imm-op add "Add" OP_ADD + (.pmacro (arg1 arg2 carry) (add arg1 arg2)) + (.pmacro (arg1 arg2 carry) (set-add-flags arg1 arg2 0)) +) + +(arith-op adc "Add with carry" OP_ADC + (.pmacro (arg1 arg2 carry) (addc arg1 arg2 carry)) + (.pmacro (arg1 arg2 carry) (set-add-flags arg1 arg2 carry)) +) + +(arith-imm-op adc "Add with carry" OP_ADC + (.pmacro (arg1 arg2 carry) (addc arg1 arg2 carry)) + (.pmacro (arg1 arg2 carry) (set-add-flags arg1 arg2 carry)) +) + +(arith-op sub "Subtract" OP_SUB + (.pmacro (arg1 arg2 borrow) (sub arg1 arg2)) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg1 arg2 1)) +) + +(arith-imm-op sub "Subtract" OP_SUB + (.pmacro (arg1 arg2 borrow) (sub arg1 arg2)) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg1 arg2 1)) +) + +(arith-op sbc "Subtract with carry" OP_SBC + (.pmacro (arg1 arg2 borrow) (subc arg1 arg2 (not borrow))) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg1 arg2 borrow)) +) + +(arith-imm-op sbc "Subtract with carry" OP_SBC + (.pmacro (arg1 arg2 borrow) (subc arg1 arg2 (not borrow))) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg1 arg2 borrow)) +) + +(arith-op rsb "Reverse subtract" OP_RSB + (.pmacro (arg1 arg2 borrow) (sub arg2 arg1)) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg2 arg1 1)) +) + +(arith-imm-op rsb "Reverse subtract" OP_RSB + (.pmacro (arg1 arg2 borrow) (sub arg2 arg1)) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg2 arg1 1)) +) + +(arith-op rsc "Reverse subtract with carry" OP_RSC + (.pmacro (arg1 arg2 borrow) (subc arg2 arg1 (not borrow))) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg2 arg1 borrow)) +) + +(arith-imm-op rsc "Reverse subtract with carry" OP_RSC + (.pmacro (arg1 arg2 borrow) (subc arg2 arg1 (not borrow))) + (.pmacro (arg1 arg2 borrow) (set-sub-flags arg2 arg1 borrow)) +) + +; Comparison instructions. +; +; For the following data processing insns, the `S' mnemonic suffix is +; redundant, but can be specified. The `S' bit is forced to 1 by the +; assembler. rd is not used. rn is tested only. +; `S' bit = 0 -> mrs,msr insns. + +(dnai tst-reg/imm-shift + "Test immediate shift" + () + "tst$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}" + (+ cond (f-op2 0) (f-imm? 0) OP_TST (f-set-cc? 1) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rm + operand2-shifttype operand2-shiftimm cbit)) + (set result (and rn operand2)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-logical-cc result carry-out))) +) + +(dnai tst-reg/reg-shift + "Test register shift" + ((R15-OFFSET 12)) + "tst$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}" + (+ cond (f-op2 0) (f-imm? 0) OP_TST (f-set-cc? 1) rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (set carry-out + (c-call BI "compute_carry_out_regshift" rm + operand2-shifttype operand2-shiftreg cbit)) + (set result (and rn operand2)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-logical-cc result carry-out))) +) + +(dnai tst-imm "Test immediate" () + "tst${cond}${set-cc?} $rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_TST (f-set-cc? 1) rn rd ror-imm8) + (sequence ((BI carry-out)) + (if (eq f-ror-imm8-rotate 0) + (set carry-out cbit) + ; FIXME: nflag BI? + (set carry-out (nflag BI ror-imm8))) + (set-logical-cc (and rn ror-imm8) carry-out)) +) + +(dnai teq-reg/imm-shift + "Test equal immediate shift" + () + "teq$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}" + (+ cond (f-op2 0) (f-imm? 0) OP_TEQ (f-set-cc? 1) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rm + operand2-shifttype operand2-shiftimm cbit)) + (set result (xor rn operand2)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-logical-cc result carry-out))) +) + +(dnai teq-reg/reg-shift + "Test equal register shift" + ((R15-OFFSET 12)) + "teq$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}" + (+ cond (f-op2 0) (f-imm? 0) OP_TEQ (f-set-cc? 1) rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2) (BI carry-out) (SI result)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (set carry-out + (c-call BI "compute_carry_out_regshift" rm + operand2-shifttype operand2-shiftreg cbit)) + (set result (xor rn operand2)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-logical-cc result carry-out))) +) + +(dnai teq-imm "Test equal immediate" () + "teq${cond}${set-cc?} $rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_TEQ (f-set-cc? 1) rn rd ror-imm8) + ; The carry bit is preserved for the immediate form of this + ; insn. ??? Though semantic analysis will believe it's read/written. + (sequence ((BI carry-out)) + (if (eq f-ror-imm8-rotate 0) + (set carry-out cbit) + ; FIXME: nflag BI? + (set carry-out (nflag BI ror-imm8))) + (set-logical-cc (xor rn ror-imm8) carry-out)) +) + +(dnai cmp-reg/imm-shift + "Compare immediate shift " + () + "cmp$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}" + (+ cond (f-op2 0) (f-imm? 0) OP_CMP (f-set-cc? 1) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-sub-flags rn operand2 1))) +) + +(dnai cmp-reg/reg-shift + "Compare register shift" + ((R15-OFFSET 12)) + "cmp$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}" + (+ cond (f-op2 0) (f-imm? 0) OP_CMP (f-set-cc? 1) rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-sub-flags rn operand2 1))) +) + +(dnai cmp-imm "Compare immediate" () + "cmp${cond}${set-cc?} $rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_CMP (f-set-cc? 1) rn rd imm12) + (set-sub-flags rn imm12 1) +) + +(dnai cmn-reg/imm-shift + "Compare negative immediate shift " + () + "cmn$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftimm}" + (+ cond (f-op2 0) (f-imm? 0) OP_CMN (f-set-cc? 1) rn rd rm + (f-operand2-reg? 0) operand2-shifttype operand2-shiftimm) + (sequence ((SI operand2)) + (set operand2 + (c-call SI "compute_operand2_immshift" rm + operand2-shifttype operand2-shiftimm)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-add-flags rn operand2 0))) +) + +(dnai cmn-reg/reg-shift + "Compare negative register shift" + ((R15-OFFSET 12)) + "cmn$cond${set-cc?} $rd,$rn,$rm,${operand2-shifttype} ${operand2-shiftreg}" + (+ cond (f-op2 0) (f-imm? 0) OP_CMN (f-set-cc? 1) rn rd rm + (f-operand2-reg? 1) (f-bit7 0) + operand2-shifttype operand2-shiftreg) + (sequence ((SI operand2)) + (set operand2 + (c-call SI "compute_operand2_regshift" rm + operand2-shifttype operand2-shiftreg)) + (if (eq f-rd 15) + (set (reg h-cpsr) (reg h-spsr)) + (set-add-flags rn operand2 0))) +) + +(dnai cmn-imm "Compare negative immediate" () + "cmn${cond}${set-cc?} $rn,$imm12" + (+ cond (f-op2 0) (f-imm? 1) OP_CMN (f-set-cc? 1) rn rd imm12) + ; ??? Is this right? + (set-add-flags rn imm12 0) +) + +; Multiple load and store insns. + +(define-pmacro (multi-action bit-num semantic-fn) + (if (and reglist (sll 1 bit-num)) + (semantic-fn bit-num)) +) + +(define-pmacro (ldmda-action bit-num) + (sequence () + (set (reg WI h-gr bit-num) (mem WI addr)) + (set addr (sub addr 4))) +) + +(define-pmacro (ldmda-action-r15 ignored) + (sequence () + (set pc (mem WI addr)) + (set addr (sub addr 4))) +) + +(dnai ldmda "Load multiple registers (postindex, decrement)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 0) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 ldmda-action-r15) + (multi-action 14 ldmda-action) + (multi-action 13 ldmda-action) + (multi-action 12 ldmda-action) + (multi-action 11 ldmda-action) + (multi-action 10 ldmda-action) + (multi-action 9 ldmda-action) + (multi-action 8 ldmda-action) + (multi-action 7 ldmda-action) + (multi-action 6 ldmda-action) + (multi-action 5 ldmda-action) + (multi-action 4 ldmda-action) + (multi-action 3 ldmda-action) + (multi-action 2 ldmda-action) + (multi-action 1 ldmda-action) + (multi-action 0 ldmda-action) + ) +) + +(dnai ldmda-wb "Load multiple registers (postindex, decrement, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 1) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 ldmda-action-r15) + (multi-action 14 ldmda-action) + (multi-action 13 ldmda-action) + (multi-action 12 ldmda-action) + (multi-action 11 ldmda-action) + (multi-action 10 ldmda-action) + (multi-action 9 ldmda-action) + (multi-action 8 ldmda-action) + (multi-action 7 ldmda-action) + (multi-action 6 ldmda-action) + (multi-action 5 ldmda-action) + (multi-action 4 ldmda-action) + (multi-action 3 ldmda-action) + (multi-action 2 ldmda-action) + (multi-action 1 ldmda-action) + (multi-action 0 ldmda-action) + (set rn addr)) +) + +(define-pmacro (ldmib-action bit-num) + (sequence () + (set addr (add addr 4)) + (set (reg WI h-gr bit-num) (mem WI addr))) +) + +(define-pmacro (ldmib-action-r15 ignored) + (sequence () + (set addr (add addr 4)) + (set pc (mem WI addr))) +) + +(dnai ldmib "Load multiple register (preindex, increment)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 0) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 ldmib-action) + (multi-action 1 ldmib-action) + (multi-action 2 ldmib-action) + (multi-action 3 ldmib-action) + (multi-action 4 ldmib-action) + (multi-action 5 ldmib-action) + (multi-action 6 ldmib-action) + (multi-action 7 ldmib-action) + (multi-action 8 ldmib-action) + (multi-action 9 ldmib-action) + (multi-action 10 ldmib-action) + (multi-action 11 ldmib-action) + (multi-action 12 ldmib-action) + (multi-action 13 ldmib-action) + (multi-action 14 ldmib-action) + (multi-action 15 ldmib-action-r15)) +) + +(dnai ldmib-wb "Load multiple registers (preindex, increment, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 1) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 ldmib-action) + (multi-action 1 ldmib-action) + (multi-action 2 ldmib-action) + (multi-action 3 ldmib-action) + (multi-action 4 ldmib-action) + (multi-action 5 ldmib-action) + (multi-action 6 ldmib-action) + (multi-action 7 ldmib-action) + (multi-action 8 ldmib-action) + (multi-action 9 ldmib-action) + (multi-action 10 ldmib-action) + (multi-action 11 ldmib-action) + (multi-action 12 ldmib-action) + (multi-action 13 ldmib-action) + (multi-action 14 ldmib-action) + (multi-action 15 ldmib-action-r15) + (set rn addr)) +) + +(define-pmacro (ldmia-action bit-num) + (sequence () + (set (reg WI h-gr bit-num) (mem WI addr)) + (set addr (add addr 4))) +) + +(define-pmacro (ldmia-action-r15 ignored) + (sequence () + (set pc (mem WI addr)) + (set addr (add addr 4))) +) + +(dnai ldmia "Load multiple registers (postindex, increment)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 0) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 ldmia-action) + (multi-action 1 ldmia-action) + (multi-action 2 ldmia-action) + (multi-action 3 ldmia-action) + (multi-action 4 ldmia-action) + (multi-action 5 ldmia-action) + (multi-action 6 ldmia-action) + (multi-action 7 ldmia-action) + (multi-action 8 ldmia-action) + (multi-action 9 ldmia-action) + (multi-action 10 ldmia-action) + (multi-action 11 ldmia-action) + (multi-action 12 ldmia-action) + (multi-action 13 ldmia-action) + (multi-action 14 ldmia-action) + (multi-action 15 ldmia-action-r15)) +) + +(dnai ldmia-wb "Load multiple registers (postindex, increment, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 1) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 ldmia-action) + (multi-action 1 ldmia-action) + (multi-action 2 ldmia-action) + (multi-action 3 ldmia-action) + (multi-action 4 ldmia-action) + (multi-action 5 ldmia-action) + (multi-action 6 ldmia-action) + (multi-action 7 ldmia-action) + (multi-action 8 ldmia-action) + (multi-action 9 ldmia-action) + (multi-action 10 ldmia-action) + (multi-action 11 ldmia-action) + (multi-action 12 ldmia-action) + (multi-action 13 ldmia-action) + (multi-action 14 ldmia-action) + (multi-action 15 ldmia-action-r15) + (set rn addr)) +) + +(define-pmacro (ldmdb-action bit-num) + (sequence () + (set addr (sub addr 4)) + (set (reg WI h-gr bit-num) (mem WI addr))) +) + +(define-pmacro (ldmdb-action-r15 bit-num) + (sequence () + (set addr (sub addr 4)) + (set pc (mem WI addr))) +) + +(dnai ldmdb "Load multiple registers (preindex, decrement)" + () + "ldm$cond .." + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 0) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 ldmdb-action-r15) + (multi-action 14 ldmdb-action) + (multi-action 13 ldmdb-action) + (multi-action 12 ldmdb-action) + (multi-action 11 ldmdb-action) + (multi-action 10 ldmdb-action) + (multi-action 9 ldmdb-action) + (multi-action 8 ldmdb-action) + (multi-action 7 ldmdb-action) + (multi-action 6 ldmdb-action) + (multi-action 5 ldmdb-action) + (multi-action 4 ldmdb-action) + (multi-action 3 ldmdb-action) + (multi-action 2 ldmdb-action) + (multi-action 1 ldmdb-action) + (multi-action 0 ldmdb-action)) +) + +(dnai ldmdb-wb "Load multiple registers (preindex, decrement, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 1) (f-load? 1) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 ldmdb-action-r15) + (multi-action 14 ldmdb-action) + (multi-action 13 ldmdb-action) + (multi-action 12 ldmdb-action) + (multi-action 11 ldmdb-action) + (multi-action 10 ldmdb-action) + (multi-action 9 ldmdb-action) + (multi-action 8 ldmdb-action) + (multi-action 7 ldmdb-action) + (multi-action 6 ldmdb-action) + (multi-action 5 ldmdb-action) + (multi-action 4 ldmdb-action) + (multi-action 3 ldmdb-action) + (multi-action 2 ldmdb-action) + (multi-action 1 ldmdb-action) + (multi-action 0 ldmdb-action) + (set rn addr)) +) + +(define-pmacro (stmdb-action bit-num) + (sequence () + (set addr (sub addr 4)) + (set (mem WI addr) (reg WI h-gr bit-num))) +) + +(define-pmacro (stmdb-action-r15 ignore) + (sequence () + (set addr (sub addr 4)) + (set (mem WI addr) (add (reg WI h-gr 15) 4))) +) + +(dnai stmdb "Store multiple registers (preindex, decrement)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 0) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 stmdb-action-r15) + (multi-action 14 stmdb-action) + (multi-action 13 stmdb-action) + (multi-action 12 stmdb-action) + (multi-action 11 stmdb-action) + (multi-action 10 stmdb-action) + (multi-action 9 stmdb-action) + (multi-action 8 stmdb-action) + (multi-action 7 stmdb-action) + (multi-action 6 stmdb-action) + (multi-action 5 stmdb-action) + (multi-action 4 stmdb-action) + (multi-action 3 stmdb-action) + (multi-action 2 stmdb-action) + (multi-action 1 stmdb-action) + (multi-action 0 stmdb-action)) +) + +(dnai stmdb-wb "Store multiple registers (preindex, decrement, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 1) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 stmdb-action-r15) + (multi-action 14 stmdb-action) + (multi-action 13 stmdb-action) + (multi-action 12 stmdb-action) + (multi-action 11 stmdb-action) + (multi-action 10 stmdb-action) + (multi-action 9 stmdb-action) + (multi-action 8 stmdb-action) + (multi-action 7 stmdb-action) + (multi-action 6 stmdb-action) + (multi-action 5 stmdb-action) + (multi-action 4 stmdb-action) + (multi-action 3 stmdb-action) + (multi-action 2 stmdb-action) + (multi-action 1 stmdb-action) + (multi-action 0 stmdb-action) + (set rn addr)) +) + +(define-pmacro (stmib-action bit-num) + (sequence () + (set addr (add addr 4)) + (set (mem WI addr) (reg WI h-gr bit-num))) +) + +(define-pmacro (stmib-action-r15 ignore) + (sequence () + (set addr (add addr 4)) + (set (mem WI addr) (add (reg WI h-gr 15) 4))) +) + +(dnai stmib "Store multiple registers (preindex, increment)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 0) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 stmib-action) + (multi-action 1 stmib-action) + (multi-action 2 stmib-action) + (multi-action 3 stmib-action) + (multi-action 4 stmib-action) + (multi-action 5 stmib-action) + (multi-action 6 stmib-action) + (multi-action 7 stmib-action) + (multi-action 8 stmib-action) + (multi-action 9 stmib-action) + (multi-action 10 stmib-action) + (multi-action 11 stmib-action) + (multi-action 12 stmib-action) + (multi-action 13 stmib-action) + (multi-action 14 stmib-action) + (multi-action 15 stmib-action-r15)) +) + +(dnai stmib-wb "Store multiple registers (preindex, increment, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 1) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 1) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 stmib-action) + (multi-action 1 stmib-action) + (multi-action 2 stmib-action) + (multi-action 3 stmib-action) + (multi-action 4 stmib-action) + (multi-action 5 stmib-action) + (multi-action 6 stmib-action) + (multi-action 7 stmib-action) + (multi-action 8 stmib-action) + (multi-action 9 stmib-action) + (multi-action 10 stmib-action) + (multi-action 11 stmib-action) + (multi-action 12 stmib-action) + (multi-action 13 stmib-action) + (multi-action 14 stmib-action) + (multi-action 15 stmib-action-r15) + (set rn addr)) +) + +(define-pmacro (stmia-action bit-num) + (sequence () + (set (mem WI addr) (reg WI h-gr bit-num)) + (set addr (add addr 4))) +) + +(define-pmacro (stmia-action-r15 ignore) + (sequence () + (set (mem WI addr) (add (reg WI h-gr 15) 4)) + (set addr (add addr 4))) +) + +(dnai stmia "Store multiple registers (postindex, increment)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 0) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 stmia-action) + (multi-action 1 stmia-action) + (multi-action 2 stmia-action) + (multi-action 3 stmia-action) + (multi-action 4 stmia-action) + (multi-action 5 stmia-action) + (multi-action 6 stmia-action) + (multi-action 7 stmia-action) + (multi-action 8 stmia-action) + (multi-action 9 stmia-action) + (multi-action 10 stmia-action) + (multi-action 11 stmia-action) + (multi-action 12 stmia-action) + (multi-action 13 stmia-action) + (multi-action 14 stmia-action) + (multi-action 15 stmia-action-r15)) +) + +(dnai stmia-wb "Store multiple registers (postindex, increment, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 1) (f-load-psr? 0) + (f-write-back? 1) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 0 stmia-action) + (multi-action 1 stmia-action) + (multi-action 2 stmia-action) + (multi-action 3 stmia-action) + (multi-action 4 stmia-action) + (multi-action 5 stmia-action) + (multi-action 6 stmia-action) + (multi-action 7 stmia-action) + (multi-action 8 stmia-action) + (multi-action 9 stmia-action) + (multi-action 10 stmia-action) + (multi-action 11 stmia-action) + (multi-action 12 stmia-action) + (multi-action 13 stmia-action) + (multi-action 14 stmia-action) + (multi-action 15 stmia-action-r15) + (set rn addr)) +) + +(define-pmacro (stmda-action-r15 ignore) + (sequence () + (set (mem WI addr) (add (reg WI h-gr 15) 4)) + (set addr (sub addr 4))) +) + +(define-pmacro (stmda-action bit-num) + (sequence () + (set (mem WI addr) (reg WI h-gr bit-num)) + (set addr (sub addr 4))) +) + +(dnai stmda "Store multiple registers (postindex, decrement)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 0) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 stmda-action-r15) + (multi-action 14 stmda-action) + (multi-action 13 stmda-action) + (multi-action 12 stmda-action) + (multi-action 11 stmda-action) + (multi-action 10 stmda-action) + (multi-action 9 stmda-action) + (multi-action 8 stmda-action) + (multi-action 7 stmda-action) + (multi-action 6 stmda-action) + (multi-action 5 stmda-action) + (multi-action 4 stmda-action) + (multi-action 3 stmda-action) + (multi-action 2 stmda-action) + (multi-action 1 stmda-action) + (multi-action 0 stmda-action)) +) + +(dnai stmda-wb "Store multiple registers (postindex, decrement, writeback)" + () + "FIXME" + (+ cond (f-op3 4) (f-preindex? 0) (f-up-down 0) (f-load-psr? 0) + (f-write-back? 1) (f-load? 0) rn reglist) + (sequence ((WI addr)) + (set addr rn) + (multi-action 15 stmda-action-r15) + (multi-action 14 stmda-action) + (multi-action 13 stmda-action) + (multi-action 12 stmda-action) + (multi-action 11 stmda-action) + (multi-action 10 stmda-action) + (multi-action 9 stmda-action) + (multi-action 8 stmda-action) + (multi-action 7 stmda-action) + (multi-action 6 stmda-action) + (multi-action 5 stmda-action) + (multi-action 4 stmda-action) + (multi-action 3 stmda-action) + (multi-action 2 stmda-action) + (multi-action 1 stmda-action) + (multi-action 0 stmda-action) + (set rn addr)) +) + + +; Coprocessor instructions. +; Currently not implemented, so omit these, such that we take the +; undefined instruction trap as specified by the ARM documentation. + +(dnai mrs-c "Transfer CPSR contents to a register" + () + "mrs$cond $rd,cpsr" + (+ cond (f-op5 2) PSR_CURRENT (f-op-mrs1 #xF) rd (f-op-mrs2 0)) + (set rd (reg h-cpsr)) +) + +(dnai mrs-s "Transfer SPSR contents to a register" + () + "mrs$cond $rd,spsr" + (+ cond (f-op5 2) PSR_SAVED (f-op-mrs1 #xF) rd (f-op-mrs2 0)) + (set rd (reg h-spsr)) +) + +(dnai msr-c "Transfer register contents to CPSR" + () + "msr$cond cpsr,$rm" + (+ cond (f-op5 2) PSR_CURRENT (f-op-msr1 #x29F) (f-op-msr2 0) rm) + (set (reg h-cpsr) rm) +) + +(dnai msr-s "Transfer register contents to SPSR" + () + "msr$cond spsr,$rm" + (+ cond (f-op5 2) PSR_SAVED (f-op-msr1 #x29F) (f-op-msr2 0) rm) + (set (reg h-spsr) rm) +) + +; TODO: msr to flag bits only + +; Commented out until ifield assertions added, collides with str/ldr. +; ??? It's possible to rewrite str,ldr, but assertions are wanted anyway. + +;(dnai undefined "Undefined instruction" +; () +; "undef" +; (+ cond (f-op3 3) undef-dont1 (f-bit4 1) undef-dont2) +; ; Generate an undefined exception. +; ; Jump to the vector held in 0x4. +; ; FIXME: More state change than this occurs. +; (set pc (mem WI #x4)) +;) diff --git a/cgen/attr.scm b/cgen/attr.scm new file mode 100644 index 00000000000..1d8cd7cbbc1 --- /dev/null +++ b/cgen/attr.scm @@ -0,0 +1,910 @@ +; Attributes. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; There are 4 kinds of attributes: boolean, integer, enum, and bitset. Boolean +; attributes are really enum attributes with two possible values, but they +; occur frequently enough that they are special cased. +; +; All objects that use attributes must have two methods: +; - 'get-atlist - returns the object's attr-list +; - 'set-atlist! - set the object's attr-list +; +; In .cpu files, attribute lists are associative lists of (NAME VALUE). +; Boolean attributes are specified as (NAME #t) or (NAME #f), +; but for convenience ATTR and !ATTR are also supported. +; integer/enum attrs are specified as (ATTR value). +; Bitset attrs are specified as (ATTR val1,val2,val3). +; In all cases the value needn't be constant, and can be an expression, +; though expressions are currently only supported for META-attributes +; (attributes that don't appear in any generated code). +; +; Example: +; (FOO1 !FOO2 (BAR 3) (FOO3 X) (MACH sparc,sparclite)) +; +; ??? Implementation of expressions is being postponed as long +; as possible, avoiding adding complications for complication's sake, and +; because I'm not completely sure how I want to do them. +; The syntax for an expression value is (ATTR (rtx-func ...)). +; +; ??? May wish to allow a bitset attribute like (ATTR val1,!val2), where `!' +; means to turn off that particular bit (or bits if val2 refers to several). +; +; ??? May wish to allow specifying enum attributes by only having to +; specify the value (move names into "enum space" or some such). + +; An attr-list (or "atlist") is a collection of attributes. +; Attributes are stored as an associative list. +; There is possible confusion between "alist" (associative-list) and +; "atlist" (attribute-list) but in practice I haven't had a problem. +; ??? May wish to change this to a list of objects, as the alist doesn't carry +; enough info. However the alist is simple and fast. + +(define <attr-list> (class-make '<attr-list> nil '(prefix attrs) nil)) + +(define atlist-prefix (elm-make-getter <attr-list> 'prefix)) +(define atlist-attrs (elm-make-getter <attr-list> 'attrs)) + +(define (atlist? x) (class-instance? <attr-list> x)) + +; An empty attribute-list. + +(define atlist-empty (make <attr-list> "" nil)) + +; The attribute baseclass. +; The attributes of <ident> are the set of attributes for this attribute +; [meaning attributes themselves can have attributes]. +; [Ya, that's clumsily written. I left it that way for fun.] +; An odd notion that is of some use. It's current raison d'etre is to +; support sanitization of attributes [which is implemented with the +; `sanitize' attribute]. + +(define <attribute> + (class-make '<attribute> + '(<ident>) + '( + ; List of object types this attribute is for. + ; Possible element values are: + ; attr, enum, cpu, mach, model, ifield, hardware, operand, + ; insn + ; A value of #f means the attribute is for everything. + for + ) + nil) +) + +; Accessors. + +(define atlist-for (elm-make-getter <attribute> 'for)) + +; A class for each type of attribute. + +; `values' exists for boolean-attribute to simplify the code, it's ignored. +; Ditto for `default'. The default for boolean-attribute is always #f. + +(define <boolean-attribute> + (class-make '<boolean-attribute> + '(<attribute>) + '(default values) + nil) +) + +; For bitset attributes, VALUES is a list of symbols, one for each bit. +; Int's are used to record the bitset in the generated code so there's a limit +; of 32 elements, though there's nothing inherent in the description language +; that precludes removing the limit. + +(define <bitset-attribute> + (class-make '<bitset-attribute> + '(<attribute>) + '(default values) + nil) +) + +; For integer attributes, VALUES is a list of ints, one for each possible +; value, or the empty list of all values are permissible. + +(define <integer-attribute> + (class-make '<integer-attribute> + '(<attribute>) + '(default values) + nil) +) + +; For enum attributes, VALUES is a list of symbols, one for each possible +; value. + +(define <enum-attribute> + (class-make '<enum-attribute> + '(<attribute>) + '(default values) + nil) +) + +; Return a boolean indicating if X is a <boolean-attribute> object. + +(define (bool-attr? x) (class-instance? <boolean-attribute> x)) + +; Return a boolean indicating if X is a <bitset-attribute> object. + +(define (bitset-attr? x) (class-instance? <bitset-attribute> x)) + +; Return a symbol indicating the kind of attribute ATTR is. +; The result is one of boolean,integer,enum,bitset. + +(define (attr-kind attr) + (case (object-class-name attr) + ((<boolean-attribute>) 'boolean) + ((<integer-attribute>) 'integer) + ((<enum-attribute>) 'enum) + ((<bitset-attribute>) 'bitset) + (else (error "attr-kind: internal error, not an attribute class" + (object-class-name attr)))) +) + +; Accessors. + +(define (attr-default attr) (elm-xget attr 'default)) +(define (attr-values attr) (elm-xget attr 'values)) + +; Create an attribute. +; Attributes are stored in attribute lists using the actual value +; rather than an object containing the value, so we only have to cons +; NAME and VALUE rather than building some object. This is for simplicity +; and speed. We try to incrementally complicate things, only as necessary. + +; VALUE must be #f or #t. + +(define (bool-attr-make name value) (cons name value)) + +; VALUES must be a comma separated list of symbols +; (e.g. val1,val2 not (val1 val2)). + +(define (bitset-attr-make name values) (cons name values)) + +; VALUE must be a number (or maybe a symbol). + +(define (int-attr-make name value) (cons name value)) + +; VALUE must be a symbol. + +(define (enum-attr-make name value) (cons name value)) + +; A boolean attribute's value is either #t or #f. + +(method-make! + <boolean-attribute> 'parse-value + (lambda (self errtxt val) + (if (and (not (null? val)) + (boolean? (car val))) + (cons (obj:name self) (car val)) + (parse-error errtxt "boolean attribute not one of #f/#t" + (cons (obj:name self) val)))) +) + +; A bitset attribute's value is a comma separated list of elements. +; We don't validate the values. In the case of the MACH attribute, +; there's no current mechanism to create it after all define-mach's have +; been read in. +; ??? Need to decide whether all define-mach's must appear before any +; define-insn's. It would be nice to be able to spread an architecture's +; description over several .cpu files. +; ??? On the other hand, all machs are specified in define-arch. +; Perhaps creation of builtins could be defered until then. + +(method-make! + <bitset-attribute> 'parse-value + (lambda (self errtxt val) + (if (and (not (null? val)) + (or (symbol? (car val)) + (string? (car val))) + (null? (cdr val))) + (cons (obj:name self) (car val)) + (parse-error errtxt "improper bitset attribute" + (cons (obj:name self) val)))) +) + +; An integer attribute's value is a number +; (or maybe a symbol representing that value). + +(method-make! + <integer-attribute> 'parse-value + (lambda (self errtxt val) + (if (and (not (null? val)) + (or (number? (car val)) (symbol? (car val))) + (null? (cdr val))) + (cons (obj:name self) (car val)) + (parse-error errtxt "improper integer attribute" + (cons (obj:name self) val)))) +) + +; An enum attribute's value is a symbol representing that value. + +(method-make! + <enum-attribute> 'parse-value + (lambda (self errtxt val) + (if (and (not (null? val)) + (or (symbol? (car val)) (string? (car val))) + (null? (cdr val))) + (cons (obj:name self) (car val)) + (parse-error errtxt "improper enum attribute" + (cons (obj:name self) val)))) +) + +; Parse a boolean attribute's value definition. + +(method-make! + <boolean-attribute> 'parse-value-def + (lambda (self errtxt values) + (if (equal? values '(#f #t)) + values + (parse-error errtxt "boolean value list must be (#f #t)" values))) +) + +; Parse a bitset attribute's value definition. +; FIXME: treated as enum? + +(method-make! + <bitset-attribute> 'parse-value-def + (lambda (self errtxt values) + (parse-enum-vals "" values)) +) + +; Parse an integer attribute's value definition. +; FIXME: Unfinished. + +(method-make! + <integer-attribute> 'parse-value-def + (lambda (self errtxt values) values) +) + +; Parse an enum attribute's value definition. +; See parse-enum-vals for more info. + +(method-make! + <enum-attribute> 'parse-value-def + (lambda (self errtxt values) + (parse-enum-vals "" values)) +) + +; Make an attribute list object from a list of name/value pairs. + +(define (atlist-make prefix . attrs) (make <attr-list> prefix attrs)) + +; Parse an attribute definition. +; This is the main routine for building an attribute object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; TYPE-CLASS is the class of the object to create. +; i.e. one of <{boolean,bitset,integer,enum}-attribute>. +; If DEFAULT is #f, use the first value. +; ??? Allowable values for integer attributes is wip. + +(define (-attr-parse errtxt type-class name comment attrs for default values) + (logit 2 "Processing attribute " name " ...\n") + (let* ((name (parse-name name errtxt)) + (errtxt (string-append errtxt ":" name)) + (result (new type-class)) + (parsed-values (send result 'parse-value-def errtxt values))) + (elm-xset! result 'name name) + (elm-xset! result 'comment (parse-comment comment errtxt)) + (elm-xset! result 'attrs (atlist-parse attrs "" errtxt)) + (elm-xset! result 'for for) + ; Set the default. + (case (class-name type-class) + ((<boolean-attribute>) + (if (and (not (memq default '(#f #t))) + (not (rtx? default))) + (parse-error errtxt "invalid default" default)) + (elm-xset! result 'default default)) + ((<integer-attribute>) + (let ((default (if default default (if (null? values) 0 (car values))))) + (if (and (not (integer? default)) + (not (rtx? default))) + (parse-error errtxt "invalid default" default)) + (elm-xset! result 'default default))) + ((<bitset-attribute> <enum-attribute>) + (let ((default (if default default (caar parsed-values)))) + (if (and (not (assq default parsed-values)) + (not (rtx? default))) + (parse-error errtxt "invalid default" default)) + (elm-xset! result 'default default)))) + (elm-xset! result 'values parsed-values) + result) +) + +; Read an attribute description +; This is the main routine for analyzing attributes in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -attr-parse is invoked to create the attribute object. + +(define (-attr-read errtxt . arg-list) + (let (; Current attribute elements: + (type-class 'not-set) ; attribute type + (name nil) + (comment "") + (attrs nil) + (for #f) ; assume for everything + (default #f) ; assume boolean + (values '(#f #t)) ; assume boolean + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((type) (set! type-class (case (cadr arg) + ((boolean) <boolean-attribute>) + ((bitset) <bitset-attribute>) + ((integer) <integer-attribute>) + ((enum) <enum-attribute>) + (else (parse-error + errtxt + "invalid attribute type" + (cadr arg)))))) + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((for) (set! for (cdr arg))) + ((default) (set! default (cadr arg))) + ((values) (set! values (cdr arg))) + (else (parse-error errtxt "invalid attribute arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-attr-parse errtxt type-class name comment attrs for default values) + ) +) + +; Main routine for defining attributes in .cpu files. + +(define define-attr + (lambda arg-list + (let ((a (apply -attr-read (cons "define-attr" arg-list)))) + (current-attr-add! a) + a)) +) + +; Query routines. + +; Lookup ATTR-NAME in ATTR-LIST. +; The result is the object or #f if not found. + +(define (attr-lookup attr-name attr-list) + (object-assq attr-name attr-list) +) + +; Return a boolean indicating if boolean attribute ATTR is "true" in +; attribute alist ALIST. +; Note that if the attribute isn't present, it is defined to be #f. + +(define (attr-has-attr? alist attr) + (let ((a (assq attr alist))) + (cond ((not a) a) + ((boolean? (cdr a)) (cdr a)) + (else (error "Not a boolean attribute:" attr)))) +) + +(method-make! <attr-list> 'has-attr? + (lambda (self attr) (attr-has-attr? (elm-get self 'attrs) attr)) +) + +(define (atlist-has-attr? atlist attr) + (send atlist 'has-attr? attr) +) + +; Expand attribute value ATVAL, which is an rtx expression. +; OWNER is the containing object or #f if there is none. +; OWNER is needed if an attribute is defined in terms of other attributes. +; If it's #f obviously ATVAL can't be defined in terms of others. + +(define (-attr-eval atval owner) + (let* ((estate (estate-make-for-eval #f owner)) + (expr (rtx-compile #f (rtx-simplify #f owner atval nil) nil)) + (value (rtx-eval-with-estate expr 'DFLT estate))) + (cond ((symbol? value) value) + ((number? value) value) + (error "-attr-eval: internal error, unsupported result:" value))) +) + +; Return value of ATTR in attribute alist ALIST. +; If not present, return the default value. +; OWNER is the containing object or #f if there is none. + +(define (attr-value alist attr owner) + (let ((a (assq-ref alist attr))) + (if a + (if (pair? a) ; pair? -> cheap non-null-list? + (-attr-eval a owner) + a) + (attr-lookup-default attr owner))) +) + +; Return the value of ATTR in ATLIST. +; OWNER is the containing object or #f if there is none. + +(define (atlist-attr-value atlist attr owner) + (attr-value (atlist-attrs atlist) attr owner) +) + +; Same as atlist-attr-value but return nil if attribute not present. + +(define (atlist-attr-value-no-default atlist attr owner) + (let ((a (assq-ref (atlist-attrs atlist) attr))) + (if a + (if (pair? a) ; pair? -> cheap non-null-list? + (-attr-eval a owner) + a) + nil)) +) + +; Return the default for attribute A. +; If A isn't a non-boolean attribute, we assume it's a boolean one, and +; return #f (??? for backward's compatibility, to be removed in time). +; OWNER is the containing object or #f if there is none. + +(define (attr-lookup-default a owner) + (let ((at (current-attr-lookup a))) + (if at + (if (bool-attr? at) + #f + (let ((deflt (attr-default at))) + (if deflt + (if (pair? deflt) ; pair? -> cheap non-null-list? + (-attr-eval deflt owner) + deflt) + ; If no default was provided, use the first value. + (caar (attr-values at))))) + #f)) +) + +; Return a boolean indicating if X is present in BITSET. +; Bitset values are recorded as val1,val2,.... + +(define (bitset-attr-member? x bitset) + (->bool (memq x (bitset-attr->list bitset))) +) + +; Routines for accessing attributes in objects. + +; Get/set attributes of OBJ. +; OBJ is any object which supports the get-atlist message. + +(define (obj-atlist obj) + (let ((result (send obj 'get-atlist))) + ; As a speed up, we allow objects to specify an empty attribute list + ; with #f or (), rather than creating an attr-list object. + ; ??? There is atlist-empty now which should be used directly. + (if (or (null? result) (not result)) + atlist-empty + result)) +) +(define (obj-set-atlist! obj attrs) (send obj 'set-atlist! attrs)) + +; Add attribute ATTR to OBJ. +; The attribute is prepended to the front so it overrides any existing +; definition. + +(define (obj-cons-attr! obj attr) + (obj-set-atlist! obj (atlist-cons attr (obj-atlist obj))) +) + +; Add attribute list ATLIST to OBJ. +; Attributes in ATLIST override existing values, so ATLIST is "prepended". + +(define (obj-prepend-atlist! obj atlist) + ; Must have same prefix. + (assert (equal? (atlist-prefix (obj-atlist obj)) + (atlist-prefix atlist))) + (obj-set-atlist! obj (atlist-append atlist (obj-atlist obj))) +) + +; Return boolean of whether OBJ has boolean attribute ATTR or not. +; OBJ is any object. + +(define (obj-has-attr? obj attr) + (atlist-has-attr? (obj-atlist obj) attr) +) + +; FIXME: for backward compatibility. Delete in time. +(define has-attr? obj-has-attr?) + +; Return value of attribute ATTR in OBJ. +; If the attribute isn't present, the default is returned. +; OBJ is any object that supports the get-atlist method. + +(define (obj-attr-value obj attr) + (let ((atlist (obj-atlist obj))) + (atlist-attr-value atlist attr obj)) +) + +; Utilities. + +; Convert a bitset value "a,b,c" into a list (a b c). + +(define (bitset-attr->list x) + (map string->symbol (string-cut x #\,)) +) + +; Return the enum of ATTR-NAME for type TYPE. +; TYPE is one of 'ifld, 'hw, 'operand, 'insn. + +(define (gen-attr-enum type attr-name) + (string-upcase (string-append "CGEN_" type "_" (gen-sym attr-name))) +) + +; Return a list of enum value definitions for gen-enum-decl. +; Attributes numbers are organized as follows: booleans are numbered 0-31. +; The range is because that's what fits in a portable int. Unused numbers +; are left unused. Non-booleans are numbered starting at 32. +; An alternative is start numbering the booleans at 32. The generated code +; is simpler with the current way (the "- 32" to get back the bit number or +; array index number occurs less often). +; +; Three special values are created: +; END-BOOLS - mark end of boolean attributes +; END-NBOOLS - mark end of non-boolean attributes +; START-NBOOLS - marks the start of the non-boolean attributes +; (needed in case first non-bool is sanytized out). +; +; ATTR-OBJ-LIST is a list of <attribute> objects (always subclassed of course). + +(define (attr-list-enum-list attr-obj-list) + (let ((sorted-attrs (-attr-sort (attr-remove-meta-attrs attr-obj-list)))) + (assert (<= (length (car sorted-attrs)) 32)) + (append! + (map (lambda (bool-attr) + (list (obj:name bool-attr) '- + (atlist-attrs (obj-atlist bool-attr)))) + (car sorted-attrs)) + (list '(END-BOOLS)) + (list '(START-NBOOLS 31)) + (map (lambda (nbool-attr) + (list (obj:name nbool-attr) '- + (atlist-attrs (obj-atlist nbool-attr)))) + (cdr sorted-attrs)) + (list '(END-NBOOLS)) + )) +) + +; Sort an alist of attributes so non-boolean attributes are at the front. +; This is used to sort a particular object's attributes. +; This is required by the C support code (cgen.h:CGEN_ATTR_VALUE). +; Boolean attributes appear as (NAME . #t/#f), non-boolean ones appear as +; (NAME . VALUE). Attributes of the same type are sorted by name. + +(define (-attr-sort-alist alist) + (sort alist + (lambda (a b) + ;(display (list a b "\n")) + (cond ((and (boolean? (cdr a)) (boolean? (cdr b))) + (string<? (symbol->string (car a)) (symbol->string (car b)))) + ((boolean? (cdr a)) #f) ; we know b is non-bool here + ((boolean? (cdr b)) #t) ; we know a is non-bool here + (else (string<? (symbol->string (car a)) + (symbol->string (car b))))))) +) + +; Sort ATTR-LIST into two lists: bools and non-bools. +; The car of the result is the bools, the cdr is the non-bools. +; Attributes requiring a fixed index have the INDEX attribute, +; and used for the few special attributes that are refered to by +; architecture independent code. +; For each of non-bools and bools, put attributes with the INDEX attribute +; first. This is used to sort a list of attributes for output (e.g. define +; the attr enum). +; +; ??? Record index number with the INDEX attribute? +; At present it's just a boolean. + +(define (-attr-sort attr-list) + (let loop ((fixed-non-bools nil) + (non-fixed-non-bools nil) + (fixed-bools nil) + (non-fixed-bools nil) + (attr-list attr-list)) + (cond ((null? attr-list) + (cons (append! (reverse! fixed-bools) + (reverse! non-fixed-bools)) + (append! (reverse! fixed-non-bools) + (reverse! non-fixed-non-bools)))) + ((bool-attr? (car attr-list)) + (if (obj-has-attr? (car attr-list) 'INDEX) + (loop fixed-non-bools non-fixed-non-bools + (cons (car attr-list) fixed-bools) non-fixed-bools + (cdr attr-list)) + (loop fixed-non-bools non-fixed-non-bools + fixed-bools (cons (car attr-list) non-fixed-bools) + (cdr attr-list)))) + (else + (if (obj-has-attr? (car attr-list) 'INDEX) + (loop (cons (car attr-list) fixed-non-bools) non-fixed-non-bools + fixed-bools non-fixed-bools + (cdr attr-list)) + (loop fixed-non-bools (cons (car attr-list) non-fixed-non-bools) + fixed-bools non-fixed-bools + (cdr attr-list)))))) +) + +; Return number of non-bools in attributes ATLIST. + +(define (attr-count-non-bools atlist) + (count-true (map (lambda (a) (not (bool-attr? a))) + atlist)) +) + +; Given an alist of attributes, return the non-bools. + +(define (attr-non-bool-attrs alist) + (let loop ((result nil) (alist alist)) + (cond ((null? alist) (reverse! result)) + ((boolean? (cdar alist)) (loop result (cdr alist))) + (else (loop (cons (car alist) result) (cdr alist))))) +) + +; Given an alist of attributes, return the bools. + +(define (attr-bool-attrs alist) + (let loop ((result nil) (alist alist)) + (cond ((null? alist) (reverse! result)) + ((boolean? (cdar alist)) + (loop (cons (car alist) result) (cdr alist))) + (else (loop result (cdr alist))))) +) + +; Parse an attribute spec. +; CONTEXT is a <context> object or #f if there is none. +; ATTRS is a list of attribute specs (e.g. (FOO !BAR (BAZ 3))). +; The result is the attribute alist. + +(define (attr-parse context attrs) + (if (not (list? attrs)) + (context-error context "improper attribute list" attrs)) + (let ((alist nil)) + (for-each (lambda (elm) + (cond ((symbol? elm) + ; boolean attribute + (if (char=? (string-ref elm 0) #\!) + (set! alist (acons (string->symbol (string-drop1 elm)) #f alist)) + (set! alist (acons elm #t alist))) + (if (not (current-attr-lookup (caar alist))) + (context-error context "unknown attribute" (caar alist)))) + ((and (list? elm) (pair? elm) (symbol? (car elm))) + (let ((a (current-attr-lookup (car elm)))) + (if (not a) + (context-error context "unknown attribute" elm)) + (set! alist (cons (send a 'parse-value + (context-prefix context);FIXME + (cdr elm)) alist)))) + (else (context-error context "improper attribute" elm)))) + attrs) + alist) +) + +; Parse an object attribute spec. +; ATTRS is a list of attribute specs (e.g. (FOO !BAR (BAZ 3))). +; The result is an <attr-list> object. + +(define (atlist-parse attrs prefix errtxt) + (make <attr-list> prefix (attr-parse (context-make-prefix errtxt) attrs)) +) + +; Return the source form of an atlist's values. +; Externally attributes are ((name1 value1) (name2 value2) ...). +; Internally they are ((name1 . value1) (name2 . value2) ...). + +(define (atlist-source-form atlist) + (map (lambda (attr) + (list (car attr) (cdr attr))) + (atlist-attrs atlist)) +) + +; cons an attribute to an attribute list to create a new attribute list +; ATLIST is either an attr-list object or #f or () (both of the latter two +; signify an empty attribute list, in which case we make the prefix of the +; result ""). + +(define (atlist-cons attr atlist) + (if (or (not atlist) (null? atlist)) + (make <attr-list> "" (cons attr nil)) + (make <attr-list> (atlist-prefix atlist) (cons attr (atlist-attrs atlist)))) +) + +; Append one attribute list to another. +; The prefix for the new atlist is taken from the first one. + +(define (atlist-append attr-list1 attr-list2) + (make <attr-list> + (atlist-prefix attr-list1) + (append (atlist-attrs attr-list1) (atlist-attrs attr-list2))) +) + +; Remove meta-attributes from ALIST. +; "meta" may be the wrong adjective to use here. +; The attributes in question are not intended to appear in generated files. +; They started out being attributes of attributes, hence the name "meta". + +(define (attr-remove-meta-attrs-alist alist) + (let ((all-attrs (current-attr-list))) + ; FIXME: Why not use find? + (let loop ((result nil) (alist alist)) + (if (null? alist) + (reverse! result) + (let ((attr (attr-lookup (caar alist) all-attrs))) + (if (and attr (has-attr? attr 'META)) + (loop result (cdr alist)) + (loop (cons (car alist) result) (cdr alist))))))) +) + +; Remove meta-attributes from ATTR-LIST. +; "meta" may be the wrong adjective to use here. +; The attributes in question are not intended to appear in generated files. +; They started out being attributes of attributes, hence the name "meta". + +(define (attr-remove-meta-attrs attr-list) + ; FIXME: Why not use find? + (let loop ((result nil) (attr-list attr-list)) + (cond ((null? attr-list) + (reverse! result)) + ((has-attr? (car attr-list) 'META) + (loop result (cdr attr-list))) + (else + (loop (cons (car attr-list) result) (cdr attr-list))))) +) + +; Remove duplicates from ATTRS, a list of attributes. +; Attribute lists are typically small so we use a simple O^2 algorithm. +; The leading entry of an attribute overrides subsequent ones so this is +; defined to pick the first entry of each attribute. + +(define (attr-nub attrs) + (let loop ((result nil) (attrs attrs)) + (cond ((null? attrs) (reverse! result)) + ((assq (caar attrs) result) (loop result (cdr attrs))) + (else (loop (cons (car attrs) result) (cdr attrs))))) +) + +; Return a list of all attrs in TABLE-LIST, a list of lists of arbitrary +; elements. A list of lists is passed to simplify computation of insn +; attributes where the insns and macro-insns are on separate lists and +; appending them into one list would be unnecessarily expensive. +; ACCESSOR is a function to access the attrs field from TABLE-LIST. +; Duplicates are eliminated and the list is sorted so non-boolean attributes +; are at the front (required by the C code that fetches attribute values). +; STD-ATTRS is an `attr-list' object of attrs that are always available. +; The actual values returned are random (e.g. #t vs #f). We could +; canonicalize them. +; The result is an alist of all the attributes that are used in TABLE-LIST. +; ??? The cdr of each element is some random value. Perhaps it should be +; the default value or perhaps we should just return a list of names. +; ??? No longer used. + +(define (attr-compute-all table-list accessor std-attrs) + (let ((accessor (lambda (elm) (atlist-attrs (accessor elm))))) + (attr-remove-meta-attrs-alist + (attr-nub + (-attr-sort-alist + (append + (apply append + (map (lambda (table-elm) + (apply append + (find-apply accessor + (lambda (e) + (let ((attrs (accessor e))) + (not (null? attrs)))) + table-elm))) + table-list)) + (atlist-attrs std-attrs)))))) +) + +; Return lists of attributes for particular object types. +; FIXME: The output shouldn't be required to be sorted. + +(define (current-attr-list-for type) + (let ((sorted (-attr-sort (find (lambda (a) + (if (atlist-for a) + (memq type (atlist-for a)) + #t)) + (attr-remove-meta-attrs + (current-attr-list)))))) + ; Current behaviour puts the non-bools at the front. + (append! (cdr sorted) (car sorted))) +) +(define (current-ifld-attr-list) + (current-attr-list-for 'ifield) +) +(define (current-hw-attr-list) + (current-attr-list-for 'hardware) +) +(define (current-op-attr-list) + (current-attr-list-for 'operand) +) +(define (current-insn-attr-list) + (current-attr-list-for 'insn) +) + +; Methods to emit the C value of an attribute. +; These don't _really_ belong here (C code doesn't belong in the appl'n +; independent part of CGEN), but there isn't a better place for them +; (maybe utils-cgen.scm?) and there's only a few of them. + +(method-make! + <boolean-attribute> 'gen-value-for-defn + (lambda (self value) + (if (not value) + "0" + "1")) + ;(string-upcase (string-append (obj:name self) "_" value))) +) + +(method-make! + <bitset-attribute> 'gen-value-for-defn + (lambda (self value) + (string-drop1 + (string-upcase + (string-map (lambda (x) + (string-append "|(1<<" + (gen-sym self) + "_" (gen-c-symbol x) ")")) + (bitset-attr->list value))))) +) + +(method-make! + <integer-attribute> 'gen-value-for-defn + (lambda (self value) + (number->string value)) +) + +(method-make! + <enum-attribute> 'gen-value-for-defn + (lambda (self value) + (string-upcase (gen-c-symbol (string-append (obj:name self) "_" value)))) +) + +; Called before loading a .cpu file to initialize. + +(define (attr-init!) + + (reader-add-command! 'define-attr + "\ +Define an attribute, name/value pair list version. +" + nil 'arg-list define-attr) + + *UNSPECIFIED* +) + +; Called before a . cpu file is read in to install any builtins. +; One thing this does is define all attributes requiring a fixed index, +; keeping them all in one place. +; ??? Perhaps it would make sense to define all predefined attributes here. + +(define (attr-builtin!) + (define-attr '(type boolean) '(name VIRTUAL) '(comment "virtual object")) + + ; The meta attribute is used for attributes that aren't to appear in + ; generated output (need a better name). + (define-attr '(for attr) '(type boolean) '(name META)) + + ; Objects to keep local to a generated file. + (define-attr '(for keyword) '(type boolean) '(name PRIVATE)) + + ; Attributes requiring fixed indices. + ; ALIAS is used for instructions that are aliases of more general insns. + ; ALIAS insns are ignored by the simulator. + (define-attr '(for attr) '(type boolean) '(name INDEX) '(attrs META)) + (define-attr '(for insn) '(type boolean) '(name ALIAS) + '(comment "insn is an alias of another") + '(attrs INDEX)) + + *UNSPECIFIED* +) + +; Called after loading a .cpu file to perform any post-processing required. + +(define (attr-finish!) + *UNSPECIFIED* +) diff --git a/cgen/cgen-gas.scm b/cgen/cgen-gas.scm new file mode 100644 index 00000000000..c6d3b945466 --- /dev/null +++ b/cgen/cgen-gas.scm @@ -0,0 +1,80 @@ +; CPU description file generator for the GAS testsuite. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; This is invoked to build several .s files and a script to run to +; generate the .d files and .exp file. +; This is invoked to build: tmp-build.sh cpu-cpu.exp + +; Load the various support routines. + +(define (load-files srcdir) + ; Fix up Scheme to be what we use (guile is always in flux). + (primitive-load-path (string-append srcdir "/fixup.scm")) + + (load (string-append srcdir "/read.scm")) + (load (string-append srcdir "/desc.scm")) + (load (string-append srcdir "/desc-cpu.scm")) + (load (string-append srcdir "/opcodes.scm")) + (load (string-append srcdir "/opc-asmdis.scm")) + (load (string-append srcdir "/opc-ibld.scm")) + (load (string-append srcdir "/opc-itab.scm")) + (load (string-append srcdir "/opc-opinst.scm")) + (load (string-append srcdir "/gas-test.scm")) +) + +(define gas-arguments + (list + (list '-B "file" "generate build.sh in <file>" + (lambda (arg) (file-write arg cgen-build.sh))) + (list '-E "file" "generate allinsn.exp in <file>" + (lambda (arg) (file-write arg cgen-allinsn.exp))) + ) +) + +; Kept global so it's available to the other .scm files. +(define srcdir ".") + +; Scan argv for -s srcdir. +; We can't process any other args until we find the cgen source dir. +; The result is srcdir. +; We assume "-s" isn't the argument to another option. Unwise, yes. +; Alternatives are to require it to be the first argument or at least preceed +; any option with a "-s" argument, or to put knowledge of the common argument +; set and common argument parsing code in every top level file. + +(define (find-srcdir argv) + (let loop ((argv argv)) + (if (null? argv) + (error "`-s srcdir' not present, can't load cgen")) + (if (string=? "-s" (car argv)) + (begin + (if (null? (cdr argv)) + (error "missing srcdir arg to `-s'")) + (cadr argv)) + (loop (cdr argv)))) +) + +; Main routine, parses options and calls generators. + +(define (cgen-gas argv) + (let () + + ; Find and set srcdir, then load all Scheme code. + ; Drop the first argument, it is the script name (i.e. argv[0]). + (set! srcdir (find-srcdir (cdr argv))) + (set! %load-path (cons srcdir %load-path)) + (load-files srcdir) + + (display-argv argv) + + (cgen #:argv argv + #:app-name "gas-test" + #:arg-spec gas-arguments + #:init gas-test-init! + #:finish gas-test-finish! + #:analyze gas-test-analyze!) + ) +) + +(cgen-gas (program-arguments)) diff --git a/cgen/cgen-opc.scm b/cgen/cgen-opc.scm new file mode 100644 index 00000000000..cd98fe0598d --- /dev/null +++ b/cgen/cgen-opc.scm @@ -0,0 +1,99 @@ +; CPU description file generator for the GNU Binutils. +; This is invoked to build: $arch-desc.[ch], $arch-opinst.c, +; $arch-opc.h, $arch-opc.c, $arch-asm.in, $arch-dis.in, and $arch-ibld.[ch]. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; +; This is a standalone script, we don't load anything until we parse the +; -s argument (keeps reliance off of environment variables, etc.). + +; Load the various support routines. + +(define (load-files srcdir) + ; Fix up Scheme to be what we use (guile is always in flux). + (primitive-load-path (string-append srcdir "/fixup.scm")) + + (load (string-append srcdir "/read.scm")) + (load (string-append srcdir "/desc.scm")) + (load (string-append srcdir "/desc-cpu.scm")) + (load (string-append srcdir "/opcodes.scm")) + (load (string-append srcdir "/opc-asmdis.scm")) + (load (string-append srcdir "/opc-ibld.scm")) + (load (string-append srcdir "/opc-itab.scm")) + (load (string-append srcdir "/opc-opinst.scm")) +) + +(define opc-arguments + (list + (list '-H "file" "generate $arch-desc.h in <file>" + (lambda (arg) (file-write arg cgen-desc.h))) + (list '-C "file" "generate $arch-desc.c in <file>" + (lambda (arg) (file-write arg cgen-desc.c))) + (list '-O "file" "generate $arch-opc.h in <file>" + (lambda (arg) (file-write arg cgen-opc.h))) + (list '-P "file" "generate $arch-opc.c in <file>" + (lambda (arg) (file-write arg cgen-opc.c))) + (list '-Q "file" "generate $arch-opinst.c in <file>" + (lambda (arg) (file-write arg cgen-opinst.c))) + (list '-B "file" "generate $arch-ibld.h in <file>" + (lambda (arg) (file-write arg cgen-ibld.h))) + (list '-L "file" "generate $arch-ibld.in in <file>" + (lambda (arg) (file-write arg cgen-ibld.in))) + (list '-A "file" "generate $arch-asm.in in <file>" + (lambda (arg) (file-write arg cgen-asm.in))) + (list '-D "file" "generate $arch-dis.in in <file>" + (lambda (arg) (file-write arg cgen-dis.in))) + ) +) + +; (-R "file" "generate $cpu-reloc.h") ; FIXME: wip (rename to -abi.h?) +; (-S "file" "generate cpu-$cpu.c") ; FIXME: wip (bfd's cpu-$cpu.c) +; ((-R) (file-write *arg* cgen-reloc.c)) +; ((-S) (file-write *arg* cgen-bfdcpu.c)) + +; Kept global so it's available to the other .scm files. +(define srcdir ".") + +; Scan argv for -s srcdir. +; We can't process any other args until we find the cgen source dir. +; The result is srcdir. +; We assume "-s" isn't the argument to another option. Unwise, yes. +; Alternatives are to require it to be the first argument or at least preceed +; any option with a "-s" argument, or to put knowledge of the common argument +; set and common argument parsing code in every top level file. + +(define (find-srcdir argv) + (let loop ((argv argv)) + (if (null? argv) + (error "`-s srcdir' not present, can't load cgen")) + (if (string=? "-s" (car argv)) + (begin + (if (null? (cdr argv)) + (error "missing srcdir arg to `-s'")) + (cadr argv)) + (loop (cdr argv)))) +) + +; Main routine, parses options and calls generators. + +(define (cgen-opc argv) + (let () + + ; Find and set srcdir, then load all Scheme code. + ; Drop the first argument, it is the script name (i.e. argv[0]). + (set! srcdir (find-srcdir (cdr argv))) + (set! %load-path (cons srcdir %load-path)) + (load-files srcdir) + + (display-argv argv) + + (cgen #:argv argv + #:app-name "opcodes" + #:arg-spec opc-arguments + #:init opcodes-init! + #:finish opcodes-finish! + #:analyze opcodes-analyze!) + ) +) + +(cgen-opc (program-arguments)) diff --git a/cgen/cgen-sim.scm b/cgen/cgen-sim.scm new file mode 100644 index 00000000000..766153ae1be --- /dev/null +++ b/cgen/cgen-sim.scm @@ -0,0 +1,112 @@ +; Simulator generator entry point. +; This is invoked to build: arch.h, cpu-<cpu>.h, memops.h, semops.h, decode.h, +; decode.c, extract.c, semantics.c, ops.c, model.c, mainloop.in. +; +; memops.h, semops.h, ops.c, mainloop.in are either deprecated or wip. +; +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; +; This is a standalone script, we don't load anything until we parse the +; -s argument (keeps reliance off of environment variables, etc.). + +; Load the various support routines. + +(define (load-files srcdir) + ; Fix up Scheme to be what we use (guile is always in flux). + (primitive-load-path (string-append srcdir "/fixup.scm")) + + (load (string-append srcdir "/read.scm")) + (load (string-append srcdir "/utils-sim.scm")) + (load (string-append srcdir "/sim.scm")) + (load (string-append srcdir "/sim-arch.scm")) + (load (string-append srcdir "/sim-cpu.scm")) + (load (string-append srcdir "/sim-model.scm")) + (load (string-append srcdir "/sim-decode.scm")) +) + +(define sim-arguments + (list + (list '-A "file" "generate arch.h in <file>" + (lambda (arg) (file-write arg cgen-arch.h))) + (list '-B "file" "generate arch.c in <file>" + (lambda (arg) (file-write arg cgen-arch.c))) + (list '-C "file" "generate cpu-<cpu>.h in <file>" + (lambda (arg) (file-write arg cgen-cpu.h))) + (list '-U "file" "generate cpu-<cpu>.c in <file>" + (lambda (arg) (file-write arg cgen-cpu.c))) + (list '-N "file" "generate cpu-all.h in <file>" + (lambda (arg) (file-write arg cgen-cpuall.h))) + (list '-F "file" "generate memops.h in <file>" + (lambda (arg) (file-write arg cgen-mem-ops.h))) + (list '-P "file" "generate semops.h in <file>" + (lambda (arg) (file-write arg cgen-sem-ops.h))) + (list '-T "file" "generate decode.h in <file>" + (lambda (arg) (file-write arg cgen-decode.h))) + (list '-D "file" "generate decode.c in <file>" + (lambda (arg) (file-write arg cgen-decode.c))) + (list '-E "file" "generate extract.c in <file>" + (lambda (arg) (file-write arg cgen-extract.c))) + (list '-R "file" "generate read.c in <file>" + (lambda (arg) (file-write arg cgen-read.c))) + (list '-W "file" "generate write.c in <file>" + (lambda (arg) (file-write arg cgen-write.c))) + (list '-S "file" "generate semantics.c in <file>" + (lambda (arg) (file-write arg cgen-semantics.c))) + (list '-X "file" "generate sem-switch.c in <file>" + (lambda (arg) (file-write arg cgen-sem-switch.c))) + (list '-O "file" "generate ops.c in <file>" + (lambda (arg) (file-write arg cgen-ops.c))) + (list '-M "file" "generate model.c in <file>" + (lambda (arg) (file-write arg cgen-model.c))) + (list '-L "file" "generate mainloop.in in <file>" + (lambda (arg) (file-write arg cgen-mainloop.in))) + ) +) + +; Kept global so it's available to the other .scm files. +(define srcdir ".") + +; Scan argv for -s srcdir. +; We can't process any other args until we find the cgen source dir. +; The result is srcdir. +; We assume "-s" isn't the argument to another option. Unwise, yes. +; Alternatives are to require it to be the first argument or at least preceed +; any option with a "-s" argument, or to put knowledge of the common argument +; set and common argument parsing code in every top level file. + +(define (find-srcdir argv) + (let loop ((argv argv)) + (if (null? argv) + (error "`-s srcdir' not present, can't load cgen")) + (if (string=? "-s" (car argv)) + (begin + (if (null? (cdr argv)) + (error "missing srcdir arg to `-s'")) + (cadr argv)) + (loop (cdr argv)))) +) + +; Main routine, parses options and calls generators. + +(define (cgen-sim argv) + (let () + + ; Find and set srcdir, then load all Scheme code. + ; Drop the first argument, it is the script name (i.e. argv[0]). + (set! srcdir (find-srcdir (cdr argv))) + (set! %load-path (cons srcdir %load-path)) + (load-files srcdir) + + (display-argv argv) + + (cgen #:argv argv + #:app-name "sim" + #:arg-spec sim-arguments + #:init sim-init! + #:finish sim-finish! + #:analyze sim-analyze!) + ) +) + +(cgen-sim (program-arguments)) diff --git a/cgen/cgen-stest.scm b/cgen/cgen-stest.scm new file mode 100644 index 00000000000..ed1edec72fd --- /dev/null +++ b/cgen/cgen-stest.scm @@ -0,0 +1,79 @@ +; CPU description file generator for the simulator testsuite. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; This is invoked to build several .s files and a script to run to +; generate the .d files and .exp file. +; This is invoked to build: tmp-build.sh cpu-cpu.exp + +; Load the various support routines +(define (load-files srcdir) + ; Fix up Scheme to be what we use (guile is always in flux). + (primitive-load-path (string-append srcdir "/fixup.scm")) + + (load (string-append srcdir "/read.scm")) + (load (string-append srcdir "/desc.scm")) + (load (string-append srcdir "/desc-cpu.scm")) + (load (string-append srcdir "/opcodes.scm")) + (load (string-append srcdir "/opc-asmdis.scm")) + (load (string-append srcdir "/opc-ibld.scm")) + (load (string-append srcdir "/opc-itab.scm")) + (load (string-append srcdir "/opc-opinst.scm")) + (load (string-append srcdir "/sim-test.scm")) +) + +(define stest-arguments + (list + (list '-B "file" "generate build.sh" + (lambda (arg) (file-write arg cgen-build.sh))) + (list '-E "file" "generate the testsuite .exp" + (lambda (arg) (file-write arg cgen-allinsn.exp))) + ) +) + +; Kept global so it's available to the other .scm files. +(define srcdir ".") + +; Scan argv for -s srcdir. +; We can't process any other args until we find the cgen source dir. +; The result is srcdir. +; We assume "-s" isn't the argument to another option. Unwise, yes. +; Alternatives are to require it to be the first argument or at least preceed +; any option with a "-s" argument, or to put knowledge of the common argument +; set and common argument parsing code in every top level file. + +(define (find-srcdir argv) + (let loop ((argv argv)) + (if (null? argv) + (error "`-s srcdir' not present, can't load cgen")) + (if (string=? "-s" (car argv)) + (begin + (if (null? (cdr argv)) + (error "missing srcdir arg to `-s'")) + (cadr argv)) + (loop (cdr argv)))) +) + +; Main routine, parses options and calls generators. + +(define (cgen-stest argv) + (let () + + ; Find and set srcdir, then load all Scheme code. + ; Drop the first argument, it is the script name (i.e. argv[0]). + (set! srcdir (find-srcdir (cdr argv))) + (set! %load-path (cons srcdir %load-path)) + (load-files srcdir) + + (display-argv argv) + + (cgen #:argv argv + #:app-name "sim-test" + #:arg-spec stest-arguments + #:init sim-test-init! + #:finish sim-test-finish! + #:analyze sim-test-analyze!) + ) +) + +(cgen-stest (program-arguments)) diff --git a/cgen/configure b/cgen/configure new file mode 100755 index 00000000000..0e48be6b04b --- /dev/null +++ b/cgen/configure @@ -0,0 +1,1374 @@ +#! /bin/sh + +# Guess values for system-dependent variables and create Makefiles. +# Generated automatically using autoconf version 2.13 +# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc. +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. + +# Defaults: +ac_help= +ac_default_prefix=/usr/local +# Any additions from configure.in: +ac_help="$ac_help + --enable-maintainer-mode enable make rules and dependencies not useful + (and sometimes confusing) to the casual installer" + +# Initialize some variables set by options. +# The variables have the same names as the options, with +# dashes changed to underlines. +build=NONE +cache_file=./config.cache +exec_prefix=NONE +host=NONE +no_create= +nonopt=NONE +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +sitefile= +srcdir= +target=NONE +verbose= +x_includes=NONE +x_libraries=NONE +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datadir='${prefix}/share' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +libdir='${exec_prefix}/lib' +includedir='${prefix}/include' +oldincludedir='/usr/include' +infodir='${prefix}/info' +mandir='${prefix}/man' + +# Initialize some other variables. +subdirs= +MFLAGS= MAKEFLAGS= +SHELL=${CONFIG_SHELL-/bin/sh} +# Maximum number of lines to put in a shell here document. +ac_max_here_lines=12 + +ac_prev= +for ac_option +do + + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval "$ac_prev=\$ac_option" + ac_prev= + continue + fi + + case "$ac_option" in + -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;; + *) ac_optarg= ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case "$ac_option" in + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir="$ac_optarg" ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build="$ac_optarg" ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file="$ac_optarg" ;; + + -datadir | --datadir | --datadi | --datad | --data | --dat | --da) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ + | --da=*) + datadir="$ac_optarg" ;; + + -disable-* | --disable-*) + ac_feature=`echo $ac_option|sed -e 's/-*disable-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + eval "enable_${ac_feature}=no" ;; + + -enable-* | --enable-*) + ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; } + fi + ac_feature=`echo $ac_feature| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "enable_${ac_feature}='$ac_optarg'" ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix="$ac_optarg" ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he) + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat << EOF +Usage: configure [options] [host] +Options: [defaults in brackets after descriptions] +Configuration: + --cache-file=FILE cache test results in FILE + --help print this message + --no-create do not create output files + --quiet, --silent do not print \`checking...' messages + --site-file=FILE use FILE as the site file + --version print the version of autoconf that created configure +Directory and file names: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [same as prefix] + --bindir=DIR user executables in DIR [EPREFIX/bin] + --sbindir=DIR system admin executables in DIR [EPREFIX/sbin] + --libexecdir=DIR program executables in DIR [EPREFIX/libexec] + --datadir=DIR read-only architecture-independent data in DIR + [PREFIX/share] + --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data in DIR + [PREFIX/com] + --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var] + --libdir=DIR object code libraries in DIR [EPREFIX/lib] + --includedir=DIR C header files in DIR [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include] + --infodir=DIR info documentation in DIR [PREFIX/info] + --mandir=DIR man documentation in DIR [PREFIX/man] + --srcdir=DIR find the sources in DIR [configure dir or ..] + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM + run sed PROGRAM on installed program names +EOF + cat << EOF +Host type: + --build=BUILD configure for building on BUILD [BUILD=HOST] + --host=HOST configure for HOST [guessed] + --target=TARGET configure for TARGET [TARGET=HOST] +Features and packages: + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR +EOF + if test -n "$ac_help"; then + echo "--enable and --with options recognized:$ac_help" + fi + exit 0 ;; + + -host | --host | --hos | --ho) + ac_prev=host ;; + -host=* | --host=* | --hos=* | --ho=*) + host="$ac_optarg" ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir="$ac_optarg" ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir="$ac_optarg" ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir="$ac_optarg" ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir="$ac_optarg" ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst \ + | --locals | --local | --loca | --loc | --lo) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* \ + | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) + localstatedir="$ac_optarg" ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir="$ac_optarg" ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir="$ac_optarg" ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix="$ac_optarg" ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix="$ac_optarg" ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix="$ac_optarg" ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name="$ac_optarg" ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir="$ac_optarg" ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir="$ac_optarg" ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site="$ac_optarg" ;; + + -site-file | --site-file | --site-fil | --site-fi | --site-f) + ac_prev=sitefile ;; + -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*) + sitefile="$ac_optarg" ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir="$ac_optarg" ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir="$ac_optarg" ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target="$ac_optarg" ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers) + echo "configure generated by autoconf version 2.13" + exit 0 ;; + + -with-* | --with-*) + ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + case "$ac_option" in + *=*) ;; + *) ac_optarg=yes ;; + esac + eval "with_${ac_package}='$ac_optarg'" ;; + + -without-* | --without-*) + ac_package=`echo $ac_option|sed -e 's/-*without-//'` + # Reject names that are not valid shell variable names. + if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then + { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; } + fi + ac_package=`echo $ac_package| sed 's/-/_/g'` + eval "with_${ac_package}=no" ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes="$ac_optarg" ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries="$ac_optarg" ;; + + -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; } + ;; + + *) + if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then + echo "configure: warning: $ac_option: invalid host type" 1>&2 + fi + if test "x$nonopt" != xNONE; then + { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } + fi + nonopt="$ac_option" + ;; + + esac +done + +if test -n "$ac_prev"; then + { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; } +fi + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +# File descriptor usage: +# 0 standard input +# 1 file creation +# 2 errors and warnings +# 3 some systems may open it to /dev/tty +# 4 used on the Kubota Titan +# 6 checking for... messages and results +# 5 compiler messages saved in config.log +if test "$silent" = yes; then + exec 6>/dev/null +else + exec 6>&1 +fi +exec 5>./config.log + +echo "\ +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. +" 1>&5 + +# Strip out --no-create and --no-recursion so they do not pile up. +# Also quote any args containing shell metacharacters. +ac_configure_args= +for ac_arg +do + case "$ac_arg" in + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c) ;; + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;; + *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*) + ac_configure_args="$ac_configure_args '$ac_arg'" ;; + *) ac_configure_args="$ac_configure_args $ac_arg" ;; + esac +done + +# NLS nuisances. +# Only set these to C if already set. These must not be set unconditionally +# because not all systems understand e.g. LANG=C (notably SCO). +# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'! +# Non-C LC_CTYPE values break the ctype check. +if test "${LANG+set}" = set; then LANG=C; export LANG; fi +if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi +if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi +if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -rf conftest* confdefs.h +# AIX cpp loses on an empty file, so make sure it contains at least a newline. +echo > confdefs.h + +# A filename unique to this package, relative to the directory that +# configure is in, which we can look for to find out if srcdir is correct. +ac_unique_file=read.scm + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then its parent. + ac_prog=$0 + ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'` + test "x$ac_confdir" = "x$ac_prog" && ac_confdir=. + srcdir=$ac_confdir + if test ! -r $srcdir/$ac_unique_file; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r $srcdir/$ac_unique_file; then + if test "$ac_srcdir_defaulted" = yes; then + { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; } + else + { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; } + fi +fi +srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'` + +# Prefer explicitly selected file to automatically selected ones. +if test -z "$sitefile"; then + if test -z "$CONFIG_SITE"; then + if test "x$prefix" != xNONE; then + CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" + else + CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" + fi + fi +else + CONFIG_SITE="$sitefile" +fi +for ac_site_file in $CONFIG_SITE; do + if test -r "$ac_site_file"; then + echo "loading site script $ac_site_file" + . "$ac_site_file" + fi +done + +if test -r "$cache_file"; then + echo "loading cache $cache_file" + . $cache_file +else + echo "creating cache $cache_file" + > $cache_file +fi + +ac_ext=c +# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options. +ac_cpp='$CPP $CPPFLAGS' +ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5' +ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5' +cross_compiling=$ac_cv_prog_cc_cross + +ac_exeext= +ac_objext=o +if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then + # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu. + if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then + ac_n= ac_c=' +' ac_t=' ' + else + ac_n=-n ac_c= ac_t= + fi +else + ac_n= ac_c='\c' ac_t= +fi + + +ac_aux_dir= +for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do + if test -f $ac_dir/install-sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f $ac_dir/install.sh; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + fi +done +if test -z "$ac_aux_dir"; then + { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; } +fi +ac_config_guess=$ac_aux_dir/config.guess +ac_config_sub=$ac_aux_dir/config.sub +ac_configure=$ac_aux_dir/configure # This should be Cygnus configure. + + +# Do some error checking and defaulting for the host and target type. +# The inputs are: +# configure --host=HOST --target=TARGET --build=BUILD NONOPT +# +# The rules are: +# 1. You are not allowed to specify --host, --target, and nonopt at the +# same time. +# 2. Host defaults to nonopt. +# 3. If nonopt is not specified, then host defaults to the current host, +# as determined by config.guess. +# 4. Target and build default to nonopt. +# 5. If nonopt is not specified, then target and build default to host. + +# The aliases save the names the user supplied, while $host etc. +# will get canonicalized. +case $host---$target---$nonopt in +NONE---*---* | *---NONE---* | *---*---NONE) ;; +*) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;; +esac + + +# Make sure we can run config.sub. +if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then : +else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; } +fi + +echo $ac_n "checking host system type""... $ac_c" 1>&6 +echo "configure:586: checking host system type" >&5 + +host_alias=$host +case "$host_alias" in +NONE) + case $nonopt in + NONE) + if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then : + else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; } + fi ;; + *) host_alias=$nonopt ;; + esac ;; +esac + +host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias` +host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` +host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` +host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` +echo "$ac_t""$host" 1>&6 + +echo $ac_n "checking target system type""... $ac_c" 1>&6 +echo "configure:607: checking target system type" >&5 + +target_alias=$target +case "$target_alias" in +NONE) + case $nonopt in + NONE) target_alias=$host_alias ;; + *) target_alias=$nonopt ;; + esac ;; +esac + +target=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $target_alias` +target_cpu=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` +target_vendor=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` +target_os=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` +echo "$ac_t""$target" 1>&6 + +echo $ac_n "checking build system type""... $ac_c" 1>&6 +echo "configure:625: checking build system type" >&5 + +build_alias=$build +case "$build_alias" in +NONE) + case $nonopt in + NONE) build_alias=$host_alias ;; + *) build_alias=$nonopt ;; + esac ;; +esac + +build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias` +build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'` +build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'` +build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'` +echo "$ac_t""$build" 1>&6 + +test "$host_alias" != "$target_alias" && + test "$program_prefix$program_suffix$program_transform_name" = \ + NONENONEs,x,x, && + program_prefix=${target_alias}- + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# ./install, which can be erroneously created by make from ./install.sh. +echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 +echo "configure:659: checking for a BSD compatible install" >&5 +if test -z "$INSTALL"; then +if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" + for ac_dir in $PATH; do + # Account for people who put trailing slashes in PATH elements. + case "$ac_dir/" in + /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + if test -f $ac_dir/$ac_prog; then + if test $ac_prog = install && + grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + else + ac_cv_path_install="$ac_dir/$ac_prog -c" + break 2 + fi + fi + done + ;; + esac + done + IFS="$ac_save_IFS" + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL="$ac_cv_path_install" + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL="$ac_install_sh" + fi +fi +echo "$ac_t""$INSTALL" 1>&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +echo $ac_n "checking whether build environment is sane""... $ac_c" 1>&6 +echo "configure:712: checking whether build environment is sane" >&5 +# Just in case +sleep 1 +echo timestamp > conftestfile +# Do `set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t $srcdir/configure conftestfile` + fi + if test "$*" != "X $srcdir/configure conftestfile" \ + && test "$*" != "X conftestfile $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + { echo "configure: error: ls -t appears to fail. Make sure there is not a broken +alias in your environment" 1>&2; exit 1; } + fi + + test "$2" = conftestfile + ) +then + # Ok. + : +else + { echo "configure: error: newly created file is older than distributed files! +Check your system clock" 1>&2; exit 1; } +fi +rm -f conftest* +echo "$ac_t""yes" 1>&6 +if test "$program_transform_name" = s,x,x,; then + program_transform_name= +else + # Double any \ or $. echo might interpret backslashes. + cat <<\EOF_SED > conftestsed +s,\\,\\\\,g; s,\$,$$,g +EOF_SED + program_transform_name="`echo $program_transform_name|sed -f conftestsed`" + rm -f conftestsed +fi +test "$program_prefix" != NONE && + program_transform_name="s,^,${program_prefix},; $program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s,\$\$,${program_suffix},; $program_transform_name" + +# sed with no file args requires a program. +test "$program_transform_name" = "" && program_transform_name="s,x,x," + +echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 +echo "configure:769: checking whether ${MAKE-make} sets \${MAKE}" >&5 +set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` +if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftestmake <<\EOF +all: + @echo 'ac_maketemp="${MAKE}"' +EOF +# GNU make sometimes prints "make[1]: Entering...", which would confuse us. +eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=` +if test -n "$ac_maketemp"; then + eval ac_cv_prog_make_${ac_make}_set=yes +else + eval ac_cv_prog_make_${ac_make}_set=no +fi +rm -f conftestmake +fi +if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then + echo "$ac_t""yes" 1>&6 + SET_MAKE= +else + echo "$ac_t""no" 1>&6 + SET_MAKE="MAKE=${MAKE-make}" +fi + + +PACKAGE=cgen + +VERSION=1.0 + +if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then + { echo "configure: error: source directory already configured; run "make distclean" there first" 1>&2; exit 1; } +fi +cat >> confdefs.h <<EOF +#define PACKAGE "$PACKAGE" +EOF + +cat >> confdefs.h <<EOF +#define VERSION "$VERSION" +EOF + + + +missing_dir=`cd $ac_aux_dir && pwd` +echo $ac_n "checking for working aclocal""... $ac_c" 1>&6 +echo "configure:815: checking for working aclocal" >&5 +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if (aclocal --version) < /dev/null > /dev/null 2>&1; then + ACLOCAL=aclocal + echo "$ac_t""found" 1>&6 +else + ACLOCAL="$missing_dir/missing aclocal" + echo "$ac_t""missing" 1>&6 +fi + +echo $ac_n "checking for working autoconf""... $ac_c" 1>&6 +echo "configure:828: checking for working autoconf" >&5 +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if (autoconf --version) < /dev/null > /dev/null 2>&1; then + AUTOCONF=autoconf + echo "$ac_t""found" 1>&6 +else + AUTOCONF="$missing_dir/missing autoconf" + echo "$ac_t""missing" 1>&6 +fi + +echo $ac_n "checking for working automake""... $ac_c" 1>&6 +echo "configure:841: checking for working automake" >&5 +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if (automake --version) < /dev/null > /dev/null 2>&1; then + AUTOMAKE=automake + echo "$ac_t""found" 1>&6 +else + AUTOMAKE="$missing_dir/missing automake" + echo "$ac_t""missing" 1>&6 +fi + +echo $ac_n "checking for working autoheader""... $ac_c" 1>&6 +echo "configure:854: checking for working autoheader" >&5 +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if (autoheader --version) < /dev/null > /dev/null 2>&1; then + AUTOHEADER=autoheader + echo "$ac_t""found" 1>&6 +else + AUTOHEADER="$missing_dir/missing autoheader" + echo "$ac_t""missing" 1>&6 +fi + +echo $ac_n "checking for working makeinfo""... $ac_c" 1>&6 +echo "configure:867: checking for working makeinfo" >&5 +# Run test in a subshell; some versions of sh will print an error if +# an executable is not found, even if stderr is redirected. +# Redirect stdin to placate older versions of autoconf. Sigh. +if (makeinfo --version) < /dev/null > /dev/null 2>&1; then + MAKEINFO=makeinfo + echo "$ac_t""found" 1>&6 +else + MAKEINFO="$missing_dir/missing makeinfo" + echo "$ac_t""missing" 1>&6 +fi + + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# ./install, which can be erroneously created by make from ./install.sh. +echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 +echo "configure:893: checking for a BSD compatible install" >&5 +if test -z "$INSTALL"; then +if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":" + for ac_dir in $PATH; do + # Account for people who put trailing slashes in PATH elements. + case "$ac_dir/" in + /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + if test -f $ac_dir/$ac_prog; then + if test $ac_prog = install && + grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + else + ac_cv_path_install="$ac_dir/$ac_prog -c" + break 2 + fi + fi + done + ;; + esac + done + IFS="$ac_save_IFS" + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL="$ac_cv_path_install" + else + # As a last resort, use the slow shell script. We don't cache a + # path for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the path is relative. + INSTALL="$ac_install_sh" + fi +fi +echo "$ac_t""$INSTALL" 1>&6 + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6 +echo "configure:946: checking for Cygwin environment" >&5 +if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 951 "configure" +#include "confdefs.h" + +int main() { + +#ifndef __CYGWIN__ +#define __CYGWIN__ __CYGWIN32__ +#endif +return __CYGWIN__; +; return 0; } +EOF +if { (eval echo configure:962: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_cygwin=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_cygwin=no +fi +rm -f conftest* +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_cygwin" 1>&6 +CYGWIN= +test "$ac_cv_cygwin" = yes && CYGWIN=yes +echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6 +echo "configure:979: checking for mingw32 environment" >&5 +if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + cat > conftest.$ac_ext <<EOF +#line 984 "configure" +#include "confdefs.h" + +int main() { +return __MINGW32__; +; return 0; } +EOF +if { (eval echo configure:991: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then + rm -rf conftest* + ac_cv_mingw32=yes +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + ac_cv_mingw32=no +fi +rm -f conftest* +rm -f conftest* +fi + +echo "$ac_t""$ac_cv_mingw32" 1>&6 +MINGW32= +test "$ac_cv_mingw32" = yes && MINGW32=yes + + +echo $ac_n "checking for executable suffix""... $ac_c" 1>&6 +echo "configure:1010: checking for executable suffix" >&5 +if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then + echo $ac_n "(cached) $ac_c" 1>&6 +else + if test "$CYGWIN" = yes || test "$MINGW32" = yes; then + ac_cv_exeext=.exe +else + rm -f conftest* + echo 'int main () { return 0; }' > conftest.$ac_ext + ac_cv_exeext= + if { (eval echo configure:1020: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then + for file in conftest.*; do + case $file in + *.c | *.o | *.obj | *.ilk | *.pdb) ;; + *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;; + esac + done + else + { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; } + fi + rm -f conftest* + test x"${ac_cv_exeext}" = x && ac_cv_exeext=no +fi +fi + +EXEEXT="" +test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext} +echo "$ac_t""${ac_cv_exeext}" 1>&6 +ac_exeext=$EXEEXT + + +# Set target cpu. +arch=${target_cpu} + + +echo $ac_n "checking whether to enable maintainer-specific portions of Makefiles""... $ac_c" 1>&6 +echo "configure:1046: checking whether to enable maintainer-specific portions of Makefiles" >&5 + # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given. +if test "${enable_maintainer_mode+set}" = set; then + enableval="$enable_maintainer_mode" + USE_MAINTAINER_MODE=$enableval +else + USE_MAINTAINER_MODE=no +fi + + echo "$ac_t""$USE_MAINTAINER_MODE" 1>&6 + + +if test $USE_MAINTAINER_MODE = yes; then + MAINTAINER_MODE_TRUE= + MAINTAINER_MODE_FALSE='#' +else + MAINTAINER_MODE_TRUE='#' + MAINTAINER_MODE_FALSE= +fi + MAINT=$MAINTAINER_MODE_TRUE + + +if test "$program_transform_name" = s,x,x,; then + program_transform_name= +else + # Double any \ or $. echo might interpret backslashes. + cat <<\EOF_SED > conftestsed +s,\\,\\\\,g; s,\$,$$,g +EOF_SED + program_transform_name="`echo $program_transform_name|sed -f conftestsed`" + rm -f conftestsed +fi +test "$program_prefix" != NONE && + program_transform_name="s,^,${program_prefix},; $program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s,\$\$,${program_suffix},; $program_transform_name" + +# sed with no file args requires a program. +test "$program_transform_name" = "" && program_transform_name="s,x,x," + + +trap '' 1 2 15 +cat > confcache <<\EOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs. It is not useful on other systems. +# If it contains results you don't want to keep, you may remove or edit it. +# +# By default, configure uses ./config.cache as the cache file, +# creating it if it does not exist already. You can give configure +# the --cache-file=FILE option to use a different cache file; that is +# what configure does when it calls configure scripts in +# subdirectories, so they share the cache. +# Giving --cache-file=/dev/null disables caching, for debugging configure. +# config.status only pays attention to the cache file if you give it the +# --recheck option to rerun configure. +# +EOF +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, don't put newlines in cache variables' values. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +(set) 2>&1 | + case `(ac_space=' '; set | grep ac_space) 2>&1` in + *ac_space=\ *) + # `set' does not quote correctly, so add quotes (double-quote substitution + # turns \\\\ into \\, and sed turns \\ into \). + sed -n \ + -e "s/'/'\\\\''/g" \ + -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p" + ;; + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p' + ;; + esac >> confcache +if cmp -s $cache_file confcache; then + : +else + if test -w $cache_file; then + echo "updating cache $cache_file" + cat confcache > $cache_file + else + echo "not updating unwritable cache $cache_file" + fi +fi +rm -f confcache + +trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15 + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Any assignment to VPATH causes Sun make to only execute +# the first set of double-colon rules, so remove it if not needed. +# If there is a colon in the path, we need to keep it. +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d' +fi + +trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15 + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +cat > conftest.defs <<\EOF +s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g +s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g +s%\[%\\&%g +s%\]%\\&%g +s%\$%$$%g +EOF +DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '` +rm -f conftest.defs + + +# Without the "./", some shells look in PATH for config.status. +: ${CONFIG_STATUS=./config.status} + +echo creating $CONFIG_STATUS +rm -f $CONFIG_STATUS +cat > $CONFIG_STATUS <<EOF +#! /bin/sh +# Generated automatically by configure. +# Run this file to recreate the current configuration. +# This directory was configured as follows, +# on host `(hostname || uname -n) 2>/dev/null | sed 1q`: +# +# $0 $ac_configure_args +# +# Compiler output produced by configure, useful for debugging +# configure, is in ./config.log if it exists. + +ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]" +for ac_option +do + case "\$ac_option" in + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion" + exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;; + -version | --version | --versio | --versi | --vers | --ver | --ve | --v) + echo "$CONFIG_STATUS generated by autoconf version 2.13" + exit 0 ;; + -help | --help | --hel | --he | --h) + echo "\$ac_cs_usage"; exit 0 ;; + *) echo "\$ac_cs_usage"; exit 1 ;; + esac +done + +ac_given_srcdir=$srcdir +ac_given_INSTALL="$INSTALL" + +trap 'rm -fr `echo "Makefile doc/Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15 +EOF +cat >> $CONFIG_STATUS <<EOF + +# Protect against being on the right side of a sed subst in config.status. +sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g; + s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF +$ac_vpsub +$extrasub +s%@SHELL@%$SHELL%g +s%@CFLAGS@%$CFLAGS%g +s%@CPPFLAGS@%$CPPFLAGS%g +s%@CXXFLAGS@%$CXXFLAGS%g +s%@FFLAGS@%$FFLAGS%g +s%@DEFS@%$DEFS%g +s%@LDFLAGS@%$LDFLAGS%g +s%@LIBS@%$LIBS%g +s%@exec_prefix@%$exec_prefix%g +s%@prefix@%$prefix%g +s%@program_transform_name@%$program_transform_name%g +s%@bindir@%$bindir%g +s%@sbindir@%$sbindir%g +s%@libexecdir@%$libexecdir%g +s%@datadir@%$datadir%g +s%@sysconfdir@%$sysconfdir%g +s%@sharedstatedir@%$sharedstatedir%g +s%@localstatedir@%$localstatedir%g +s%@libdir@%$libdir%g +s%@includedir@%$includedir%g +s%@oldincludedir@%$oldincludedir%g +s%@infodir@%$infodir%g +s%@mandir@%$mandir%g +s%@host@%$host%g +s%@host_alias@%$host_alias%g +s%@host_cpu@%$host_cpu%g +s%@host_vendor@%$host_vendor%g +s%@host_os@%$host_os%g +s%@target@%$target%g +s%@target_alias@%$target_alias%g +s%@target_cpu@%$target_cpu%g +s%@target_vendor@%$target_vendor%g +s%@target_os@%$target_os%g +s%@build@%$build%g +s%@build_alias@%$build_alias%g +s%@build_cpu@%$build_cpu%g +s%@build_vendor@%$build_vendor%g +s%@build_os@%$build_os%g +s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g +s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g +s%@INSTALL_DATA@%$INSTALL_DATA%g +s%@PACKAGE@%$PACKAGE%g +s%@VERSION@%$VERSION%g +s%@ACLOCAL@%$ACLOCAL%g +s%@AUTOCONF@%$AUTOCONF%g +s%@AUTOMAKE@%$AUTOMAKE%g +s%@AUTOHEADER@%$AUTOHEADER%g +s%@MAKEINFO@%$MAKEINFO%g +s%@SET_MAKE@%$SET_MAKE%g +s%@EXEEXT@%$EXEEXT%g +s%@arch@%$arch%g +s%@MAINTAINER_MODE_TRUE@%$MAINTAINER_MODE_TRUE%g +s%@MAINTAINER_MODE_FALSE@%$MAINTAINER_MODE_FALSE%g +s%@MAINT@%$MAINT%g + +CEOF +EOF + +cat >> $CONFIG_STATUS <<\EOF + +# Split the substitutions into bite-sized pieces for seds with +# small command number limits, like on Digital OSF/1 and HP-UX. +ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script. +ac_file=1 # Number of current file. +ac_beg=1 # First line for current file. +ac_end=$ac_max_sed_cmds # Line after last line for current file. +ac_more_lines=: +ac_sed_cmds="" +while $ac_more_lines; do + if test $ac_beg -gt 1; then + sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file + else + sed "${ac_end}q" conftest.subs > conftest.s$ac_file + fi + if test ! -s conftest.s$ac_file; then + ac_more_lines=false + rm -f conftest.s$ac_file + else + if test -z "$ac_sed_cmds"; then + ac_sed_cmds="sed -f conftest.s$ac_file" + else + ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file" + fi + ac_file=`expr $ac_file + 1` + ac_beg=$ac_end + ac_end=`expr $ac_end + $ac_max_sed_cmds` + fi +done +if test -z "$ac_sed_cmds"; then + ac_sed_cmds=cat +fi +EOF + +cat >> $CONFIG_STATUS <<EOF + +CONFIG_FILES=\${CONFIG_FILES-"Makefile doc/Makefile"} +EOF +cat >> $CONFIG_STATUS <<\EOF +for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then + # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". + case "$ac_file" in + *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'` + ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;; + *) ac_file_in="${ac_file}.in" ;; + esac + + # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories. + + # Remove last slash and all that follows it. Not all systems have dirname. + ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'` + if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then + # The file is in a subdirectory. + test ! -d "$ac_dir" && mkdir "$ac_dir" + ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`" + # A "../" for each directory in $ac_dir_suffix. + ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'` + else + ac_dir_suffix= ac_dots= + fi + + case "$ac_given_srcdir" in + .) srcdir=. + if test -z "$ac_dots"; then top_srcdir=. + else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;; + /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;; + *) # Relative path. + srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix" + top_srcdir="$ac_dots$ac_given_srcdir" ;; + esac + + case "$ac_given_INSTALL" in + [/$]*) INSTALL="$ac_given_INSTALL" ;; + *) INSTALL="$ac_dots$ac_given_INSTALL" ;; + esac + + echo creating "$ac_file" + rm -f "$ac_file" + configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure." + case "$ac_file" in + *Makefile*) ac_comsub="1i\\ +# $configure_input" ;; + *) ac_comsub= ;; + esac + + ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"` + sed -e "$ac_comsub +s%@configure_input@%$configure_input%g +s%@srcdir@%$srcdir%g +s%@top_srcdir@%$top_srcdir%g +s%@INSTALL@%$INSTALL%g +" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file +fi; done +rm -f conftest.s* + +EOF +cat >> $CONFIG_STATUS <<EOF + +EOF +cat >> $CONFIG_STATUS <<\EOF + +exit 0 +EOF +chmod +x $CONFIG_STATUS +rm -fr confdefs* $ac_clean_files +test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1 + diff --git a/cgen/configure.in b/cgen/configure.in new file mode 100644 index 00000000000..c229bd80d19 --- /dev/null +++ b/cgen/configure.in @@ -0,0 +1,18 @@ +dnl Process this file with autoconf to produce a configure script. + +AC_PREREQ(2.13) +AC_INIT(read.scm) +AC_CANONICAL_SYSTEM +AM_INIT_AUTOMAKE(cgen, 1.0) + +AC_PROG_INSTALL +AC_EXEEXT + +# Set target cpu. +arch=${target_cpu} +AC_SUBST(arch) + +AM_MAINTAINER_MODE +AC_ARG_PROGRAM + +AC_OUTPUT([Makefile doc/Makefile]) diff --git a/cgen/cos.scm b/cgen/cos.scm new file mode 100644 index 00000000000..7bb2a6e8630 --- /dev/null +++ b/cgen/cos.scm @@ -0,0 +1,1336 @@ +; Cgen's Object System. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; When Guile has an official object implementation that is stable, things will +; be switched over then. Until such time, there's no point in getting hyper +; (although doing so is certainly fun, but only to a point). +; If the Guile team decides there won't be any official object system +; (which isn't unreasonable) then we'll pick the final object system then. +; Until such time, there are better things to do than trying to build a +; better object system. If this is important enough to you, help the Guile +; team finish the module(/object?) system. +; +; Classes look like: +; +; #(class-tag +; class-name +; parent-name-list +; elm-alist +; method-alist +; full-elm-initial-list +; full-method-alist ; ??? not currently used +; class-descriptor) +; +; PARENT-NAME-LIST is a list of the names of parent classes (the inheritance +; tree). +; +; ELM-ALIST is an alist of (symbol private? vector-index . initial-value) +; for this class only. +; Values can be looked up by name, via elm-make-[gs]etter routines, or +; methods can use elm-get/set! for speed. +; Various Lisp (or Lisp-like) OOP systems (e.g. CLOS, Dylan) call these +; "slots". Maybe for consistency "slot" would be a better name. Some might +; confuse that with intentions at directions. Given that something better +; will eventually happen, being deliberately different is useful. +; +; METHOD-ALIST is an alist of (symbol . (virtual? . procedure)) for this +; class only. +; +; FULL-ELM-INITIAL-LIST is the elements of the flattened inheritance tree. +; Initially it is #f meaning it hasn't been computed yet. +; It is computed when the class is first instantiated. During development, +; it can be reset to #f after some module has been reloaded (requires all +; object instantiation happens later of course). +; +; FULL-METHOD-ALIST is an alist of the methods of the flattened inheritance +; tree. Each element is (symbol . (parent-list-entry . method)). +; Initially it is #f meaning it hasn't been computed yet. +; It is computed when the class is first instantiated. During development, +; it can be reset to #f after some module has been reloaded (requires all +; object instantiation happens later of course). +; +; CLASS-DESCRIPTOR is the processed form of parent-name-list. +; There is an entry for the class and one for each parent (recursively): +; (class mi? (base-offset . delta) child-backpointer (parent1-entry) ...). +; mi? is #t if the class or any parent class has multiple inheritance. +; This is used by the element access routines. +; base-offset is the offset in the element vector of the baseclass (or first +; baseclass in the mi case). +; delta is the offset from base-offset of the class's own elements +; (as opposed to elements in any parent class). +; child-backpointer is #f in the top level object. +; ??? child->subclass, parent->superclass? +; Initially the class-descriptor is #f meaning it hasn't been computed yet. +; It is computed when the class is first instantiated. During development, +; it can be reset to #f after some module has been reloaded (requires all +; object instantiation to happen later of course). +; +; An object is a vector of 2 elements: #(object-elements class-descriptor). +; ??? Things would be simpler if objects were a pair but that makes eval'ing +; them trickier. Vectors are nice in that they're self-evaluating, though +; due to the self-referencing, which Guile 1.2 can't handle, apps have to +; be careful. +; ??? We could use smobs/records/whatever but the difference isn't big enough +; for me to care at this point in time. +; +; `object-elements' looks like: +; +; #(object-tag +; class +; element1 +; element2 +; ...) +; +; CLASS is the class the object is an instance of. +; +; User visible procs: +; +; (class-make name parents elements methods) -> class +; +; Create a class. The result is then passed back by procedures requiring +; a class argument. Note however that PARENTS is a list of class names, +; not the class data type. This allows reloading the definition of a +; parent class without having to reload any subclasses. To implement this +; classes are recorded internally, and `object-init!' must be called if any +; class has been redefined. +; +; (class-list) -> list of all defined classes +; +; (class-name class) -> name of CLASS +; +; (class-lookup class-name) -> class +; +; (class-instance? class object) -> #t if OBJECT is an instance of CLASS +; +; (object-class object) -> class of OBJECT +; +; (object-class-name object) -> class name of OBJECT +; +; (send object method-name . args) -> result of invoking METHOD-NAME +; +; (send-next object method-name . args) -> result of invoking next METHOD-NAME +; +; (new class) -> instantiate CLASS +; +; The object is initialized with values specified when CLASS +; (and its parent classes) was defined. +; +; (vmake class . args) -> instantiate class and initialize it with 'vmake! +; +; This is shorthand for (send (new class) 'vmake! args). +; ARGS is a list of option names and arguments (a la CLOS). +; ??? Not implemented yet. +; +; (method-vmake! object . args) -> modify OBJECT from ARGS +; +; This is the standard 'vmake! method, available for use by user-written +; 'vmake! methods. +; ??? Not implemented yet. +; +; (make class . args) -> instantiate CLASS and initialize it with 'make! +; +; This is shorthand for (send (new class) 'make! arg1 ...). +; This is a positional form of `new'. +; +; (method-make-make! class elm1-name elm2-name ...) -> unspecified +; +; Create a 'make! method that sets the specified elements. +; +; (object-copy object) -> copy of OBJ +; +; ??? Whether to discard the parent or keep it and retain specialization +; is undecided. +; +; (object-copy-top object) -> copy of OBJECT with spec'n discarded +; +; (object-parent object parent-path) -> parent object in OBJECT via PARENT-PATH +; +; (class? foo) -> return #t if FOO is a class +; +; (object? foo) -> return #t if FOO is an object +; +; (method-make! class name lambda) -> unspecified +; +; Add method NAME to CLASS. +; +; (method-make-virtual! class name lambda) -> unspecified +; +; Add virtual method NAME to CLASS. +; +; (method-make-forward! class elm-name methods) -> unspecified +; +; Add METHODS to CLASS that pass the "message" onto the object in element +; ELM-NAME. +; +; (method-make-virtual-forward! class elm-name methods) -> unspecified +; +; Add virtual METHODS to CLASS that pass the "message" onto the object in +; element ELM-NAME. +; +; (elm-get object elm-name) -> value of element ELM-NAME in OBJ +; +; Can only be used in methods. +; +; (elm-set! object elm-name new-value) -> unspecified +; +; Set element ELM-NAME in OBJECT to NEW-VALUE. +; Can only be used in methods. +; +; (elm-make-getter class elm-name) -> lambda +; +; Return lambda to get the value of ELM-NAME in CLASS. +; +; (elm-make-setter class elm-name) -> lambda +; +; Return lambda to set the value of ELM-NAME in CLASS. +; +; Conventions used in this file: +; - procs/vars internal to this file are prefixed with "-" +; [Of course this could all be put in a module; later if ever since +; once Guile has its own official object system we'll convert. Note that +; it currently does not.] +; - except for a few exceptions, public procs begin with one of +; class-, object-, elm-, method-. +; The exceptions are make, new, parent, send. + +(define -class-tag "class") +(define -object-tag "object") + +; List of all classes. + +(define -class-list ()) + +; ??? Were written as a procedures for Hobbit's sake (I think). +(define -object-unspecified #:unspecified) +(define -object-unbound #:unbound) + +; Associative list of classes to be traced. + +(define -object-debug-classes #f) + +; Associative list of elements to be traced. + +(define -object-debug-elements #f) + +; Associative list of messages to be traced. + +(define -object-debug-methods #f) + +; True if error messages are verbose and debugging messages are printed. + +(define -object-verbose? #f) + +; Cover fn to set verbosity. + +(define (object-set-verbose! verbose?) + (set! -object-verbose? verbose?) +) + +; Signal error if not class/object. + +(define (-class-check maybe-class proc-name . extra-text) + (if (not (class? maybe-class)) + (apply -object-error + (append! (list proc-name maybe-class "not a class") + extra-text))) + -object-unspecified +) +(define (-object-check-name maybe-name proc-name . extra-text) + (if (not (symbol? maybe-name)) + (apply -object-error + (append! (list proc-name maybe-name) extra-text))) + -object-unspecified +) +(define (-object-check maybe-object proc-name . extra-text) + (if (not (object? maybe-object)) + (apply -object-error + (append! (list proc-name maybe-object "not an object") + extra-text))) + -object-unspecified +) + +; X is any arbitrary Scheme data. +(define (-object-error proc-name x . text) + (error (string-append proc-name ": " (apply string-append text) + (if (object? x) + (string-append + " (class: " (-object-class-name x) + (if (method-present? x 'get-name) + (string-append ", name: " + (send x 'get-name)) + "") + ")") + "") + "") + x) +) + +; Low level class operations. + +; Return boolean indicating if X is a class. + +(define (class? class) + (and (vector? class) (eq? -class-tag (vector-ref class 0))) +) + +; Accessors. + +(define (-class-name class) (vector-ref class 1)) +(define (-class-parents class) (vector-ref class 2)) +(define (-class-elements class) (vector-ref class 3)) +(define (-class-methods class) (vector-ref class 4)) +(define (-class-all-initial-values class) (vector-ref class 5)) +(define (-class-all-methods class) (vector-ref class 6)) +(define (-class-class-desc class) (vector-ref class 7)) + +(define (-class-set-parents! class parents) + (vector-set! class 2 parents) +) + +(define (-class-set-elements! class elm-alist) + (vector-set! class 3 elm-alist) +) + +(define (-class-set-methods! class method-alist) + (vector-set! class 4 method-alist) +) + +(define (-class-set-all-initial-values! class init-list) + (vector-set! class 5 init-list) +) + +(define (-class-set-all-methods! class all-meth-list) + (vector-set! class 6 all-meth-list) +) + +(define (-class-set-class-desc! class parent-list) + (vector-set! class 7 parent-list) +) + +; Make a class. +; The new definition overrides any existing definition. + +(define (-class-make! name parents elements methods) + (let ((class (vector -class-tag name parents elements methods #f #f #f)) + (list-entry (assq name -class-list))) + (if list-entry + (set-cdr! list-entry class) + (set! -class-list (acons name class -class-list))) + class) +) + +; Lookup a class given its name. +; The result is the class or #f if not found. + +(define (class-lookup name) (assq-ref -class-list name)) + +; Return a list of all direct parent classes of CLASS. + +(define (-class-parent-classes class) + ; -class-parents returns the names, we want the actual classes. + (let loop ((parents (-class-parents class)) + (result ())) + (if (null? parents) + (reverse! result) + (let ((parent (class-lookup (car parents)))) + (if (not parent) + ; The proc name we pass here is made up as we don't + ; want it to be the name of an internal proc. + (-object-error "class" (car parents) "not a class")) + (loop (cdr parents) (cons parent result))))) +) + +; Cover proc of -class-name for the outside world to use. +; The result is the name of the class or #f if CLASS is not a class. +; We could issue an error here, but to be consistent with object-class-name +; we don't. + +(define (class-name class) + (if (class? class) + (-class-name class) + #f) +) + +; Return a boolean indicating if CLASS or any parent class has +; multiple inheritance. + +(define (-class-mi? class) + (-class-desc-mi? (-class-class-desc class)) +) + +; Class descriptor utilities. +; A class-descriptor is: +; (class mi? (base-offset . delta) child-backpointer (parent1-entry) ...) + +;(define (-class-desc-make class offset bkptr parents) +; (append (list class offset bkptr) parents) +;) +(define (-class-desc? maybe-class-desc) + (and (pair? maybe-class-desc) + (class? (car maybe-class-desc))) +) +(define -class-desc-class car) +(define -class-desc-mi? cadr) +(define -class-desc-offset caddr) +(define -class-desc-offset-base caaddr) +(define -class-desc-offset-delta cdaddr) +(define -class-desc-child cadddr) +(define -class-desc-parents cddddr) +; Note that this is an assq on the classes themselves, not their names. +; The result is the parent's class-descriptor. +(define -class-desc-lookup-parent assq) + +; Compute the class descriptor of CLASS. +; OFFSET is the beginning offset in the element vector. +; We can assume the parents of CLASS have already been initialized. +; +; A class-descriptor is: +; (class mi? (base-offset . delta) child-backpointer (parent1-entry) ...) +; MI? is a boolean indicating if multiple inheritance is present. +; BASE-OFFSET is the offset into the object vector of the baseclass's elements +; (or first baseclass in the mi case). +; DELTA is the offset from BASE-OFFSET of the class's own elements. +; CHILD is the backlink to the direct child class or #f for the top class. +; ??? Is the use of `top' backwards from traditional usage? + +(define (-class-compute-class-desc class offset child) + + ; OFFSET must be global to the calculation because it is continually + ; incremented as we recurse down through the hierarchy (actually, as we + ; traverse back up). At any point in time it is the offset from the start + ; of the element vector of the next class's elements. + ; Object elements are laid out using a depth first traversal of the + ; inheritance tree. + + (define (compute1 class child base-offset) + + ; Build the result first, then build our parents so that our parents have + ; the right value for the CHILD-BACKPOINTER field. + ; Use a bogus value for mi? and offset for the moment. + ; The correct values are set later. + + (let ((result (list class #f (cons 999 999) child)) + (mi? (> (length (-class-parents class)) 1))) + + ; Recurse on the parents. + ; We use `append!' here as the location of `result' is now fixed so + ; that our parent's child-backpointer remains stable. + + (append! result + (let loop ((parents (-class-parents class)) + (parent-descs ()) + (base-offset base-offset)) + (if (null? parents) + (reverse! parent-descs) + (let ((parent (class-lookup (car parents)))) + (if (not parent) + ; The proc name we pass here is made up as we don't + ; want it to be the name of an internal proc. + (-object-error "class" (car parents) "not a class")) + (if (and (not mi?) + (-class-mi? parent)) + (set! mi? #t)) + (let ((parent-desc (compute1 parent result base-offset))) + (loop (cdr parents) + (cons parent-desc parent-descs) + offset)))))) + + (list-set! result 1 mi?) + (list-set! result 2 (cons base-offset (- offset base-offset))) + (set! offset (+ offset (length (-class-elements class)))) + result)) + + (compute1 class child offset) +) + +; Return the top level class-descriptor of CLASS-DESC. + +(define (-class-desc-top class-desc) + (if (-class-desc-child class-desc) + (-class-desc-top (-class-desc-child class-desc)) + class-desc) +) + +; Pretty print a class descriptor. + +(define (class-desc-dump class-desc) + (let* ((cep (current-error-port)) + (top-desc (-class-desc-top class-desc)) + (spaces (lambda (n port) + (display (make-string n #\space) port))) + (writeln (lambda (indent port . args) + (spaces indent port) + (for-each (lambda (arg) (display arg port)) + args) + (newline port))) + ) + (letrec ((dump (lambda (cd indent) + (writeln indent cep "Class: " + (-class-name (-class-desc-class cd))) + (writeln indent cep " mi?: " + (-class-desc-mi? cd)) + (writeln indent cep " base offset: " + (-class-desc-offset-base cd)) + (writeln indent cep " delta: " + (-class-desc-offset-delta cd)) + (writeln indent cep " child: " + (if (-class-desc-child cd) + (-class-name (-class-desc-class + (-class-desc-child cd))) + "-top-")) + (for-each (lambda (parent-cd) (dump parent-cd (+ indent 4))) + (-class-desc-parents cd)) + ))) + (display "Top level class: " cep) + (display (-class-name (-class-desc-class top-desc)) cep) + (newline cep) + (dump class-desc 0) + )) +) + +; Low level object utilities. + +; Make an object. +; All elements get initial (or unbound) values. + +(define (-object-make! class) + (-class-check-init! class) + (vector (apply vector (append! (list -object-tag class) + (-class-all-initial-values class))) + (-class-class-desc class)) +) + +; Make an object using VALUES. +; VALUES must specify all elements in the class (and parent classes). + +(define (-object-make-with-values! class class-desc values) + (-class-check-init! class) + (vector (apply vector (append! (list -object-tag class) values)) + class-desc) +) + +; Copy an object. +; If TOP?, the copy is of the top level object with any specialization +; discarded. +; WARNING: A shallow copy is currently done on the elements! + +(define (-object-copy obj top?) + (if top? + (vector (-object-vector-copy (-object-elements obj)) + (-class-class-desc (-object-top-class obj))) + (vector (-object-vector-copy (-object-elements obj)) + (-object-class-desc obj))) +) + +; Specialize an object to be one from a parent class. +; The result is the same object, but with a different view (confined to +; a particular parent class). + +(define (-object-specialize obj class-desc) + (vector (-object-elements obj) class-desc) +) + +; Accessors. + +(define (-object-elements obj) (vector-ref obj 0)) +(define (-object-class-desc obj) (vector-ref obj 1)) +(define (-object-class obj) (-class-desc-class (-object-class-desc obj))) +(define (-object-class-name obj) (-class-name (-object-class obj))) +(define (-object-top-class obj) (vector-ref (-object-elements obj) 1)) + +(define (-object-elm-get obj class-desc elm-base-offset) + (vector-ref (-object-elements obj) + (+ (-class-desc-offset-base class-desc) elm-base-offset)) +) + +(define (-object-elm-set! obj class-desc elm-base-offset new-val) + (vector-set! (-object-elements obj) + (+ (-class-desc-offset-base class-desc) elm-base-offset) + new-val) + -object-unspecified +) + +; Return a boolean indicating of OBJ has multiple-inheritance. + +(define (-object-mi? obj) + (-class-mi? (-object-top-class obj)) +) + +; Return boolean indicating if X is an object. + +(define (object? obj) + (and (vector? obj) + (= (vector-length obj) 2) + (vector? (vector-ref obj 0)) + (eq? -object-tag (vector-ref (vector-ref obj 0) 0)) + (-class-desc? (vector-ref obj 1))) +) + +; Return the class of an object. + +(define (object-class obj) + (-object-check obj "object-class") + (-object-class obj) +) + +; Cover proc of -object-class-name for the outside world to use. +; The result is the name of the class or #f if OBJ is not an object. + +(define (object-class-name obj) + (if (object? obj) + (-object-class-name obj) + #f) +) + +; Class operations. + +; Return the list of initial values for CLASS. +; The result does not include parent classes. + +(define (-class-my-initial-values class) + (map cadr (-class-elements class)) +) + +; Initialize class if not already done. +; FIXME: Need circularity check. Later. + +(define (-class-check-init! class) + ; This should be fast the second time through, so don't do any + ; computation until we know it's necessary. + + (if (not (-class-all-initial-values class)) + + (begin + + ; First pass ensures all parents are initialized. + (for-each -class-check-init! + (-class-parent-classes class)) + + ; Next pass initializes the initial value list. + (letrec ((get-inits + (lambda (class) + (let ((parents (-class-parent-classes class))) + (append (apply append (map get-inits parents)) + (-class-my-initial-values class)))))) + + (let* ((parents (-class-parent-classes class)) + (inits (append (apply append (map get-inits parents)) + (-class-my-initial-values class)))) + (-class-set-all-initial-values! class inits))) + + ; Next pass initializes the class's class-descriptor. + ; Object elements begin at offset 2 in the element vector. + (-class-set-class-desc! class + (-class-compute-class-desc class 2 #f)) + )) + + -object-unspecified +) + +; Make a class. +; +; PARENTS is a list of names of parent classes. The parents need not +; exist yet, though they must exist when the class is first instantiated. +; ELMS is a either a list of either element names or name/value pairs. +; Elements without initial values are marked as "unbound". +; METHODS is an initial alist of methods. More methods can be added with +; method-make!. + +(define (class-make name parents elms methods) + (let ((elm-list #f)) + + ; Mark elements without initial values as unbound, and + ; compute indices into the element vector (relative to the class's + ; offset). + ; Elements are recorded as (symbol initial-value private? . vector-index) + ; FIXME: For now all elements are marked as "public". + (let loop ((elm-list-tmp ()) (index 0) (elms elms)) + (if (null? elms) + (set! elm-list (reverse! elm-list-tmp)) ; done + (if (pair? (car elms)) + (loop (acons (caar elms) + (cons (cdar elms) (cons #f index)) + elm-list-tmp) + (+ index 1) + (cdr elms)) + (loop (acons (car elms) + (cons -object-unbound (cons #f index)) + elm-list-tmp) + (+ index 1) + (cdr elms))))) + + (let ((result (-class-make! name parents elm-list methods))) + + ; Create the standard `make!' method. + ; The caller can override afterwards if desired. + ; Note that if there are any parent classes then we don't know the names + ; of all of the elements yet, that is only known after the class has been + ; initialized which only happens when the class is first instantiated. + ; This method won't be called until that happens though so we're safe. + ; This is written without knowledge of the names, it just initializes + ; all elements. + (method-make! result 'make! + (lambda args + (let ((self (car args))) + ; Ensure exactly all of the elements are provided. + (if (not (= (length args) + (- (vector-length (-object-elements self)) 1))) + (-object-error "make!" "" "wrong number of arguments to method `make!'")) + (-object-make-with-values! (-object-top-class self) + (-object-class-desc self) + (cdr args))))) + + result)) +) + +; Create an object of a class CLASS. + +(define (new class) + (-class-check class "new") + + (if -object-verbose? + (display (string-append "Instantiating class " (-class-name class) ".\n") + (current-error-port))) + + (-object-make! class) +) + +; Make a copy of OBJ. +; WARNING: A shallow copy is done on the elements! + +(define (object-copy obj) + (-object-check obj "object-copy") + (-object-copy obj #f) +) + +; Make a copy of OBJ. +; This makes a copy of top level object, with any specialization discarded. +; WARNING: A shallow copy is done on the elements! + +(define (object-copy-top obj) + (-object-check obj "object-copy-top") + (-object-copy obj #t) +) + +; Utility to define a standard `make!' method. +; A standard make! method is one in which all it does is initialize +; fields from args. + +(define (method-make-make! class args) + (let ((lambda-expr + (append (list 'lambda (cons 'self args)) + (map (lambda (elm) (list 'elm-set! 'self + (list 'quote elm) elm)) + args) + '(self)))) + (method-make! class 'make! (eval lambda-expr)) + ) +) + +; The "standard" way to invoke `make!' is (send (new class) 'make! ...). +; This puts all that in a cover function. + +(define (make class . operands) + (apply send (append (cons (new class) ()) '(make!) operands)) +) + +; Return #t if class X is a subclass of BASE-NAME. + +(define (-class-subclass? base-name x) + (if (eq? base-name (-class-name x)) + #t + (let loop ((parents (-class-parents x))) + (if (null? parents) + #f + (if (-class-subclass? base-name (class-lookup (car parents))) + #t + (loop (cdr parents)))))) +) + +; Return #t if OBJECT is an instance of CLASS. +; This does not signal an error if OBJECT is not an object as this is +; intended to be used in class predicates. + +(define (class-instance? class object) + (-class-check class "class-instance?") + (if (object? object) + (-class-subclass? (-class-name class) (-object-class object)) + #f) +) + +; Element operations. + +; Lookup an element in a class-desc. +; The result is (class-desc . (private? . elm-offset)) or #f if not found. +; ??? We could define accessors of the result but knowledge of its format +; is restricted to this section of the source. + +(define (-class-lookup-element class-desc elm-name) + (let* ((class (-class-desc-class class-desc)) + (elm (assq elm-name (-class-elements class)))) + (if elm + (cons class-desc (cddr elm)) + (let loop ((parents (-class-desc-parents class-desc))) + (if (null? parents) + #f + (let ((elm (-class-lookup-element (car parents) elm-name))) + (if elm + elm + (loop (cdr parents))))) + )) + ) +) + +; Given the result of -class-lookup-element, return the element's delta +; from base-offset. + +(define (-elm-delta index) + (+ (-class-desc-offset-delta (car index)) + (cddr index)) +) + +; Return a boolean indicating if ELM is bound in OBJ. + +(define (elm-bound? obj elm) + (-object-check obj "elm-bound?") + (let* ((index (-class-lookup-element (-object-class-desc obj) elm)) + (val (-object-elm-get obj (car index) (-elm-delta index)))) + (not (eq? val -object-unbound))) +) + +; Subroutine of elm-get. + +(define (-elm-make-method-getter self name) + (-object-check self "elm-get") + (let ((index (-class-lookup-element (-object-class-desc self) name))) + (if index + (procedure->memoizing-macro + (lambda (exp env) + `(lambda (obj) + (-object-elm-get obj (-object-class-desc obj) + ,(-elm-delta index))))) + (-object-error "elm-get" self "element not present: " name))) +) + +; Get an element from an object. +; If OBJ is `self' then the caller is required to be a method and we emit +; memoized code. Otherwise we do things the slow way. +; ??? There must be a better way. +; What this does is turn +; (elm-get self 'foo) +; into +; ((-elm-make-method-get self 'foo) self) +; Note the extra set of parens. -elm-make-method-get then does the lookup of +; foo and returns a memoizing macro that returns the code to perform the +; operation with O(1). Cute, but I'm hoping there's an easier/better way. + +(defmacro elm-get (self name) + (if (eq? self 'self) + `(((-elm-make-method-getter ,self ,name)) ,self) + `(elm-xget ,self ,name)) +) + +; Subroutine of elm-set!. + +(define (-elm-make-method-setter self name) + (-object-check self "elm-set!") + (let ((index (-class-lookup-element (-object-class-desc self) name))) + (if index + (procedure->memoizing-macro + (lambda (exp env) + `(lambda (obj new-val) + (-object-elm-set! obj (-object-class-desc obj) + ,(-elm-delta index) new-val)))) + (-object-error "elm-set!" self "element not present: " name))) +) + +; Set an element in an object. +; This can only be used by methods. +; See the comments for `elm-get'! + +(defmacro elm-set! (self name new-val) + (if (eq? self 'self) + `(((-elm-make-method-setter ,self ,name)) ,self ,new-val) + `(elm-xset! ,self ,name ,new-val)) +) + +; Get an element from an object. +; This is for invoking from outside a method, and without having to +; use elm-make-getter. It should be used sparingly. + +(define (elm-xget obj name) + (-object-check obj "elm-xget") + (let ((index (-class-lookup-element (-object-class-desc obj) name))) + ; FIXME: check private? + (if index + (-object-elm-get obj (car index) (-elm-delta index)) + (-object-error "elm-xget" obj "element not present: " name))) +) + +; Set an element in an object. +; This is for invoking from outside a method, and without having to +; use elm-make-setter. It should be used sparingly. + +(define (elm-xset! obj name new-val) + (-object-check obj "elm-xset!") + (let ((index (-class-lookup-element (-object-class-desc obj) name))) + ; FIXME: check private? + (if index + (-object-elm-set! obj (car index) (-elm-delta index) new-val) + (-object-error "elm-xset!" obj "element not present: " name))) +) + +; Return a boolean indicating if object OBJ has element NAME. + +(define (elm-present? obj name) + (-object-check obj "elm-present?") + (->bool (-class-lookup-element (-object-class-desc obj) name)) +) + +; Return lambda to get element NAME in CLASS. +; FIXME: validate name. + +(define (elm-make-getter class name) + (-class-check class "elm-make-getter") + ; We use delay here as we can't assume parent classes have been + ; initialized yet. + (let ((fast-index (delay (-class-lookup-element + (-class-class-desc class) name)))) + (lambda (obj) + ; ??? Should be able to use fast-index in mi case. + ; ??? Need to involve CLASS in lookup. + (let ((index (if (-object-mi? obj) + (-class-lookup-element (-object-class-desc obj) name) + (force fast-index)))) + (-object-elm-get obj (car index) (-elm-delta index))))) +) + +; Return lambda to set element NAME in CLASS. +; FIXME: validate name. + +(define (elm-make-setter class name) + (-class-check class "elm-make-setter") + ; We use delay here as we can't assume parent classes have been + ; initialized yet. + (let ((fast-index (delay (-class-lookup-element + (-class-class-desc class) name)))) + (lambda (obj newval) + ; ??? Should be able to use fast-index in mi case. + ; ??? Need to involve CLASS in lookup. + (let ((index (if (-object-mi? obj) + (-class-lookup-element (-object-class-desc obj) name) + (force fast-index)))) + (-object-elm-set! obj (car index) (-elm-delta index) newval)))) +) + +; Return a list of all elements in OBJ. + +(define (elm-list obj) + (cddr (vector->list (-object-elements obj))) +) + +; Method operations. + +; Lookup the next method in a class. +; This means begin the search in the parents. +; ??? What should this do for virtual methods. At present we treat them as +; non-virtual. + +(define (-method-lookup-next class-desc method-name) + (let loop ((parents (-class-desc-parents class-desc))) + (if (null? parents) + #f + (let ((meth (-method-lookup (car parents) method-name #f))) + (if meth + meth + (loop (cdr parents)))))) +) + +; Lookup a method in a class. +; The result is (class-desc . method). If the method is found in a parent +; class, the associated parent class descriptor is returned. If the method is +; a virtual method, the appropriate subclass's class descriptor is returned. +; VIRTUAL? is #t if virtual methods are to be treated as such. +; Otherwise they're treated as normal methods. +; +; FIXME: We don't yet implement the method cache. + +(define (-method-lookup class-desc method-name virtual?) + (if -object-verbose? + (display (string-append "Looking up method " method-name " in " + (-class-name (-class-desc-class class-desc)) ".\n") + (current-error-port))) + + (let ((meth (assq method-name (-class-methods (-class-desc-class class-desc))))) + (if meth + (if (and virtual? (cadr meth)) ; virtual? + ; Traverse back up the inheritance chain looking for overriding + ; methods. The closest one to the top is the one to use. + (let loop ((child (-class-desc-child class-desc)) + (goal-class-desc class-desc) + (goal-meth meth)) + (if child + (begin + (if -object-verbose? + (display (string-append "Looking up virtual method " + method-name " in " + (-class-name (-class-desc-class child)) + ".\n") + (current-error-port))) + (let ((meth (assq method-name (-class-methods (-class-desc-class child))))) + (if meth + ; Method found, update goal object and method. + (loop (-class-desc-child child) child meth) + ; Method not found at this level. + (loop (-class-desc-child child) goal-class-desc goal-meth)))) + ; Went all the way up to the top. + (cons goal-class-desc (cddr goal-meth)))) + ; Non-virtual, done. + (cons class-desc (cddr meth))) + ; Method not found, search parents. + (-method-lookup-next class-desc method-name))) +) + +; Return a boolean indicating if object OBJ has method NAME. + +(define (method-present? obj name) + (-object-check obj "method-present?") + (->bool (-method-lookup (-object-class-desc obj) name #f)) +) + +; Return method NAME of CLASS or #f if not present. +; ??? Assumes CLASS has been initialized. + +(define (method-proc class name) + (-class-check class "method-proc") + (let ((meth (-method-lookup (-class-class-desc class) name #t))) + (if meth + (cdr meth) + #f)) +) + +; Add a method to a class. +; FIXME: ensure method-name is a symbol + +(define (method-make! class method-name method) + (-class-check class "method-make!") + (if (not (procedure? method)) + (-object-error "method-make!" method "method must be a procedure")) + (-class-set-methods! class (acons method-name + (cons #f method) + (-class-methods class))) + -object-unspecified +) + +; Add a virtual method to a class. +; FIXME: ensure method-name is a symbol + +(define (method-make-virtual! class method-name method) + (-class-check class "method-make-virtual!") + (if (not (procedure? method)) + (-object-error "method-make-virtual!" method "method must be a procedure")) + (-class-set-methods! class (acons method-name + (cons #t method) + (-class-methods class))) + -object-unspecified +) + +; Utility to create "forwarding" methods. +; METHODS are forwarded to class member ELM-NAME, assumed to be an object. +; The created methods take a variable number of arguments. +; Argument length checking will be done by the receiving method. +; FIXME: ensure elm-name is a symbol + +(define (method-make-forward! class elm-name methods) + (for-each (lambda (method-name) + (method-make! + class method-name + (eval `(lambda args + (apply send + (cons (elm-get (car args) + (quote ,elm-name)) + (cons (quote ,method-name) + (cdr args)))))))) + methods) + -object-unspecified +) + +; Same as method-make-forward! but creates virtual methods. +; FIXME: ensure elm-name is a symbol + +(define (method-make-virtual-forward! class elm-name methods) + (for-each (lambda (method-name) + (method-make-virtual! + class method-name + (eval `(lambda args + (apply send + (cons (elm-get (car args) + (quote ,elm-name)) + (cons (quote ,method-name) + (cdr args)))))))) + methods) + -object-unspecified +) + +; Utility of send, send-next. + +(define (-object-method-notify obj method-name maybe-next) + (set! -object-verbose? #f) + (display (string-append "Sending " maybe-next method-name " to" + (if (method-present? obj 'get-name) + (let ((name (send obj 'get-name))) + (if (or (symbol? name) (string? name)) + (string-append " object " name) + "")) + "") + " class " (object-class-name obj) ".\n") + (current-error-port)) + (set! -object-verbose? #t) +) + +; Invoke a method in an object. +; When the method is invoked, the (possible parent class) object in which the +; method is found is passed to the method. +; ??? The word `send' comes from "sending messages". Perhaps should pick +; a better name for this operation. + +(define (send obj method-name . args) + (-object-check obj "send") + (-object-check-name method-name "send" "not a method name") + (if -object-verbose? (-object-method-notify obj method-name "")) + + (let ((class-desc.meth (-method-lookup (-object-class-desc obj) + method-name #t))) + (if class-desc.meth + (apply (cdr class-desc.meth) + (cons (-object-specialize obj (car class-desc.meth)) + args)) + (-object-error "send" obj "method not supported: " method-name))) +) + +; Invoke the next method named METHOD-NAME in the heirarchy of OBJ. +; i.e. the method that would have been invoked if the calling method +; didn't exist. +; This may only be called by a method. +; ??? Ideally we shouldn't need the METHOD-NAME argument. It could be +; removed with a bit of effort, but is it worth it? + +(define (send-next obj method-name . args) + (-object-check obj "send-next") + (-object-check-name method-name "send-next" "not a method name") + (if -object-verbose? (-object-method-notify obj method-name "next ")) + + (let ((class-desc.meth (-method-lookup-next (-object-class-desc obj) + method-name))) + (if class-desc.meth + (apply (cdr class-desc.meth) + (cons (-object-specialize obj (car class-desc.meth)) + args)) + (-object-error "send-next" obj "method not supported: " method-name))) +) + +; Parent operations. + +; Subroutine of `parent' to lookup a (potentially nested) parent class. +; The result is the parent's class-descriptor or #f if not found. + +(define (-class-parent class-desc parent) + (let* ((parent-descs (-class-desc-parents class-desc)) + (desc (-class-desc-lookup-parent parent parent-descs))) + (if desc + desc + (let loop ((parents parent-descs)) + (if (null? parents) + #f + (let ((desc (-class-parent (car parents) parent))) + (if desc + desc + (loop (cdr parents)))))))) +) + +; Subroutine of `parent' to lookup a parent via a path. +; PARENT-PATH, a list, is the exact path to the parent class. +; The result is the parent's class-descriptor or #f if not found. +; For completeness' sake, if PARENT-PATH is empty, CLASS-DESC is returned. + +(define (-class-parent-via-path class-desc parent-path) + (if (null? parent-path) + class-desc + (let ((desc (-class-desc-lookup-parent (car parent-path) + (-class-desc-parents class-desc)))) + (if desc + (if (null? (cdr parent-path)) + desc + (-class-parent-via-path (car desc) (cdr parent-path))) + #f))) +) + +; Lookup a parent class of object OBJ. +; CLASS is either a class or a list of classes. +; If CLASS is a list, it is a (possibly empty) "path" to the parent. +; Otherwise it is any parent and is searched for breadth-first. +; ??? Methinks this should be depth-first. +; The result is OBJ, specialized to the found parent. + +(define (object-parent obj class) + (-object-check obj "object-parent") + (cond ((class? class) #t) + ((list? class) (for-each (lambda (class) (-class-check class + "object-parent")) + class)) + (else (-object-error "object-parent" class "invalid parent path"))) + + ; Hobbit generates C code that passes the function + ; -class-parent-via-path or -class-parent, not the appropriate + ; SCM object. +; (let ((result ((if (or (null? class) (pair? class)) +; -class-parent-via-path +; -class-parent) +; obj class))) + ; So it's rewritten like this. + (let ((result (if (class? class) + (-class-parent (-object-class-desc obj) class) + (-class-parent-via-path (-object-class-desc obj) class)))) + (if result + (-object-specialize obj result) + (-object-error "object-parent" obj "parent not present"))) + ; FIXME: should print path in error message. +) + +; Make PARENT-NAME a parent of CLASS, cons'd unto the front of the search +; order. This is used to add a parent class to a class after it has already +; been created. Obviously this isn't something one does willy-nilly. +; The parent is added to the front of the current parent list (affects +; method lookup). + +(define (class-cons-parent! class parent-name) + (-class-check class "class-cons-parent!") + (-object-check-name parent-name "class-cons-parent!" "not a class name") + (-class-set-parents! class (cons parent-name (-class-parents class))) + -object-unspecified +) + +; Make PARENT-NAME a parent of CLASS, cons'd unto the end of the search order. +; This is used to add a parent class to a class after it has already been +; created. Obviously this isn't something one does willy-nilly. +; The parent is added to the end of the current parent list (affects +; method lookup). + +(define (class-append-parent! class parent-name) + (-class-check class "class-append-parent!") + (-object-check-name parent-name "class-append-parent!" "not a class name") + (-class-set-parents! obj (append (-class-parents obj) (list parent-name))) + -object-unspecified +) + +; Miscellaneous publically accessible utilities. + +; Reset the object system (delete all classes). + +(define (object-reset!) + (set! -class-list ()) + -object-unspecified +) + +; Call once to initialize the object system. +; Only necessary if classes have been modified after objects have been +; instantiated. This usually happens during development only. + +(define (object-init!) + (for-each (lambda (class) + (-class-set-all-initial-values! class #f) + (-class-set-all-methods! class #f) + (-class-set-class-desc! class #f)) + (class-list)) + (for-each (lambda (class) + (-class-check-init! class)) + (class-list)) + -object-unspecified +) + +; Return list of all classes. + +(define (class-list) (map cdr -class-list)) + +; Utility to map over a class and all its parent classes, recursively. + +(define (class-map-over-class proc class) + (cons (proc class) + (map (lambda (class) (class-map-over-class proc class)) + (-class-parent-classes class))) +) + +; Return class tree of a class or object. + +(define (class-tree class-or-object) + (cond ((class? class-or-object) + (class-map-over-class class-name class-or-object)) + ((object? class-or-object) + (class-map-over-class class-name (-object-class class-or-object))) + (else (-object-error "class-tree" class-or-object + "not a class or object"))) +) + +; Return names of each alist. + +(define (-class-alist-names class) + (list (-class-name class) + (map car (-class-elements class)) + (map car (-class-methods class))) +) + +; Return complete layout of class-or-object. + +(define (class-layout class-or-object) + (cond ((class? class-or-object) + (class-map-over-class -class-alist-names class-or-object)) + ((object? class-or-object) + (class-map-over-class -class-alist-names (-object-class class-or-object))) + (else (-object-error "class-layout" class-or-object + "not a class or object"))) +) + +; Like assq but based on the `name' element. +; WARNING: Slow. + +(define (object-assq name obj-list) + (find-first (lambda (o) (eq? (elm-xget o 'name) name)) + obj-list) +) + +; Like memq but based on the `name' element. +; WARNING: Slow. + +(define (object-memq name obj-list) + (let loop ((r obj-list)) + (cond ((null? r) #f) + ((eq? name (elm-xget (car r) 'name)) r) + (else (loop (cdr r))))) +) + +; Misc. internal utilities. + +; We need a fast vector copy operation. +; If `vector-copy' doesn't exist (which is assumed to be the fast one), +; provide a simple version. +; FIXME: Need deep copier instead. + +(if (defined? 'vector-copy) + (define -object-vector-copy vector-copy) + (define (-object-vector-copy v) (list->vector (vector->list v))) +) + +; Profiling support + +(if (and #f (defined? 'proc-profile)) + (begin + (proc-profile elm-get) + (proc-profile elm-set!) + (proc-profile elm-present?) + (proc-profile -method-lookup) + (proc-profile send) + (proc-profile new) + (proc-profile make) + )) diff --git a/cgen/decode.scm b/cgen/decode.scm new file mode 100644 index 00000000000..3fbda2174df --- /dev/null +++ b/cgen/decode.scm @@ -0,0 +1,640 @@ +; Application independent decoder support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; +; This file provides utilities for building instruction set decoders. +; At present its rather limited, and is geared towards the simulator +; where the goal is hyper-efficiency [not that there isn't room for much +; improvement, but rather that that's what the current focus is]. +; +; The CPU description file provides the first pass's bit mask with the +; `decode-assist' spec. This gives the decoder a head start on how to +; efficiently decode the instruction set. The rest of the decoder is +; determined algorithmically. +; ??? Need to say more here. +; +; The main entry point is decode-build-table. +; +; Main procedure call tree: +; decode-build-table +; -build-slots +; -build-decode-table-guts +; -build-decode-table-entry +; -build-slots +; -build-decode-table-guts +; +; -build-slots/-build-decode-table-guts are recursively called to construct a +; tree of "table-guts" elements, and then the application recurses on the +; result. For example see sim-decode.scm. +; +; FIXME: Don't create more than 3 shifts (i.e. no more than 3 groups). +; FIXME: Exits when insns are unambiguously determined, even if there are more +; opcode bits to examine. + +; Decoder data structures and accessors. +; The set of instruction is internally recorded as a tree of two data +; structures: "table-guts" and "table-entry". +; [The choice of "table-guts" is historical, a better name will come to mind +; eventually.] + +; Decoded tables data structure, termed "table guts". +; A simple data structure of 4 elements: +; bitnums: list of bits that have been used thus far to decode the insn +; startbit: bit offset in instruction of value in C local variable `insn' +; bitsize: size of value in C local variable `insn', the number +; of bits of the instruction read thus far +; entries: list of insns that match the decoding thus far, +; each entry in the list is a `dtable-entry' record + +(define (dtable-guts-make bitnums startbit bitsize entries) + (vector bitnums startbit bitsize entries) +) + +; Accessors. +(define (dtable-guts-bitnums tg) (vector-ref tg 0)) +(define (dtable-guts-startbit tg) (vector-ref tg 1)) +(define (dtable-guts-bitsize tg) (vector-ref tg 2)) +(define (dtable-guts-entries tg) (vector-ref tg 3)) + +; A decoded subtable. +; A simple data structure of 3 elements: +; key: name to distinguish this subtable from others, used for lookup +; table: a table-guts element +; name: name of C variable containing the table +; +; The implementation uses a list so the lookup can use assv. + +(define (subdtable-make key table name) + (list key table name) +) + +; Accessors. +(define (subdtable-key st) (car st)) +(define (subdtable-table st) (cadr st)) +(define (subdtable-name st) (caddr st)) + +; List of decode subtables. +(define -decode-subtables nil) + +(define (subdtable-lookup key) (assv key -decode-subtables)) + +; Add SUBTABLE-GUTS to the subtables list if not already present. +; Result is the subtable entry already present, or new entry. +; The key is computed so as to make comparisons possible with assv. + +(define (subdtable-add subtable-guts name) + (let* ((key (string->symbol + (string-append + (numbers->string (dtable-guts-bitnums subtable-guts) " ") + " " (number->string (dtable-guts-bitsize subtable-guts)) + (string-map + (lambda (elm) + (case (dtable-entry-type elm) + ((insn) + (string-append " " (obj:name (dtable-entry-value elm)))) + ((table) + (string-append " " (subdtable-name (dtable-entry-value elm)))) + ((expr) + (string-append " " (exprtable-name (dtable-entry-value elm)))) + (else (error "bad dtable entry type:" + (dtable-entry-type elm))))) + (dtable-guts-entries subtable-guts))))) + (entry (subdtable-lookup key))) + (if (not entry) + (begin + (set! -decode-subtables (cons (subdtable-make key subtable-guts name) + -decode-subtables)) + (car -decode-subtables)) + entry)) +) + +; An instruction and predicate for final matching. + +(define (exprtable-entry-make insn expr) + (vector insn expr (rtl-find-ifields expr)) +) + +; Accessors. + +(define (exprtable-entry-insn entry) (vector-ref entry 0)) +(define (exprtable-entry-expr entry) (vector-ref entry 1)) +(define (exprtable-entry-iflds entry) (vector-ref entry 2)) + +; Return a pseudo-cost of processing exprentry X. + +(define (exprentry-cost x) + (let ((expr (exprtable-entry-expr x))) + (case (rtx-name expr) + ((member) (length (rtx-member-set expr))) + (else 4))) +) + +; Sort an exprtable, optimum choices first. +; Basically an optimum choice is a cheaper choice. + +(define (exprtable-sort expr-list) + (sort expr-list + (lambda (a b) + (let ((costa (exprentry-cost a)) + (costb (exprentry-cost b))) + (< costa costb)))) +) + +; Return the name of the expr table for INSN-EXPRS, +; which is a list of exprtable-entry elements. + +(define (-gen-exprtable-name insn-exprs) + (string-map (lambda (x) + (string-append (obj:name (exprtable-entry-insn x)) + "-" + (rtx-strdump (exprtable-entry-expr x)))) + insn-exprs) +) + +; A set of instructions that need expressions to distinguish. +; Typically the expressions are ifield-assertion specs. +; INSN-EXPRS is a sorted list of exprtable-entry elements. +; The list is considered sorted in the sense that the first insn to satisfy +; its predicate is chosen. + +(define (exprtable-make name insn-exprs) + (vector name insn-exprs) +) + +; Accessors. + +(define (exprtable-name etable) (vector-ref etable 0)) +(define (exprtable-insns etable) (vector-ref etable 1)) + +; Decoded table entry data structure. +; A simple data structure of 3 elements: +; index: index in the parent table +; entry type indicator: 'insn or 'table or 'expr +; value: the insn or subtable or exprtable + +(define (dtable-entry-make index type value) + (assert value) + (vector index type value) +) + +; Accessors. +(define (dtable-entry-index te) (vector-ref te 0)) +(define (dtable-entry-type te) (vector-ref te 1)) +(define (dtable-entry-value te) (vector-ref te 2)) + +; Return #t if BITNUM is a good bit to use for decoding. +; MASKS is a list of opcode masks. +; MASK-LENS is a list of lengths of each value in MASKS. +; BITNUM is the number of the bit to test. It's value depends on LSB0?. +; It can be no larger than the smallest element in MASKS. +; E.g. If MASK-LENS consists of 16 and 32 and LSB0? is #f, BITNUM must +; be from 0 to 15. +; FIXME: This isn't quite right. What if LSB0? = #t? Need decode-bitsize. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; +; FIXME: This is just a first cut, but the governing intent is to not require +; targets to specify decode tables, hints, or algorithms. +; Certainly as it becomes useful they can supply such information. +; The point is to avoid having to as much as possible. +; +; FIXME: Bit numbers shouldn't be considered in isolation. +; It would be better to compute use counts of all of them and then see +; if there's a cluster of high use counts. + +(define (-usable-decode-bit? masks mask-lens bitnum lsb0?) + (let* ((has-bit (map (lambda (msk len) + (bit-set? msk (if lsb0? bitnum (- len bitnum 1)))) + masks mask-lens))) + (or (all-true? has-bit) + ; If half or more insns use the bit, it's a good one. + ; FIXME: An empirical guess at best. + (>= (count-true has-bit) (quotient (length has-bit) 2)) + )) +) + + +; Compute population counts for each bit. Return it as a vector indexed by bit number. +(define (-mask-bit-population masks mask-lens lsb0?) + (let* ((max-length (apply max mask-lens)) + (population (make-vector max-length 0))) + (for-each (lambda (mask len) + (logit 5 " population count mask=" (number->hex mask) " len=" len "\n") + (for-each (lambda (bitno) + (if (bit-set? mask (if lsb0? bitno (- len bitno 1))) + (vector-set! population bitno + (+ 1 (vector-ref population bitno))))) + (-range len))) + masks mask-lens) + population) +) + + +; Return a list (0 ... limit-1) +(define (-range limit) + (let loop ((i 0) + (indices (list))) + (if (= i limit) (reverse indices) (loop (+ i 1) (cons i indices)))) +) + +; Return a list (base ... base+size-1) +(define (-range2 base size) + (let loop ((i base) + (indices (list))) + (if (= i (+ base size)) (reverse indices) (loop (+ i 1) (cons i indices)))) +) + + +; Return a copy of given vector, with all entries with given indices set to `value' +(define (-vector-copy-set-all vector indices value) + (let ((new-vector (make-vector (vector-length vector)))) + (for-each (lambda (index) + (vector-set! new-vector index (if (memq index indices) + value + (vector-ref vector index)))) + (-range (vector-length vector))) + new-vector) +) + + +; Return a list of indices whose counts in the given vector exceed the given threshold. +(define (-population-above-threshold population threshold) + (find (lambda (index) (if (vector-ref population index) + (>= (vector-ref population index) threshold) + #f)) + (-range (vector-length population))) +) + + +; Return the top few most popular indices in the population vector, ignoring any +; that are already used (marked by negative count). Don't exceed `size' unless +; the clustering is just too good to pass up. +(define (-population-top-few population size) + (let loop ((old-picks (list)) + (remaining-population population) + (count-threshold (apply max (map (lambda (value) (if value value 0)) + (vector->list population))))) + (let* ((new-picks (-population-above-threshold remaining-population count-threshold))) + (logit 4 "-population-top-few" + " picks=(" old-picks ") pop=(" remaining-population ")" + " threshold=" count-threshold " new-picks=(" new-picks ")\n") + (cond + ; No new matches? + ((null? new-picks) + (begin (assert (not (null? old-picks))) + old-picks)) + ; Way too many matches? + ((> (+ (length new-picks) (length old-picks)) (+ 2 size)) + (list-take (+ 2 size) (append new-picks old-picks))) + ; About right number of matches? + ((> (+ (length new-picks) (length old-picks)) (- 1 size)) + (append old-picks new-picks)) + ; Not enough? Lower the threshold a bit and try to add some more. + (else + (loop (append old-picks new-picks) + (-vector-copy-set-all remaining-population new-picks #f) + (truncate (* 0.8 count-threshold))))))) +) + + + +; Given list of insns, return list of bit numbers of constant bits in opcode +; that they all share (or mostly share), up to MAX elements. +; ALREADY-USED is a list of bitnums we can't use. +; STARTBIT is the bit offset of the instruction value that C variable `insn' +; holds (note that this is independent of LSB0?). +; DECODE-BITSIZE is the number of bits of the insn that `insn' holds. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; +; Nil is returned if there are none, meaning that there is an ambiguity in +; the specification up to the current word. +; +; We assume INSN-LIST matches all opcode bits before STARTBIT. +; FIXME: Revisit, as a more optimal decoder is sometimes achieved by doing +; a cluster of opcode bits that appear later in the insn, and then coming +; back to earlier ones. +; +; All insns are assumed to start at the same address so we handle insns of +; varying lengths - we only analyze the common bits in all of them. +; +; Note that if we get called again to compute further opcode bits, we +; start looking at STARTBIT again (rather than keeping track of how far in +; the insn word we've progressed). We could do this as an optimization, but +; we also have to handle the case where the initial set of decode bits misses +; some and thus we have to go back and look at them. It may also turn out +; that an opcode bit is skipped over because it doesn't contribute much +; information to the decoding process (see -usable-decode-bit?). As the +; possible insn list gets wittled down, the bit will become significant. Thus +; the optimization is left for later. Also, see preceding FIXME. + +(define (decode-get-best-bits insn-list already-used startbit max decode-bitsize lsb0?) + (let* ((raw-population (-mask-bit-population (map insn-base-mask insn-list) + (map insn-base-mask-length insn-list) + lsb0?)) + ; (undecoded (if lsb0? + ; (-range2 startbit (+ startbit decode-bitsize)) + ; (-range2 (- startbit decode-bitsize) startbit))) + (used+undecoded already-used) ; (append already-used undecoded)) + (filtered-population (-vector-copy-set-all raw-population used+undecoded #f)) + (favorite-indices (-population-top-few filtered-population max)) + (sorted-indices (sort favorite-indices (lambda (a b) + (if lsb0? (> a b) (< a b)))))) + (logit 3 + "Best decode bits (prev=" already-used " start=" startbit " decode=" decode-bitsize ")" + "=>" + "(" sorted-indices ")\n") + sorted-indices) +) + + +(define (OLDdecode-get-best-bits insn-list already-used startbit max decode-bitsize lsb0?) + (let ((masks (map insn-base-mask insn-list)) + ; ??? We assume mask lengths are repeatedly used for insns longer + ; than the base insn size. + (mask-lens (map insn-base-mask-length insn-list)) + (endbit (if lsb0? + -1 ; FIXME: for now (gets sparc port going) + (+ startbit decode-bitsize))) + (incr (if lsb0? -1 1))) + (let loop ((result nil) + (bitnum (if lsb0? + (+ startbit (- decode-bitsize 1)) + startbit))) + (if (or (= (length result) max) (= bitnum endbit)) + (reverse! result) + (if (and (not (memq bitnum already-used)) + (-usable-decode-bit? masks mask-lens bitnum lsb0?)) + (loop (cons bitnum result) (+ bitnum incr)) + (loop result (+ bitnum incr)))) + )) +) + +; Return list of decode table entry numbers for INSN's opcode bits BITNUMS. +; This is the indices into the decode table that match the instruction. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; +; Example: If BITNUMS is (0 1 2 3 4 5), and the constant (i.e. opcode) part of +; the those bits of INSN is #b1100xx (where 'x' indicates a non-constant +; part), then the result is (#b110000 #b110001 #b110010 #b110011). + +(define (-opcode-slots insn bitnums lsb0?) + (letrec ((opcode (insn-value insn)) + (insn-len (insn-base-mask-length insn)) + (decode-len (length bitnums)) + (compute (lambda (val insn-len decode-len bl) + ;(display (list val insn-len decode-len bl)) (newline) + ; Oh My God. This isn't tail recursive. + (if (null? bl) + 0 + (+ (if (bit-set? val + (if lsb0? + (car bl) + (- insn-len (car bl) 1))) + (integer-expt 2 (- (length bl) 1)) + 0) + (compute val insn-len decode-len (cdr bl))))))) + (let* ((opcode (compute (insn-value insn) insn-len decode-len bitnums)) + (opcode-mask (compute (insn-base-mask insn) insn-len decode-len bitnums)) + (indices (missing-bit-indices opcode-mask (- (integer-expt 2 decode-len) 1)))) + (logit 3 "insn =" (obj:name insn) " opcode=" opcode " indices=" indices "\n") + (map (lambda (index) (+ opcode index)) indices))) +) + +; Subroutine of -build-slots. +; Fill slot in INSN-VEC that INSN goes into. +; BITNUMS is the list of opcode bits. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; +; Example: If BITNUMS is (0 1 2 3 4 5) and the constant (i.e. opcode) part of +; the first six bits of INSN is #b1100xx (where 'x' indicates a non-constant +; part), then elements 48 49 50 51 of INSN-VEC are cons'd with INSN. +; Each "slot" is a list of matching instructions. + +(define (-fill-slot! insn-vec insn bitnums lsb0?) + ;(display (string-append "fill-slot!: " (obj:name insn) " ")) (display bitnums) (newline) + (let ((slot-nums (-opcode-slots insn bitnums lsb0?))) + ;(display (list "Filling slot(s)" slot-nums "...")) (newline) + (for-each (lambda (slot-num) + (vector-set! insn-vec slot-num + (cons insn (vector-ref insn-vec slot-num)))) + slot-nums) + *UNSPECIFIED* + ) +) + +; Given a list of constant bitnums (ones that are predominantly, though perhaps +; not always, in the opcode), record each insn in INSN-LIST in the proper slot. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; The result is a vector of insn lists. Each slot is a list of insns +; that go in that slot. + +(define (-build-slots insn-list bitnums lsb0?) + (let ((result (make-vector (integer-expt 2 (length bitnums)) nil))) + ; Loop over each element, filling RESULT. + (for-each (lambda (insn) + (-fill-slot! result insn bitnums lsb0?)) + insn-list) + result) +) + +; Compute the name of a decode table, prefixed with PREFIX. +; INDEX-LIST is a list of pairs: list of bitnums, table entry number, +; in reverse order of traversal (since they're built with cons). +; INDEX-LIST may be empty. + +(define (-gen-decode-table-name prefix index-list) + (set! index-list (reverse index-list)) + (string-append + prefix + "table" + (string-map (lambda (elm) (string-append "_" (number->string elm))) + ; CDR of each element is the table index. + (map cdr index-list))) +) + +; Generate one decode table entry for INSN-VEC at INDEX. +; INSN-VEC is a vector of slots where each slot is a list of instructions that +; map to that slot (opcode value). If a slot is nil, no insn has that opcode +; value so the decoder marks it as being invalid. +; STARTBIT is the bit offset of the instruction value that C variable `insn' +; holds (note that this is independent of LSB0?). +; DECODE-BITSIZE is the number of bits of the insn that `insn' holds. +; INDEX-LIST is a list of pairs: list of bitnums, table entry number. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; INVALID-INSN is an <insn> object to use for invalid insns. +; The result is a dtable-entry element (or "slot"). + +; ??? For debugging. +(define -build-decode-table-entry-args #f) + +(define (-build-decode-table-entry insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn) + (let ((slot (filter-harmlessly-ambiguous-insns (vector-ref insn-vec index)))) + (logit 2 "Processing decode entry " + (number->string index) + " in " + (-gen-decode-table-name "decode_" index-list) + ", " + (cond ((null? slot) "invalid") + ((= 1 (length slot)) (insn-syntax (car slot))) + (else "subtable")) + " ...\n") + + (cond + ; If no insns map to this value, mark it as invalid. + ((null? slot) (dtable-entry-make index 'insn invalid-insn)) + + ; If only one insn maps to this value, that's it for this insn. + ((= 1 (length slot)) + ; FIXME: Incomplete: need to check further opcode bits. + (dtable-entry-make index 'insn (car slot))) + + ; Otherwise more than one insn maps to this value and we need to look at + ; further opcode bits. + (else + (logit 3 "Building subtable at index " (number->string index) + ", decode-bitsize = " (number->string decode-bitsize) + ", indices used thus far:" + (string-map (lambda (i) (string-append " " (number->string i))) + (apply append (map car index-list))) + "\n") + + (let ((bitnums (decode-get-best-bits slot + (apply append (map car index-list)) + startbit 4 + decode-bitsize lsb0?))) + + ; If bitnums is nil, either there is an ambiguity or we need to read + ; more of the instruction in order to distinguish insns in SLOT. + (if (and (null? bitnums) + (< startbit (apply min (map insn-length slot)))) + (begin + ; We might be able to resolve the ambiguity by reading more bits. + ; We know from the < test that there are, indeed, more bits to + ; be read. + (set! startbit (+ startbit decode-bitsize)) + ; FIXME: The calculation of the new decode-bitsize will + ; undoubtedly need refinement. + (set! decode-bitsize + (min decode-bitsize + (- (apply min (map insn-length slot)) + startbit))) + (set! bitnums (decode-get-best-bits slot + ;nil ; FIXME: what to put here? + (apply append (map car index-list)) + startbit 4 + decode-bitsize lsb0?)))) + + ; If bitnums is still nil there is an ambiguity. + (if (null? bitnums) + + (begin + ; If all insns are marked as DECODE-SPLIT, don't warn. + (if (not (all-true? (map (lambda (insn) + (obj-has-attr? insn 'DECODE-SPLIT)) + slot))) + (message "WARNING: Decoder ambiguity detected: " + (string-drop1 ; drop leading comma + (string-map (lambda (insn) + (string-append ", " (obj:name insn))) + slot)) + "\n")) + ; Things aren't entirely hopeless. See if any ifield-assertion + ; specs are present. + ; FIXME: For now we assume that if they all have an + ; ifield-assertion spec, then there is no ambiguity (it's left + ; to the programmer to get it right). This can be made more + ; clever later. + ; FIXME: May need to back up startbit if we've tried to read + ; more of the instruction. + (let ((assertions (map insn-ifield-assertion slot))) + (if (not (all-true? assertions)) + (begin + ; Save arguments for debugging purposes. + (set! -build-decode-table-entry-args + (list insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn)) + (error "Unable to resolve ambiguity (maybe need some ifield-assertion specs?)"))) + ; FIXME: Punt on even simple cleverness for now. + (let ((exprtable-entries + (exprtable-sort (map exprtable-entry-make + slot + assertions)))) + (dtable-entry-make index 'expr + (exprtable-make + (-gen-exprtable-name exprtable-entries) + exprtable-entries))))) + + ; There is no ambiguity so generate the subtable. + ; Need to build `subtable' separately because we + ; may be appending to -decode-subtables recursively. + (let* ((insn-vec (-build-slots slot bitnums lsb0?)) + (subtable + (-build-decode-table-guts insn-vec bitnums startbit + decode-bitsize index-list lsb0? + invalid-insn))) + (dtable-entry-make index 'table + (subdtable-add subtable + (-gen-decode-table-name "" index-list))))))) + ) + ) +) + +; Given vector of insn slots, generate the guts of the decode table, recorded +; as a list of 3 elements: bitnums, decode-bitsize, and list of entries. +; Bitnums is recorded with the guts so that tables whose contents are +; identical but are accessed by different bitnums are treated as separate in +; -decode-subtables. Not sure this will ever happen, but play it safe. +; +; BITNUMS is the list of bit numbers used to build the slot table. +; STARTBIT is the bit offset of the instruction value that C variable `insn' +; holds (note that this is independent of LSB0?). +; For example, it is initially zero. If DECODE-BITSIZE is 16 and after +; scanning the first fetched piece of the instruction, more decoding is +; needed, another piece will be fetched and STARTBIT will then be 16. +; DECODE-BITSIZE is the number of bits of the insn that `insn' holds. +; INDEX-LIST is a list of pairs: list of bitnums, table entry number. +; Decode tables consist of entries of two types: actual insns and +; pointers to other tables. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; INVALID-INSN is an <insn> object representing invalid insns. + +(define (-build-decode-table-guts insn-vec bitnums startbit decode-bitsize index-list lsb0? invalid-insn) + (logit 2 "Processing decoder for bits" + (numbers->string bitnums " ") + " ...\n") + + (dtable-guts-make + bitnums startbit decode-bitsize + (map (lambda (index) + (-build-decode-table-entry insn-vec startbit decode-bitsize index + (cons (cons bitnums index) + index-list) + lsb0? invalid-insn)) + (iota (vector-length insn-vec)))) +) + +; Entry point. +; Return a table that efficiently decodes INSN-LIST. +; BITNUMS is the set of bits to initially key off of. +; DECODE-BITSIZE is the number of bits of the instruction that `insn' holds. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; INVALID-INSN is an <insn> object representing the `invalid' insn (for +; instructions values that don't decode to any entry in INSN-LIST). + +(define (decode-build-table insn-list bitnums decode-bitsize lsb0? invalid-insn) + ; Initialize the list of subtables computed. + (set! -decode-subtables nil) + + ; ??? Another way to handle simple forms of ifield-assertions (like those + ; created by insn specialization) is to record a copy of the insn for each + ; possible value of the ifield and modify its ifield list with the ifield's + ; value. This would then let the decoder table builder handle it normally. + ; I wouldn't create N insns, but would rather create an intermediary record + ; that recorded the necessary bits (insn, ifield-list, remaining + ; ifield-assertions). + + (let ((insn-vec (-build-slots insn-list bitnums lsb0?))) + (let ((table-guts (-build-decode-table-guts insn-vec bitnums + 0 decode-bitsize + nil lsb0? + invalid-insn))) + table-guts)) +) diff --git a/cgen/desc-cpu.scm b/cgen/desc-cpu.scm new file mode 100644 index 00000000000..1e3799c94df --- /dev/null +++ b/cgen/desc-cpu.scm @@ -0,0 +1,954 @@ +; Generate .c/.h versions of main elements of cpu description file. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; ISA support code. + +(define (-gen-isa-table-defns) + (logit 2 "Generating isa table defns ...\n") + + (string-list + "\ +/* Instruction set variants. */ + +static const CGEN_ISA @arch@_cgen_isa_table[] = { +" + (string-list-map (lambda (isa) + (gen-obj-sanitize + isa + (string-append " { " + "\"" (obj:name isa) "\", " + (number->string + (isa-default-insn-bitsize isa)) + ", " + (number->string + (isa-base-insn-bitsize isa)) + ", " + (number->string + (isa-min-insn-bitsize isa)) + ", " + (number->string + (isa-max-insn-bitsize isa)) + " },\n"))) + (current-isa-list)) + "\ + { 0, 0, 0, 0, 0 } +}; +\n" + ) +) + +; Mach support code. + +; Return C code to describe the various cpu variants. +; Currently this is quite simple, the various cpu names and their mach numbers +; are recorded in a "keyword" table. +; ??? No longer used as there is the mach attribute. +; +;(set! mach-table (make <keyword> 'mach "machine list" +; (make <attr-list> "" nil) ; FIXME: sanitization? +; (map (lambda (elm) (list (obj:name elm) (mach-number elm))) +; (current-mach-list)))) + +(define (-gen-mach-table-decls) + (logit 2 "Generating machine table decls ...\n") + "" ; (gen-decl mach-table) +) + +(define (-gen-mach-table-defns) + (logit 2 "Generating machine table defns ...\n") + + (string-list + "\ +/* Machine variants. */ + +static const CGEN_MACH @arch@_cgen_mach_table[] = { +" + (string-list-map (lambda (mach) + (gen-obj-sanitize + mach + (string-append " { " + "\"" (obj:name mach) "\", " + "\"" (mach-bfd-name mach) "\", " + (mach-enum mach) + " },\n"))) + (current-mach-list)) + "\ + { 0, 0, 0 } +}; +\n" + ) +) + +; Attribute support code. + +; Return C code to describe the various attributes. + +(define (-gen-attr-table-decls) + (logit 2 "Generating attribute table decls ...\n") + (string-append + "/* Attributes. */\n" + "extern const CGEN_ATTR_TABLE @arch@_cgen_hardware_attr_table[];\n" + "extern const CGEN_ATTR_TABLE @arch@_cgen_ifield_attr_table[];\n" + "extern const CGEN_ATTR_TABLE @arch@_cgen_operand_attr_table[];\n" + "extern const CGEN_ATTR_TABLE @arch@_cgen_insn_attr_table[];\n" + "\n" + ) +) + +; Alternative GEN-MASK argument to gen-bool-attrs. +; This uses the `A' macro to abbreviate the attribute definition. + +(define (gen-A-attr-mask prefix name) + (string-append "A(" (string-upcase (gen-c-symbol name)) ")") +) + +; Instruction fields support code. + +; Return C code to declare various ifield bits. + +(define (gen-ifld-decls) + (logit 2 "Generating instruction field decls ...\n") + (string-list + "/* Ifield support. */\n\n" + "extern const struct cgen_ifld @arch@_cgen_ifld_table[];\n\n" + "/* Ifield attribute indices. */\n\n" + (gen-attr-enum-decl "cgen_ifld" (current-ifld-attr-list)) + (gen-enum-decl 'ifield_type "@arch@ ifield types" + "@ARCH@_" + (append (gen-obj-list-enums (non-derived-ifields (current-ifld-list))) + '((f-max)))) + "#define MAX_IFLD ((int) @ARCH@_F_MAX)\n\n" + ) +) + +; Return C code to define the instruction field table, +; and any other ifield related definitions. + +(define (gen-ifld-defns) + (logit 2 "Generating ifield table ...\n") + (let* ((ifld-list (find (lambda (f) (not (has-attr? f 'VIRTUAL))) + (non-derived-ifields (current-ifld-list)))) + (all-attrs (current-ifld-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-list + "\ +/* The instruction field table. */ + +#define A(a) (1 << CONCAT2 (CGEN_IFLD_,a)) + +const CGEN_IFLD @arch@_cgen_ifld_table[] = +{ +" + (string-list-map + (lambda (ifld) + (gen-obj-sanitize ifld + (string-append + " { " + (ifld-enum ifld) ", " + "\"" (obj:name ifld) "\", " + (number->string (ifld-word-offset ifld)) ", " + (number->string (ifld-word-length ifld)) ", " + (number->string (ifld-start ifld #f)) ", " + (number->string (ifld-length ifld)) ", " + (gen-obj-attr-defn 'ifld ifld all-attrs + num-non-bools gen-A-attr-mask) + " },\n"))) + ifld-list) + "\ + { 0, 0, 0, 0, 0, 0, {0, {0}} } +}; + +#undef A + +" + )) +) + +; Hardware support. + +; Return C code to declare the various hardware bits +; that can be (or must be) defined before including opcode/cgen.h. + +(define (gen-hw-decls) + (logit 2 "Generating hardware decls ...\n") + (string-list + "/* Hardware attribute indices. */\n\n" + (gen-attr-enum-decl "cgen_hw" (current-hw-attr-list)) + (gen-enum-decl 'cgen_hw_type "@arch@ hardware types" + "HW_" ; FIXME: @ARCH@_ + (append (nub (map (lambda (hw) + (cons (hw-sem-name hw) + (cons '- + (atlist-attrs + (obj-atlist hw))))) + (current-hw-list)) + (lambda (elm) (car elm))) + '((max)))) + "#define MAX_HW ((int) HW_MAX)\n\n" + ) +) + +; Return declarations of variables tables used by HW. + +(define (-gen-hw-decl hw) + (string-append + (if (and (hw-indices hw) + ; ??? Commented out as opcode changes are needed + ) ; (not (obj-has-attr? (hw-indices hw) 'PRIVATE))) + (gen-decl (hw-indices hw)) + "") + (if (and (hw-values hw) + ; ??? Commented out as opcode changes are needed + ) ; (not (obj-has-attr? (hw-values hw) 'PRIVATE))) + (gen-decl (hw-values hw)) + "") + ) +) + +; Return C code to declare the various hardware bits +; that must be defined after including opcode/cgen.h. + +(define (gen-hw-table-decls) + (logit 2 "Generating hardware table decls ...\n") + (string-list + "/* Hardware decls. */\n\n" + (string-map -gen-hw-decl (current-hw-list)) + "\n" + ) +) + +; Return definitions of variables tables used by HW. +; Only do this for `PRIVATE' elements. Public ones are emitted elsewhere. + +(define (-gen-hw-defn hw) + (string-append + (if (and (hw-indices hw) + (obj-has-attr? (hw-indices hw) 'PRIVATE)) + (gen-defn (hw-indices hw)) + "") + (if (and (hw-values hw) + (obj-has-attr? (hw-values hw) 'PRIVATE)) + (gen-defn (hw-values hw)) + "") + ) +) + +; Generate the tables for the various hardware bits (register names, etc.). +; A table is generated for each element, and then another table is generated +; which collects them all together. +; Uses include looking up a particular register set so that a new reg +; can be added to it [at runtime]. + +(define (gen-hw-table-defns) + (logit 2 "Generating hardware table ...\n") + (let* ((all-attrs (current-hw-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-list + (string-list-map gen-defn (current-kw-list)) + (string-list-map -gen-hw-defn (current-hw-list)) + " + +/* The hardware table. */ + +#define A(a) (1 << CONCAT2 (CGEN_HW_,a)) + +const CGEN_HW_ENTRY @arch@_cgen_hw_table[] = +{ +" + (string-list-map + (lambda (hw) + (gen-obj-sanitize hw + (string-list + " { " + "\"" (obj:name hw) "\", " + (hw-enum hw) ", " + ; ??? No element currently requires both indices and + ; values specs so we only output the needed one. + (or (and (hw-indices hw) + (send (hw-indices hw) 'gen-table-entry)) + (and (hw-values hw) + (send (hw-values hw) 'gen-table-entry)) + "CGEN_ASM_NONE, 0, ") + (gen-obj-attr-defn 'hw hw all-attrs + num-non-bools gen-A-attr-mask) + " },\n"))) + (current-hw-list)) + "\ + { 0, 0, CGEN_ASM_NONE, 0, {0, {0}} } +}; + +#undef A + +" + )) +) + +; Utilities of cgen-opc.h. + +; Return #define's of several constants. +; FIXME: Some of these to be moved into table of structs, one per cpu family. + +(define (-gen-hash-defines) + (logit 2 "Generating #define's ...\n") + (string-list + "#define CGEN_ARCH @arch@\n\n" + "/* Given symbol S, return @arch@_cgen_<S>. */\n" + "#define CGEN_SYM(s) CONCAT3 (@arch@,_cgen_,s)\n\n" + "/* Selected cpu families. */\n" + ; FIXME: Move to sim's arch.h. + (string-map (lambda (cpu) + (gen-obj-sanitize cpu + (string-append "#define HAVE_CPU_" + (string-upcase (gen-sym cpu)) + "\n"))) + (current-cpu-list)) + "\n" + "#define CGEN_INSN_LSB0_P " (if (current-arch-insn-lsb0?) "1" "0") + "\n\n" + "/* Minimum size of any insn (in bytes). */\n" + "#define CGEN_MIN_INSN_SIZE " + (number->string (bits->bytes + (apply min (map isa-min-insn-bitsize (current-isa-list))))) + "\n\n" + "/* Maximum size of any insn (in bytes). */\n" + "#define CGEN_MAX_INSN_SIZE " + (number->string (bits->bytes + (apply max (map isa-max-insn-bitsize (current-isa-list))))) + "\n\n" + ; This tells the assembler/disassembler whether or not it can use an int to + ; record insns, which is faster. Since this controls the typedef of the + ; insn buffer, only enable this if all isas support it. + "#define CGEN_INT_INSN_P " + (if (all-true? (map isa-integral-insn? (current-isa-list))) "1" "0") + "\n" + "\n" + "/* Maximum nymber of syntax bytes in an instruction. */\n" + "#define CGEN_ACTUAL_MAX_SYNTAX_BYTES " + ; The +2 account for the leading "MNEM" and trailing 0. + (number->string (+ 2 (apply max (map (lambda (insn) + (length (syntax-break-out (insn-syntax insn)))) + (current-insn-list))))) + "\n" + "\n" + "/* CGEN_MNEMONIC_OPERANDS is defined if mnemonics have operands.\n" + " e.g. In \"b,a foo\" the \",a\" is an operand. If mnemonics have operands\n" + " we can't hash on everything up to the space. */\n" + (if strip-mnemonic? + "/*#define CGEN_MNEMONIC_OPERANDS*/\n" + "#define CGEN_MNEMONIC_OPERANDS\n") + "\n" + ; "/* Maximum number of operands any insn or macro-insn has. */\n" + ; FIXME: Should compute. + ; "#define CGEN_MAX_INSN_OPERANDS 16\n" + ; "\n" + "/* Maximum number of fields in an instruction. */\n" + "#define CGEN_ACTUAL_MAX_IFMT_OPERANDS " + (number->string (apply max (map (lambda (f) (length (ifmt-ifields f))) + (current-ifmt-list)))) + "\n\n" + ) +) + +; Operand support. + +; Return C code to declare various operand bits. + +(define (gen-operand-decls) + (logit 2 "Generating operand decls ...\n") + (string-list + "/* Operand attribute indices. */\n\n" + (gen-attr-enum-decl "cgen_operand" (current-op-attr-list)) + (gen-enum-decl 'cgen_operand_type "@arch@ operand types" + "@ARCH@_OPERAND_" + (nub (append (gen-obj-list-enums (current-op-list)) + '((max))) + car)) + "/* Number of operands types. */\n" + "#define MAX_OPERANDS ((int) @ARCH@_OPERAND_MAX)\n\n" + "/* Maximum number of operands referenced by any insn. */\n" + "#define MAX_OPERAND_INSTANCES " + (number->string (max-operand-instances)) + "\n\n" + ) +) + +; Generate C code to define the operand table. + +(define (gen-operand-table) + (logit 2 "Generating operand table ...\n") + (let* ((all-attrs (current-op-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-list + "\ +/* The operand table. */ + +#define A(a) (1 << CONCAT2 (CGEN_OPERAND_,a)) +#define OPERAND(op) CONCAT2 (@ARCH@_OPERAND_,op) + +const CGEN_OPERAND @arch@_cgen_operand_table[] = +{ +" + (string-list-map + (lambda (op) + (gen-obj-sanitize op + (string-append + "/* " (obj:name op) ": " (obj:comment op) " */\n" + (if (or (derived-operand? op) + (anyof-operand? op)) + "" + (string-append + " { " + "\"" (obj:name op) "\", " + (op-enum op) ", " + (hw-enum (op:hw-name op)) ", " + (number->string (op:start op)) ", " + (number->string (op:length op)) ",\n" + " " + (gen-obj-attr-defn 'operand op all-attrs + num-non-bools gen-A-attr-mask) + " },\n" + ))))) + (current-op-list)) + "\ + { 0, 0, 0, 0, 0, {0, {0}} } +}; + +#undef A + +" + ) + ) +) + +; Instruction table support. + +; Return C code to declare various insn bits. + +(define (gen-insn-decls) + (logit 2 "Generating instruction decls ...\n") + (string-list + "/* Insn attribute indices. */\n\n" + (gen-attr-enum-decl "cgen_insn" (current-insn-attr-list)) + ) +) + +; Generate an insn table entry for INSN. +; ALL-ATTRS is a list of all instruction attributes. +; NUM-NON-BOOLS is the number of non-boolean insn attributes. + +(define (gen-insn-table-entry insn all-attrs num-non-bools) + (gen-obj-sanitize + insn + (string-list + "/* " (insn-syntax insn) " */\n" + " {\n" + " " + (if (has-attr? insn 'ALIAS) "-1" (insn-enum insn)) ", " + "\"" (obj:name insn) "\", " + "\"" (insn-mnemonic insn) "\", " + ;(if (has-attr? insn 'ALIAS) "0" (number->string (insn-length insn))) ",\n" + (number->string (insn-length insn)) ",\n" +; ??? There is currently a problem with embedded newlines, and this might +; best be put in another file [the table is already pretty big]. +; Might also wish to output bytecodes instead. +; " " +; (if (insn-semantics insn) +; (string-append "\"" +; (with-output-to-string +; ; ??? Should we do macro expansion here? +; (lambda () (display (insn-semantics insn)))) +; "\"") +; "0") +; ",\n" + ; ??? Might wish to output the raw format spec here instead + ; (either as plain text or bytecodes). + ; Values could be lazily computed and cached. + " " + (gen-obj-attr-defn 'insn insn all-attrs num-non-bools gen-A-attr-mask) + "\n },\n")) +) + +; Generate insn table. + +(define (gen-insn-table) + (logit 2 "Generating instruction table ...\n") + (let* ((all-attrs (current-insn-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-write + "\ +#define A(a) (1 << CONCAT2 (CGEN_INSN_,a)) +#define OP(field) CGEN_SYNTAX_MAKE_FIELD (OPERAND (field)) + +/* The instruction table. */ + +static const CGEN_IBASE @arch@_cgen_insn_table[MAX_INSNS] = +{ + /* Special null first entry. + A `num' value of zero is thus invalid. + Also, the special `invalid' insn resides here. */ + { 0, 0, 0, 0, {0, {0}} },\n" + + (lambda () + (string-write-map (lambda (insn) + (logit 3 "Generating insn table entry for " (obj:name insn) " ...\n") + (gen-insn-table-entry insn all-attrs num-non-bools)) + (non-multi-insns (current-insn-list)))) + + "\ +}; + +#undef A +#undef MNEM +#undef OP + +" + ) + ) +) + +; Cpu table handling support. +; +; ??? A lot of this can live in a machine independent file, but there's +; currently no place to put this file (there's no libcgen). libopcodes is the +; wrong place as some simulator ports use this but they don't use libopcodes. + +; Return C routines to open/close a cpu description table. +; This is defined here and not in cgen-opc.in because it refers to +; CGEN_{ASM,DIS}_HASH and insn_table/macro_insn_table which is defined +; earlier in the file. ??? Things can certainly be rearranged though +; and opcodes/cgen.sh modified to insert the generated part into the middle +; of the file like is done for assembler/disassembler support. + +(define (-gen-cpu-open) + (string-append + "\ +/* Subroutine of @arch@_cgen_cpu_open to look up a mach via its bfd name. */ + +static const CGEN_MACH * +lookup_mach_via_bfd_name (table, name) + const CGEN_MACH *table; + const char *name; +{ + while (table->name) + { + if (strcmp (name, table->bfd_name) == 0) + return table; + ++table; + } + abort (); +} + +/* Subroutine of @arch@_cgen_cpu_open to build the hardware table. */ + +static void +build_hw_table (cd) + CGEN_CPU_TABLE *cd; +{ + int i; + int machs = cd->machs; + const CGEN_HW_ENTRY *init = & @arch@_cgen_hw_table[0]; + /* MAX_HW is only an upper bound on the number of selected entries. + However each entry is indexed by it's enum so there can be holes in + the table. */ + const CGEN_HW_ENTRY **selected = + (const CGEN_HW_ENTRY **) xmalloc (MAX_HW * sizeof (CGEN_HW_ENTRY *)); + + cd->hw_table.init_entries = init; + cd->hw_table.entry_size = sizeof (CGEN_HW_ENTRY); + memset (selected, 0, MAX_HW * sizeof (CGEN_HW_ENTRY *)); + /* ??? For now we just use machs to determine which ones we want. */ + for (i = 0; init[i].name != NULL; ++i) + if (CGEN_HW_ATTR_VALUE (&init[i], CGEN_HW_MACH) + & machs) + selected[init[i].type] = &init[i]; + cd->hw_table.entries = selected; + cd->hw_table.num_entries = MAX_HW; +} + +/* Subroutine of @arch@_cgen_cpu_open to build the hardware table. */ + +static void +build_ifield_table (cd) + CGEN_CPU_TABLE *cd; +{ + cd->ifld_table = & @arch@_cgen_ifld_table[0]; +} + +/* Subroutine of @arch@_cgen_cpu_open to build the hardware table. */ + +static void +build_operand_table (cd) + CGEN_CPU_TABLE *cd; +{ + int i; + int machs = cd->machs; + const CGEN_OPERAND *init = & @arch@_cgen_operand_table[0]; + /* MAX_OPERANDS is only an upper bound on the number of selected entries. + However each entry is indexed by it's enum so there can be holes in + the table. */ + const CGEN_OPERAND **selected = + (const CGEN_OPERAND **) xmalloc (MAX_OPERANDS * sizeof (CGEN_OPERAND *)); + + cd->operand_table.init_entries = init; + cd->operand_table.entry_size = sizeof (CGEN_OPERAND); + memset (selected, 0, MAX_OPERANDS * sizeof (CGEN_OPERAND *)); + /* ??? For now we just use mach to determine which ones we want. */ + for (i = 0; init[i].name != NULL; ++i) + if (CGEN_OPERAND_ATTR_VALUE (&init[i], CGEN_OPERAND_MACH) + & machs) + selected[init[i].type] = &init[i]; + cd->operand_table.entries = selected; + cd->operand_table.num_entries = MAX_OPERANDS; +} + +/* Subroutine of @arch@_cgen_cpu_open to build the hardware table. + ??? This could leave out insns not supported by the specified mach/isa, + but that would cause errors like \"foo only supported by bar\" to become + \"unknown insn\", so for now we include all insns and require the app to + do the checking later. + ??? On the other hand, parsing of such insns may require their hardware or + operand elements to be in the table [which they mightn't be]. */ + +static void +build_insn_table (cd) + CGEN_CPU_TABLE *cd; +{ + int i; + const CGEN_IBASE *ib = & @arch@_cgen_insn_table[0]; + CGEN_INSN *insns = (CGEN_INSN *) xmalloc (MAX_INSNS * sizeof (CGEN_INSN)); + + memset (insns, 0, MAX_INSNS * sizeof (CGEN_INSN)); + for (i = 0; i < MAX_INSNS; ++i) + insns[i].base = &ib[i]; + cd->insn_table.init_entries = insns; + cd->insn_table.entry_size = sizeof (CGEN_IBASE); + cd->insn_table.num_init_entries = MAX_INSNS; +} + +/* Subroutine of @arch@_cgen_cpu_open to rebuild the tables. */ + +static void +@arch@_cgen_rebuild_tables (cd) + CGEN_CPU_TABLE *cd; +{ + int i,n_isas; + unsigned int isas = cd->isas; +#if 0 + unsigned int machs = cd->machs; +#endif + + cd->int_insn_p = CGEN_INT_INSN_P; + + /* Data derived from the isa spec. */ +#define UNSET (CGEN_SIZE_UNKNOWN + 1) + cd->default_insn_bitsize = UNSET; + cd->base_insn_bitsize = UNSET; + cd->min_insn_bitsize = 65535; /* some ridiculously big number */ + cd->max_insn_bitsize = 0; + for (i = 0; i < MAX_ISAS; ++i) + if (((1 << i) & isas) != 0) + { + const CGEN_ISA *isa = & @arch@_cgen_isa_table[i]; + + /* Default insn sizes of all selected isas must be equal or we set + the result to 0, meaning \"unknown\". */ + if (cd->default_insn_bitsize == UNSET) + cd->default_insn_bitsize = isa->default_insn_bitsize; + else if (isa->default_insn_bitsize == cd->default_insn_bitsize) + ; /* this is ok */ + else + cd->default_insn_bitsize = CGEN_SIZE_UNKNOWN; + + /* Base insn sizes of all selected isas must be equal or we set + the result to 0, meaning \"unknown\". */ + if (cd->base_insn_bitsize == UNSET) + cd->base_insn_bitsize = isa->base_insn_bitsize; + else if (isa->base_insn_bitsize == cd->base_insn_bitsize) + ; /* this is ok */ + else + cd->base_insn_bitsize = CGEN_SIZE_UNKNOWN; + + /* Set min,max insn sizes. */ + if (isa->min_insn_bitsize < cd->min_insn_bitsize) + cd->min_insn_bitsize = isa->min_insn_bitsize; + if (isa->max_insn_bitsize > cd->max_insn_bitsize) + cd->max_insn_bitsize = isa->max_insn_bitsize; + + ++n_isas; + } + +#if 0 /* Does nothing?? */ + /* Data derived from the mach spec. */ + for (i = 0; i < MAX_MACHS; ++i) + if (((1 << i) & machs) != 0) + { + const CGEN_MACH *mach = & @arch@_cgen_mach_table[i]; + + ++n_machs; + } +#endif + + /* Determine which hw elements are used by MACH. */ + build_hw_table (cd); + + /* Build the ifield table. */ + build_ifield_table (cd); + + /* Determine which operands are used by MACH/ISA. */ + build_operand_table (cd); + + /* Build the instruction table. */ + build_insn_table (cd); +} + +/* Initialize a cpu table and return a descriptor. + It's much like opening a file, and must be the first function called. + The arguments are a set of (type/value) pairs, terminated with + CGEN_CPU_OPEN_END. + + Currently supported values: + CGEN_CPU_OPEN_ISAS: bitmap of values in enum isa_attr + CGEN_CPU_OPEN_MACHS: bitmap of values in enum mach_attr + CGEN_CPU_OPEN_BFDMACH: specify 1 mach using bfd name + CGEN_CPU_OPEN_ENDIAN: specify endian choice + CGEN_CPU_OPEN_END: terminates arguments + + ??? Simultaneous multiple isas might not make sense, but it's not (yet) + precluded. + + ??? We only support ISO C stdargs here, not K&R. + Laziness, plus experiment to see if anything requires K&R - eventually + K&R will no longer be supported - e.g. GDB is currently trying this. */ + +CGEN_CPU_DESC +@arch@_cgen_cpu_open (enum cgen_cpu_open_arg arg_type, ...) +{ + CGEN_CPU_TABLE *cd = (CGEN_CPU_TABLE *) xmalloc (sizeof (CGEN_CPU_TABLE)); + static int init_p; + unsigned int isas = 0; /* 0 = \"unspecified\" */ + unsigned int machs = 0; /* 0 = \"unspecified\" */ + enum cgen_endian endian = CGEN_ENDIAN_UNKNOWN; + va_list ap; + + if (! init_p) + { + init_tables (); + init_p = 1; + } + + memset (cd, 0, sizeof (*cd)); + + va_start (ap, arg_type); + while (arg_type != CGEN_CPU_OPEN_END) + { + switch (arg_type) + { + case CGEN_CPU_OPEN_ISAS : + isas = va_arg (ap, unsigned int); + break; + case CGEN_CPU_OPEN_MACHS : + machs = va_arg (ap, unsigned int); + break; + case CGEN_CPU_OPEN_BFDMACH : + { + const char *name = va_arg (ap, const char *); + const CGEN_MACH *mach = + lookup_mach_via_bfd_name (@arch@_cgen_mach_table, name); + + machs |= mach->num << 1; + break; + } + case CGEN_CPU_OPEN_ENDIAN : + endian = va_arg (ap, enum cgen_endian); + break; + default : + fprintf (stderr, \"@arch@_cgen_cpu_open: unsupported argument `%d'\\n\", + arg_type); + abort (); /* ??? return NULL? */ + } + arg_type = va_arg (ap, enum cgen_cpu_open_arg); + } + va_end (ap); + + /* mach unspecified means \"all\" */ + if (machs == 0) + machs = (1 << MAX_MACHS) - 1; + /* base mach is always selected */ + machs |= 1; + /* isa unspecified means \"all\" */ + if (isas == 0) + isas = (1 << MAX_ISAS) - 1; + if (endian == CGEN_ENDIAN_UNKNOWN) + { + /* ??? If target has only one, could have a default. */ + fprintf (stderr, \"@arch@_cgen_cpu_open: no endianness specified\\n\"); + abort (); + } + + cd->isas = isas; + cd->machs = machs; + cd->endian = endian; + /* FIXME: for the sparc case we can determine insn-endianness statically. + The worry here is where both data and insn endian can be independently + chosen, in which case this function will need another argument. + Actually, will want to allow for more arguments in the future anyway. */ + cd->insn_endian = endian; + + /* Table (re)builder. */ + cd->rebuild_tables = @arch@_cgen_rebuild_tables; + @arch@_cgen_rebuild_tables (cd); + + /* Default to not allowing signed overflow. */ + cd->signed_overflow_ok_p = 0; + + return (CGEN_CPU_DESC) cd; +} + +/* Cover fn to @arch@_cgen_cpu_open to handle the simple case of 1 isa, 1 mach. + MACH_NAME is the bfd name of the mach. */ + +CGEN_CPU_DESC +@arch@_cgen_cpu_open_1 (mach_name, endian) + const char *mach_name; + enum cgen_endian endian; +{ + return @arch@_cgen_cpu_open (CGEN_CPU_OPEN_BFDMACH, mach_name, + CGEN_CPU_OPEN_ENDIAN, endian, + CGEN_CPU_OPEN_END); +} + +/* Close a cpu table. + ??? This can live in a machine independent file, but there's currently + no place to put this file (there's no libcgen). libopcodes is the wrong + place as some simulator ports use this but they don't use libopcodes. */ + +void +@arch@_cgen_cpu_close (cd) + CGEN_CPU_DESC cd; +{ + if (cd->insn_table.init_entries) + free ((CGEN_INSN *) cd->insn_table.init_entries); + if (cd->hw_table.entries) + free ((CGEN_HW_ENTRY *) cd->hw_table.entries); + free (cd); +} + +") +) + +; General initialization C code +; Code is appended during processing. + +(define -cputab-init-code "") +(define (cputab-add-init! code) + (set! -cputab-init-code (string-append -cputab-init-code code)) +) + +; Return the C code to define the various initialization functions. +; This does not include assembler/disassembler specific stuff. +; Generally, this function doesn't do anything. +; It exists to allow a global-static-constructor kind of thing should +; one ever be necessary. + +(define (gen-init-fns) + (logit 2 "Generating init fns ...\n") + (string-append + "\ +/* Initialize anything needed to be done once, before any cpu_open call. */ + +static void +init_tables () +{\n" + -cputab-init-code + "}\n\n" + ) +) + +; Top level C code generators + +; FIXME: Create enum objects for all the enums we explicitly declare here. +; Then they'd be usable and we wouldn't have to special case them here. + +(define (cgen-desc.h) + (logit 1 "Generating " (current-arch-name) "-desc.h ...\n") + (string-write + (gen-copyright "CPU data header for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifndef @ARCH@_CPU_H +#define @ARCH@_CPU_H + +" + -gen-hash-defines + ; This is defined in arch.h. It's not defined here as there is yet to + ; be a need for it in the assembler/disassembler. + ;(gen-enum-decl 'model_type "model types" + ; "MODEL_" + ; (append (map list (map obj:name (current-model-list))) '((max)))) + ;"#define MAX_MODELS ((int) MODEL_MAX)\n\n" + "/* Enums. */\n\n" + (string-map gen-decl (current-enum-list)) + "/* Attributes. */\n\n" + (string-map gen-decl (current-attr-list)) + "/* Number of architecture variants. */\n" + ; If there is only 1 isa, leave out special handling. */ + (if (= (length (current-isa-list)) 1) + "#define MAX_ISAS 1\n" + "#define MAX_ISAS ((int) ISA_MAX)\n") + "#define MAX_MACHS ((int) MACH_MAX)\n\n" + gen-ifld-decls + gen-hw-decls + gen-operand-decls + gen-insn-decls + "/* cgen.h uses things we just defined. */\n" + "#include \"opcode/cgen.h\"\n\n" + -gen-attr-table-decls + -gen-mach-table-decls + gen-hw-table-decls + "\n" + (lambda () (gen-extra-cpu.h srcdir (current-arch-name))) ; from <arch>.opc + " + +#endif /* @ARCH@_CPU_H */ +" + ) +) + +; This file contains the "top level" definitions of the cpu. +; This includes various elements of the description file, expressed in C. +; +; ??? A lot of this file can go in a machine-independent file! However, +; some simulators don't use the cgen opcodes support so there is currently +; no place to put this file. To be revisited when we do have such a place. + +(define (cgen-desc.c) + (logit 1 "Generating " (current-arch-name) "-desc.c ...\n") + (string-write + (gen-copyright "CPU data for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#include \"sysdep.h\" +#include <ctype.h> +#include <stdio.h> +#include <stdarg.h> +#include \"ansidecl.h\" +#include \"bfd.h\" +#include \"symcat.h\" +#include \"@prefix@-desc.h\" +#include \"@prefix@-opc.h\" +#include \"opintl.h\" +#include \"libiberty.h\" +\n" + (lambda () (gen-extra-cpu.c srcdir (current-arch-name))) ; from <arch>.opc + gen-attr-table-defns + -gen-isa-table-defns + -gen-mach-table-defns + gen-hw-table-defns + gen-ifld-defns + gen-operand-table + gen-insn-table + gen-init-fns + -gen-cpu-open + ) +) diff --git a/cgen/desc.scm b/cgen/desc.scm new file mode 100644 index 00000000000..d5ba7529b2e --- /dev/null +++ b/cgen/desc.scm @@ -0,0 +1,238 @@ +; General cpu info generator support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; +; This file generates C versions of the more salient parts of the description +; file. It's currently part of opcodes or simulator support, +; and doesn't exist as its own "application" (i.e. user of cgen), +; though that's not precluded. + +; strip-mnemonic?: If each mnemonic is constant, the insn table doesn't need +; to record them in the syntax field as the mnemonic field also contains it. +; Furthermore, the insn table can be hashed on complete mnemonic. +; ??? Should live in <derived-arch-data> or some such. + +(define strip-mnemonic? #f) + +; Attribute support code. + +(define (gen-attr-table-defn type attr-list) + (string-append + "const CGEN_ATTR_TABLE " + "@arch@_cgen_" type "_attr_table[] =\n{\n" + (string-map (lambda (attr) + (gen-obj-sanitize + attr + (string-append " { " + "\"" + (string-upcase (obj:name attr)) + "\", " + (if (class-instance? <boolean-attribute> attr) + "&bool_attr[0], &bool_attr[0]" + (string-append "& " (gen-sym attr) + "_attr[0], & " + (gen-sym attr) + "_attr[0]")) + " },\n"))) + attr-list) + " { 0, 0, 0 }\n" + "};\n\n") +) + +(define (gen-attr-table-defns) + (logit 2 "Generating attribute table defns ...\n") + (string-append + "\ +/* Attributes. */ + +static const CGEN_ATTR_ENTRY bool_attr[] = +{ + { \"#f\", 0 }, + { \"#t\", 1 }, + { 0, 0 } +}; + +" + ; Generate tables mapping names to values for all the non-boolean attrs. + (string-map gen-defn (current-attr-list)) + ; Generate tables for each domain (ifld, insn, etc.) mapping attribute type + ; to index. + (gen-attr-table-defn "ifield" (current-ifld-attr-list)) + (gen-attr-table-defn "hardware" (current-hw-attr-list)) + (gen-attr-table-defn "operand" (current-op-attr-list)) + (gen-attr-table-defn "insn" (current-insn-attr-list)) + ) +) + +; HW-ASM is the base class for supporting hardware elements in the opcode table +; (aka assembler/disassembler). + +; Return the C declaration. +; It is up to a derived class to redefine this as necessary. + +(method-make! <hw-asm> 'gen-decl (lambda (self) "")) + +; Return the C definition. +; It is up to a derived class to redefine this as necessary. + +(method-make! <hw-asm> 'gen-defn (lambda (self) "")) + +(method-make! <hw-asm> 'gen-ref (lambda (self) "0")) + +(method-make! <hw-asm> 'gen-init (lambda (self) "")) + +(method-make! <hw-asm> 'gen-table-entry (lambda (self) "CGEN_ASM_NONE, 0, ")) + +; Prefix of global variables describing operand values. + +(define hw-asm-prefix "@arch@_cgen_opval_") + +; Emit a C reference to a value operand. +; Usually the operand's details are stored in a struct so in the default +; case return that struct (?correct?). The caller must add the "&" if desired. + +(define (gen-hw-asm-ref name) + (string-append hw-asm-prefix (gen-c-symbol name)) +) + +; Keyword support. + +; Keyword operands. +; Return the C declaration of a keyword list. + +(method-make! + <keyword> 'gen-decl + (lambda (self) + (string-append + "extern CGEN_KEYWORD " + (gen-hw-asm-ref (elm-get self 'name)) + ";\n")) +) + +; Return the C definition of a keyword list. + +(method-make! + <keyword> 'gen-defn + (lambda (self) + (string-append + "static CGEN_KEYWORD_ENTRY " + (gen-hw-asm-ref (elm-get self 'name)) "_entries" + "[] =\n{\n" + (string-drop -2 ; Delete trailing ",\n" [don't want the ,] + (string-map (lambda (e) + (string-append + " { " + "\"" (car e) "\", " ; operand name + (if (string? (cadr e)) + (cadr e) + (number->string (cadr e))) ; value + ", {0, {0}}, 0, 0" + " },\n" + )) + (elm-get self 'values))) + "\n};\n\n" + "CGEN_KEYWORD " + (gen-hw-asm-ref (elm-get self 'name)) + " =\n{\n" + " & " (gen-hw-asm-ref (elm-get self 'name)) "_entries[0],\n" + " " (number->string (length (elm-get self 'values))) ",\n" + " 0, 0, 0, 0\n" + "};\n\n" + ) + ) +) + +; Return a reference to a keyword table. + +(method-make! + <keyword> 'gen-ref + (lambda (self) (string-append "& " (gen-hw-asm-ref (elm-get self 'name)))) +) + +(method-make! + <keyword> 'gen-table-entry + (lambda (self) + (string-append "CGEN_ASM_KEYWORD, (PTR) " (send self 'gen-ref) ", ")) +) + +; Return the C code to initialize a keyword. +; If the `hash' attr is present, the values are hashed. Currently this is +; done by calling back to GAS to have it add the registers to its symbol table. +; FIXME: Currently unused. Should be done either in the open routine or +; lazily upon lookup. + +(method-make! + <keyword> 'gen-init + (lambda (self) + (cond ((has-attr? self 'HASH) + (string-append + " @arch@_cgen_asm_hash_keywords (" + (send self 'gen-ref) + ");\n" + )) + (else "")) + ) +) + +; Operand support. + +; Return a reference to the operand's attributes. + +(method-make! + <operand> 'gen-attr-ref + (lambda (self) + (string-append "& CGEN_OPERAND_ATTRS (CGEN_SYM (operand_table)) " + "[" (op-enum self) "]")) +) + +; Name of C variable that is a pointer to the fields struct. + +(define ifields-var "fields") + +; Given FIELD, an `ifield' object, return an lvalue for the operand in +; IFIELDS-VAR. + +(define (gen-operand-result-var field) + (string-append ifields-var "->" (gen-sym field)) +) + +; Basic description init,finish,analyzer support. + +; Return a boolean indicating if all insns have a constant mnemonic +; (ie: no $'s in insn's name in `syntax' field). +; If constant, one can build the assembler hash table using the entire +; mnemonic. + +(define (constant-mnemonics?) + #f ; FIXME +) + +; Initialize any "desc" specific things before loading the .cpu file. +; N.B. Since "desc" is always a part of another application, that +; application's init! routine must call this one. + +(define (desc-init!) + *UNSPECIFIED* +) + +; Finish any "desc" specific things after loading the .cpu file. +; This is separate from analyze-data! as cpu-load performs some +; consistency checks in between. +; N.B. Since "desc" is always a part of another application, that +; application's finish! routine must call this one. + +(define (desc-finish!) + *UNSPECIFIED* +) + +; Compute various needed globals and assign any computed fields of +; the various objects. This is the standard routine that is called after +; a .cpu file is loaded. +; N.B. Since "desc" is always a part of another application, that +; application's analyze! routine must call this one. + +(define (desc-analyze!) + (set! strip-mnemonic? (constant-mnemonics?)) + + *UNSPECIFIED* +) diff --git a/cgen/dev.scm b/cgen/dev.scm new file mode 100644 index 00000000000..66d15624023 --- /dev/null +++ b/cgen/dev.scm @@ -0,0 +1,179 @@ +; CGEN Debugging support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; This file is loaded in during an interactive guile session to +; develop and debug CGEN. The user visible procs are: +; +; (use-c) +; (load-opc) +; (load-sim) +; (cload #:arch arch #:machs "mach-list" #:isas "isa-list" #:options "options") + +; First load fixup.scm to coerce guile into something we've been using. +; Guile is always in flux. +(load "fixup.scm") + +(define srcdir ".") + +; Utility to enable/disable compiled-in C code. + +(define (use-c) (set! CHECK-LOADED? #t)) +(define (no-c) (set! CHECK-LOADED? #f)) + +; Also defined in read.scm, but we need it earlier. +(define APPLICATION 'UNKNOWN) + +; Supply the path name and suffic for the .cpu file and delete the analyzer +; arg from cpu-load to lessen the typing. +(define (cload . args) + (let ((arch #f) + (keep-mach "all") + (keep-isa "all") + (options "")) + + ; Doesn't check if (cadr args) exists or if #:arch was specified, but + ; this is a debugging tool! + (let loop ((args args)) + (if (null? args) + #f ; done + (begin + (case (car args) + ((#:arch) (set! arch (cadr args))) + ((#:machs) (set! keep-mach (cadr args))) + ((#:isas) (set! keep-isa (cadr args))) + ((#:options) (set! options (cadr args))) + (else (error "unknown option:" (car args)))) + (loop (cddr args))))) + + (case APPLICATION + ((UNKNOWN) (error "application not loaded")) + ((DESC) (cpu-load (string-append arch ".cpu") + keep-mach keep-isa options + desc-init! + desc-finish! + desc-analyze!)) + ((OPCODES) (cpu-load (string-append arch ".cpu") + keep-mach keep-isa options + opcodes-init! + opcodes-finish! + opcodes-analyze!)) + ((GAS-TEST) (cpu-load (string-append arch ".cpu") + keep-mach keep-isa options + gas-test-init! + gas-test-finish! + gas-test-analyze!)) + ((SIMULATOR) (cpu-load (string-append arch ".cpu") + keep-mach keep-isa options + sim-init! + sim-finish! + sim-analyze!)) + ((SIM-TEST) (cpu-load (string-append arch ".cpu") + keep-mach keep-isa options + sim-test-init! + sim-test-finish! + sim-test-analyze!)) + (else (error "unknown application:" APPLICATION)))) +) + +; Use the debugging evaluator. +(if (not (defined? 'DEBUG-EVAL)) + (define DEBUG-EVAL #t)) + +; Tell maybe-load to always load the file. +(if (not (defined? 'CHECK-LOADED?)) + (define CHECK-LOADED? #f)) + +(define (load-opc) + (load "read") + (load "desc") + (load "desc-cpu") + (load "opcodes") + (load "opc-asmdis") + (load "opc-ibld") + (load "opc-itab") + (load "opc-opinst") + (set! verbose-level 3) + (set! APPLICATION 'OPCODES) +) + +(define (load-gtest) + (load-opc) + (load "gas-test") + (set! verbose-level 3) + (set! APPLICATION 'GAS-TEST) +) + + +(define (load-sim) + (load "read") + (load "desc") + (load "desc-cpu") + (load "utils-sim") + (load "sim") + (load "sim-arch") + (load "sim-cpu") + (load "sim-model") + (load "sim-decode") + (set! verbose-level 3) + (set! APPLICATION 'SIMULATOR) +) + +(define (load-stest) + (load-opc) + (load "sim-test") + (set! verbose-level 3) + (set! APPLICATION 'SIM-TEST) +) + +(display " +First enable compiled in C code if desired. + +(use-c) + +Then choose the application via one of: + +(load-opc) +(load-gtest) +(load-sim) +(load-stest) +") + +(display "(load-sid)\n") + +(display "\ + +Then load the .cpu file with: + +(cload #:arch \"arch\" #:machs \"keep-mach\" #:isas \"keep-isa\" #:options \"options\") + +keep-mach: +comma separated list of machs to keep or `all' + +keep-isa: +comma separated list of isas to keep or `all' + +opcode options: +[none yet] + +gas test options: +[none yet] +\n") + +(display "\ +sim options: +with-scache +with-profile=fn + +sim test options: +[none yet] +\n") + + +; If ~/.cgenrc exists, load it. + +(let ((cgenrc (string-append (getenv 'HOME) "/.cgenrc"))) + (if (file-exists? cgenrc) + (load cgenrc)) +) diff --git a/cgen/doc/Makefile.am b/cgen/doc/Makefile.am new file mode 100644 index 00000000000..6cfcc78cfa1 --- /dev/null +++ b/cgen/doc/Makefile.am @@ -0,0 +1,17 @@ +## Process this file with automake to generate Makefile.in + +AUTOMAKE_OPTIONS = cygnus + +info_TEXINFOS = cgen.texi + +DOCFILES = app.texi cgen.texi intro.texi notes.texi opcodes.texi \ + pmacros.texi porting.texi \ + rtl.texi sim.texi + +# version.texi is handled by autoconf/automake +cgen.info: $(DOCFILES) version.texi +cgen.dvi: $(DOCFILES) version.texi + +# This one isn't ready for prime time yet. Not even a little bit. + +noinst_TEXINFOS = cgen.texi diff --git a/cgen/doc/Makefile.in b/cgen/doc/Makefile.in new file mode 100644 index 00000000000..370b2242d3a --- /dev/null +++ b/cgen/doc/Makefile.in @@ -0,0 +1,335 @@ +# Makefile.in generated automatically by automake 1.4 from Makefile.am + +# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + + +SHELL = @SHELL@ + +srcdir = @srcdir@ +top_srcdir = @top_srcdir@ +VPATH = @srcdir@ +prefix = @prefix@ +exec_prefix = @exec_prefix@ + +bindir = @bindir@ +sbindir = @sbindir@ +libexecdir = @libexecdir@ +datadir = @datadir@ +sysconfdir = @sysconfdir@ +sharedstatedir = @sharedstatedir@ +localstatedir = @localstatedir@ +libdir = @libdir@ +infodir = @infodir@ +mandir = @mandir@ +includedir = @includedir@ +oldincludedir = /usr/include + +DESTDIR = + +pkgdatadir = $(datadir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ + +top_builddir = .. + +ACLOCAL = @ACLOCAL@ +AUTOCONF = @AUTOCONF@ +AUTOMAKE = @AUTOMAKE@ +AUTOHEADER = @AUTOHEADER@ + +INSTALL = @INSTALL@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS) +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +transform = @program_transform_name@ + +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_alias = @build_alias@ +build_triplet = @build@ +host_alias = @host_alias@ +host_triplet = @host@ +target_alias = @target_alias@ +target_triplet = @target@ +EXEEXT = @EXEEXT@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +PACKAGE = @PACKAGE@ +VERSION = @VERSION@ +arch = @arch@ + +AUTOMAKE_OPTIONS = cygnus + +info_TEXINFOS = cgen.texi + +DOCFILES = app.texi cgen.texi intro.texi notes.texi opcodes.texi \ + pmacros.texi porting.texi \ + rtl.texi sim.texi + + +# This one isn't ready for prime time yet. Not even a little bit. + +noinst_TEXINFOS = cgen.texi +mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs +CONFIG_CLEAN_FILES = +TEXI2DVI = `if test -f $(top_srcdir)/../texinfo/util/texi2dvi; then echo $(top_srcdir)/../texinfo/util/texi2dvi; else echo texi2dvi; fi` +TEXINFO_TEX = $(top_srcdir)/../texinfo/texinfo.tex +INFO_DEPS = cgen.info +DVIS = cgen.dvi +TEXINFOS = cgen.texi +DIST_COMMON = Makefile.am Makefile.in stamp-vti version.texi + + +DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST) + +TAR = gtar +GZIP_ENV = --best +all: all-redirect +.SUFFIXES: +.SUFFIXES: .dvi .info .ps .texi .texinfo .txi +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) + cd $(top_srcdir) && $(AUTOMAKE) --cygnus doc/Makefile + +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + cd $(top_builddir) \ + && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status + + +$(srcdir)/version.texi: @MAINTAINER_MODE_TRUE@stamp-vti + @: + +$(srcdir)/stamp-vti: cgen.texi $(top_srcdir)/configure.in + @echo "@set UPDATED `$(SHELL) $(top_srcdir)/../mdate-sh $(srcdir)/cgen.texi`" > vti.tmp + @echo "@set EDITION $(VERSION)" >> vti.tmp + @echo "@set VERSION $(VERSION)" >> vti.tmp + @cmp -s vti.tmp $(srcdir)/version.texi \ + || (echo "Updating $(srcdir)/version.texi"; \ + cp vti.tmp $(srcdir)/version.texi) + -@rm -f vti.tmp + @cp $(srcdir)/version.texi $@ + +mostlyclean-vti: + -rm -f vti.tmp + +clean-vti: + +distclean-vti: + +maintainer-clean-vti: + -@MAINTAINER_MODE_TRUE@rm -f $(srcdir)/stamp-vti $(srcdir)/version.texi + +cgen.info: cgen.texi version.texi +cgen.dvi: cgen.texi version.texi + + +DVIPS = dvips + +.texi.info: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< + +.texi.dvi: + TEXINPUTS=$(top_srcdir)/../texinfo/texinfo.tex:$$TEXINPUTS \ + MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< + +.texi: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< + +.texinfo.info: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< + +.texinfo: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< + +.texinfo.dvi: + TEXINPUTS=$(top_srcdir)/../texinfo/texinfo.tex:$$TEXINPUTS \ + MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< + +.txi.info: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< + +.txi.dvi: + TEXINPUTS=$(top_srcdir)/../texinfo/texinfo.tex:$$TEXINPUTS \ + MAKEINFO='$(MAKEINFO) -I $(srcdir)' $(TEXI2DVI) $< + +.txi: + @rm -f $@ $@-[0-9] $@-[0-9][0-9] + $(MAKEINFO) -I $(srcdir) $< +.dvi.ps: + $(DVIPS) $< -o $@ + +install-info-am: $(INFO_DEPS) + @$(NORMAL_INSTALL) + $(mkinstalldirs) $(DESTDIR)$(infodir) + @list='$(INFO_DEPS)'; \ + for file in $$list; do \ + if test -f $$file; then d=.; else d=$(srcdir); fi; \ + for ifile in `cd $$d && echo $$file $$file-[0-9] $$file-[0-9][0-9]`; do \ + if test -f $$d/$$ifile; then \ + echo " $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile"; \ + $(INSTALL_DATA) $$d/$$ifile $(DESTDIR)$(infodir)/$$ifile; \ + else : ; fi; \ + done; \ + done + @$(POST_INSTALL) + @if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ + list='$(INFO_DEPS)'; \ + for file in $$list; do \ + echo " install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file";\ + install-info --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/$$file || :;\ + done; \ + else : ; fi + +uninstall-info: + $(PRE_UNINSTALL) + @if $(SHELL) -c 'install-info --version | sed 1q | fgrep -s -v -i debian' >/dev/null 2>&1; then \ + ii=yes; \ + else ii=; fi; \ + list='$(INFO_DEPS)'; \ + for file in $$list; do \ + test -z "$ii" \ + || install-info --info-dir=$(DESTDIR)$(infodir) --remove $$file; \ + done + @$(NORMAL_UNINSTALL) + list='$(INFO_DEPS)'; \ + for file in $$list; do \ + (cd $(DESTDIR)$(infodir) && rm -f $$file $$file-[0-9] $$file-[0-9][0-9]); \ + done + +dist-info: $(INFO_DEPS) + list='$(INFO_DEPS)'; \ + for base in $$list; do \ + if test -f $$base; then d=.; else d=$(srcdir); fi; \ + for file in `cd $$d && eval echo $$base*`; do \ + test -f $(distdir)/$$file \ + || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ + || cp -p $$d/$$file $(distdir)/$$file; \ + done; \ + done + +mostlyclean-aminfo: + -rm -f cgen.aux cgen.cp cgen.cps cgen.dvi cgen.fn cgen.fns cgen.ky \ + cgen.kys cgen.ps cgen.log cgen.pg cgen.toc cgen.tp cgen.tps \ + cgen.vr cgen.vrs cgen.op cgen.tr cgen.cv cgen.cn + +clean-aminfo: + +distclean-aminfo: + +maintainer-clean-aminfo: + for i in $(INFO_DEPS); do \ + rm -f $$i; \ + if test "`echo $$i-[0-9]*`" != "$$i-[0-9]*"; then \ + rm -f $$i-[0-9]*; \ + fi; \ + done +clean-info: mostlyclean-aminfo +tags: TAGS +TAGS: + + +distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir) + +subdir = doc + +distdir: $(DISTFILES) + @for file in $(DISTFILES); do \ + if test -f $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + cp -pr $$d/$$file $(distdir)/$$file; \ + else \ + test -f $(distdir)/$$file \ + || ln $$d/$$file $(distdir)/$$file 2> /dev/null \ + || cp -p $$d/$$file $(distdir)/$$file || :; \ + fi; \ + done + $(MAKE) $(AM_MAKEFLAGS) top_distdir="$(top_distdir)" distdir="$(distdir)" dist-info +info-am: $(INFO_DEPS) +info: info-am +dvi-am: $(DVIS) +dvi: dvi-am +check-am: +check: check-am +installcheck-am: +installcheck: installcheck-am +install-info-am: +install-info: install-info-am +install-exec-am: +install-exec: install-exec-am + +install-data-am: +install-data: install-data-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am +install: install-am +uninstall-am: +uninstall: uninstall-am +all-am: Makefile +all-redirect: all-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install +installdirs: + + +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -rm -f Makefile $(CONFIG_CLEAN_FILES) + -rm -f config.cache config.log stamp-h stamp-h[0-9]* + +maintainer-clean-generic: +mostlyclean-am: mostlyclean-vti mostlyclean-aminfo mostlyclean-generic + +mostlyclean: mostlyclean-am + +clean-am: clean-vti clean-aminfo clean-generic mostlyclean-am + +clean: clean-am + +distclean-am: distclean-vti distclean-aminfo distclean-generic clean-am + +distclean: distclean-am + +maintainer-clean-am: maintainer-clean-vti maintainer-clean-aminfo \ + maintainer-clean-generic distclean-am + @echo "This command is intended for maintainers to use;" + @echo "it deletes files that may require special tools to rebuild." + +maintainer-clean: maintainer-clean-am + +.PHONY: mostlyclean-vti distclean-vti clean-vti maintainer-clean-vti \ +install-info-am uninstall-info mostlyclean-aminfo distclean-aminfo \ +clean-aminfo maintainer-clean-aminfo tags distdir info-am info dvi-am \ +dvi check check-am installcheck-am installcheck install-info-am \ +install-info install-exec-am install-exec install-data-am install-data \ +install-am install uninstall-am uninstall all-redirect all-am all \ +installdirs mostlyclean-generic distclean-generic clean-generic \ +maintainer-clean-generic clean mostlyclean distclean maintainer-clean + + +# version.texi is handled by autoconf/automake +cgen.info: $(DOCFILES) version.texi +cgen.dvi: $(DOCFILES) version.texi + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/cgen/doc/app.texi b/cgen/doc/app.texi new file mode 100644 index 00000000000..27142e32504 --- /dev/null +++ b/cgen/doc/app.texi @@ -0,0 +1,430 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Writing an application +@chapter Writing an application +@cindex Writing an application + +This chapter contains information for those wishing to write their own +CGEN application. + +@menu +* File Layout:: Organization of source files +* File Generation Process:: Workflow in cgen +* Coding Conventions:: Coding conventions +* Accessing Loaded Data:: Reading data from loaded .cpu files +* Name References:: Architecture names in generated code +* String Building:: Building long strings and writing them out +* COS:: Cgen's Object System +@end menu + +@node File Layout +@section File Layout + +Source files in cgen are organized in a very specific way.@footnote{As the +number of source files grows the entire layout may be changed, but until then +this is how things are.} It makes it easy to find things. + +@itemize @bullet +@item top level file is cgen-<app>.scm +The best way to create this file is to copy an existing application's file +(e.g. cgen-opc.scm) and modify to suit. +@item file <app>.scm contains general app-specific utilities +@item other files are <app>-foo.scm +@item add entry to dev.scm (load-<app>) +@end itemize + +@node File Generation Process +@section File Generation Process + +This is an overview of cgen workflow. + +@itemize @bullet + +@item cgen is started with list of files to generate and code generation +options + +@item source code is loaded + +@itemize @minus +@item application independent code is loaded if not compiled in +@item application specific code is loaded + +Currently app-specific code is never compiled in. +@itemize @minus +@item doesn't affect speed as much as application independent stuff +@item subject to more frequent changes +@item makes it easier to do application development if changes to .scm +files are "ready to use" +@end itemize +@end itemize + +@item ultimately procedure `cpu-load' is called which is the main driver for +loading .cpu files + +@item various data structures are initialized + +@item data files are loaded + +@itemize @minus +@item main <arch>.cpu file is loaded + +There is a #include-like mechanism for loading other files so big +architectures can be broken up into several files. + +While the architecture description is being loaded, entries not requested +are discarded. This happens, for example, when building a simulator: +there's no point in keeping instructions specific to a machine that is +not being generated. What to keep is based on the MACH and ISA attributes. + +@item application specific data files are loaded + +e.g. <arch>.sim +@end itemize + +@item builtin elements are created + +@item each requested file is generated by calling cgen-<file> generator + +The output is written to the output file with @code{with-output-to-file} so +the code must write to @code{(current-output-port)}. + +Some files require heavy duty processing of the cpu description. +For example the simulator computes the instruction formats from the +instruction field lists of each instruction. This computation is defered +to each cgen-<file> procedure that needs it and must be explicitly requested +by them. The results are cached so this is only done once of course. + +@item additional processing for some opcodes files + +Several opcodes files are built from three sources. + +@itemize @minus +@item generated code + +@item section in <arch>.opc file + +It's not appropriate to put large amounts of C (or perhaps any C) in +cgen description files, yet some things are best expressed in some +other language (e.g. assembler/disassembler operand parsing/printing). + +@item foo.in file + +It seems cleaner to put large amounts of non-machine-generated C +in separate files from code generator. +@end itemize + +@end itemize + +@node Coding Conventions +@section Coding Conventions + +@itemize @bullet +@item unless definition occupies one line, final trailing parenthesis is on +a line by itself beginning in column one +@item definitions internal to a source file begin with '-' +@item global state variables are named *foo-bar* +[FIXME: current code needs updating] +@item avoid uppercase (except for ???) +@item procedures that return a boolean result end in '?' +@item procedures that modify something end in '!' +@item classes are named <name> +@end itemize + +@node Accessing Loaded Data +@section Accessing Loaded Data + +Each kind of description file entry (defined with `define-foo') is recorded +in an object of class <foo>.@footnote{not true for <arch> but will be RSN} +All the data is collected together in an object of class +<system>.@footnote{got a better name?} +@footnote{modes aren't recorded here, should they be?} + +Data for the currently selected architecture is obtained with several +access functions. + +@smallexample + (current-arch-name) + - return symbol that is the name of the arch + - this is the name specified with `define-arch' + + (current-arch-comment) + - return the comment specified with `define-arch' + + (current-arch-atlist) + - return the attributes specified with `define-arch' + + (current-arch-default-alignment) + - return a symbol indicated the default aligment + - one of aligned, unaligned, forced + + (current-arch-insn-lsb0?) + - return a #t if the least significant bit in a word is numbered 0 + - return a #f if the most significant bit in a word is numbered 0 + + (current-arch-mach-name-list) + - return a list of names (as symbols) of all machs in the architecture + + (current-arch-isa-name-list) + - return a list of names (as symbols) of all isas in the architecture + + - for most of the remaining elements, there are three main accessors + [foo is sometimes abbreviated] + - current-foo-list - returns list of <foo> objects in the architecture + - current-foo-add! - add a <foo> object to the architecture + - current-foo-lookup - lookup the <foo> object based on its name + + <atlist> + (current-attr-list) + (current-attr-add!) + (current-attr-lookup) + + <enum> + (current-enum-list) + (current-enum-add!) + (current-enum-lookup) + + <keyword> + (current-kw-list) + (current-kw-add!) + (current-kw-lookup) + + <isa> + (current-isa-list) + (current-isa-add!) + (current-isa-lookup) + + <cpu> + (current-cpu-list) + (current-cpu-add!) + (current-cpu-lookup) + + <mach> + (current-mach-list) + (current-mach-add!) + (current-mach-lookup) + + <model> + (current-model-list) + (current-model-add!) + (current-model-lookup) + + <hardware> + (current-hw-list) + (current-hw-add!) + (current-hw-lookup) + + <ifield> + (current-ifld-list) + (current-ifld-add!) + (current-ifld-lookup) + + <operand> + (current-op-list) + (current-op-add!) + (current-op-lookup) + + <insn> + (current-insn-list) + (current-insn-add!) + (current-insn-lookup) + + <macro-insn> + (current-minsn-list) + (current-minsn-add!) + (current-minsn-lookup) + + (current-ifmt-list) + - return list of computed <iformat> objects + + (current-sfmt-list) + - return list of computed <sformat> objects + + [there are a few more to be documented, not sure they'll remain as is] +@end smallexample + +@node Name References +@section Name References + +To simplify writing code generators, system names can be +specified with fixed strings rather than having to compute them. +The output is post-processed to convert the strings to the actual names. +Upper and lower case names are supported. + +@itemize @bullet +@item For the architecture name use @@arch@@, @@ARCH@@. +@item For the cpu family name use @@cpu@@, @@CPU@@. +@item For the prefix use @@prefix@@, @@PREFIX@@. +@end itemize + +The @samp{prefix} notion is to segregate different code for the same +cpu family. For example, this is used to segregate the ARM ISA from the +Thumb ISA. + +@node String Building +@section String Building + +Output generation uses a combination of writing text out as it is computed +and building text for later writing out. + +The top level file generator uses @code{string-write}. It takes string-lists +and thunks as arguments and writes each argument in turn to stdout. +String-lists are lists of strings (nested arbitrarily deep). It's cheaper +to @code{cons} long strings together than to use @code{string-append}. +Thunks return string-lists to write out, but isn't computed until all +preceeding arguments to `string-write' have been written out. This allows +defering building up of large amounts of text until it needs to be. + +The main procedures for building strings and writing them out are: + +@itemize @bullet + +@item (string-write string-list-or-thunk1 string-list-or-thunk2 ...) + +Loops over arguments writing them out in turn. + +@item (string-write-map proc string-list-or-thunk-list) + +Apply proc to each element in string-list-or-thunk-list and write out +the result. + +@item (string-list arg1 arg2 ...) + +Return list of arguments. This is identical to @code{list} except it +is intended to take string-lists as arguments. + +@item (string-list-map proc arg-list) + +Return list of @code{proc} applied to each element of @code{arg-list}. +This is identical to @code{map} except it is intended to take strings +as arguments. + +@item (string-append string1 string2 ...) + +For small arguments it's just as well to use @code{string-append}. +This is a standard Scheme procedure. The output is also easier to read +when developing interactively. And some subroutines are used in multiple +contexts including some where strings are required. + +@end itemize + +@node COS +@section COS + +COS is Cgen's Object System. It's a simple OO system for Guile that +was written to provide something useful until Guile had its own. +COS will be replaced with GOOPs if the Scheme implementation of cgen is kept. + +The pure Scheme implementation of COS uses vectors to record objects and +classes. The C implementation uses smobs (though classes are still +implemented with vectors). + +A complete list of user-visible functions is at the top of @file{cos.scm}. + +Here is a list of the frequently used ones. + +@itemize @bullet + +@item (class-make name parent-name-list element-list method-list) + +Use @code{class-make} to define a class. + +@smallexample +name: symbol, <name-of-class> +parent-name-list: list of symbols, names of each parent class +element-list: list of either symbols or (symbol . initial-value) +method-list: list of (symbol . lambda) +@end smallexample + +The result is the class's definition. It is usually assigned to a global +variable with same name as class's name. Current cgen code always does +this. It's not a requirement but it is convention. + +@item (new <class-name>) + +Create a new object with @code{new}. +@code{<class-name>} is typically the global variable that recorded +the results of @code{class-make}. The result is a new object of the +requested class. Class elements have either an "undefined" value +or an initial value if one was specified when the class was defined. + +@item (define-getters class-name prefix element-list) + +Elements (aka members) are read/written with "accessors". +Read accessors are defined with @code{define-getters}, which +creates one procedure for each element, each defined as +@code{(prefix-element-name object)}. + +This is a macro so don't quote anything. + +@item (define-setters class-name prefix element-list) + +Write accessors are defined with @code{define-setters}, which +creates one procedure for each element, each defined as +@code{(prefix-set-element-name! object new-value)}. + +This is a macro so don't quote anything. + +@item (elm-get object elm-name) + +This can only be used in method definitions (blech, blah blah blah). + +@item (elm-set! object elm-name new-value) + +This can only be used in method definitions (blech, blah blah blah). + +@item (send object method-name arg1 arg2) + +Invoke method @code{method-name} on @code{object}. + +The convention is to put this in a cover fn: +@code{(class-name-method-name object arg1 arg2)}. + +@item (send-next object method-name arg1 arg2) + +Same as @code{send} except only usable in methods and is used to invoke +the method in the parent class. + +@item (make object . args) + +One standard way to create a new object is with @code{make}. +It is a wrapper, defined as + +@smallexample +(define (make object . args) + (apply send (cons (new object) (cons 'make! args))) +) +@end smallexample + +@item (vmake class . args) + +The other standard way to create objects is with @code{vmake}. + +@code{args} is a list of option names and arguments. + +??? Not completely implemented yet. + +@item (method-make! class method-name lambda) + +The normal way of creating methods is to use @code{method-make!}, not define +them with the class. It's just easier to define them separately. + +@item (method-make-virtual! class method-name lambda) + +Create virtual methods created with @code{method-make-virtual!}. + +@item (method-make-forward! class elm-name methods) -> unspecified + +Forwarding a method invocation on one object to another is extremely +useful so some utilities have been created to simplify creating forwarding +methods. + +@code{methods} is a list of method names. A method is created for each one +that forwards the method onto the object contained in element ELM-NAME. + +@item (method-make-virtual-forward!) + +Same as method-make-forward! except that it creates virtual methods. + +@end itemize diff --git a/cgen/doc/cgen.texi b/cgen/doc/cgen.texi new file mode 100644 index 00000000000..5b6b54d198c --- /dev/null +++ b/cgen/doc/cgen.texi @@ -0,0 +1,118 @@ +\input texinfo @c -*- Texinfo -*- +@setfilename cgen.info + +@include version.texi + +@ifinfo +@format +START-INFO-DIR-ENTRY +* Cgen: (cgen). The Cpu tools GENerator. +END-INFO-DIR-ENTRY +@end format +@end ifinfo + +@ifinfo +Copyright @copyright{} 2000 Red Hat, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@ignore +Permission is granted to process this file through TeX and print the +results, provided the printed document carries a copying permission +notice identical to this one except for the removal of this paragraph +(this paragraph not being relevant to the printed manual). + +@end ignore + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided also that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. +@end ifinfo + +@synindex ky cp +@c +@c This file documents the Cpu tools GENerator, CGEN. +@c +@c Copyright (C) 2000 Red Hat, Inc. +@c + +@setchapternewpage odd +@settitle CGEN +@titlepage +@finalout +@title The Cpu tools GENerator, CGEN. +@subtitle Version @value{VERSION} +@sp 1 +@subtitle @value{UPDATED} +@author Douglas J. Evans +@author Red Hat, Inc. +@page + +@tex +{\parskip=0pt \hfill Red Hat\par \hfill +\TeX{}info \texinfoversion\par } +@end tex + +@vskip 0pt plus 1filll +Copyright @copyright{} 2000 Red Hat, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided also that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. +@end titlepage + +@node Top +@top Introduction + +@cindex version +This brief manual contains preliminary documentation for the CGEN program, +version @value{VERSION}. + +@menu +* Introduction:: Introduction +* Running CGEN:: How to run CGEN +* RTL:: The Register Transfer Language CGEN uses +* Preprocessor macros:: Macros to simplify description file writing +* Porting:: Porting +* Opcodes:: Assembler/disassembler support +* Simulation:: Simulation support +* Writing an application:: Writing your own CGEN application +* Glossary:: Glossary +* Miscellaneous notes:: Notes needing a better home +* Credits:: Credits +* Index:: Index +@end menu + +@include intro.texi +@include running.texi +@include rtl.texi +@include pmacros.texi +@include porting.texi +@include opcodes.texi +@include sim.texi +@include app.texi +@include glossary.texi +@include notes.texi +@include credits.texi + +@node Index +@unnumbered Index + +@printindex cp + +@contents +@bye diff --git a/cgen/doc/credits.texi b/cgen/doc/credits.texi new file mode 100644 index 00000000000..91d6e31d29b --- /dev/null +++ b/cgen/doc/credits.texi @@ -0,0 +1,27 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Credits +@chapter Credits + +The following people, listed in alphabetical order, have helped in their own +way. Thanks! + +@itemize @minus +@item Dave Brolley +@item Andrew Cagney +@item Steve Chamberlain +@item Nick Clifton +@item Bob Cmelik +@item Frank Ch. Eigler +@item Ben Elliston +@item Kim Knuttila +@item Ken Raeburn +@item Jim Wilson +@end itemize + +There's a TV program I watched growing up called ``The Hilarious House +Of Frightenstein''. The credits at the end had a twist in that Billy +Van, who played most of the characters, appeared in them again and +again. I would do the same here for Ian Lance Taylor. diff --git a/cgen/doc/glossary.texi b/cgen/doc/glossary.texi new file mode 100644 index 00000000000..932efec1eed --- /dev/null +++ b/cgen/doc/glossary.texi @@ -0,0 +1,29 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Glossary +@chapter Glossary + +@table @asis +@item arch +This is the overall architecture. It is the same as BFD's use of +@emph{arch}. + +@item isa +Acronym for Instruction Set Architecture. + +@item mach +This is a variant of the architecture, short for machine. It is +essentially the same as BFD's use of @emph{mach}. + +@item CPU family +A group of related mach's. Simulator support is organized along ``CPU +family'' lines to keep related mach's together under one roof to +simplify things. The organization is semi-arbitrary and is up to the +programmer. + +@item model +An implementation of a mach. It is essentially akin to the argument +to @code{-mtune=} in SPARC GCC (and other GCC ports). +@end table diff --git a/cgen/doc/internals.texi b/cgen/doc/internals.texi new file mode 100644 index 00000000000..381c41da44a --- /dev/null +++ b/cgen/doc/internals.texi @@ -0,0 +1,377 @@ +\input texinfo @c -*- Texinfo -*- + +@c This file is work in progress. +@c Don't expect it to go through texinfo just yet. --bje + +@include version.texi + +@ifinfo +Copyright @copyright{} 2000 Red Hat, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@ignore +Permission is granted to process this file through TeX and print the +results, provided the printed document carries a copying permission +notice identical to this one except for the removal of this paragraph +(this paragraph not being relevant to the printed manual). + +@end ignore + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided also that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. +@end ifinfo + +@synindex ky cp +@c +@c This file documents the internals of the Cpu tools GENerator, CGEN. +@c +@c Copyright (C) 2000 Red Hat, Inc. +@c + +@setchapternewpage odd +@settitle CGEN +@titlepage +@finalout +@title The Cpu tools GENerator, CGEN. +@subtitle Version @value{VERSION} +@sp 1 +@subtitle @value{UPDATED} +@author Ben Elliston +@author Red Hat, Inc. +@page + +@tex +{\parskip=0pt \hfill Red Hat, Inc.\par \hfill +\TeX{}info \texinfoversion\par } +@end tex + +@vskip 0pt plus 1filll +Copyright @copyright{} 2000 Red Hat, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided also that +the entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. +@end titlepage + +@node Top +@top Introduction + +@cindex version +This manual documents the internals of CGEN, version @value{VERSION}. + +@menu +* Introduction:: Introduction +* Guile:: +* Conventions:: Coding conventions +* Applications:: +* Source file overview:: +* Option processing:: +* Parsing:: +* Version numbering:: +* Glossary:: Glossary +* Index:: Index +@end menu + +@node Introduction +@chapter Introduction + +This document details the implementation and internals of CGEN, the +``Cpu tools GENerator''. It focuses on theory of operation and concepts +rather than extensive details of the implementation--these details +date too quickly. + +@node Conventions +@chapter Conventions + +There are a number of conventions used in the cgen source code. If you +take the time to absorb these now, the code will be much easier to +understand. + +@itemize @bullet +@item Procedures and variables local to a file are named @code{-foo}. +@item Only routines that emit application code begin with @code{gen-}. +@item Symbols beginning with @code{c-} are either variables containing C code + or procedures that generate C code, similarily for C++ and @code{c++-}. +@item Variables containing C code begin with @code{c-}. +@item Only routines that emit an entire file begin with @code{cgen-}. +@item All @file{.cpu} file elements shall have @code{-foo-parse} and + @code{-foo-read} procedures. +@item Global variables containing class definitions shall be named + @code{<class-name>}. +@item Procedures related to a particular class shall be named + @code{class-name-proc-name}, where @code{class-name} may be abbreviated. +@item Procedures that test whether something is an object of a + particular class shall be named @code{class-name?}. +@item In keeping with Scheme conventions, predicates shall have a + @code{?} suffix. +@item In keeping with Scheme conventions, methods and procedures that + modify an argument or have other side effects shall have a + @code{!} suffix, usually these procs return @code{*UNSPECIFIED*}. +@item All @code{-foo-parse}, @code{parse-foo} procs shall have @code{context} + as the first argument. [FIXME: not all such procs have been + converted] +@end itemize + +@node Applications +@chapter Applications + +One of the most importance concepts to grasp with CGEN is that it is not +a simulator generator. It's a generic tool generator--it can be used to +generate a simulator, an assembler, a disassembler and so on. These +``applications'' can then produce different outputs from the same CPU +description. + +When you want to run the cgen framework, an application-specific source +file is loaded into the Guile interpreter to get cgen running. This +source file loads in any other source files it needs and then, for +example, calls: + +@example + (cgen #:argv argv + #:app-name "sim" + #:arg-spec sim-arguments + #:init sim-init! + #:finish sim-finish! + #:analyze sim-analyze!) + ) +@end example + +This gets the whole framework started, in an application-specific way. + +node Source file overview +@chapter Source file overview + +@table @file + +@item *.cpu, *.opc, *.sim +Files belonging to each CPU description. .sim files are automatically +included if they are defined for the given architecture. + +@item doc/*.texi +Texinfo documentation for cgen. + +@item slib/*.scm +Third-party libraries written in Scheme. For example, sort.scm is a +collection of procedures to sort lists. + +@item Makefile.am +automake Makefile for cgen. + +@item NEWS +News about cgen. + +@item README +Notes to read abot cgen. + +@item attr.scm +Handling of cgen attributes. + +@item cgen-gas.scm +Top-level for GAS testsuite generation. + +@item cgen-opc.scm +Top-level for opcodes generation. + +@item cgen-sid.scm +Top-level for SID simulator generation. + +@item cgen-sim.scm +Top-level for older simulator generation. + +@item cgen-stest.scm +Top-level for simulator testsuite generation. + +@item configure.in +Template for `configure'--process with autoconf. + +@item cos.scm +cgen object system. Adds object oriented features to the Scheme +language. See the top of @file{cos.scm} for the user-visible +procedures. + +@item decode.scm +Generic decoder routines. + +@item desc-cpu.scm +??? + +@item desc.scm +??? + +@item dev.scm +Debugging support. + +@item enum.scm +Enumerations. + +@item fixup.scm +Some procedure definitions to patch up possible differences between +older and newer versions of Guile: + + * define a (load..) procedure that uses + primitive-load-path if load-from-path is not known. + + * define =? and >=? if they aren't already known. + + * define %stat, reverse! and debug-enable in terms of + older equivalent procedures, if they aren't already + known. + +@item gas-test.scm +GAS testsuite generator. + +@item hardware.scm +Hardware description routines. + +@item ifield.scm +Instruction fields. + +@item insn.scm +Instruction defintions. + +@item mach.scm +Architecture description routines. + +@item minsn.scm +Macro instructions. + +@item mode.scm +Modes. + +@item model.scm +Model specification. + +@item opc-asmdis.scm +For the opcodes applications. + +@item opc-ibld.scm +Ditto. + +@item opc-itab.scm +Ditto. + +@item opc-opinst.scm +Ditto. + +@item opcodes.scm +Ditto. + +@item operand.scm +Operands. + +@item pgmr-tools.scm +Programmer tools--debugging tools, mainly. + +@item pmacros.scm +Preprocessor macros. + +@item profile.scm +Unused? + +@item read.scm +Read and parse .cpu files. @code{maybe_load} is used to load in files +for required symbols if they are not already present in the environment +(say, because it was compiled). + +@item rtl-c.scm +RTL to C translation. + +@item rtl.scm +RTL support. + +@item rtx-funcs.scm +RTXs. + +@item sem-frags.scm +Semantic fragments. + +@item semantics.scm +Semantic analysis for the CPU descriptions. + +@item sid-cpu.scm +For the SID application. + +@item sid-decode.scm +Ditto. + +@item sid-model.scm +Ditto. + +@item sid.scm +Ditto. + +@item sim-arch.scm +For the simulator application. + +@item sim-cpu.scm +Ditto. + +@item sim-decode.scm +Ditto. + +@item sim-model.scm +Ditto. + +@item sim-test.scm +For the simulator testsuite application. + +@item sim.scm +For the simulator application. + +@item simplify.inc +Preprocessor macros to simplify CPU description files. This file is not +loaded by the Scheme interpreter, but is instead included by the .cpu +file. + +@item types.scm +Low-level types. + +@item utils-cgen.scm +cgen-specific utilities. + +@item utils-gen.scm +Code generation specific utilities. + +@item utils-sim.scm +Simulator specific utilities. + +@item utils.scm +Miscellaneous utilities. + +@end table + +@code{cgen} is the main entry point called by application file +generators. It just calls @code{-cgen}, but it does so wrapped inside a +@code{catch-with-backtrace} procedure to make debugging easier. + +@node Version numbering +@chapter Version numbering + +There are two version numbers: the version number of cgen itself and a +version number for the description language it accepts. These are kept +in the symbols @code{-CGEN-VERSION} and @code{-CGEN-LANG-VERSION} in +@file{read.scm}. + +@node Index +@unnumbered Index + +@printindex cp + +@contents +@bye diff --git a/cgen/doc/intro.texi b/cgen/doc/intro.texi new file mode 100644 index 00000000000..76b6851f522 --- /dev/null +++ b/cgen/doc/intro.texi @@ -0,0 +1,759 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Introduction +@comment node-name, next, previous, up +@chapter Introduction to CGEN + +@menu +* Overview:: +* CPU description language:: +* Opcodes support:: +* Simulator support:: +* Testing support:: +* Implementation language:: +@end menu + +@node Overview +@section Overview + +CGEN is a project to provide a framework and toolkit for writing cpu tools. + +@menu +* Goal:: What CGEN tries to achieve. +* Why do it?:: +* Maybe it should not be done?:: +* How ambitious is CGEN?:: +* What is missing that should be there soon?:: +@end menu + +@node Goal +@subsection Goal + +The goal of CGEN (pronounced @emph{seejen}, and short for +"Cpu tools GENerator") is to provide a uniform framework and toolkit +for writing programs like assemblers, disassemblers, and +simulators without explicitly closing any doors on future things one +might wish to do. In the end, its scope is the things the software developer +cares about when writing software for the cpu (compilation, assembly, +linking, simulation, profiling, debugging, ???). + +Achieving the goal is centered around having an application independent +description of a CPU (plus environment, like ABI) that applications can then +make use of. In the end that's a lot to ask for from one language. What +applications can or should be able to use CGEN is left to evolve over time. +The description language itself is thus also left to evolve over time! + +Achieving the goal also involves having a toolkit, libcgen, that contains +a compiled form of the cpu description plus a suite of routines for working +with the data. + +CGEN is not a new idea. Some GNU ports have done something like this -- +for example, the SH port in its early days. However, the idea never really +``caught on''. CGEN was started because I think it should. + +Since CGEN is a very ambitious project, there are currently lots of +things that aren't written down, let alone implemented. It will take +some time to flush all the details out, but in and of itself that doesn't +necessarily mean they can't be flushed out, or that they haven't been +considered. + +@node Why do it? +@subsection Why do it? + +I think it is important that GNU assembler/disassembler/simulator ports +be done from a common framework. On some level it's fun doing things +from scratch, which was and still is to a large extent current +practice, but this is not the place for that. + +@itemize @bullet +@item the more ports of something one has, the more important it is that they +be the same. + +@item the more complex each of them become, the more important it is +that they be the same. + +@item if they all are the same, a feature added to one is added to all +of them--within the context of their similarity, of course. + +@item with a common framework in place the planning of how to architect +a port is taken care of, the main part of what's left is simply writing +the CPU description. + +@item the more applications that use the common framework, the fewer +places the data needs to be typed in and maintained. + +@item new applications can take advantage of data and utilities that +already exist. + +@item a common framework provides a better launching point for bigger things. +@end itemize + +@node Maybe it should not be done? +@subsection Maybe it should not be done? + +However, no one has yet succeeded in pushing for such an extensive common +framework.@footnote{I'm just trying to solicit input here. Maybe these +questions will help get that input.} + +@itemize @bullet +@item maybe people think it's not worth it? + +@item maybe they just haven't had the inclination to see it through? +(where ``inclination'' includes everything from the time it would take +to the dealing with the various parties whose turf you would tread on) + +@item maybe in the case of assemblers and simulators they're not complex +enough to see much benefit? + +@item maybe the resulting tight coupling among the various applications +will cause problems that offset any gains? + +@item maybe there's too much variance to try to achieve a common +framework, so that all attempts are doomed to become overly complex? + +@item as a corollary of the previous item, maybe in the end trying to +combine ISA syntax (the assembly language), with ISA semantics (simulation), +with architecture implementation (performance), would become overly complex? +@end itemize + +@node How ambitious is CGEN? +@subsection How ambitious is CGEN? + +CGEN is a very ambitious project, as future projects can be: + +@menu +* More complicated simulators:: +* Profiling tools:: +* Program analysis tools:: +* ABI description:: +* Machine generated architecture reference material:: +* Tools like what NJMCT provides:: +* Input to a compiler's backend:: +* Hardware/software codesign:: +@end menu + +@node More complicated simulators +@subsubsection More complicated simulators + +Current CGEN-based simulators achieve their speed by using GCC's +"computed goto" facility to implement a threaded interpreter. +The "main loop" of the cpu engine is contained within one function +and the administrivia of running the program is reduced to about three +host instructions per target instruction (one to increment a "virtual pc", +one to fetch the address of code that implements that next target instruction, +and one to branch to it). Target instructions can be simulated with as few as +seven@footnote{Actually, this can be reduced even more by creating copies of +an instruction specialized for all the various inputs.} instructions for an +"add" (load address of src1, load src1, load address of src2, load src2, add, +load address of result, store result). So ignoring overhead (which +is minimal for frequently executed code) that's ten host instructions per +"typical" target instruction. Pretty good.@footnote{The actual results +depend, of course, on the exact mix of target instructions in the application, +what instructions the host cpu has, and how efficiently the rest of the +simulator is (e.g. floating point and memory operations can require a hundred +or more host instructions).} + +However, things can still be better. There is still some implementation +related overhead that can be removed. The two instructions to branch +to the next instruction would be unnecessary if instruction executors +were concatenated together. The fetching and storing of target registers +can be reduced if target registers were kept in host registers across +instruction boundaries (and the longer one can keep them in host registers +the better). A consequence of both of these improvements is the number +of memory operations is drastically reduced. There isn't a lot of ILP +in the simulation of target instructions to hide memory latencies. +Another consequence of these improvements is the opportunity to perform +inter-target-instruction scheduling of the host instructions and other +optimizations. + +There are two ways to achieve these improvements. Both involve converting +basic blocks (or superblocks) in the target application into the host +instruction set and compiling that. The first way involves doing this +"offline". The target program is analyzed and each instruction is converted +into, for example, C code that implements the instruction. The result is +compiled and then the new version of the target program is run. + +The second way is to do the translation from target instruction set to +host instruction set while the target program is running. This is often +refered to as JIT (Just In Time) simulation (FIXME: proper phrasing here?). +One way to implement this is to simulate instructions the way existing +CGEN simulators do, but keep track of how frequently a basic block is +executed. If a block gets executed often enough, then compile a translation +of it to the host instruction set and switch to using that. This avoids +the overhead of doing the compilation on code that is rarely executed. +Note that here is one place where a dual cpu system can be put to good use. +One cpu handles the simulation and the other handles compilation (translating +target instructions to host instructions). +CGEN can@footnote{This hasn't actually been implemented so there is +some hand waving here.} handle a large part of building the JIT compiler +because both host and target architectures are recorded in a way that is +amenable to program manipulation. + +A hybrid of these two ways is to translate target basic blocks to +C code, compile it, and dynamically load the result into the running +simulation. Problems with this are that one must invoke an external program +(though one could dynamically load a special form of C compiler I suppose) +and there's a lot of overhead parsing and optimizing the C code. On the +other hand one gets to take full advantage of the compiler's optimization +technology. And if the application takes a long time to simulate, the +extra cost may be worthwhile. A dual cpu system is of benefit here too. + +@node Profiling tools +@subsubsection Profiling tools + +It is useful to know how well an architecture is being utilized. +For one, this helps build better architectures. It also helps determine +how well a compilation system is using an architecture. + +CGEN-based simulators already compute instruction frequency counts. +It's straightforward to add register frequency counts. +Monitoring other aspects of the ISA is also possible. The description +file provides all the necessary data, all that's needed is to write a +generator for an application that then performs the desired analysis. + +Function unit, pipeline, and other architecture implementation related items +requires a lot more effort but it is doable. The guideline for this effort +is again coming up with an application-independent specification of these +things. + +CGEN does not currently support memory or cache profiling. +Obviously they're important, and support may be added in the future. +One thing that would be straightforward to add is the building of +trace data for usage by cache and memory analysis tools. +The point though is that these tools won't benefit much from CGEN's +existence. + +Another kind of profiling tool is one that takes the program to +be profiled as input, inserts profiling code into it, and then generates +a new version of the program which is then run.@footnote{Note that there +are other uses for such a program modification tool besides profiling.} +Recorded in CGEN's description files should be all the necessary ISA related +data to do this. One thing that's missing is code to handle the file format +and relocations.@xref{ABI description}. + +@node Program analysis tools +@subsubsection Program analysis tools + +Related to profiling tools are static program analysis tools. +By this I mean taking machine code as input and analyzing it in some way. +Except for symbolic information (which could come from BFD or elsewhere), +CGEN provides enough information to analyze machine code, both the +the raw instructions *and* their semantics. Libcgen should contain +all the basic tools for doing this. + +@node ABI description +@subsubsection ABI description + +Several tools need knowledge of not only a cpu's ISA but also of the ABI +in use. I believe it makes sense to apply the same goals that went into +CGEN's architecture description language to an ABI description language: +specify the ABI in an application independent way and then have a basic +toolkit/library that uses that data and allow the writing of program +generators for applications that want more than what the toolkit/library +provides. + +Part of what an ABI defines is the file format and relocations. +This is something that BFD is built for. I think a BFD rewrite +should happen and should be based, at least in part, on a CGEN-style +ABI description. This rewrite would be one user of the ABI description, +but certainly not the only user. +One problem with this approach is that BFD requires a lot of file format +specific C code. I doubt all of this code is amenable to being described +in an application independent way. Careful separation of such things +will be necessary. It may even be useful to ignore old file formats +and limit such a BFD rewrite to ELF (not that ELF is free from such +warts, of course). + +@node Machine generated architecture reference material +@subsubsection Machine generated architecture reference material + +Engineers often need to refer to architecture documentation. +One problem is that there's often only so many hardcopy manuals +to go around. Since the CPU description contains a lot of the information +engineers need to find it makes sense to convert that information back +into a readable form. The manual can then be online available to everyone. +Furthermore, each architecture will be documented using the same style +making it easier to move from architecture to architecture. + +@node Tools like what NJMCT provides +@subsubsection Tools like what NJMCT provides + +NJMCT is the New Jersey Machine Code Toolkit. +It focuses exclusively on the encoding and decoding of instructions. +[FIXME: wip, need to say more]. + +@node Input to a compiler's backend +@subsubsection Input to a compiler's backend + +One can define a GCC port to include these four things: + +@itemize @bullet +@item cpu architecture description +@item cpu implementation description +@item ABI description +@item miscellaneous +@end itemize + +The CGEN description provides all of the cpu architecture description +that the compiler needs. +However, the current design of the CPU description language is geared +towards going from machine instructions to semantic content, whereas +what a compiler wants is to do is go from semantic content to machine +instructions, so in the end this might not be a reasonable thing to +pursue. On the other hand, that problem can be solved in part by +specifying two sets of semantics for each instruction: one for the +compiler side of things, and one for the simulator side of things. +Frequently they will be the same thing and thus need only be specified once. +Though specifying them twice, for the two different contexts, is reasonable +I think. If the two versions of the semantics are used by multiple applications +this makes even more sense. + +The planned rewrite of model support in CGEN will support whatever the +compiler needs for the implementation description. + +Compiler's also need to know the target's ABI, which isn't relevant +for an architecture description. On the other hand, more than just +the compiler needs knowledge of the ABI. Thus it makes sense to think +about how many tools there are that need this knowledge and whether one +can come up with a unifying description of the ABI. Hence one future +project is to add the ABI description to CGEN. This would encompass +in essence most of what is contained in the System V ABI documentation. + +That leaves the "miscellaneous" part. Essentially this is a catchall +for whatever else is needed. This would include things like +include file directory locations, ???. There's probably no need to +add these to the CGEN description language. + +One can even envision a day when GCC emits object files directly. +The instruction description contains enough information to build +the instructions and the ABI support would provide enough +information on relocations and object file formats. +Debugging information should be treated as an orthogonal concept. +At present it is outside the scope of CGEN, though clearly the same +reasoning behind CGEN applies to debugging support as well. + +@node Hardware/software codesign +@subsubsection Hardware/software codesign + +This section isn't very well thought out -- not much time has been put +into it. The thought is that some interface with VHDL/Verilog could +be created that would assist hw/sw codesign. + +Another related application is to have a feedback mechanism from the +compilation system that helps improve the architecture description +(both CGEN and HDL). +For example, the compiler could determine what instructions would have +made a significant benefit for a particular application. CGEN descriptions +for these instructions could be generated, resulting in a new set of +compilation tools from which the hypothesis of adding the new instructions +could then be validated. Note that adding these new instructions only +required writing CGEN descriptions of them (setting aside HDL concerns). +Once done, all relevant tools would be automagically updated to support +the new instructions. + +@node What is missing that should be there soon? +@subsection What's missing that should be there soon? + +@itemize @bullet +@item Support for complex ISA's (i386, m68k). + +Early versions had the framework of the support, but it's all bit-rotten. + +@item ABI description + +As discussed elsewhere, one thing that many tools need knowledge of besides +the ISA is the ABI. Clearly ABI's are orthogonal to ISA's and one cpu +may have multiple ABI's running on it. Thus the ABI description needs to +be independent of the architecture description. It would still be useful +for the ABI to refer to things in the architecture description. + +@item Model description + +The current design is enough to get reasonable cycle counts from +the simulator but it doesn't take into account all the uses one would +want to make of this data. + +@item File organization + +I believe a lot of what is in libopcodes should be moved to libcgen. +Libcgen will contain the bulk of the cpu description in processed form. +It will also contain a suite of utilities for accessing the data. + +ABI support could either live in libcgen or separately in libcgenabi. +libbfd would be a user of this library. + +Instruction semantics should also be recorded in libcgen, probably +in bytecode form. Operand usage tables, needed for example by the +m32r assembler, can be lazily computed at runtime. + +Applications can either make use of libcgen or given the application +independence of the description language they can write their won code +generators to tailor the output as needed. + +@end itemize + +@node CPU description language +@section CPU description language + +The goal of CGEN is to provide a uniform and extensible framework for +doing assemblers/disassemblers and simulators, as well as allowing +further tools to be developed as necessary. + +With that in mind I think the place to start is in defining a CPU +description language that is sufficiently powerful for all the current +and perceived future needs: an application independent description of +the CPU. From the CPU description, tables and code can be generated +that an application framework can then use (e.g. opcode table for +assembly/disassembly, decoder/executor for simulation). + +By "application independence" I mean the data is recorded in a way that +doesn't intentionally close any doors on uses of the data. One example of +this is using RTL to describe instruction semantics rather than, say, C. +The assembler can also make use of the instruction semantics. It doesn't +make use of the semantics, per se, but what it does use is the input and +output operand information that is machine generated from the semantics. +Groking operand usage from C is possible I guess, but a lot harder. +So by writing the semantics in RTL multiple applications can make use if it. +One can also generate from the RTL code in languages other than C. + +@menu +* Language requirements:: +* Layout:: +* Language problems:: +@end menu + +@node Language requirements +@subsection Language requirements + +The CPU description file needs to provide at least the following: + +@itemize @bullet +@item elements of the CPU's architecture (registers, etc.) +@item elements of a CPU's implementation (e.g. pipeline) +@item how the bits of an instruction word map to the instruction's semantics +@item semantic specification in a way that is amenable to being +understood and manipulated +@item performance measurement parameters +@item support for multiple ISA variants +@item assembler syntax of the instruction set +@item how that syntax maps to the bits of the instruction word, and back +@item support for generating test files +@item ??? +@end itemize + +In addition to this, elements of the particular ABI in use is also needed. +These things will obviously need to be defined separately from the cpu +for obvious reasons. + +@itemize @bullet +@item file format +@item relocations +@item function calling conventions +@item ??? +@end itemize + +Some architectures require knowledge of the pipeline in order to do +accurate simulation (because, for example, some registers don't have +interlocks) so that will be required as well, as opposed to being solely +for performance measurement. Pipeline knowledge is also needed in order +to achieve accurate profiling information. However, I haven't spent +much time on this yet. The current design/implementation is a first +pass in order to get something working, and will be revisited. + +Support for generating test files is not complete. Currently the GAS +test suite generator gets by (barely) without them. The simulator test +suite generator just generates templates and leaves the programmer to +fill in the details. But I think this information should be present, +meaning that for situations where test vectors can't be derived from the +existing specs, new specs should be added as part of the description +language. This would make writing testcases an integral part of writing +the .cpu file. Clearly there is a risk in having machine generated +testcases - but there are ways to eliminate or control the risk. + +The syntax of a suitable description language needs to have these +properties: + +@itemize @bullet +@item simple +@item expressive +@item easily parsed +@item easy to learn +@item understandable by program generators +@item extensible +@end itemize + +It would also help to not start over completely from scratch. GCC's RTL +satisfies all these goals, and is used as the basis for the description +language used by CGEN. + +Extensibility is achieved by specifying everything as name/value pairs. +This allows new elements to be added and even CPU specific elements to +be added without complicating the language or requiring a new element in +a @code{define_insn} type entry to be added to each existing port. +Macros can be used to eliminate the verbosity of repetitively specifying +the ``name'' part, so one can have it both ways. Imagine GCC's +@file{.md} file elements specified as name/value pairs with macro's +called @code{define_expand}, @code{define_insn}, etc. that handle the +common cases and expand the entry to the full @code{(define_full_expand +(name addsi3) (template ...) (condition ...) ...)}. + +Scheme also uses @code{(foo :keyword1 value1 :keyword2 value2 ...)}, +though that isn't implemented yet (or maybe @code{#:keyword} depending +upon what is enabled in Guile). + +@node Layout +@subsection Layout + +Here is a graphical layout of the hierarchy of elements of a @file{.cpu} file. + +@example + architecture + / \ + cpu-family1 cpu-family2 ... + / \ + machine1 machine2 ... + / \ + model1 model2 ... +@end example + +Each of these elements is explained in more detail in @ref{RTL}. The +@emph{architecture} is one of @samp{sparc}, @samp{m32r}, etc. Within +the @samp{sparc} architecture, the @emph{cpu-family} might be +@samp{sparc32} or @samp{sparc64}. Within the @samp{sparc32} CPU family, +the @emph{machine} might be @samp{sparc-v8}, @samp{sparclite}, etc. +Within the @samp{sparc-v8} machine classificiation, the @emph{model} +might be @samp{hypersparc} or @samp{supersparc}. + +Instructions form their own hierarchy as each instruction may be supported +by more than one machine. Also, some architectures can handle more than +one instruction set on one chip (e.g. ARM). + +@example + isa + | + instruction + / \ + operand1 operand2 ... + | | + hw1+ifield1 hw2+ifield2 ... +@end example + +Each of these elements is explained in more detail in @ref{RTL}. + +@node Language problems +@subsection Language problems + +There are at least two potential problem areas in the language's design. + +The first problem is variation in assembly language syntax. Examples of +this are Intel vs AT&T i386 syntax, and Motorola vs MIT M68k syntax. +I think there isn't a sufficient number of important cases to warrant +handling this efficiently. One could either ignore the issue for +situations where divergence is sufficient to dissuade one from handling +it in the existing design, or one could provide a front end or +use/extend the existing macro mechanism. + +One can certainly argue that description of assembler syntax should be +separated from the hardware description. Doing so would prevent +complications in supporting multiple or even difficult assembler +syntaxes from complicating the hardware description. On the other hand, +there is a lot of duplication, and in the end for the intended uses of +CGEN I think the benefits of combining assembler support with hardware +description outweigh the disadvantages. Note that the assembler +portions of the description aren't used by the simulator @footnote{The +simulator currently uses elements of the opcode table since the opcode +table is a nice central repository for such things. However, the +assembler/disassembler isn't part of the simulator, and the +portions of the opcode table can be generated and recorded elsewhere +should it prove reasonable to do so. The CPU description file won't +change, which is the important thing.}, so if one wanted to implement +the disassembler/assembler via other means one can. + +The other potential problem area is relocations. Clearly part of +processing assembly code is dealing with the relocations involved +(e.g. GOT table specification). Relocation support necessarily requires +BFD and GAS support, both of which need cleanup in this area. Rewriting +BFD to provide a better interface so reloc handling in GAS can be +cleaned up is believed to be something this project can and should take +advantage of, and that any attempt at adding relocation support should +be done by first cleaning up GAS/BFD. That can be left for another day +though. :-) + +One can certainly argue trying to combine an ABI description with a +hardware description is problematic as there can be more than one ABI. +However, there often isn't and in the cases where there isn't the +simplified porting and maintenance is worth it, in the author's opinion. +Furthermore, the current language doesn't embed ABI elements +with hardware description elements. Careful segregation of such things +might ameliorate any problems. + +@node Opcodes support +@section Opcodes support + +Opcodes support comes in the form of machine generated opcode tables as +well as supporting routines. + +@node Simulator support +@section Simulator support + +Simulator support comes in the form of machine generated the decoder/executer +as well as the structure that records CPU state information (ie. registers). + +@node Testing support +@section Testing support + +@menu +* Assembler/disassembler testing:: +* Simulator testing:: +@end menu + +Inherent in the design is the ability to machine generate test cases both +for the assembler/disassembler and for the simulator. Furthermore, it +is not unreasonable to add to the description file data specifically +intended to assist or guide the testing process. What kinds of +additions that will be needed is unknown at present. + +@node Assembler/disassembler testing +@subsection Assembler/disassembler testing + +The description of instructions and their fields contains to some extent +not only the syntax but the possible values for each field. For +example, in the specification of an immediate field, it is known what +the allowable range of values is. Thus it is possible to machine +generate test cases for such instructions. Obviously one wouldn't want +to test for each number that a number field can contain, however one can +generate a representative set of any size. Likewise with register +fields, mnemonic fields, etc. A good starting point would be the edge +cases, the values at either end of the range of allowable values. + +When I first raised the possibility of machine generated test cases the +first response I got was that this wouldn't be useful because the same +data was being used to generate both the program and the test cases. An +error might be propagated to both and thus nullify the test. For +example if an opcode field was supposed to have the value 1 and the +description file had the value 2, then this error wouldn't be caught. +However, this assumes test cases are generated during the testing run! +And it ignores the profound amount of typing that is saved by machine +generating test cases! (I discount the argument that this kind of +exhaustive testing is unnecessary). + +One solution to the above problem is to not generate the test cases +during the testing run (which was implicit in the proposal, but perhaps +should have been explicit). Another solution is to generate the +test cases during the test run but first verify them by some external +means before actually using them in any test. The latter solution is +only mentioned for completeness sake; its implementation is problematic +as any external means would necessarily be computer driven and the level +of confidence in the result isn't 100%. + +So how are machine generated test cases verified? By machine, by hand, +and by time. The test cases are checked into CVS and are not regenerated +without care. Every time the test cases are regenerated, the diffs are +examined to ensure the bug triggering the regeneration has been fixed +and that no new bugs have been introduced. In all likelihood once a +port is more or less done, regeneration of test cases would stop anyway, +and all further changes would be done manually. + +``By machine'' means that for example in the case of ports with a native +assembler one can run the test case through the native assembler and use +that as a good first pass. + +``By hand'' means one can go through each test case and verifying them +manually. This is what is done in the case of non-machine generated +test cases, the only difference is the perceived difference in quantity. +And in the case of machine generated test cases comments can be added to +each test to help with the manual verification (e.g. a comment can be +added that splits the instruction into its fields and shows their names +and values). + +``By time'' means that this process needn't be done instantaneously. +This is no different than the non-machine generated case again except in +the perceived difference in quantity of test cases. + +Note that no claim is made that manually generated test cases aren't +needed. Clearly there will be some cases that the description file +doesn't describe and thus can't machine generate. + +@node Simulator testing +@subsection Simulator testing + +Machine generation of simulator test cases is possible because the +semantics of each instruction is written in a way that is understandable +to the generator. At the very least, knowledge of what the instructions +are is present! Obviously there will be some instructions that can't +be adequately expressed in RTL and are thus not amenable to having a +test case being machine generated. There may even be some RTL'd +semantics that fall into this category. It is believed, however, that +there will still be a large percentage of instructions amenable to +having test cases machine generated for them. Such test cases can +certainly be hand generated, but it is believed that this is a large +amount of unnecessary typing that typically won't be done due to the +amount. Again, I discount the argument that this kind of exhaustive +testing isn't necessary. + +An example is the simple arithmetic instructions. These take zero, one, +or more arguments and produce a result. The description file contains +sufficient data to generate such an instruction, the hard part is in +providing the environment to set up the required inputs (e.g. loading +values into registers) and retrieve the output (e.g. retrieve a value +from a register). + +Certainly at the very least all the administrivia for each test case can +be machine generated (i.e. a template file can be generated for each +instruction, leaving the programmer to fill in the details). + +The strategy used for assembler/disassembler test cases is also used here. +Test cases are kept in CVS and are not regenerated without care. + +@node Implementation language +@section Implementation language + +The chosen implementation language is Scheme. The reasons for this are: + +@itemize @bullet +@item Parsing RTL in Scheme is real easy, though I did make some albeit +minor changes to make it easier. While it doesn't take more than a few +dozen lines of C to parse RTL, it doesn't take any lines of Scheme - +the parser is built into the interpreter. + +@item An interactive environment is a better environment to work in, +especially in the early stages of an ambitious project like this. + +@item Guile is developing as an embeddable interpreter. +I wanted room for growth in many dimensions, and having the implementation +language be an embeddable interpreter supports this. + +@item I wanted to learn Scheme (Yes, not a technical reason, blah blah blah). + +@item Numbers in Scheme can have arbitrary precision so representing 64 +bit (or higher) numbers on a 32 bit host is well defined. + +@item It seemed useful to have an implementation language similar to the +CPU description language. The Scheme implementation seems simpler +than a C implementation would be. +@end itemize + +One issue that arises with the use of Scheme as the implementation +language is whether to generate files in the source tree, with the +issues that involves, or generate the files in the build tree (and thus +require Guile to build Binutils and the issues that involves). Trying +to develop something like this is easier in an interactive environment, +so Scheme as the first implementation language is, to me, a better +choice than C or C++. In such a big project it also helps to have a +more expressive language so relatively complex code and be written with +fewer lines of code. + +One consequence is maintenance is more difficult in that the +generated files (e.g. @file{opcodes/m32r-*.[ch]}) are checked into CVS +at Red Hat, and a change to a CPU description requires rebuilding the +generated files and checking them in as well. And a change that affects +each port requires each port to be regenerated and checked in. +This is more palatable for maintainer tools such as @code{bison}, +@code{flex}, @code{autoconf} and @code{automake}, as their input files +don't change as often. + + +Whether to continue with Scheme, convert the code to a compiled +language, or have both is an important, open issue. diff --git a/cgen/doc/notes.texi b/cgen/doc/notes.texi new file mode 100644 index 00000000000..b21a59b0719 --- /dev/null +++ b/cgen/doc/notes.texi @@ -0,0 +1,237 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Miscellaneous notes +@chapter Miscellaneous notes +@cindex Miscellaneous notes + +This chapter is a repository of miscellaneous notes that belong elsewhere +or nowhere. They're here because I want them written down, for now anyway, +and I'm not sure where else to put them. There may be duplication here +with things elsewhere in the docs. I'm not bothering to ensure there isn't. +It's better to have things written down twice than not at all. If there +is a conflict between notes here and elsewhere, check the chronology. +I may have changed my mind. If not, the situation may be complicated and I +don't have a strong opinion on what's right. No claim is made that these +notes represent my complete opinion. (Hmmm... lessee what other caveats +I can throw in here ... :-) + +@c ??? Shouldn't have to append " notes" to every menu entry. +@c It's done because some entries collide with menu entries in other +@c chapters and texinfo doesn't like that (complains or crashes). + +@menu +* Description language notes:: +* CGEN architecture notes:: +* COS notes:: +* RTL notes:: +* Guile implementation notes:: +* Code generation notes:: +* Machine generated files notes:: +* Implementation language notes:: +@end menu + +@node Description language notes +@section Description language notes + +@itemize @minus + +@item timing support + +The current implementation of timing (aka pipeline, function units, etc.) +support is a quick hack in order to achieve useful numbers out of the +simulator. It is intended to be replaced with something a lot more +sophisticated. Remember to keep in mind cgen's goal of application +independence when designing the new version. For example, it must handle +things like code scheduling in a compiler (where speed of analysis is not +critical) to scheduling in a dynamic compiler (where speed of analysis is +critical). It must also handle semi-accurate to fully-accurate cycle +counting in simulators (where the former might trade off accuracy for speed +which one wouldn't do in the latter, assuming there is a trade-off to be +made). It must also handle the representation and handling of pipelines +with program visible hazards. + +@item organization of cpu description + +One thing that may not be apparent is that the description language +doesn't preclude one item (say an insn) from having its definition +spread over several files. One example would be to leave the timing +elements unspecified in the "main" entry of an insn, and then have +a machine-specific file providing timing characteristics, etc. + +One can even leave the semantics to be defined elsewhere. +The `=' insn format prefix is not currently used very much (no need). +It might also need better documentation. + +A possible break-up of an item's description into several files should be +generally supported (where reasonable). + +@end itemize + +@node CGEN architecture notes +@section CGEN architecture notes + +@itemize @minus + +@item compiled form of description in libcgen + +The current compiled form of the cpu description has been focused on +two applications: opcodes and simulator. No doubt there are things present +that will present problems to future applications. +One thing on the todo list has been to record semantics with the compiled +form, probably as bytecode. Maybe it would make sense to record the +entire cpu description as a kind of bytecode. This would allow apps to +instantiate it for the task at hand as they please. + +@item function-style attributes + +Attributes currently only support static (compile-time computed) notions. +They should also support run-time computed values. The way to do this is +to record such attributes as bytecode and lazily (or not lazily) evaluate +them at runtime, perhaps caching the results. It might make sense to +record all attributes this way (though I currently don't think so). + +@item importance of description language + +When hacking on cgen, the description language takes priority over +implementation. That cannot be stressed enough. When faced with +choices of what to do, put the elegance, maintainability, and application +independence of the description language first. Implementation will almost +always take shortcuts due to application specific requirements. Theoretically +the description language won't have to; at least that's where the effort +in application independence should be put. + +@end itemize + +@node COS notes +@section COS notes + +@itemize @minus + +@item elm-xget, elm-xset + +These procedures are quick hacks and should be avoided. +Existing uses should be replaced. +Where they're used it's either because of laziness or because +I wasn't sure whether I wanted to allow global access to the element, +so using an easily grep-able hack let's me find them and revisit them. + +@end itemize + +@node RTL notes +@section RTL notes + +@itemize @minus + +@item Where's strict_lowpart? Where's foo? + +Elements of gcc's rtl like strict_lowpart, pre_inc, etc. aren't in +cgen's rtl only because thus far there hasn't been a compelling need +for them. When there is a compelling need they'll be added. + +@item boolean values + +Sometimes #f/#t is used for boolean values. +However the "boolean" mode @code{BI} has values 0 and 1. +Which one is in use is context dependent. +Not sure there is a problem but it should be revisited. + +@item #f to denote "unspecified" values + +Sometimes () is used to specify "unspecified" values. +Other times #f is used. Should standardize in #f. + +@item ifield assertions + +Perhaps these should be renamed to "constraints". +"ifield-assertion" sounds clumsy. + +@end itemize + +@node Guile implementation notes +@section Guile implementation notes + +@itemize @minus + +@item +Remaining todo is to complete switchover from "errtxt" (a string) +in .cpu file reader support to "context" (a <context> object). + +@item +Remaining todo is to complete switchover of naming functions from +"prefix:function" to "prefix-function". One reasonable naming style +is "prefix-verb-noun". I like it. + +@item +Slib uses "prefix:foo" for "internal" routines. Maybe that would be +a better choice than the current "-prefix-foo" style. + +@end itemize + +@node Code generation notes +@section Code generation notes + +@itemize @minus + +@item foo + +@end itemize + +@node Machine generated files notes +@section Machine generated files notes + +@itemize @minus + +@item +In the end I think the best thing is to build the machine generated files +when the tools themselves are built (same as gcc's gen* -> insn* files). + +@end itemize + +@node Implementation language notes +@section Implementation language notes + +In the end I think the implementation language (or the Guile +implementation) will have to change. +If one compares the speed of gcc's gen* file generators vs cgen's, +and one envisions the day when machine generated files are +built at build time, then I think the user community will require +similar speed in file generation. Guile isn't fast enough. +And while Guile+Hobbit may be, for the one-time builder the time +taken to compile Hobbit, run it, and compile the result, will appear +to swamp any gains. There is also the additional burden of +building Guile first (though with my prefered Guile implementation +I'm _hoping_ that wouldn't be a problem). + +The pragmatic choice is C. Blech. + +A better choice would be C++ but then that would obviously place a +requirement on having a C++ compiler available in order to build binutils, +for example (assuming machine generated files are built at build time). + +Java would also be a better implementation language than C +[an interesting experiment would be Kawa]. But it's worse as a pragmatic +choice than C++. + +My prefered choice is a small-and-fast subset of Guile that gets +distributed with binutils, gdb, etc. IMO Guile is too bloated +and unmaintainable for the casual maintainer (hacking on its innards +requires too steep a learning curve, and is one that is easily slipped back +down should one step away from it for too long). If those can be fixed and +the speed of cgen's file generation can be made acceptable, then that +is the path I would choose. + +In making the choice people need to look forward rather than look backward. +We're finally switching the GNU tools to ANSI C. If the host doesn't provide +an ANSI C compiler the user is expected to get one (GCC). +Well, G++ is available on most if not all hosts of concern, so +in this day and age requiring C++ in order to build binutils isn't +as much of a burden as it use to be. Cgen is a forward looking design. +At its heart is a goal to close no doors on future uses. That's a +pretty lofty goal. Forcing people to achieve that goal with C because +of pragmatic concerns is unjustifiable, IMO. + +Note that changing the "implementation language" does _not_ mean +Guile cannot or will not be used for various things! I think Guile +should continue to be used for prototyping as well as certain applications. diff --git a/cgen/doc/opcodes.texi b/cgen/doc/opcodes.texi new file mode 100644 index 00000000000..4085aa20588 --- /dev/null +++ b/cgen/doc/opcodes.texi @@ -0,0 +1,186 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Opcodes +@chapter Opcodes support +@cindex Opcodes support + +Opcodes support comes in the form of machine generated opcode tables as +well as supporting routines. + +@menu +* Generated files:: List of generated files +* The .opc file:: Target specific C code +* Special assembler parsing needs:: +@end menu + +@node Generated files +@section Generated files + +The basic interface is defined by +@file{include/opcode/cgen.h} which is included by the machine generated +@file{<arch>-desc.h}. @file{opcode/cgen.h} can stand on its own for the +target independent stuff, but to get target specific parts of the +interface use @file{<arch>-desc.h}. + +The generated files are: + +@table @file +@item <arch>-desc.h +Defines macros, enums, and types used to describe the chip. +@item <arch>-desc.c +Tables of various things describing the chip. +This does not include assembler syntax nor semantic information. +@item <arch>-ibld.c +Routines for constructing and deconstructing instructions. +@item <arch>-opc.h +Declarations necessary for assembly/disassembly that aren't used +elsewhere and thus left out of @file{<arch>-desc.h}. +@item <arch>-opc.c +Assembler syntax tables. +@item <arch>-asm.c +Assembler support routines. +@item <arch>-dis.c +Disassembler support routines. +@item <arch>-opinst.c +Operand instance tables. +These describe which hardware elements are read and which are written +for each instruction. This file isn't generated for all architectures, +only ones that can make use of the data. For example the M32R uses them +to emit warnings if the output of one parallel instruction is the input +of another, and to control creating parallel instructions during optimizing +assembly. +@end table + +@node The .opc file +@section The .opc file + +Files with suffix @file{.opc} (e.g. @file{m32r.opc}) contain target +specific C code that accompanies the cpu description file. +The @file{.opc} file is split into 4 sections: + +@itemize @minus +@item opc.h + +This section contains additions to the generated @file{$target-opc.h} file. + +Typically defined here are these macros: + +@itemize @bullet +@item #define CGEN_DIS_HASH_SIZE N + +Specifies the size of the hash table to use during disassembly. +A hash table is built of the selected mach's instructions in order to +speed up disassembly. +@item #define CGEN_DIS_HASH(buffer, value) + +Given BUFFER, a pointer to the instruction being disassembled and +VALUE, the value of the instruction as a host integer, return an +index into the hash chain for the instruction. The result must be +in the range 0 to CGEN_DIS_HASH_SIZE-1. + +VALUE is only usable if all instructions fit in a portable integer (32 bits). + +N.B. The result must depend on opcode portions of the instruction only. +Normally one wants to use between 6 and 8 bits of opcode info for the hash +table. However, some instruction sets don't use the same set of bits +for all insns. Certainly they'll have at least one opcode bit in common +with all insns, but beyond that it can vary. Here's a possible definition +for sparc. + +@example +#undef CGEN_DIS_HASH_SIZE +#define CGEN_DIS_HASH_SIZE 256 +#undef CGEN_DIS_HASH +extern const unsigned int sparc_cgen_opcode_bits[]; +#define CGEN_DIS_HASH(buffer, insn) \ +((((insn) >> 24) & 0xc0) \ + | (((insn) & sparc_cgen_opcode_bits[((insn) >> 30) & 3]) >> 19)) +@end example + +@code{sparc_cgen_opcode_bits} would be defined in the @samp{asm.c} section as + +@example +/* It is important that we only look at insn code bits + as that is how the opcode table is hashed. + OPCODE_BITS is a table of valid bits for each of the + main types (0,1,2,3). */ +const unsigned int sparc_cgen_opcode_bits[4] = @{ + 0x01c00000, 0x0, 0x01f80000, 0x01f80000 +@}; +@end example +@end itemize + +@item opc.c + +@item asm.c + +This section contains additions to the generated @file{$target-asm.c} file. +Typically defined here are functions used by operands with a @code{parse} +define-operand handler spec. + +@item dis.c + +This section contains additions to the generated @file{$target-dis.c} file. + +Typically defined here these macros: + +@itemize @bullet +@item #define CGEN_PRINT_NORMAL(cd, info, value, attrs, pc, length) +@item #define CGEN_PRINT_ADDRESS(cd, info, value, attrs, pc, length) +@item #define CGEN_PRINT_INSN function_name +@c FIXME: should be CGEN_PRINT_INSN(cd, pc, info) +@item #define CGEN_BFD_ARCH bfd_arch_<name> +@item #define CGEN_COMPUTE_ISA(info) +@end itemize + +@end itemize + +@node Special assembler parsing needs +@section Special assembler parsing needs + +Often parsing of assembly instructions requires more than what +a program-generated assembler can handle. For example one version +of an instruction may only accept certain registers, rather than +the entire set. + +Here's an example taken from the @samp{m32r} architecture. + +32 bit addresses are built up with a two instruction sequence: one to +load the high 16 bits of a register, and another to @code{or}-in the +lower 16 bits. + +@example +seth r0,high(some_symbol) +or3 r0,r0,low(some_symbol) +@end example + +When assembling, special code must be called to recognize the +@code{high} and @code{low} pseudo-ops and generate the appropriate +relocations. This is indicated by specifying a "parse handler" for +the operand in question. Here is the @code{define-operand} +for the lower 16 bit operand. + +@example +(define-operand + (name ulo16) + (comment "16 bit unsigned immediate, for low()") + (attrs) + (type h-ulo16) + (index f-uimm16) + (handlers (parse "ulo16")) +) +@end example + +The generated parser will call a function named @code{parse_ulo16} +for the immediate operand of the @code{or3} instruction. +The name of the function is constructed by prepended "parse_" to the +argument of the @code{parse} spec. + +@example +errmsg = parse_ulo16 (cd, strp, M32R_OPERAND_ULO16, &fields->f_uimm16); +@end example + +But where does one put the @code{parse_ulo16} function? +Answer: in the @samp{asm.c} section of @file{m32r.opc}. diff --git a/cgen/doc/pmacros.texi b/cgen/doc/pmacros.texi new file mode 100644 index 00000000000..cc41dd4114e --- /dev/null +++ b/cgen/doc/pmacros.texi @@ -0,0 +1,457 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Preprocessor macros +@chapter Preprocessor macros +@cindex Preprocessor macros +@cindex pmacros + +Preprocessor macros provide a way of simplifying the writing of +@file{.cpu} files and serve the same purpose that macros do in C. + +@menu +* Defining a preprocessor macro:: @code{define-pmacro} +* Using preprocessor macros:: +* Macro expansion:: The @code{pmacro-expand} procedure +* Default argument values:: Specifying default values of arguments +* Multiple output expressions:: Using @code{begin} +* Symbol concatenation:: The @code{.sym} builtin +* String concatenation:: The @code{.str} builtin +* Convert a number to a hex:: The @code{.hex} builtin +* Convert a string to uppercase:: The @code{.upcase} builtin +* Convert a string to lowercase:: The @code{.downcase} builtin +* Getting part of a string:: The @code{.substr} builtin +* List splicing:: The @code{.splice} builtin +* Number generation:: The @code{.iota} builtin +* Mapping a macro over a list:: The @code{.map} builtin +* Applying a macro to a list:: The @code{.apply} builtin +* Defining a macro inline:: The @code{.pmacro} builtin +* Passing macros as arguments:: Passing a macro to another macro +@end menu + +@node Defining a preprocessor macro +@section Defining a preprocessor macro +@cindex define-pmacro + +Preprocessor macros are defined with: + +@smallexample +(define-pmacro (name parm1 parm2 ... parmN) + expansion +) +@end smallexample + +The result is @samp{expansion} with parameters replaced with the actual +arguments of the macro invocation. Free variables are left unchanged. +[A "free variable", as defined here, is one that doesn't appear in the +parameter list.] + +@c ??? This used to be true, but currently isn't. +@c If the result is another macro invocation, it is expanded in turn. + +@samp{expansion} must be exactly one expression. + +@node Using preprocessor macros +@section Using preprocessor macros + +Preprocessor macros are invoked in either of two ways: positional arguments +and arguments by name. +@c Rather lame wording. + +@smallexample +(define-pmacro (foo arg1 arg2) (bar arg1 arg2)) + +; Invoke by positional arguments. + +(foo abc def) ==> (bar abc def) + +; Invoke by naming arguments. + +(foo #:arg1 ghi #:arg2 jkl) ==> (bar ghi jkl) +@end smallexample + +@c If you think more should be said here, I agree. +@c Please think of something. + +@node Macro expansion +@section Macro expansion + +At the implementation level, pmacros are expand with the +@code{pmacro-expand} Scheme procedure. + +The following is executed from a Guile shell, as opposed to +appearing in a cpu description file, hence the extra quoting. + +@smallexample +guile> (define-pmacro '(foo a b) '(+ a b)) +guile> (pmacro-expand '(foo 3 4)) +(+ 3 4) +@end smallexample + +@node Default argument values +@section Default argument values + +Invoking pmacros by specifying argument names allows some, or all, +arguments to be elided and thus allows for arguments to have default values. + +Specify default values with the following syntax. + +@smallexample +(define-pmacro (macro-name (arg1 . default-value) + (arg2 . default value) ...) + ... +) +@end smallexample + +Example: + +@smallexample +(define-pmacro (foo (arg1 . 1) (arg2 . 2)) + (bar arg1 arg2) +) + +(foo #:arg2 33) ==> (bar 1 33) +@end smallexample + +@node Multiple output expressions +@section Multiple output expressions +@cindex begin + +The result of a preprocessor macro is exactly one expression. +It is often useful, however, to return multiple expressions, say for +example when you want one macro to define several instructions. + +The way to do this is to enclose all the expressions with @code{begin}. +@code{begin} is only valid at the top [definition] level. + +??? It's moderately clumsy to restrict @code{begin} like this. +Using @code{sequence} for this purpose might be cleaner except that +sequence locals don't make sense in this context (though perhaps that's +a lesser evil). In the end, @code{begin} can be shorthand for a void-mode +sequence with no locals so I haven't been in a rush to resolve this. + +@node Symbol concatenation +@section Symbol concatenation +@cindex .sym + +Symbol and string concatenation are supported. Symbol concatenation is +done with: + +@code{(.sym arg1 arg2 ...)} + +Acceptable arguments are symbols, strings, and numbers. +The result is a symbol with the arguments concatenated together. +Numbers are converted to a string, base 10, and then to a symbol. +The result must be a valid Scheme symbol with the additional restriction +that the first character must be a letter. + +@node String concatenation +@section String concatenation +@cindex .str + +String concatenation is done with + +@code{(.str arg1 arg2 ...)} + +Acceptable arguments are symbols, strings, and numbers. The result is a +string with the arguments concatenated together. +Numbers are converted base 10. + +Example: + +@smallexample +(define-pmacro (bin-op mnemonic op2-op sem-op) + (dni mnemonic + (.str mnemonic " reg/reg") + () + (.str mnemonic " $dr,$sr") + (+ OP1_0 op2-op dr sr) + (set dr (sem-op dr sr)) + ()) +) +(bin-op and OP2_12 and) +(bin-op or OP2_14 or) +(bin-op xor OP2_13 xor) +@end smallexample + +@node Convert a number to a hex +@section Convert a number to a hex + +Convert a number to a lowercase hex string with @code{.hex}. If +@code{width} is present, the result is that many characters beginning +with the least significant digit. Zeros are prepended as necessary. + +Syntax: @code{(.hex number [width])} + +Examples: + +@smallexample +(.hex 42) --> "2a" +(.hex 42 1) --> "a" +(.hex 42 4) --> "002a" +@end smallexample + +@node Convert a string to uppercase +@section Convert a string to uppercase + +Convert a string to uppercase with @code{.upcase}. + +Syntax: @code{(.upcase string)} + +Example: + +@smallexample +(.upcase "foo!") --> "FOO!" +@end smallexample + +@node Convert a string to lowercase +@section Convert a string to lowercase + +Convert a string to lowercase with @code{.downcase}. + +Syntax: @code{(.downcase string)} + +Example: + +@smallexample +(.downcase "BAR?") --> "bar?" +@end smallexample + +@node Getting part of a string +@section Getting part of a string + +Extract a part of a string with @code{.substr}. + +Syntax: @code{(.substr string start end)} + +where @samp{start} is the starting character, and @samp{end} is one past +the ending character. Character numbering begins at position 0. +If @samp{start} and @samp{end} are the same, and both valid, the empty +string is returned. + +Example: + +@smallexample +(.substr "howzitgoineh?" 2 6) --> "wzit" +@end smallexample + +@node List splicing +@section List splicing +@cindex .splice + +It is often useful to splice a list into a "parent" list. +This is best explained with an example. + +@smallexample +(define-pmacro (splice-test a b c) + (.splice a (.unsplice b) c)) +(pmacro-expand (splice-test (1 (2) 3))) + +--> (1 2 3) +@end smallexample + +Note that a level of parentheses around @code{2} has been removed. + +This is useful, for example, when one wants to pass a list of fields to +a macro that defines an instruction. For example: + +@smallexample +(define-pmacro (cond-move-1 name comment mnemonic cc-prefix cc-name cc-opcode + src-name src-opcode cond test) + (dni name + (.str "move %" cc-name " " comment ", v9 page 191") + ((MACH64)) + (.str mnemonic " " cc-prefix cc-name ",$" src-name ",$rd") + (.splice + OP_2 rd OP3_MOVCC cond + (.unsplice cc-opcode) (.unsplice src-opcode)) + (if (test cc-name) + (set rd src-name)) + ()) +) +@end smallexample + +This macro, taken from @file{sparc64.cpu}, defines a conditional move +instruction. Arguments @code{cc-opcode} and @code{src-opcode} are lists +of fields. The macro is invoked with (simplified from @file{sparc64.cpu}): + +@smallexample +(cond-move-1 mova-icc "blah ..." mova + "%" icc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 0)) + rs2 ((f-i 0) (f-fmt4-res10-6 0) rs2) + CC_A test-always) +(cond-move-1 mova-imm-icc "blah ..." mova + "%" icc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 0)) + simm11 ((f-i 1) simm11) + CC_A test-always) +@end smallexample + +Macro @code{cond-move-1} is being used here to define both the register +and the immediate value case. Each case has a slightly different list +of opcode fields. Without the use of @code{.splice}/@code{.unsplice}, +the resulting formats would be: + +@smallexample +(+ OP_2 rd OP3_MOVCC CC_A ((f-fmt4-cc2-1) (f-fmt4-cc1-0 0)) + ((f-i 0) (f-fmt4-res10-6 0) rs2)) + +and + +(+ OP_2 rd OP3_MOVCC CC_A ((f-fmt4-cc2-1) (f-fmt4-cc1-0 0)) + ((f-i 1) simm11)) +@end smallexample + +respectively. This is not what is wanted. What is wanted is + +@smallexample +(+ OP_2 rd OP3_MOVCC CC_A (f-fmt4-cc2-1) (f-fmt4-cc1-0 0) + (f-i 0) (f-fmt4-res10-6 0) rs2) + +and + +(+ OP_2 rd OP3_MOVCC CC_A (f-fmt4-cc2-1) (f-fmt4-cc1-0 0) + (f-i 1) simm11) +@end smallexample + +respectively, which is what @code{.splice} achieves. + +@code{.unsplice} is a special reserved symbol that is only recognized inside +@code{.splice}. + +@node Number generation +@section Number generation +@cindex .iota +@cindex Number generation + +Machine descriptions often require a list of sequential numbers. +Generate a list of numbers with the @code{.iota} builtin macro. + +The syntax is @samp{(.iota count [start [incr]])}. + +Examples: + +@smallexample +(.iota 5) --> 0 1 2 3 4 +(.iota 5 4) --> 4 5 6 7 8 +(.iota 5 5 -1) --> 5 4 3 2 1 +@end smallexample + +@node Mapping a macro over a list +@section Mapping a macro over a list +@cindex .map + +Apply a macro to each element of a list, or set of lists, with @code{.map}. + +The syntax is @samp{(.map macro-name list1 [list2 ...])}. + +The result is a list with @samp{macro-name} applied to each element of +@samp{listN}. @samp{macro-name} should take as many arguments as there +are lists. This is often useful in constructing enum and register name lists. + +Example: + +@smallexample +(define-pmacro (foo name number) ((.sym X name) number)) +(.map foo (A B C D E) (.iota 5)) + +--> + +((XA 0) (XB 1) (XC 2) (XD 3) (XE 4)) +@end smallexample + +@node Applying a macro to a list +@section Applying a macro to a list + +Invoke a macro with each argument coming from an element of a list, +with @code{.apply}. + +The syntax is @samp{(.apply macro-name list)}. + +The result is the result of invoking macro @samp{macro-name}. +@samp{macro-name} should take as many arguments as there elements in +@samp{list}. If @samp{macro-name} takes a variable number of trailing +arguments, there must be at least as many list elements as there are +fixed arguments. +@c clumsily worded or what + +Example: +@c need a more useful example + +@smallexample +(.apply .str (.iota 5)) + +--> + +"01234" +@end smallexample + +Note that @code{(.str (.iota 5))} is an error. Here the list +@samp{(0 1 2 3 4)} is passed as the first argument of @code{.str}, +which is wrong. + +@node Defining a macro inline +@section Defining a macro inline + +Define a macro inline with @code{.pmacro}. +This is only supported when passing macros as arguments to other macros. + +@smallexample +(define-pmacro (load-op suffix op2-op mode ext-op) + (begin + (dni (.sym ld suffix) (.str "ld" suffix) + () + (.str "ld" suffix " $dr,@@$sr") + (+ OP1_2 op2-op dr sr) + (set dr (ext-op WI (mem: mode sr))) + ()) + ) +) + +(load-op "" OP2_12 WI (.pmacro (mode expr) expr)) +(load-op b OP2_8 QI (.pmacro (mode expr) (ext: mode expr))) +(load-op h OP2_10 HI (.pmacro (mode expr) (ext: mode expr))) +(load-op ub OP2_9 QI (.pmacro (mode expr) (zext: mode expr))) +(load-op uh OP2_11 HI (.pmacro (mode expr) (zext: mode expr))) +@end smallexample + +Currently, .pmacro's don't bind the way Scheme lambda expressions do. +For example, arg2 in the second pmacro is not bound to the arg2 argument +of the first pmacro. + +@smallexample +(define-pmacro (foo arg1 arg2) ((.pmacro (bar) (+ arg2 bar)) arg1)) +(foo 3 4) ==> (+ arg2 3) +@end smallexample + +One can make an argument either way. I'm not sure what the right thing +to do here is (leave things as is, or have lexical binding like Scheme). + +@node Passing macros as arguments +@section Passing macros as arguments + +Macros may be passed to other macros. + +Example: + +@smallexample +(define-pmacro (no-ext-expr mode expr) expr) +(define-pmacro (ext-expr mode expr) (ext: mode expr)) +(define-pmacro (zext-expr mode expr) (zext: mode expr)) + +(define-pmacro (load-op suffix op2-op mode ext-op) + (begin + (dni (.sym ld suffix) (.str "ld" suffix) + () + (.str "ld" suffix " $dr,@@$sr") + (+ OP1_2 op2-op dr sr) + (set dr (ext-op WI (mem: mode sr))) + ()) + ) +) + +(load-op "" OP2_12 WI no-ext-expr) +(load-op b OP2_8 QI ext-expr) +(load-op h OP2_10 HI ext-expr) +(load-op ub OP2_9 QI zext-expr) +(load-op uh OP2_11 HI zext-expr) +@end smallexample diff --git a/cgen/doc/porting.texi b/cgen/doc/porting.texi new file mode 100644 index 00000000000..551953ee845 --- /dev/null +++ b/cgen/doc/porting.texi @@ -0,0 +1,863 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Porting +@chapter Porting +@cindex Porting + +This chapter describes how to do a CGEN port. +It focuses on doing binutils and simulator ports, but the general +procedure should be generally applicable. + +@menu +* Introduction to porting:: +* Supported Guile versions:: +* Running configure:: +* Writing a CPU description file:: +* Doing an opcodes port:: +* Doing a GAS port:: +* Building a GAS test suite:: +* Doing a simulator port:: +* Building a simulator test suite:: +@end menu + +@node Introduction to porting +@section Introduction to porting + +Doing a GNU tools port for a new processor basically consists of porting the +following components more or less in order. The order can be changed, +of course, but the following order is reasonable. Certainly things like +BFD and opcodes need to be finished earlier than others. Bugs in +earlier pieces are often not found until testing later pieces so each +piece isn't necessarily finished until they all are. + +@itemize @bullet +@item DejaGNU +@item BFD +@item CGEN +@item Opcodes +@item GAS +@item Binutils +@item Linker (@code{ld}) +@item newlib +@item libgloss +@item simulator +@item GCC +@item GDB +@end itemize + +The use of CGEN affects the opcodes, GAS, and simulator portions only. +As always, the M32R port is a good reference base. + +One goal of CGEN is to describe the CPU in an application independent manner +so that program generators can do all the repetitive work of generating +code and tables for each CPU that is ported. + +For opcodes, several files are generated. No additional code need be +written in the opcodes directory although as an escape hatch the user +can add target specific code to file <arch>.opc in the CGEN source +directory. These functions will be included in the relevant generated +files. An example of when you need to create an <arch>.opc file is when +there are special pseudo-ops that need to be parsed, for example the +high/shigh pseudo-ops of the M32R. +@xref{Doing an opcodes port}. + +For GAS, no files are generated (except test cases!) so the port is done +more or less like the other GAS ports except that the assembler uses the +CGEN-built opcode table plus @file{devo/gas/cgen.[ch]}. + +For the simulator, several files are built, and other support files need +to be written. @xref{Doing a simulator port}. + +@node Supported Guile versions +@section Supported Guile versions + +In order to avoid suffering from the bug of the day when using +snapshots, CGEN development has been confined to Guile releases only. +As of this writing (1999-04-26) only Guile 1.2 and 1.3 are supported. +At some point in the future older versions of Guile will no longer be +supported. + +If using Guile 1.2, configure it with @code{--enable-guile-debug +--enable-dynamic-linking} to work around an unknown bug in this version +of Guile. I ran into this on Solaris 2.6. + +@node Running configure +@section Running @code{configure} + +When doing porting or maintenance activity with CGEN, the build tree +must be configured with the @code{--enable-cgen-maint} option. This +adds the necessary dependencies to the @file{devo/opcodes} and +@file{devo/sim} directories. + +CGEN uses Guile so it must be installed. At present the CGEN configury +requires that if Guile isn't installed in @file{/usr/local} then the +@code{--with-guile=/guile/install/dir} option must be passed to +@file{configure} to specify where Guile is installed. + +@node Writing a CPU description file +@section Writing a CPU description file + +The first step in doing a CGEN port is writing a CPU description file. +The best way to do that is to take an existing file (such as the M32R) +and use it as a template. + +Writing a CPU description file generally involves writing each of the +following types of entries, in order. @xref{RTL} for detailed +descriptions of each type of entry that appears in the description file. + +@menu +* Conventions:: Programming style conventions +* Writing define-arch:: Architecture wide specs +* Writing define-isa:: Instruction set characteristics +* Writing define-cpu:: CPU families +* Writing define-mach:: Machine variants +* Writing define-model:: Models of each machine variant +* Writing define-hardware:: Hardware elements +* Writing define-ifield:: Instruction fields +* Writing define-normal-insn-enum:: Instruction enums +* Writing define-operand:: Instruction operands +* Writing define-insn:: Instructions +* Writing define-macro-insn:: Macro instructions +* Using define-pmacro:: Preprocessor macros +* Interactive development:: Useful things to do in a Guile shell +@end menu + +@node Conventions +@subsection Conventions + +First a digression on conventions and programming style. + +@enumerate 1 +@item @code{define-foo} vs. @code{define-normal-foo} + +Each CPU description @code{define-} entry generally provides two forms: +the normal form and the general form. The normal form has a simple, +fixed-argument syntax that allows one to specify the most popular +elements. When one needs to specify more obscure elements of the +entry one uses the long form which is a list of name/value pairs. The +naming convention is to call the normal form @code{define-normal-foo} +and the general form @code{define-foo}. + +@item Parentheses placement + +Consider: + +@example +(define-normal-insn-enum + insn-op1 "insn format enums" () f-op1 OP1_ + (ADD ADDC SUB SUBC + AND OR XOR INV) +) +@end example + +All Lisp/Scheme code I've read puts the trailing parenthesis on the +previous line. CGEN programming style says the last trailing +parenthesis goes on a line by itself. If someone wants to put forth an +argument of why this should change, please do. I like putting the +very last parenthesis on a line by itself in column 1 because it makes +it easier to traverse the file with a parenthesis matching keystroke. + +@item @code{StudlyCaps} vs. @code{_} vs. @code{-} + +The convention is to have most things lowercase with words separated by +@samp{-}. Things that are uppercase are fixed and well defined: enum +values and mode names. +@c FIXME: Seems to me there's a few others. +This convention must be followed. +@end enumerate + +@node Writing define-arch +@subsection Writing define-arch + +Various simple and architecture-wide common things like the name of the +processor must be defined somewhere, so all of this stuff is put under +@code{define-arch}. + +This must be the first entry in the description file. + +@node Writing define-isa +@subsection Writing define-isa + +There are two purposes to @code{define-isa}. +The first is to specify parameters needed to decode instructions. + +The second is to give the instruction set a name. This is important for +architectures like the ARM where one CPU can execute multiple +instruction sets. + +@node Writing define-cpu +@subsection Writing define-cpu + +CPU families are an internal and artificial classification designed to +collect processor variants that are sufficiently similar together under +one roof for the simulator. What is ``sufficiently similar'' is up to +the programmer. For example, if the only difference between two +processor variants is that one has a few extra instructions, there's no +point in treating them separately in the simulator. + +When simulating the variant without the extra instructions, said +instructions are marked as ``invalid''. On the other hand, putting 32 +and 64 bit variants of an architecture under one roof is problematic +since the word size is different. What ``under one roof'' means is left +fuzzy for now, but basically the simulator engine has a collection of +structures defining internal state, and ``CPU families'' minimize the +number of copies of generated code that manipulate this state. + +@node Writing define-mach +@subsection Writing define-mach + +CGEN uses ``mach'' in the same sense that BFD uses ``mach''. +``Mach'', which is short for `machine', defines a variant of +the architecture. + +@c There may be a need for a many-to-one correspondence between CGEN +@c machs and BFD machs. + +@node Writing define-model +@subsection Writing define-model + +When describing a CPU, in any context, there is ``architecture'' and +there is ``implementation''. In CGEN parlance a ``model'' is an +implementation of a ``mach''. Models specify pipeline and other +performance related characteristics of the implementation. + +Some architectures bring pipeline details up into the architecture +(rather than making them an implementation detail). It's not clear +yet how to handle all the various possibilities so at present this is +done on a case-by-case basis. Maybe a straightforward solution will +emerge. + +@node Writing define-hardware +@subsection Writing define-hardware + +The registers of the processor are specified with +@code{define-hardware}. Also, immediate constants and addresses are +defined to be ``hardware''. By convention, all hardware elements names +are prefaced with @samp{h-}. This convention must be followed. + +Pre-defined hardware elements are: + +@table @code +@item h-memory +Normal CPU memory@footnote{A temporary simplifying assumption is to treat all +memory identically. Being able to specify various kinds of memory +(e.g. on-chip RAM,ROM) is work-in-progress.} +@item h-sint +signed integer +@item h-uint +unsigned integer +@item h-addr +an address +@item h-iaddr +an instruction address +@end table + +Where are floats you ask? They'll be defined when the need arises. + +The program counter is named @samp{h-pc} and must be specified. +It is not a builtin element as sometimes architectures need to +modify its behaviour (in the get/set specs). + +@node Writing define-ifield +@subsection Writing define-ifield + +Writing instruction field entries involves analyzing the instruction set +and creating an entry for each field. If a field has multiple purposes, +one can create separate entries for each intended purpose. The names +should generally follow the names used by the architecture reference +manual. + +By convention, all instruction field names are prefaced with @samp{f-}. This +convention must be followed. + +@node Writing define-normal-insn-enum +@subsection Writing define-normal-insn-enum + +Writing instruction enum entries involves analyzing the instruction set +and attaching names to the opcode fields. For example, if a field named +@samp{op1} is used to select which of add, addc, sub, subc, and, or, +xor, and inv instructions, one would write something like the following: + +@example +(define-normal-insn-enum + insn-op1 "insn format enums" () f-op1 OP1_ + (ADD ADDC SUB SUBC + AND OR XOR INV) +) +@end example + +These entries simplify instruction definitions by giving a name to a +particular value for a particular instruction field. By convention, +enum names are uppercase. This convention must be followed. + +@node Writing define-operand +@subsection Writing define-operand + +Operands are what instruction semantics use to refer to hardware +elements. The typical use of an operand is to map instruction fields to +hardware. For example, if field @samp{f-r2} is used to specify one of +the registers defined by the @code{h-gr} hardware entry, one would +write: + +@code{(dnop sr "source register" () h-gr f-r2)} + +@code{dnop} is short for ``define normal operand'' @footnote{A profound +aversion to typing causes me to often provide brief names of things that +get typed a lot.}. @xref{RTL} for more information. + +@node Writing define-insn +@subsection Writing define-insn + +This involves going through the CPU manual and writing an entry for each +instruction. Instructions specific to a particular machine variant are +indicated so with the `MACH' attribute. Example: + +@example +(define-normal-insn + add "add instruction + ((MACH mach1)) ; or (MACH mach1,mach2,...) for multiple variants + ... +) +@end example + +The `base' machine is a predefined machine variant that includes +instructions available to all variants, and is the default if no +`MACH' attribute is specified. + +When the @file{.cpu} file is processed, CGEN will analyze the semantics +to determine: + +@itemize @bullet +@item input operands + +The list of hardware elements read by the instruction. + +@item output operands + +The list of hardware elements written by the instruction. + +@item attributes + +Instruction attributes that can be computed from the semantics. + +CTI: control transfer instruction, generally a branch. + +@itemize @bullet +@item UNCOND-CTI + +The instruction unconditionally sets pc. + +@item COND-CTI + +The instruction conditionally sets pc. + +@item SKIP-CTI + +NB. This is an expermental attribute. Its usage needs to evolve. + +@item DELAY-SLOT + +NB. This is an expermental attribute. Its usage needs to evolve. +@end itemize + +@end itemize + +CGEN will also try to simplify the semantics as much as possible: + +@itemize @bullet +@item Constant folding + +Expressions involving constants are simplified and any resulting +non-taken paths of conditional expressions are discarded. +@end itemize + +@node Writing define-macro-insn +@subsection Writing define-macro-insn + +Some instructions are really aliases for other instructions, maybe even +a sequence of them. For example, an architecture that has a general +decrement-then-store instruction might have a specialized version of +this instruction called @code{push} supported by the assembler. These +are handled with ``macro instructions''. Macro instructions are used by +the assembler/disassembler only. They are not used by the simulator. + +@node Using define-pmacro +@subsection Using define-pmacro + +When a group of entries, say instructions, share similar information, a +macro (in the C preprocessor sense) can be used to simplify the +description. This can be used to save a lot of typing, which also +improves readability since often 1 page of code is easier to understand +than 4. + +Here is an example from the M32R port. + +@example +(define-pmacro (bin-op mnemonic op2-op sem-op imm-prefix imm) + (begin + (dni mnemonic + (.str mnemonic " reg/reg") + () + (.str mnemonic " $dr,$sr") + (+ OP1_0 op2-op dr sr) + (set dr (sem-op dr sr)) + () + ) + (dni (.sym mnemonic "3") + (.str mnemonic " reg/" imm) + () + (.str mnemonic "3 $dr,$sr," imm-prefix "$" imm) + (+ OP1_8 op2-op dr sr imm) + (set dr (sem-op sr imm)) + () + ) + ) +) +(bin-op add OP2_10 add "$hash" slo16) +(bin-op and OP2_12 and "" uimm16) +(bin-op or OP2_14 or "$hash" ulo16) +(bin-op xor OP2_13 xor "" uimm16) +@end example + +@code{.sym/.str} are short for Scheme's @code{symbol-append} and +@code{string-append} operations and are conceptually the same as the C +preprocessor's @code{##} concatenation operator. @xref{Symbol +concatenation} and @xref{String concatenation} for details. + +@node Interactive development +@subsection Interactive development + +The normal way@footnote{Normal for me anyway, certainly each person will have +their own preference} of writing a CPU description file involves starting Guile +and developing the .CPU file interactively. The basic steps are + +@enumerate 1 +@item Run @code{guile}. +@item @code{(load "dev.scm")} +@item Load application, e.g. @code{(load-opc)} or @code{(load-sim)} +@item Load CPU description file, e.g. @code{(cload #:arch "m32r")} +@item Run generators until output looks reasonable, e.g. @code{(cgen-opc.c)} +@end enumerate + +To assist in the development process and to cut down on some typing, +@file{dev.scm} looks for @file{$HOME/.cgenrc} and, if present, loads it. +Typical things that @file{.cgenrc} contains are definitions of procedures +that combine steps 3 and 4 above. + +Example: + +@example +(define (m32r-opc) + (load-opc) + (cload #:arch "m32r") +) +(define (m32r-sim) + (load-sim) + (cload #:arch "m32r" #:options "with-scache with-profile=fn") +) +(define (m32rbf-sim) + (load-sim) + (cload #:arch "m32r" #:machs "m32r" #:options "with-scache with-profile=fn") +) +(define (m32rxf-sim) + (load-sim) + (cload #:arch "m32r" #:machs "m32rx" #:options "with-scache with-profile=fn") +) +@end example + +CPU description files are loaded into an interactive guile session with +@code{cload}. The syntax is: + +@example +(cload #:arch arch + [#:machs "mach-list"] + [#:isas "isa-list"] + [#:options "option-list"]) +@end example + +Only the @code{#:arch} argument is mandatory. + +@samp{mach-list} is a comma separated string of machines to keep. + +@samp{isa-list} is a comma separated string of isas to keep. + +@samp{options} is a space separated string of options for the application. + +@node Doing an opcodes port +@section Doing an opcodes port + +The best way to begin a port is to take an existing one (preferably one +that is similar to the new port) and use it as a template. + +@enumerate 1 +@item Run @code{guile}. +@item @code{(load "dev.scm")}. This loads in a set of interactive +development routines. +@item @code{(load-opc)}. Load the opcodes support. +@item Edit your @file{<arch>.cpu} and @file{<arch>.opc} files. + @itemize @bullet + @item The @file{.cpu} file is the main description file. + @item The @file{.opc} file provides additional C support code. + @end itemize +@item @code{(cload #:arch "<arch>")} +@item Run each of: + @itemize @bullet + @item @code{(cgen-desc.h)} + @item @code{(cgen-desc.c)} + @item @code{(cgen-opc.h)} + @item @code{(cgen-opc.c)} + @item @code{(cgen-ibld.in)} + @item @code{(cgen-asm.in)} + @item @code{(cgen-dis.in)} + @item @code{(cgen-opinst.c)} -- [optional] + @end itemize +@item Repeat steps 4, 5 and 6 until the output looks reasonable. +@item Add dependencies to @file{opcodes/Makefile.am} to generate the +eight opcodes files (use the M32R port as an example). +@item Run @code{make dep} from the @file{opcodes} build directory. +@item Run @code{make all-opcodes} from the top level build directory. +@end enumerate + +Note that Guile is not currently shipped with Binutils, etc. Until +Guile is shipped with Binutils, etc. or a C implementation of CGEN is +done, the generated files are installed in the source directory and +checked into CVS. + +@node Doing a GAS port +@section Doing a GAS port + +A GAS CGEN port is essentially no different than a normal port except +that the CGEN opcode table is used, and there are extra supporting +routines available in @file{gas/cgen.[ch]}. As always, a good way to +get started is to take the M32R port as a template and go from there. + +The important CGEN-specific things to keep in mind are: +@c to be expanded on as time permits + +@itemize @bullet +@item Several support routines are provided by @file{gas/cgen.c}. Some +must be used, others are available to use if you want to (in general +they should be used unless it's not possible). + + @itemize @bullet + @item @code{gas_cgen_init_parse} + @itemize @minus + @item Call from @code{md_assemble} before doing anything + else. + @item Must be used. + @end itemize + @item @code{gas_cgen_record_fixup} + @itemize @minus + @item Cover function to @code{fix_new}. + @end itemize + @item @code{gas_cgen_record_fixup_exp} + @itemize @minus + @item Cover function to @code{fix_new_exp}. + @end itemize + @item @code{gas_cgen_parse_operand} + @itemize @minus + @item Callback for opcode table based parser, set in + @code{md_begin}. + @end itemize + @item @code{gas_cgen_finish_insn} + @itemize @minus + @item After parsing an instruction, call this to add the + instruction to the frag and queue any fixups. + @end itemize + @item @code{gas_cgen_md_apply_fix3} + @itemize @minus + @item Provides basic @code{md_apply_fix3} support. + @item @code{#define md_apply_fix3 + gas_cgen_md_apply_fix3} if you're able to use + it. + @end itemize + @item @code{gas_cgen_tc_gen_reloc} + @itemize @minus + @item Provides basic @code{tc_gen_reloc} support in function. + @item @code{#define tc_gen_reloc gas_cgen_tc_gen_reloc} + if you're able to use it. + @end itemize + @end itemize + +@item @code{md_begin} should contain the following (plus anything else you +want of course): + +@example + /* Set the machine number and endianness. */ + gas_cgen_opcode_desc = + <arch>_cgen_opcode_open (CGEN_CPU_OPEN_MACHS, + 0 /* mach number */, + CGEN_CPU_OPEN_ENDIAN, + (target_big_endian + ? CGEN_ENDIAN_BIG + : CGEN_ENDIAN_LITTLE), + CGEN_CPU_OPEN_END); + + <arch>_cgen_init_asm (gas_cgen_opcode_desc); + + /* This is a callback from cgen to gas to parse operands. */ + cgen_set_parse_operand_fn (gas_cgen_opcode_desc, gas_cgen_parse_operand); +@end example + +@item @code{md_assemble} should contain the following basic framework: + +@example +@{ + const CGEN_INSN *insn; + char *errmsg; + CGEN_FIELDS fields; +#if CGEN_INT_INSN_P + cgen_insn_t buffer[CGEN_MAX_INSN_SIZE / sizeof (CGEN_INSN_INT)]; +#else + char buffer[CGEN_MAX_INSN_SIZE]; +#endif + + gas_cgen_init_parse (); + + insn = m32r_cgen_assemble_insn (gas_cgen_opcode_desc, str, + &fields, buffer, &errmsg); + + if (! insn) + @{ + as_bad (errmsg); + return; + @} + + gas_cgen_finish_insn (insn, buffer, CGEN_FIELDS_BITSIZE (&fields), + relax_p, /* non-zero to allow relaxable insns */ + result); /* non-null if results needed for later */ +@} +@end example + +@end itemize + +@node Building a GAS test suite +@section Building a GAS test suite + +CGEN can also build the template for test cases for all instructions. In +some cases it can also generate the actual instructions. The result is +then assembled, disassembled, verified, and checked into CVS. Further +changes are usually done by hand as it's easier. The goal here is to +save the enormous amount of initial typing that is required. + +@enumerate 1 +@item @code{cd} to the CGEN build directory +@item @code{make gas-test} + +At this point two files have been created in the CGEN build directory: +@file{gas-allinsn.exp} and @file{gas-build.sh}. + +@item Copy @file{gas-allinsn.exp} to @file{devo/gas/testsuite/gas/<arch>/allinsn.exp}. +@item @code{sh gas-build.sh $build/gas} + +At this point directory tmpdir contains two files: @file{allinsn.s} and +@file{allinsn.d}. File @file{allinsn.d} usually needs a bit of massaging. + +@item Copy @file{tmpdir/allinsn.[sd]} to @file{devo/gas/testsuite/gas/<arch>} +@item Run @code{make check} in the @file{gas} build directory and +massage things until you're satisfied the files are correct. +@item Check files into CVS. +@end enumerate + +At this point further additions/modifications are usually done by hand. + +@node Doing a simulator port +@section Doing a simulator port + +The same basic procedure for opcodes porting applies here. + +@enumerate 1 +@item Run @code{guile}. +@item @code{(load "dev.scm")} +@item @code{(load-sim)} +@item Edit your @file{<arch>.cpu} file. +@item @code{(cload #:arch "<arch>")} +@item Run each of: + @itemize @bullet + @item @code{(cgen-arch.h)} + @item @code{(cgen-arch.c)} + @item @code{(cgen-cpuall.h)} + @end itemize +@item Repeat steps 4,5,6 until the output looks reasonable. +@item Edit your <arch>.cpu file. +@item @code{(cload #:arch "<arch>" #:machs "mach1[,mach2[,...]]")} +@item Run each of: + @itemize @bullet + @item @code{(cgen-cpu.h)} + @item @code{(cgen-cpu.c)} + @item @code{(cgen-decode.h)} + @item @code{(cgen-decode.c)} + @item @code{(cgen-semantics.c)} + @item @code{(cgen-sem-switch.c)} -- only if using a switch() + version of semantics. + @item @code{(cgen-model.c)} + @end itemize +@item Repeat steps 8, 9 and 10 until the output looks reasonable. +@end enumerate + +The following additional files are also needed. These live in the +@file{sim/<arch>} directory. Administrivia files like +@file{configure.in} and @file{Makefile.in} are omitted. + +@itemize @bullet +@item @file{sim-main.h} + +Main include file required by the ``common'' (@file{sim/common}) +support, and by each target's @file{.c} file. +This file includes the relevant other headers. +The order is fairly important. +@file{m32r/sim-main.h} is a good starting point. + +@file{sim-main.h} also defines several types: + +@itemize @minus +@item @code{_sim_cpu} -- a struct containing all state for a +particular CPU. +@item @code{sim_state} -- contains all state of the simulator. +A @code{SIM_DESC} (which is the result of sim_open and is akin +to a file descriptor) points to one of these. +@item @code{sim_cia} -- type of an instruction address. For +CGEN this is generally ``word mode'', in GCC parlance. +@end itemize + +@file{sim-main.h} also defines several macros: + +@itemize @minus +@item @code{CIA_GET(cpu)} -- return ``cia'' of the CPU +@item @code{CIA_SET(cpu,cia)} -- set the ``cia'' of the CPU +@end itemize + +``cia'' is short for "current instruction address". + +The definition of @code{sim_state} is fairly simple. Just copy the M32R +case. The definition of @code{_sim_cpu} is not simple, so pay +attention. The complexity comes from trying to create a ``derived +class'' of @code{sim_cpu} for each CPU family. What is done is define a +different version of @code{sim_cpu} in each CPU family's set of files, +with a common ``base class'' structure ``leading part'' for each +@code{sim_cpu} definition used by non-CPU-family specific files. The +way this is done is by defining @code{WANT_CPU_<CPU-FAMILY-NAME>} at the +top of CPU family specific files. The definition of @code{_sim_cpu} is +then: + +@example + struct _sim_cpu @{ + /* sim/common CPU base */ + sim_cpu_base base; + /* Static parts of CGEN. */ + CGEN_CPU cgen_CPU; + #if defined (WANT_CPU_CPUFAM1) + CPUFAM1_CPU_DATA CPU_data; + #elif defined (WANT_CPU_CPUFAM2) + CPUFAM2_CPU_DATA CPU_data; + #endif + @}; +@end example + +@item @file{tconfig.in} + +This file predates @file{sim-main.h} and was/is intended to contain +macros that configure the simulator sources. + +@itemize @bullet +@item @code{SIM_HAVE_MODEL} -- enable @file{common/sim-model.[ch]} +support. +@item @code{SIM_HANDLES_LMA} -- makes @file{sim-hload.c} do the right +thing. +@item @code{WITH_SCACHE_PBB} -- define this to 1 if using pbb scaching. +@end itemize + +@item @file{<arch>-sim.h} + +This file predates @file{sim-main.h} and contains miscellaneous macros +and definitions used by the simulator. + +@item @file{mloop.in} + +This file contains code to implement the fetch/execute process. There +are various ways to do this, and several are supported. Which one to +choose depends on the environment in which the CPU will be used. For +example when executing a program in a single-CPU environment without +devices, most or all available cycles can be devoted to simulation of the +atarget CPU. However, in an environment with devices or multiple cpus, one +may wish the CPU to execute one instruction then relinquish control so a +device operation may be done or an instruction can be simulated on a +second cpu. Efficient techniques for the former aren't necessarily the best +for the latter. + +Three versions are currently supported: + +@enumerate 1 +@item simple -- fetch/decode/execute one insn +@item scache -- same as simple but results of decoding are cached +@item pbb -- same as scache but several insns are handled each iteration +pbb stands for pseudo basic block. +@end enumerate + +This file is processed by @file{common/genmloop.sh} at build time. The +result is two files: @file{mloop.c} and @file{eng.h}. + +@item @file{sim-if.c} + +By convention this file contains @code{sim_open}, @code{sim_close}, +@code{sim_create_inferior}, @code{sim_do_command}. These functions can +live in any file of course. They're here because they're the parts of +the @code{remote-sim.h} interface that aren't provided by the common +directory. + +@item @file{<cpufam>.c} + +By convention this file contains register access and model support +functions for a CPU family (the name of this file is misnamed in the +M32R case). The register access functions implement the +@code{sim_fetch_register} and @code{sim_store_register} interface +functions (named @code{<cpufam>_@{fetch,store@}_register}), and support +code for register get/set rtl. The model support functions implement the +before/after handlers (functions that handle tracing/profiling) and +timing for each function unit. + +@item Other files + +The M32R port has two other handwritten files: @file{devices.c} and +@file{traps.c}. How you wish to organize this is up to you. +@end itemize + +@node Building a simulator test suite +@section Building a simulator test suite + +CGEN can also build the template for test cases for all instructions. In +some cases it can also generate the actual instructions +@footnote{Although this hasn't been implemented yet.}. The result is +then verified and checked into CVS. Further changes are usually done by +hand as it's easier. The goal here is to save the enormous amount of +initial typing that is required. + +@enumerate 1 +@item @code{cd} to the CGEN build directory +@item @code{make sim-test} + +At this point two files have been created in the CGEN build directory: +@file{sim-allinsn.exp} and @file{sim-build.sh}. + +@item Copy @file{sim-allinsn.exp} to +@file{devo/sim/testsuite/sim/<arch>/allinsn.exp}. +@item @code{sh sim-build.sh} + +At this point a new subdirectory called @file{tmpdir} will be created +and will contain one test case for each instruction. The framework has +been filled in but not the actual test case. It's handy to write an +``include file'' containing assembler macros that simplify writing test +cases. See @file{devo/sim/testsuite/sim/m32r/testutils.inc} for an +example. + +@item write testutils.inc +@item finish each test case +@item copy @file{tmpdir/*.cgs} to @file{devo/sim/testsuite/sim/<arch>} +@item run @code{make check} in the sim build directory and massage things until you're satisfied the files are correct +@item Check files into CVS. +@end enumerate + +@noindent At this point further additions/modifications are usually done +by hand. diff --git a/cgen/doc/rtl.texi b/cgen/doc/rtl.texi new file mode 100644 index 00000000000..3e740dbf31c --- /dev/null +++ b/cgen/doc/rtl.texi @@ -0,0 +1,2276 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node RTL +@chapter CGEN's Register Transfer Language +@cindex RTL +@cindex Register Transfer Language + +CGEN uses a variant of GCC's Register Transfer Language as the basis for +its CPU description language. + +@menu +* RTL Introduction:: Introduction to CGEN's RTL +* Trade-offs:: Various trade-offs in the design +* Rules and notes:: Rules and notes common to all entries +* Definitions:: Definitions in the description file +* Attributes:: Random data associated with any entry +* Architecture variants:: Specifying variations of a CPU +* Model variants:: Specifying variations of a CPU's implementation +* Hardware elements:: Elements of a CPU +* Instruction fields:: Fields of an instruction +* Enumerated constants:: Assigning useful names to important numbers +* Instruction operands:: +* Derived operands:: Operands for CISC-like architectures +* Instructions:: +* Macro-instructions:: +* Modes:: +* Expressions:: +* Macro-expressions:: +@end menu + +@node RTL Introduction +@section RTL Introduction + +The description language, or RTL +@footnote{While RTL stands for Register Transfer Language, it is also used +to denote the CPU description language as a whole.}, needs to support the +definition of all the +architectural and implementation features of a CPU, as well as enough +information for all intended applications. At present this is just the +opcodes table and an ISA level simulator, but it is not intended that +applications be restricted to these two areas. The goal is having an +application independent description of the CPU. In the end that's a lot to +ask for from one language. Certainly gate level specification of a CPU +is not attempted! + +The syntax of the language is inspired by GCC's RTL and by the Scheme +programming language, theoretically taking the best of both. To what +extent that is true, and to what extent that is sufficient inspiration +is certainly open to discussion. In actuality, there isn't much difference +here from GCC's RTL that is attributable to being Scheme-ish. One +important Scheme-derived concept is arbitrary precision of constants. +Sign or zero extension of constants in GCC has always been a source of +problems. In CGEN'S RTL constants have modes and there are both signed +and unsigned modes. + +Here is a graphical layout of the hierarchy of elements of a @file{.cpu} +file. + +@example + architecture + / \ + cpu-family1 cpu-family2 ... + / \ / \ + machine1 machine2 machine3 ... + / \ + model1 model2 ... +@end example + +Each of these elements is explained in more detail below. The +@emph{architecture} is one of @samp{sparc}, @samp{m32r}, etc. Within +the @samp{sparc} architecture, @emph{cpu-family} might be +@samp{sparc32}, @samp{sparc64}, etc. Within the @samp{sparc32} CPU +family, the @emph{machine} might be @samp{sparc-v8}, @samp{sparclite}, +etc. Within the @samp{sparc-v8} machine classification, @emph{model} +might be @samp{hypersparc}, @samp{supersparc}, etc. + +Instructions form their own hierarchy as each instruction may be supported +by more than one machine. Also, some architectures can handle more than +one instruction set on one chip (e.g. ARM). + +@example + isa + | + instruction + / \ + operand1 operand2 ... + | | + hw1+ifield1 hw2+ifield2 ... +@end example + +Each of these elements is explained in more detail below. + +@node Trade-offs +@section Trade-offs + +While CGEN is written in Scheme, this is not a requirement. The +description language should be considered absent of any particular +implementation, though certainly some things were done to simplify +reading @file{.cpu} files with Scheme. Scheme related choices have been +made in areas that have no serious impact on the usefulness of the CPU +description language. Places where that is not the case need to be +revisited, though there currently are no known ones. + +One place where the Scheme implementation influenced the design of +CGEN's RTL is in the handling of modes. The Scheme implementation was +simplified by treating modes as an explicit argument, rather than as an +optional suffix of the operation name. For example, compare @code{(add +SI dr sr)} in CGEN versus @code{(add:SI dr sr)} in GCC RTL. The mode is +treated as optional so a shorthand form of @code{(add dr sr)} works. + +@node Rules and notes +@section Rules and notes + +A few basic guidelines for all entries: + +@itemize @bullet +@item names must be valid Scheme symbols. +@item comments are used, for example, to comment the generated C code +@footnote{It is possible to produce a reference manual from +@file{.cpu} files and such an application wouldn't be a bad idea.}. +@item comments may be any number of lines, though generally succinct comments +are preferable@footnote{It would be reasonable to have a short form +and a long form of comment. Either as two entries are as one entry with +the short form separated from the long form via some delimiter (say the +first newline).}. +@item everything is case sensitive.@footnote{??? This is true in RTL, +though some apps add symbols and convert case that can cause collisions.} +@item while "_" is a valid character to use in symbols, "-" is preferred +@item except for the @samp{comment} and @samp{attrs} fields and unless +otherwise specified all fields must be present. +@end itemize + +Symbols and strings + +Symbols in CGEN are the same as in Scheme. +Symbols can be used anywhere a string can be used. +The reverse is not true, and in general strings can't be used in place +of symbols. + +@node Definitions +@section Definitions +@cindex Definitions + +Each entry has the same format: @code{(define-foo arg1 arg2 ...)}, where +@samp{foo} designates the type of entry (e.g. @code{define-insn}). In +the general case each argument is a name/value pair expressed as +@code{(name value)}. +(*note: Another style in common use is `:name value' and doesn't require +parentheses. Maybe that would be a better way to go here. The current +style is easier to construct from macros though.) + +While the general case is flexible, it also is excessively verbose in +the normal case. To reduce this verbosity, a second version of most +define-foo's exists that takes positional arguments. To further reduce +this verbosity, preprocessor macros can be written to simplify things +further for the normal case. See sections titled ``Simplification +macros'' below. + +@node Attributes +@section Attributes +@cindex Attributes + +Attributes are used throughout for specifying various properties. +For portability reasons attributes can only have 32 bit integral values +(signed or unsigned). +@c How about an example? + +There are four kinds of attributes: boolean, integer, enumerated, and bitset. +Boolean attributes can be achieved via others, but they occur frequently +enough that they are special cased (and one bit can be used to record them). +Bitset attributes are a useful simplification when one wants to indicate an +object can be in one of many states (e.g. an instruction may be supported by +multiple machines). + +String attributes might be a useful addition. +Another useful addition might be functional attributes (the attribute +is computed at run-time - currently all attributes are computed at +compile time). One way to implement functional attributes would be to +record the attributes as byte-code and lazily evaluate them, caching the +results as appropriate. The syntax has been carefully done to not +preclude either as an upward compatible extension. + +Attributes must be defined before they can be used. +There are several predefined attributes for entry types that need them +(instruction field, hardware, operand, and instruction). Predefined +attributes are documented in each relevant section below. + +In C applications an enum is created that defines all the attributes. +Applications that wish to be architecture independent need the attribute +to have the same value across all architectures. This is achieved by +giving the attribute the INDEX attribute, which specifies the enum value +must be fixed across all architectures. +@c FIXME: Give an example here. +@c FIXME: Need a better name than `INDEX'. + +Convention requires attribute names consist of uppercase letters, numbers, +"-", and "_", and must begin with a letter. +To be consistent with Scheme, "-" is preferred over "_". + +@subsection Boolean Attributes +@cindex Attributes, boolean + +Boolean attributes are defined with: + +@example +(define-attribute + (type boolean) + (for user-list) + (name attribute-name) + (comment "attribute comment") + (attrs attribute-attributes) +) +@end example + +The default value of boolean attributes is always false. This can be +relaxed, but it's one extra complication that is currently unnecessary. +Boolean attributes are specified in either of two forms: (NAME expr), +and NAME, !NAME. The first form is the canonical form. The latter two +are shorthand versions. `NAME' means "true" and `!NAME' means "false". +@samp{expr} is an expression that evaluates to 0 for false and non-zero +for true @footnote{The details of @code{expr} is still undecided.}. + +@code{user-list} is a space separated list of entry types that will use +the attribute. Possible values are: @samp{attr}, @samp{enum}, +@samp{cpu}, @samp{mach}, @samp{model}, @samp{ifield}, @samp{hardware}, +@samp{operand}, @samp{insn} and @samp{macro-insn}. If omitted all are +considered users of the attribute. + +@subsection Integer Attributes +@cindex Attributes, integer + +Integer attributes are defined with: + +@example +(define-attribute + (type integer) + (for user-list) + (name attribute-name) + (comment "attribute comment") + (attrs attribute-attributes) + (default expr) +) +@end example + +If omitted, the default is 0. + +(*note: The details of `expr' is still undecided. For now it must be +an integer.) + +Integer attributes are specified with (NAME expr). + +@subsection Enumerated Attributes +@cindex Attributes, enumerated + +Enumerated attributes are the same as integer attributes except the +range of possible values is restricted and each value has a name. +Enumerated attributes are defined with + +@example +(define-attribute + (type enum) + (for user-list) + (name attribute-name) + (comment "attribute comment") + (attrs attribute-attributes) + (values enum-value1 enum-value2 ...) + (default expr) +) +@end example + +If omitted, the default is the first specified value. + +(*note: The details of `expr' is still undecided. For now it must be the +name of one of the specified values.) + +Enum attributes are specified with (NAME expr). + +@subsection Bitset Attributes +@cindex Attributes, bitset + +Bitset attributes are for situations where you want to indicate something +is a subset of a small set of possibilities. The MACH attribute uses this +for example to allow specifying which of the various machines support a +particular insn. +(*note: At present the maximum number of possibilities is 32. +This is an implementation restriction which can be relaxed, but there's +currently no rush.) + +Bitset attributes are defined with: + +@example +(define-attribute + (type bitset) + (for user-list) + (name attribute-name) + (comment "attribute comment") + (attrs attribute-attributes) + (values enum-value1 enum-value2 ...) + (default default-name) +) +@end example + +@samp{default-name} must be the name of one of the specified values. If +omitted, it is the first value. + +Bitset attributes are specified with @code{(NAME val1,val2,...)}. There +must be no spaces in ``@code{val1,val2,...}'' and each value must be a +valid Scheme symbol. + +(*note: it's not clear whether allowing arbitrary expressions will be +useful here, but doing so is not precluded. For now each value must be +the name of one of the specified values.) + +@node Architecture variants +@section Architecture Variants +@cindex Architecture variants + +The base architecture and its variants are described in four parts: +@code{define-arch}, @code{define-isa}, @code{define-cpu}, and +@code{define-mach}. + +@menu +* define-arch:: +* define-isa:: +* define-cpu:: +* define-mach:: +@end menu + +@node define-arch +@subsection define-arch +@cindex define-arch + +@code{define-arch} describes the overall architecture, and must be +present. + +The syntax of @code{define-arch} is: + +@example +(define-arch + (name architecture-name) ; e.g. m32r + (comment "description") ; e.g. "Mitsubishi M32R" + (attrs attribute-list) + (default-alignment aligned|unaligned|forced) + (insn-lsb0? #f|#t) + (machs mach-name-list) + (isas isa-name-list) +) +@end example + +@subsubsection default-alignment + +Specify the default alignment to use when fetching data (and +instructions) from memory. At present this can't be overridden, but +support can be added if necessary. The default is @code{aligned}. + +@subsubsection insn-lsb0? +@cindex insn-lsb0? + +Specifies whether the most significant or least significant bit in a +word is bit number 0. Generally this should conform to the convention +in the architecture manual. This is independent of endianness and is an +architecture wide specification. There is no support for using +different bit numbering conventions within an architecture. +@c Not that such support can't be added of course. + +Instruction fields are always numbered beginning with the most +significant bit. That is, the `start' of a field is always its most +significant bit. For example, a 4 bit field in the uppermost bits of a +32 bit instruction would have a start/length of (31 4) when insn-lsb0? = +@code{#t}, and (0 4) when insn-lsb0? = @code{#f}. + +@subsubsection mach-name-list + +The list of names of machines in the architecture. +There should be one entry for each @code{define-mach}. + +@subsubsection isa-name-list + +The list of names of instruction sets in the architecture. +There must be one for each @code{define-isa}. +An example of an architecture with more than one is the ARM which +has a 32 bit instruction set and a 16 bit "Thumb" instruction set +(the sizes here refer to instruction size). + +@node define-isa +@subsection define-isa +@cindex define-isa + +@code{define-isa} describes aspects of the instruction set. +A minimum of one ISA must be defined. + +The syntax of @code{define-isa} is: + +@example +(define-isa + (name isa-name) + (comment "description") + (attrs attribute-list) + (default-insn-word-bitsize n) + (default-insn-bitsize n) + (base-insn-bitsize n) + (decode-assist (b0 b1 b2 ...)) + (liw-insns n) + (parallel-insns n) + (condition ifield-name expr) + (setup-semantics expr) + (decode-splits decode-split-list) + ; ??? missing here are fetch/execute specs +) +@end example + +@subsubsection default-insn-word-bitsize + +Specifies the default size of an instruction word in bits. +This affects the numbering of field bits in words beyond the +base instruction. +@xref{Instruction fields} for more information. + +??? There is currently no explicit way to specify a different instruction +word bitsize for particular instructions, it is derived from the instruction +field specs. + +@subsubsection default-insn-bitsize + +The default size of an instruction in bits. It is generally the size of +the smallest instruction. It is used when parsing instruction fields. +It is also used by the disassembler to know how many bytes to skip for +unrecognized instructions. + +@subsubsection base-insn-bitsize + +The minimum size of an instruction, in bits, to fetch during execution. +If the architecture has a variable length instruction set, this is the +size of the initial word to fetch. There is no need to specify the +maximum length of an instruction, that can be computed from the +instructions. Examples: + +@table @asis +@item i386 +8 +@item M68k +16 +@item SPARC +32 +@item M32R +32 +@end table + +The M32R case is interesting because instructions can be 16 or 32 bits. +However instructions on 32 bit boundaries can always be fetched 32 bits +at a time as 16 bit instructions always come in pairs. + +@subsubsection decode-assist +@cindex decode-assist + +Which bits to initially use to decode the instruction. +For example on the SPARC these are bits: 31 30 24 23 22 21 20 19. +The rest of the decoder is machine generated. +The intent of @code{decode-assist} is to give the machine generated +code a head start. + +??? It might be useful to provide greater control, but this is sufficient +for now. + +It is okay if the opcode bits are over-specified for some instructions. +It is also okay if the opcode bits are under-specified for some instructions. +The machine generated decoder will properly handle both these situations. +Just pick a useful number of bits that distinguishes most instructions. +It is usually best to not pick more than 8 bits to keep the size of the +initial decode table down. + +Bit numbering is defined by the @code{insn-lsb0?} field. + +@subsubsection liw-insns +@cindex liw-insns + +The number of instructions the CPU always fetches at once. This is +intended for architectures like the M32R, and does not refer to a CPU's +ability to pre-fetch instructions. The default is 1. + +@subsubsection parallel-insns +@cindex parallel-insns + +The maximum number of instructions the CPU can execute in parallel. The +default is 1. + +??? Rename this to @code{max-parallel-insns}? + +@subsubsection condition + +Some architectures like ARM and ARC conditionally execute every instruction +based on the condition specified by one instruction field. +The @code{condition} spec exists to support these architectures. +@code{ifield-name} is the name of the instruction field denoting the +condition and @code{expression} is an RTL expressions that returns +the value of the condition (false=zero, true=non-zero). + +@subsubsection setup-semantics + +Specify a statement to be performed prior to executing particular instructions. +This is used, for example, on the ARM where the value of the program counter +(general register 15) is a function of the instruction (it is either +pc+8 or pc+12, depending on the instruction). + +@subsubsection decode-splits + +Specify a list of field names and values to split instructions up by. +This is used, for example, on the ARM where the behavior of some instructions +is quite different when the destination register is r15 (the pc). + +The syntax is: + +@example +(decode-splits + (ifield1-name + constraints + ((split1-name (value1 value2 ...)) (split2-name ...))) + (ifield2-name + ...) +) +@end example + +@code{constraints} is work-in-progress and should be @code{()} for now. + +One copy of each instruction satisfying @code{constraint} is made +for each specified split. The semantics of each copy are then +simplified based on the known values of the specified instruction field. + +@node define-cpu +@subsection define-cpu +@cindex define-cpu + +@code{define-cpu} defines a ``CPU family'' which is a programmer +specified collection of related machines. What constitutes a family is +work-in-progress however it is intended to distinguish things like +sparc32 vs sparc64. Machines in a family are sufficiently similar that +the simulator semantic code can handle any differences at run time. At +least that's the current idea. A minimum of one CPU family must be +defined. +@footnote{FIXME: Using "cpu" in "cpu-family" here is confusing. +Need a better name. Maybe just "family"?} + +The syntax of @code{define-cpu} is: + +@example +(define-cpu + (name cpu-name) + (comment "description") + (attrs attribute-list) + (endian big|little|either) + (insn-endian big|little|either) + (data-endian big|little|either) + (float-endian big|little|either) + (word-bitsize n) + (parallel-insns n) + (file-transform transformation) +) +@end example + +@subsubsection endian + +The endianness of the architecture is one of three values: @code{big}, +@code{little} and @code{either}. + +An architecture may have multiple endiannesses, including one for each +of: instructions, integers, and floats (not that that's intended to be the +complete list). These are specified with @code{insn-endian}, +@code{data-endian}, and @code{float-endian} respectively. + +Possible values for @code{insn-endian} are: @code{big}, @code{little}, +and @code{either}. If missing, the value is taken from @code{endian}. + +Possible values for @code{data-endian} and @code{float-endian} are: @code{big}, +@code{big-words}, @code{little}, @code{little-words} and @code{either}. +If @code{big-words} then each word is little-endian. +If @code{little-words} then each word is big-endian. +If missing, the value is taken from @code{endian}. + +??? Support for these is work-in-progress. All forms are recognized +by the @file{.cpu} file reader, but not all are supported internally. + +@subsubsection word-bitsize + +The number of bits in a word. In GCC, this is @code{BITS_PER_WORD}. + +@subsubsection parallel-insns + +This is the same as the @code{parallel-insns} spec of @code{define-isa}. +It allows a CPU family to override the value. + +@subsubsection file-transform + +Specify the file name transformation of generated code. + +Each generated file has a named related to the ISA or CPU family. +Sometimes generated code needs to know the name of another generated +file (e.g. #include's). +At present @code{file-transform} specifies the suffix. + +For example, M32R/x generated files have an `x' suffix, as in @file{cpux.h} +for the @file{cpu.h} header. This is indicated with +@code{(file-transform "x")}. + +??? Ideally generated code wouldn't need to know anything about file names. +This breaks down for #include's. It can be fixed with symlinks or other +means. + +@node define-mach +@subsection define-mach +@cindex define-mach + +@code{define-mach} defines a distinct variant of a CPU. It currently +has a one-to-one correspondence with BFD's "mach number". A minimum of +one mach must be defined. + +The syntax of @code{define-mach} is: + +@example +(define-mach + (name mach-name) + (comment "description") + (attrs attribute-list) + (cpu cpu-family-name) + (bfd-name "bfd-name") + (isas isa-name-list) +) +@end example + +@subsubsection bfd-name +@cindex bfd-name + +The name of the mach as used by BFD. If not specified the name of the +mach is used. + +@subsubsection isas + +List of names of ISA's the machine supports. + +@node Model variants +@section Model Variants + +For each `machine', as defined here, there is one or more `models'. +There must be at least one model for each machine. +(*note: There could be a default, but requiring one doesn't involve that much +extra typing and forces the programmer to at least think about such things.) + +@example +(define-model + (name model-name) + (comment "description") + (attrs attribute-list) + (mach machine-name) + (state (variable-name-1 variable-mode-1) ...) + (unit name "comment" (attributes) + issue done state inputs outputs profile) +) +@end example + +@subsection mach + +The name of the machine the model is an implementation of. + +@subsection state + +A list of variable-name/mode pairs for recording global function unit +state. For example on the M32R the value is @code{(state (h-gr UINT))} +and is a bitmask of which register(s) are the targets of loads and thus +subject to load stalls. + +@subsection unit + +Specifies a function unit. Any number of function units may be specified. +The @code{u-exec} unit must be specified as it is the default. + +The syntax is: + +@example + (unit name "comment" (attributes) + issue done state inputs outputs profile) +@end example + +@samp{issue} is the number of operations that may be in progress. +It originates from GCC function unit specification. In general the +value should be 1. + +@samp{done} is the latency of the unit. The value is the number of cycles +until the result is ready. + +@samp{state} has the same syntax as the global model `state' and is a list of +variable-name/mode pairs. + +@samp{inputs} is a list of inputs to the function unit. +Each element is @code{(operand-name mode default-value)}. + +@samp{outputs} is a list of outputs of the function unit. +Each element is @code{(operand-name mode default-value)}. + +@samp{profile} is an rtl-code sequence that performs function unit +modeling. At present the only possible value is @code{()} meaning +invoke a user supplied function named @code{<cpu>_model_<mach>_<unit>}. + +The current function unit specification is a first pass in order to +achieve something that moderately works for the intended purpose (cycle +counting on the simulator). Something more elaborate is on the todo list +but there is currently no schedule for it. The new specification must +try to be application independent. Some known applications are: +cycle counting in the simulator, code scheduling in a compiler, and code +scheduling in a JIT simulator (where speed of analysis can be more +important than getting an optimum schedule). + +The inputs/outputs fields are how elements in the semantic code are mapped +to function units. Each input and output has a name that corresponds +with the name of the operand in the semantics. Where there is no +correspondence, a mapping can be made in the unit specification of the +instruction (see the subsection titled ``Timing''). + +Another way to achieve the correspondence is to create separate function +units that contain the desired input/output names. For example on the +M32R the u-exec unit is defined as: + +@example +(unit u-exec "Execution Unit" () + 1 1 ; issue done + () ; state + ((sr INT -1) (sr2 INT -1)) ; inputs + ((dr INT -1)) ; outputs + () ; profile action (default) +) +@end example + +This handles instructions that use sr, sr2 and dr as operands. A second +function unit called @samp{u-cmp} is defined as: + +@example +(unit u-cmp "Compare Unit" () + 1 1 ; issue done + () ; state + ((src1 INT -1) (src2 INT -1)) ; inputs + () ; outputs + () ; profile action (default) +) +@end example + +This handles instructions that use src1 and src2 as operands. The +organization of units is arbitrary. On the M32R, src1/src2 instructions +are typically compare instructions so a separate function unit was +created for them. + +@node Hardware elements +@section Hardware Elements + +The elements of hardware that make up a CPU are defined with +@code{define-hardware}. Examples of hardware elements include +registers, condition bits, immediate constants and memory. + +Instruction fields that provide numerical values (``immediate +constants'') aren't really elements of the hardware, but it simplifies +things to think of them this way. Think of them as @emph{constant +generators}@footnote{A term borrowed from the book on the Bulldog +compiler and perhaps other sources.}. + +Hardware elements are defined with: + +@example +(define-hardware + (name hardware-name) + (comment "description") + (attrs attribute-list) + (semantic-name hardware-semantic-name) + (type type-name type-arg1 type-arg2 ...) + (indices index-type index-arg1 index-arg2 ...) + (values values-type values-arg1 values-arg2 ...) + (handlers handler1 handler2 ...) + (get (args) (expression)) + (set (args) (expression)) +) +@end example + +The only required members are @samp{name} and @samp{type}. Convention +requires @samp{hardware-name} begin with @samp{h-}. + +@subsection attrs + +List of attributes. There are several predefined hardware attributes: + +@itemize @minus +@item MACH + +A bitset attribute used to specify which machines have this hardware element. +Do not specify the MACH attribute if the value is "all machs". + +Usage: @code{(MACH mach1,mach2,...)} +There must be no spaces in ``@code{mach1,mach2,...}''. + +@item CACHE-ADDR + +A hint to the simulator semantic code generator to tell it it can record the +address of a selected register in an array of registers. This speeds up +simulation by moving the array computation to extraction time. +This attribute is only useful to register arrays and cannot be specified +with @code{VIRTUAL} (??? revisit). + +@item PROFILE + +Ignore. This is a work-in-progress to define how to profile references +to hardware elements. + +@item VIRTUAL + +The hardware element doesn't require any storage. +This is used when you want a value that is derived from some other value. +If @code{VIRTUAL} is specified, @code{get} and @code{set} specs must be +provided. +@end itemize + +@subsection type + +This is the type of hardware. Current values are: @samp{register}, +@samp{memory}, and @samp{immediate}. + +For registers the syntax is one of: + +@example +@code{(register mode [(number)])} +@code{(register (mode bits) [(number)])} +@end example + +where @samp{(number)} is the number of registers and is optional. If +omitted, the default is @samp{(1)}. +The second form is useful for describing registers with an odd (as in +unusual) number of bits. +@code{mode} for the second form must be one of @samp{INT} or @samp{UINT}. +Since these two modes don't have an implicit size, they cannot be used for +the first form. + +@c ??? Might wish to remove the mode here and just specify number of bits. + +For memory the syntax is: + +@example +@code{(memory mode (size))} +@end example + +where @samp{(size)} is the size of the memory in @samp{mode} units. +In general @samp{mode} should be @code{QI}. + +For immediates the syntax is one of + +@example +@code{(immediate mode)} +@code{(immediate (mode bits))} +@end example + +The second form is for values for which a mode of that size doesn't exist. +@samp{mode} for the second form must be one of @code{INT} or @code{UINT}. +Since these two modes don't have an implicit size, they cannot be used +for the first form. + +??? There's no real reason why a mode like SI can't be used +for odd-sized immediate values. The @samp{bits} field indicates the size +and the @samp{mode} field indicates the mode in which the value will be used, +as well as its signedness. This would allow removing INT/UINT for this +purpose. On the other hand, a non-width specific mode allows applications +to choose one (a simulator might prefer to store immediates in an `int' +rather than, say, char if the specified mode was @code{QI}). + +@subsection indices + +Specify names for individual elements with the @code{indices} spec. +It is only valid for registers with more than one element. + +The syntax is: + +@example +@code{(indices index-type arg1 arg2 ...)} +@end example + +where @samp{index-type} specifies the kind of index and @samp{arg1 arg2 ...} +are arguments to @samp{index-type}. + +The are two supported values for @samp{index-type}: @code{keyword} +and @code{extern-keyword}. The difference is that indices defined with +@code{keyword} are kept internal to the hardware element's definition +and are not usable elsewhere, whereas @code{extern-keyword} specifies +a set of indices defined elsewhere. + +@subsubsection keyword + +@example +@code{(indices keyword "prefix" ((name1 value1) (name2 value2) ...))} +@end example + +@samp{prefix} is the common prefix for each of the index names. +For example, SPARC registers usually begin with @samp{"%"}. + +Each @samp{(name value)} pair maps a name with an index number. +An index can be specified multiple times, for example, when a register +has multiple names. + +Example from Thumb: + +@example +(define-hardware + (name h-gr-t) + (comment "Thumb's general purpose registers") + (attrs (ISA thumb) VIRTUAL) ; ??? CACHE-ADDR should be doable + (type register WI (8)) + (indices keyword "" + ((r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7))) + (get (regno) (reg h-gr regno)) + (set (regno newval) (set (reg h-gr regno) newval)) +) +@end example + +@subsubsection extern-keyword + +@example +@code{(indices extern-keyword keyword-name)} +@end example + +Example from M32R: + +@example +(define-keyword + (name gr-names) + (print-name h-gr) + (prefix "") + (values (fp 13) (lr 14) (sp 15) + (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15)) +) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE CACHE-ADDR) + (type register WI (16)) + (indices extern-keyword gr-names) +) +@end example + +@subsection values + +Specify a list of valid values with the @code{values} spec. +@c Clumsy wording. + +The syntax is identical to the syntax for @code{indices}. +It is only valid for immediates. + +Example from sparc64: + +@example +(define-hardware + (name h-p) + (comment "prediction bit") + (attrs (MACH64)) + (type immediate (UINT 1)) + (values keyword "" (("" 0) (",pf" 0) (",pt" 1))) +) +@end example + +@subsection handlers + +The @code{handlers} spec is an escape hatch for indicating when a +programmer supplied routine must be called to perform a function. + +The syntax is: + +@example +@samp{(handlers (handler-name1 "function_name1") + (handler-name2 "function_name2") + ...)} +@end example + +@samp{handler-name} must be one of @code{parse} or @code{print}. +How @samp{function_name} is used is application specific, but in +general it is the name of a function to call. The only application +that uses this at present is Opcodes. See the Opcodes documentation for +a description of each function's expected prototype. + +@subsection get + +Specify special processing to be performed when a value is read +with the @code{get} spec. + +The syntax for scalar registers is: + +@example +@samp{(get () (expression))} +@end example + +The syntax for vector registers is: + +@example +@samp{(get (index) (expression))} +@end example + +@code{expression} is an RTL expression that computes the value to return. +The mode of the result must be the mode of the register. + +@code{index} is the name of the index as it appears in @code{expression}. + +At present, @code{sequence}, @code{parallel}, and @code{case} expressions +are not allowed here. + +@subsection set + +Specify special processing to be performed when a value is written +with the @code{set} spec. + +The syntax for scalar registers is: + +@example +@samp{(set (newval) (expression))} +@end example + +The syntax for vector registers is: + +@example +@samp{(set (index newval) (expression))} +@end example + +@code{expression} is an RTL expression that stores @code{newval} +in the register. This may involve storing values in other registers as well. +@code{expression} must be one of @code{set}, @code{if}, @code{sequence}, or +@code{case}. + +@code{index} is the name of the index as it appears in @code{expression}. + +@subsection Predefined hardware elements + +Several hardware types are predefined: + +@table @code +@item h-uint +unsigned integer +@item h-sint +signed integer +@item h-memory +main memory, where ``main'' is loosely defined +@item h-addr +data address (data only) +@item h-iaddr +instruction address (instructions only) +@end table + +@subsection Program counter + +The program counter must be defined and is not a builtin. +If get/set specs are not required, define it as: + +@example +(dnh h-pc "program counter" (PC) (pc) () () ()) +@end example + +If get/set specs are required, define it as: + +@example +(define-hardware + (name h-pc) + (comment "<ARCH> program counter") + (attrs PC) + (type pc) + (get () <insert get code here>) + (set (newval) <insert set code here>) +) +@end example + +If the architecture has multiple instruction sets, all must be specified. +If they're not, the default is the first one which is not what you want. +Here's an example from @file{arm.cpu}: + +@example +(define-hardware + (name h-pc) + (comment "ARM program counter (h-gr reg 15)") + (attrs PC (ISA arm,thumb)) + (type pc) + (set (newval) + (if (reg h-tbit) + (set (raw-reg SI h-pc) (and newval -2)) + (set (raw-reg SI h-pc) (and newval -4)))) +) +@end example + +@subsection Simplification macros + +To simplify @file{.cpu} files, the @code{dnh} +(@code{define-normal-hardware}) macro exists that takes a fixed set of +positional arguments for the typical hardware element. The syntax of +@code{dnh} is: + +@code{(dnh name comment attributes type indices values handlers)} + +Example: + +@example +(dnh h-gr "general registers" + () ; attributes + (register WI (16)) + (keyword "" ((fp 13) (sp 15) (lr 14) + (r0 0) (r1 1) (r2 2) (r3 3) + (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) + (r12 12) (r13 13) (r14 14) (r15 15))) + () () +) +@end example + +This defines an array of 16 registers of mode @code{WI} ("word int"). +The names of the registers are @code{r0...r15}, and registers 13, 14 and +15 also have the names @code{fp}, @code{lr} and @code{sp} respectively. + +Scalar registers with no special requirements occur frequently. +Macro @code{dsh} (@code{define-simple-hardware}) is identical to +@code{dnh} except does not include the @code{indices}, @code{values}, +or @code{handlers} specs. + +@example +(dsh h-ibit "interrupt enable bit" () (register BI)) +@end example + +@node Instruction fields +@section Instruction Fields +@cindex Fields, instruction + +Instruction fields define the raw bitfields of each instruction. +Minimal semantic meaning is attributed to them. Support is provided for +mapping to and from the raw bit pattern and the usable contents, and +other simple manipulations. + +The syntax for defining instruction fields is: + +@example +(define-ifield + (name field-name) + (comment "description") + (attrs attribute-list) + (start starting-bit-number) + (length number-of-bits) + (follows ifield-name) + (mode mode-name) + (encode (value pc) (rtx to describe encoding)) + (decode (value pc) (rtx to describe decoding)) +) +@end example + +(*note: Whether to also provide a way to specify instruction formats is not yet +clear. Currently they are computed from the instructions, so there's no +current *need* to provided them. However, providing the ability as an +option may simplify other tools CGEN is used to generate. This +simplification would come in the form of giving known names to the formats +which CPU reference manuals often do. Pre-specified instruction formats +may also simplify expression of more complicated instruction sets.) + +(*note: Positional specification simplifies instruction description somewhat +in that there is no required order of fields, and a disjunct set of fields can +be referred to as one. On the other hand it can require knowledge of the length +of the instruction which is inappropriate in cases like the M32R where +the main fields have the same name and "position" regardless of the length +of the instruction. Moving positional specification into instruction formats, +whether machine generated or programmer specified, may be done.) + +Convention requires @samp{field-name} begin with @samp{f-}. + +@subsection attrs + +There are several predefined instruction field attributes: + +@table @code +@item PCREL-ADDR +The field contains a PC relative address. Various CPUs have various +offsets from the PC from which the address is calculated. This is +specified in the encode and decode sections. + +@item ABS-ADDR +The field contains an absolute address. + +@item SIGN-OPT +The field has an optional sign. It is sign-extended during +extraction. Allowable values are -2^(n-1) to (2^n)-1. + +@item RESERVED +The field is marked as ``reserved'' by the architecture. +This is an informational attribute. Tools may use it +to validate programs, either statically or dynamically. + +@item VIRTUAL +The field does not directly contribute to the instruction's value. This +is used to simplify semantic or assembler descriptions where a fields +value is based on other values. Multi-ifields are always virtual. +@end table + +@subsection start +The bit number of the field's most significant bit in the instruction. +Bit numbering is determined by the @code{insn-lsb0?} field of +@code{define-arch}. + +@subsection length +The number of bits in the field. +The field must be contiguous. +For non-contiguous instruction fields use "multi-ifields". +(*xref: Non-contiguous fields). + +@subsection follows +Optional. Experimental. +This should not be used for the specification of RISC-like architectures. +It is an experiment in supporting CISC-like architectures. +The argument is the name of the ifield or operand that immediately precedes +this one. In general the argument is an "anyof" operand. The @code{follows} +spec allows subsequent ifields to "float". + +@subsection mode +The mode the value is to be interpreted in. +Usually this is @code{INT} or @code{UINT}. + +@c ??? There's no real reason why modes like SI can't be used here. +The @samp{length} field specifies the number of bits in the field, +and the @samp{mode} field indicates the mode in which the value will be used, +as well as its signedness. This would allow removing INT/UINT for this +purpose. On the other hand, a non-width specific mode allows applications +to choose one (a simulator might prefer to store immediates in an `int' +rather than, say, char if the specified mode was @code{QI}). + +@subsection encode +An expression to apply to convert from usable values to raw field +values. The syntax is @code{(encode (value pc) expression)} or more +specifically @code{(encode ((<mode1> value) (IAI pc)) <expression>)}, +where @code{<mode1>} is the mode of the the ``incoming'' value, and +@code{<expression>} is an rtx to convert @code{value} to something that +can be stored in the field. + +Example: + +@example +(encode ((SF value) (IAI pc)) + (cond WI + ((eq value (const SF 1.0)) (const 0)) + ((eq value (const SF 0.5)) (const 1)) + ((eq value (const SF -1.0)) (const 2)) + ((eq value (const SF 2.0)) (const 3)) + (else (error "invalid floating point value for field foo")))) +@end example + +In this example four floating point immediate values are represented in a +field of two bits. The above might be expanded to a series of `if' statements +or the generator could determine a `switch' statement is more appropriate. + +@subsection decode + +An expression to apply to convert from raw field values to usable +values. The syntax is @code{(decode (value pc) expression)} or more +specifically @code{(decode ((WI value) (IAI pc)) <expression>)}, where +@code{<expression>} is an rtx to convert @code{value} to something +usable. + +Example: + +@example +(decode ((WI value) (IAI pc)) + (cond SF + ((eq value 0) (const SF 1.0)) + ((eq value 1) (const SF 0.5)) + ((eq value 2) (const SF -1.0)) + ((eq value 3) (const SF 2.0)))) +@end example + +There's no need to provide an error case as presumably @code{value} +would never have an invalid value, though certainly one could provide an +error case if one wanted to. + +@subsection Non-contiguous fields +@cindex Fields, non-contiguous + +Non-contiguous fields (e.g. sparc64's 16 bit displacement field) are +built on top of support for contiguous fields. The syntax for defining +such fields is: + +@example +(define-multi-ifield + (name field-name) + (comment "description") + (attrs attribute-list) + (mode mode-name) + (subfields field1-name field2-name ...) + (insert (code to set each subfield)) + (extract (code to set field from subfields)) +) +@end example + +(*note: insert/extract are analogous to encode/decode so maybe these +fields are misnamed. The operations are subtly different though.) + +Example: + +@example +(define-multi-ifield + (name f-i20) + (comment "20 bit unsigned") + (attrs) + (mode UINT) + (subfields f-i20-4 f-i20-16) + (insert (sequence () + (set (ifield f-i20-4) (srl (ifield f-i20) (const 16))) + (set (ifield f-i20-16) (and (ifield f-i20) (const #xffff))) + )) + (extract (sequence () + (set (ifield f-i20) (or (sll (ifield f-i20-4) (const 16)) + (ifield f-i20-16))) + )) +) +@end example + +@subsection subfields +The names of the already defined fields that make up the multi-ifield. + +@subsection insert +Code to set the subfields from the multi-ifield. All fields are referred +to with @code{(ifield <name>)}. + +@subsection extract +Code to set the multi-ifield from the subfields. All fields are referred +to with @code{(ifield <name>)}. + +@subsection Simplification macros +To simplify @file{.cpu} files, the @code{dnf}, @code{df} and @code{dnmf} +macros have been created. Each takes a fixed set of positional arguments +for the typical instruction field. @code{dnf} is short for +@code{define-normal-field}, @code{df} is short for @code{define-field}, +and @code{dnmf} is short for @code{define-normal-multi-ifield}. + +The syntax of @code{dnf} is: + +@code{(dnf name comment attributes start length)} + +Example: + +@code{(dnf f-r1 "register r1" () 4 4)} + +This defines a field called @samp{f-r1} that is an unsigned field of 4 +bits beginning at bit 4. All fields defined with @code{dnf} are unsigned. + +The syntax of @code{df} is: + +@code{(df name comment attributes type start length mode encode decode)} + +Example: + +@example +(df f-disp8 + "disp8, slot unknown" (PCREL-ADDR) + INT 8 8 + ((value pc) (sra WI (sub WI value (and WI pc (const -4))) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) (and WI pc (const -4))))) +@end example + +This defines a field called @samp{f-disp8} that is a signed PC-relative +address beginning at bit 8 of size 8 bits that is left shifted by 2. + +The syntax of @code{dnmf} is: + +@code{(dnmf name comment attributes mode subfields insert extract)} + +@node Enumerated constants +@section Enumerated constants +@cindex Enumerated constants +@cindex Enumerations + +Enumerated constants (@emph{enums}) are important enough in instruction +set descriptions that they are given special treatment. Enums are +defined with: + +@example +(define-enum + (name enum-name) + (comment "description") + (attrs attribute-list) + (prefix prefix) + (values val1 val2 ...) +) +@end example + +Enums in opcode fields are further enhanced by specifying the opcode +field they are used in. This allows the enum's name to be specified +in an instruction's @code{format} entry. + +@example +(define-insn-enum + (name enum-name) + (comment "description") + (attrs (attribute list)) + (prefix prefix) + (ifield instruction-field-name) + (values val1 val2 ...) +) +@end example + +(*note: @code{define-insn-enum} isn't implemented yet: use +@code{define-normal-insn-enum}) + +Example: + +@example +(define-insn-enum + (name insn-op1) + (comment "op1 field values") + (prefix OP1_) + (ifield f-op1) + (values "0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "10" "11" "12" "13" "14" "15") +) +@end example + +@subsection prefix +Convention requires each enum value to be prefixed with the same text. +Rather than specifying the prefix in each entry, it is specified once, here. +Convention requires @samp{prefix} not contain any lowercase characters. + +@subsection ifield +The name of the instruction field that the enum is intended for. + +@subsection values +A list of possible values. Each element has one of the following forms: + +@itemize @bullet +@item @code{name} +@item @code{(name)} +@item @code{(name value)} +@item @code{(name - (attribute-list))} +@item @code{(name value (attribute-list))} +@end itemize + +The syntax for numbers is Scheme's, so hex numbers are @code{#xnnnn}. +A value of @code{-} means use the next value (previous value plus 1). + +Example: + +@example +(values "a" ("b") ("c" #x12) + ("d" - (sanitize foo)) ("e" #x1234 (sanitize bar))) +@end example + +@subsection Simplification macros + +@code{(define-normal-enum name comment attrs prefix vals)} + +@code{(define-normal-insn-enum name comment attrs prefix ifield vals)} + +@node Instruction operands +@section Instruction Operands +@cindex Operands, instruction + +Instruction operands provide: + +@itemize @bullet +@item a layer between the assembler and the raw hardware description +@item the main means of manipulating instruction fields in the semantic code +@c More? +@end itemize + +The syntax is: + +@example +(define-operand + (name operand-name) + (comment "description") + (attrs attribute-list) + (type hardware-element) + (index instruction-field) + (asm asm-spec) +) +@end example + +@subsection name + +This is the name of the operand as a Scheme symbol. +The name choice is fairly important as it is used in instruction +syntax entries, instruction format entries, and semantic expressions. +It can't collide with symbols used in semantic expressions +(e.g. @code{and}, @code{set}, etc). + +The convention is that operands have no prefix (whereas ifields begin +with @samp{f-} and hardware elements begin with @samp{h-}). A prefix +like @samp{o-} would avoid collisions with other semantic elements, but +operands are used often enough that any prefix is a hassle. + +@subsection attrs + +A list of attributes. In addition to attributes defined for the operand, +an operand inherits the attributes of its instruction field. There are +several predefined operand attributes: + +@table @code +@item NEGATIVE +The operand contains negative values (not used yet so definition is +still nebulous. + +@item RELAX +This operand contains the changeable field (usually a branch address) of +a relaxable instruction. + +@item SEM-ONLY +Use the SEM-ONLY attribute for cases where the operand will only be used +in semantic specification, and not assembly code specification. A +typical example is condition codes. +@end table + +To refer to a hardware element in semantic code one must either use an +operand or one of reg/mem/const. Operands generally exist to map +instruction fields to the selected hardware element and are easier to +use in semantic code than referring to the hardware element directly +(e.g. @code{sr} is easier to type and read than @code{(reg h-gr +<index>)}). Example: + +@example + (dnop condbit "condition bit" (SEM-ONLY) h-cond f-nil) +@end example + +@code{f-nil} is the value to use when there is no instruction field + +@c There might be some language cleanup to be done here regarding f-nil. +@c It is kind of extraneous. + +@subsection type +The hardware element this operand applies to. This must be the name of a +hardware element. + +@subsection index +The index of the hardware element. This is used to mate the hardware +element with the instruction field that selects it, and must be the name +of an ifield entry. (*note: The index may be other things besides +ifields in the future.) + +@subsection asm +Sometimes it's necessary to escape to C to parse assembler, or print +a value. This field is an escape hatch to implement this. +The current syntax is: + +@code{(asm asm-spec)} + +where @code{asm-spec} is one or more of: + +@code{(parse "function_suffix")} -- a call to function +@code{parse_<function_suffix>} is generated. + +@code{(print "function_suffix")} -- a call to function +@code{print_<function_suffix>} is generated. + +These functions are intended to be provided in a separate @file{.opc} +file. The prototype of a parse function depends on the hardware type. +See @file{cgen/*.opc} for examples. + +@c FIXME: The following needs review. + +For integer it is: + +@example +static const char * +parse_foo (CGEN_CPU_DESC cd, + const char **strp, + int opindex, + unsigned long *valuep); +@end example + +@code{cd} is the result of @code{<arch>_cgen_opcode_open}. +@code{strp} is a pointer to a pointer to the assembler and is updated by +the function. +@c FIXME +@code{opindex} is ???. +@code{valuep} is a pointer to where to record the parsed value. +@c FIXME +If a relocation is needed, it is queued with a call to ???. Queued +relocations are processed after the instruction has been parsed. + +The result is an error message or NULL if successful. + +The prototype of a print function depends on the hardware type. See +@file{cgen/*.opc} for examples. For integers it is: + +@example +void print_foo (CGEN_CPU_DESC cd, + PTR dis_info, + long value, + unsigned int attrs, + bfd_vma pc, + int length); +@end example + +@samp{cd} is the result of @code{<arch>_cgen_opcode_open}. +@samp{ptr} is the `info' argument to print_insn_<arch>. +@samp{value} is the value to be printed. +@samp{attrs} is the set of boolean attributes. +@samp{pc} is the PC value of the instruction. +@samp{length} is the length of the instruction. + +Actual printing is done by calling @code{((disassemble_info *) +dis_info)->fprintf_func}. + +@node Derived operands +@section Derived Operands +@cindex Derived operands +@cindex Operands, instruction +@cindex Operands, derived + +Derived operands are an experiment in supporting the addressing modes of +CISC-like architectures. Addressing modes are difficult to support as +they essentially increase the number of instructions in the architecture +by an order of magnitude. Defining all the variants requires something +in addition to the RISC-like architecture support. The theory is that +since CISC-like instructions are basically "normal" instructions with +complex operands the place to add the necessary support is in the +operands. + +Two kinds of operands exist to support CISC-like cpus, and they work +together. "derived-operands" describe one variant of a complex +argument, and "anyof" operands group them together. + +The syntax for defining derived operands is: + +@example +(define-derived-operand + (name operand-name) + (comment "description") + (attrs attribute-list) + (mode mode-name) + (args arg1-operand-name arg2-operand-name ...) + (syntax "syntax") + (base-ifield ifield-name) + (encoding (+ arg1-operand-name arg2-operand-name ...)) + (ifield-assertion expression) + (getter expression) + (setter expression) +) +@end example + +@cindex anyof operands +@cindex Operands, anyof + +The syntax for defining anyof operands is: + +@example +(define-anyof-operand + (name operand-name) + (comment "description") + (attrs attribute-list) + (mode mode-name) + (base-ifield ifield-name) + (choices derived-operand1-name derived-operand2-name ...) +) +@end example + +@subsection mode + +The name of the mode of the operand. + +@subsection args + +List of names of operands the derived operand uses. +The operands must already be defined. +The argument operands can be any kind of operand: normal, derived, anyof. + +@subsection syntax + +Assembler syntax of the operand. + +??? This part needs more work. Addressing mode specification in assembler +needn't be localized to the vicinity of the operand. + +@subsection base-ifield + +The name of the instruction field common to all related derived operands. +Here related means "used by the same `anyof' operand". + +@subsection encoding + +The machine encoding of the operand. + +@subsection ifield-assertion + +An assertion of what values any instruction fields will or will not have +in the containing instruction. + +??? A better name for this might be "constraint". + +@subsection getter + +RTL expression to get the value of the operand. +All operands refered to must be specified in @code{args}. + +@subsection setter + +RTL expression to set the value of the operand. +All operands refered to must be specified in @code{args}. +Use @code{newval} to refer to the value to be set. + +@subsection choices + +For anyof operands, the names of the derived operands. +The operand may be "any of" the specified choices. + +@node Instructions +@section Instructions +@cindex Instructions + +Each instruction in the instruction set has an entry in the description +file. For complicated instruction sets this is a lot of typing. However, +macros can reduce a lot of that typing. The real question is given the +amount of information that must be expressed, how succinct can one express +it and still be clean and usable? I'm open to opinions on how to improve +this, but such improvements must take everything CGEN wishes to be into +account. +(*note: Of course no claim is made that the current design is the +be-all and end-all or that there is one be-all and end-all.) + +The syntax for defining an instruction is: + +@example +(define-insn + (name insn-name) + (comment "description") + (attrs attribute-list) + (syntax "assembler syntax") + (format (+ field-list)) + (semantics (semantic-expression)) + (timing timing-data) +) +@end example + +Instructions specific to a particular cpu variant are denoted as such with +the MACH attribute. + +Possible additions for the future: + +@itemize @bullet +@item a field to describe a final constraint for determining a match +@item choosing the output from a set of choices +@end itemize + +@subsection attrs + +A list of attributes, for which there are several predefined instruction +attributes: + +@table @code +@item MACH +A bitset attribute used to specify which machines have this hardware +element. Do not specify the MACH attribute if the value is for all +machines. + +Usage: @code{(MACH mach1,mach2,...)} + +There must be no spaces in ``@code{mach1,mach2,...}''. + +@item UNCOND-CTI +The instruction is an unconditional ``control transfer instruction''. + +(*note: This attribute is derived from the semantic code. However if the +computed value is wrong (dunno if it ever will be) the value can be +overridden by explicitly mentioning it.) + +@item COND-CTI +The instruction is an conditional "control transfer instruction". + +(*note: This attribute is derived from the semantic code. However if the +computed value is wrong (dunno if it ever will be) the value can be +overridden by explicitly mentioning it.) + +@item SKIP-CTI +The instruction can cause one or more insns to be skipped. This is +derived from the semantic code. + +@item DELAY-SLOT +The instruction has one or more delay slots. This is derived from the +semantic code. + +@item RELAXABLE +The instruction has one or more identical variants. The assembler tries +this one first and then the relaxation phases switches to larger ones as +necessary. + +@item RELAX +The instruction is a non-minimal variant of a relaxable instruction. It +is avoided by the assembler in the first pass. + +@item ALIAS +Internal attribute set for macro-instructions that are an alias for one +real insn. + +@item NO-DIS +For macro-instructions, don't use during disassembly. +@end table + +@subsection syntax + +This is a character string consisting of raw characters and operands. +Fields are denoted by @code{$operand} or +@code{$@{operand@}}@footnote{Support for @code{$@{operand@}} is +work-in-progress.}. If a @samp{$} is required in the syntax, it is +specified with @samp{\$}. At most one white-space character may be +present and it must be a blank separating the instruction mnemonic from +the operands. This doesn't restrict the user's assembler, this is +@c Is this reasonable? +just a description file restriction to separate the mnemonic from the +operands@footnote{The restriction can be relaxed by saying the first +blank is the one that separates the mnemonic from its operands.}. +The assembly language accepted by the generated assembler does not +have to take exactly the same form as the syntax described in this +field--additional whitespace may be present in the input file. + +Operands can refer to registers, constants, and whatever else is necessary. + +Instruction mnemonics can take operands. For example, on the SPARC a +branch instruction can take @code{,a} as an argument to indicate the +instruction is being annulled (e.g. @code{bge$a $disp22}). + +@subsection format + +This is a complete list of fields that specify the instruction. At +present it must be prefaced with @code{+} to allow for future additions. +Reserved bits must also be specified, gaps are not allowed. +@c Well, actually I think they are and it could certainly be allowed. +@c Question: should they be allowed? +The ordering of the fields is not important. + +Format elements can be any of: + +@itemize @bullet +@item instruction field specifiers with a value (e.g. @code{(f-r1 14)}) +@item an instruction field enum, as in @code{OP1_4} +@item an operand +@end itemize + +@subsection semantics +@cindex Semantics + +This field provides a mathematical description of what the instruction +does. Its syntax is GCC-RTL-like on purpose since GCC's RTL is well known +by the intended audience. However, it is not intended that it be precisely +GCC-RTL. + +Obviously there are some instructions that are difficult if not +impossible to provide a description for (e.g. I/O instructions). Rather +than create a new semantic function for each quirky operation, escape +hatches to C are provided to handle all such cases. The @code{c-code}, +@code{c-call} and @code{c-raw-call} semantic functions provide an +escape-hatch to invoke C code to perform the operation. (*xref: +Expressions) + +@subsection timing +@cindex Timing + +A list of entries for each function unit the instruction uses on each machine +that supports the instruction. The default function unit is the u-exec unit. + +The syntax is: + +@example +(mach-name (unit name (unit-var-name1 insn-operand-name1) + (unit-var-name2 insn-operand-name2) + ... + (cycles cycle-count)) +@end example + +unit-var-name/insn-operand-name mappings are optional. +They map unit inputs/outputs to semantic elements. + +@code{cycles} overrides the @code{done} value (latency) of the function +unit and is optional. + +@subsection Simplification macros + +To simplify @file{.cpu} files, the @code{dni} macro has been created. +It takes a fixed set of positional arguments for the typical instruction +field. @code{dni} is short for @code{define-normal-insn}. + +The syntax of @code{dni} is: + +@code{(dni name comment attrs syntax format semantics timing)} + +Example: + +@example +(dni addi "add 8 bit signed immediate" + () + "addi $dr,$simm8" + (+ OP1_4 dr simm8) + (set dr (add dr simm8)) + () +) +@end example + +@node Macro-instructions +@section Macro-instructions +@cindex Macro-instructions +@cindex Instructions, macro + +Macro-instructions are for the assembler side of things and are not used +by the simulator. The syntax for defining a macro-instruction is: + +@example +(define-macro-insn + (name macro-insn-name) + (comment "description") + (attrs attribute-list) + (syntax "assembler syntax") + (expansions expansion-spec) +) +@end example + +@subsection syntax + +Syntax of the macro-instruction. This has the same value as the +@code{syntax} field in @code{define-insn}. + +@subsection expansions + +An expression to emit code for the instruction. This is intended to be +general in nature, allowing tests to be done at runtime that choose the +form of the expansion. Currently the only supported form is: + +@code{(emit insn arg1 arg2 ...)} + +where @code{insn} is the name of an instruction defined with +@code{define-insn} and @emph{argn} is the set of operands to +@code{insn}'s syntax. Each argument is mapped in order to one operand +in @code{insn}'s syntax and may be any of: + +@itemize @bullet +@item operand specified in @code{syntax} +@item @code{(operand value)} +@end itemize + +Example: + +@example +(dni st-minus "st-" () + "st $src1,@-$src2" + (+ OP1_2 OP2_7 src1 src2) + (sequence ((WI new-src2)) + (set new-src2 (sub src2 (const 4))) + (set (mem WI new-src2) src1) + (set src2 new-src2)) + () +) +@end example + +@example +(dnmi push "push" () + "push $src1" + (emit st-minus src1 (src2 15)) ; "st %0,@-sp" +) +@end example + +In this example, the @code{st-minus} instruction is a general +store-and-decrement instruction and @code{push} is a specialized version +of it that uses the stack pointer. + +@node Modes +@section Modes +@cindex Modes + +Modes provide a simple and succinct way of specifying data types. + +(*note: Should more complex types will be needed (e.g. structs? unions?), +these can be handled by extending the definition of a mode to encompass them.) + +Modes are similar to their usage in GCC, but there are some differences: + +@itemize @bullet +@item modes for boolean values (i.e. bits) are also supported as they are +useful +@item integer modes exist in signed and unsigned versions +@item constants have modes +@end itemize + +Currently supported modes are: + +@table @code +@item VOID +VOIDmode in GCC. + +@item DFLT +Indicate the default mode is wanted, the value of which depends on context. +This is a pseudo-mode and never appears in generated code. + +@item BI +Boolean zero/one + +@item QI,HI,SI,DI +Same as GCC. + +QI is an 8 bit quantity ("quarter int"). +HI is a 16 bit quantity ("half int"). +SI is a 32 bit quantity ("single int"). +DI is a 64 bit quantity ("double int"). + +In cases where signedness matters, these modes are signed. + +@item UQI,UHI,USI,UDI +Unsigned versions of QI,HI,SI,DI. + +These modes do not appear in semantic RTL. Instead, the RTL function +specifies the signedness of its operands where necessary. + +??? I'm not entirely sure these unsigned modes are needed. +They are useful in removing any ambiguity in how to sign extend constants +which has been a source of problems in GCC. + +??? Some existing ports use these modes. + +@item WI,UWI +word int, unsigned word int (word_mode in gcc). +These are aliases for the real mode, typically either @code{SI} or @code{DI}. + +@item SF,DF,XF,TF +Same as GCC. + +SF is a 32 bit IEEE float ("single float"). +DF is a 64 bit IEEE float ("double float"). +XF is either an 80 or 96 bit IEEE float ("extended float"). +(*note: XF values on m68k and i386 are different so may +wish to give them different names). +TF is a 128 bit IEEE float ("??? float"). + +@item AI +Address integer + +@item IAI +Instruction address integer + +@item INT,UINT +Varying width int/unsigned-int. The width is specified by context, +usually in an instruction field definition. + +@end table + +@node Expressions +@section Expressions +@cindex Expressions + +The syntax of CGEN's RTL expressions (or @emph{rtx}) basically follows that of +GCC's RTL. + +The handling of modes is different to simplify the implementation. +Implementation shouldn't necessarily drive design, but it was a useful +simplification. Still, it needs to be reviewed. The difference is that +in GCC @code{(function:MODE arg1 ...)} is written in CGEN as +@code{(function MODE arg1 ...)}. Note the space after @samp{function}. + +GCC RTL allows flags to be recorded with RTL (e.g. MEM_VOLATILE_P). +This is supported in CGEN RTL by prefixing each RTL function's arguments +with an optional list of modifiers: +@code{(function (:mod1 :mod2) MODE arg1 ...)}. +The list is a set of modifier names prefixed with ':'. They can take +arguments. +??? Modifiers are supported by the RTL traversing code, but no use is +made of them yet. + +The currently defined semantic functions are: + +@table @code +@item (set mode destination source) +Assign @samp{source} to @samp{destination} reference in mode @samp{mode}. + +@item (set-quiet mode destination source) +Assign @samp{source} to @samp{destination} referenced in mode +@samp{mode}, but do not print any tracing message. + +@item (reg mode hw-name [index]) +Return an `operand' of hardware element @samp{hw-name} in mode @samp{mode}. +If @samp{hw-name} is an array, @samp{index} selects which register. + +@item (raw-reg mode hw-name [index]) +Return an `operand' of hardware element @samp{hw-name} in mode @samp{mode}, +bypassing any @code{get} or @code{set} specs of the register. +If @samp{hw-name} is an array, @samp{index} selects which register. +This cannot be used with virtual registers (those specified with the +@samp{VIRTUAL} attribute). + +@code{raw-reg} is most often used in @code{get} and @code{set} specs +of a register: if it weren't read and write operations would infinitely +recurse. + +@item (mem mode address) +Return an `operand' of memory referenced at @samp{address} in mode +@samp{mode}. + +@item (const mode value) +Return an `operand' of constant @samp{value} in mode @samp{mode}. + +@item (enum mode value-name) +Return an `operand' of constant @samp{value-name} in mode @samp{mode}. +The value must be from a previously defined enum. + +@item (subword mode value word-num) +Return part of @samp{value}. Which part is determined by @samp{mode} and +@samp{word-num}. There are three cases. + +If @samp{mode} is the same size as the mode of @samp{value}, @samp{word-num} +must be @samp{0} and the result is @samp{value} recast in the new mode. +There is no change in the bits of @samp{value}, they're just interpreted in a +possibly different mode. This is most often used to interpret an integer +value as a float and vice versa. + +If @samp{mode} is smaller, @samp{value} is divided into N pieces and +@samp{word-num} picks which piece. All pieces have the size of @samp{mode} +except possibly the last. If the last piece has a different size, +it cannot be referenced. +This follows GCC and is byte order dependent.@footnote{To be +revisited}. +Word number 0 is the most significant word if big-endian-words. +Word number 0 is the least significant word if little-endian-words. + +If @samp{mode} is larger, @samp{value} is interpreted in the larger mode +with the upper most significant bits treated as garbage (their value is +assumed to be unimportant to the context in which the value will be used). +@samp{word-num} must be @samp{0}. +This case is byte order independent. + +@item (join out-mode in-mode arg1 . arg-rest) +Concatenate @samp{arg1[,arg2[,...]]} to create a value of mode @samp{out-mode}. +@samp{arg1} becomes the most significant part of the result. +Each argument is interpreted in mode @samp{in-mode}. +@samp{in-mode} must evenly divide @samp{out-mode}. +??? Endianness issues have yet to be decided. + +@item (sequence mode ((mode1 local1) ...) expr1 expr2 ...) +Execute @samp{expr1}, @samp{expr2}, etc. sequentially. @samp{mode} is the +mode of the result, which is defined to be that of the last expression. +`@code{((mode1 local1) ...)}' is a set of local variables. + +@item (parallel mode empty expr1 ...) +Execute @samp{expr1}, @samp{expr2}, etc. in parallel. All inputs are +read before any output is written. @samp{empty} must be @samp{()} and +is present for consistency with @samp{sequence}. @samp{mode} must be +@samp{VOID} (void mode). @samp{((mode1 local1) ...)} is a set of local +variables. + +@item (unop mode operand) +Perform a unary arithmetic operation. @samp{unop} is one of @code{neg}, +@code{abs}, @code{inv}, @code{not}, @code{zflag}, @code{nflag}. +@code{zflag} returns a bit indicating if @samp{operand} is +zero. @code{nflag} returns a bit indicating if @samp{operand} is +negative. @code{inv} returns the bitwise complement of @samp{operand}, +whereas @code{not} returns its logical negation. + +@item (binop mode operand1 operand2) +Perform a binary arithmetic operation. @samp{binop} is one of +@code{add}, @code{sub}, @code{and}, @code{or}, @code{xor}, @code{mul}, +@code{div}, @code{udiv}, @code{mod}, @code{umod}. + +@item (binop-with-bit mode operand1 operand2 operand3) +Same as @samp{binop}, except taking 3 operands. The third operand is +always a single bit. @samp{binop-with-bit} is one of @code{addc}, +@code{add-cflag}, @code{add-oflag}, @code{subc}, @code{sub-cflag}, +@code{sub-oflag}. + +@item (shiftop mode operand1 operand2) +Perform a shift operation. @samp{shiftop} is one of @code{sll}, +@code{srl}, @code{sra}, @code{ror}, @code{rol}. + +@item (boolifop mode operand1 operand2) +Perform a sequential boolean operation. @samp{operand2} is not processed +if @samp{operand1} ``fails''. @samp{boolifop} is one of @code{andif}, +@code{orif}. + +@item (convop mode operand) +Perform a mode->mode conversion operation. @samp{convop} is one of +@code{ext}, @code{zext}, @code{trunc}, @code{float}, @code{ufloat}, +@code{fix}, @code{ufix}. + +@item (cmpop mode operand1 operand2) +Perform a comparison. @samp{cmpop} is one of @code{eq}, @code{ne}, +@code{lt}, @code{le}, @code{gt}, @code{ge}, @code{ltu}, @code{leu}, +@code{gtu}, @code{geu}. + +@item (if mode condition then [else]) +Standard @code{if} statement. + +@samp{condition} is any arithmetic expression. +If the value is non-zero the @samp{then} part is executed. +Otherwise, the @samp{else} part is executed (if present). + +@samp{mode} is the mode of the result, not of @samp{condition}. +If @samp{mode} is not @code{VOID} (void mode), @samp{else} must be present. + +@item (cond mode (condition1 expr1a ...) (...) [(else exprNa...)]) +From Scheme: keep testing conditions until one succeeds, and then +process the associated expressions. + +@item (case mode test ((case1 ..) expr1a ..) (..) [(else exprNa ..)]) +From Scheme: Compare @samp{test} with @samp{case1}, @samp{case2}, +etc. and process the associated expressions. + +@item (c-code mode "C expression") +An escape hook to insert arbitrary C code. @samp{mode} must the +compatible with the result of ``C expression''. + +@item (c-call mode symbol operand1 operand2 ...) +An escape hook to emit a subroutine call to function named @samp{symbol} +passing operands @samp{operand1}, @samp{operand2}, etc. An implicit +first argument of @code{current_cpu} is passed to @samp{symbol}. +@samp{mode} is the mode of the result. Be aware that @samp{symbol} will +be restricted by reserved words in the C programming language any by +existing symbols in the generated code. + +@item (c-raw-call mode symbol operand1 operand2 ...) +Same as @code{c-call}: except there is no implicit @code{current_cpu} +first argument. +@samp{mode} is the mode of the result. + +@item (clobber mode object) +Indicate that @samp{object} is written in mode @samp{mode}, without +saying how. This could be useful in conjunction with the C escape hooks. + +@item (annul yes?) +@c FIXME: put annul into the glossary. +Annul the following instruction if @samp{yes?} is non-zero. This rtx is +an experiment and will probably change. + +@item (skip yes?) +Skip the next instruction if @samp{yes?} is non-zero. This rtx is +an experiment and will probably change. + +@item (attr mode kind attr-name) +Return the value of attribute @samp{attr-name} in mode +@samp{mode}. @samp{kind} must currently be @samp{insn}: the current +instruction. + +@item (symbol name) +Return a symbol with value @samp{name}, for use in attribute +processing. This is equivalent to @samp{quote} in Scheme but +@samp{quote} sounds too jargonish. + +@item (eq-attr mode attr-name value) +Return non-zero if the value of attribute @samp{attr-name} is +@samp{value}. If @samp{value} is a list return ``true'' if +@samp{attr-name} is any of the listed values. + +@item (nop) +A no-op. + +@item (ifield field-name) +Return the value of field @samp{field-name}. @samp{field-name} must be a +field in the instruction. Operands can be any of: +@c ??? + +@itemize @bullet +@item an operand defined in the description file +@item a register reference, created with (reg mode [index]) +@item a memory reference, created with (mem mode address) +@item a constant, created with (const mode value) +@item a `sequence' local variable +@item another expression +@end itemize + +The @samp{symbol} in a @code{c-call} or @code{c-raw-call} function is +currently the name of a C function or macro that is invoked by the +generated semantic code. +@end table + +@node Macro-expressions +@section Macro-expressions +@cindex Macro-expressions + +Macro RTL expressions started out by wanting to not have to always +specify a mode for every expression (and sub-expression +thereof). Whereas the formal way to specify, say, an add is @code{(add +SI arg1 arg2)} if SI is the default mode of `arg1' then this can be +simply written as @code{(add arg1 arg2)}. This gets expanded to +@code{(add DFLT arg1 arg2)} where @code{DFLT} means ``default mode''. + +It might be possible to replace macro expressions with preprocessor macros, +however for the nonce there is no plan to do this. diff --git a/cgen/doc/running.texi b/cgen/doc/running.texi new file mode 100644 index 00000000000..644dad183a3 --- /dev/null +++ b/cgen/doc/running.texi @@ -0,0 +1,9 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Running CGEN +@chapter Running CGEN + +This chapter needs to explain how to run CGEN, how it fits together, and +what to expect when you do run it (ie. output, resultant files, etc). diff --git a/cgen/doc/sim.texi b/cgen/doc/sim.texi new file mode 100644 index 00000000000..11c08fa6d99 --- /dev/null +++ b/cgen/doc/sim.texi @@ -0,0 +1,45 @@ +@c Copyright (C) 2000 Red Hat, Inc. +@c This file is part of the CGEN manual. +@c For copying conditions, see the file cgen.texi. + +@node Simulation +@chapter Simulation support +@cindex Simulation support + +Simulator support comes in the form of machine generated the decoder/executer +as well as the structure that records CPU state information (ie. registers). + +There are 3 architecture-wide generated files: + +@table @file +@item arch.h +Definitions and declarations common to the entire architecture. +@item arch.c +Tables and code common to the entire architecture, but which can't be +put in the common area. +@item cpuall.h +Pseudo base classes of various structures. +@end table + +Each ``CPU family'' has its own set of the following files: + +@table @file +@item cpu.h +Definitions and declarations specific to a particular CPU family. +@item cpu.c +Tables and code specific to a particular CPU family. +@item decode.h +Decoder definitions and declarations. +@item decode.c +Decoder tables and code. +@item model.c +Tables and code for each model in the CPU family. +@item semantics.c +Code to perform each instruction. +@item sem-switch.c +Same as @file{semantics.c} but as one giant @code{switch} statement. +@end table + +A ``CPU family'' is an artificial creation to sort architecture variants +along whatever lines seem useful. Additional hand-written files must be +provided. @xref{Porting} for details. diff --git a/cgen/doc/stamp-vti b/cgen/doc/stamp-vti new file mode 100644 index 00000000000..3e1e7a5eb20 --- /dev/null +++ b/cgen/doc/stamp-vti @@ -0,0 +1,3 @@ +@set UPDATED 11 October 1999 +@set EDITION 1.0 +@set VERSION 1.0 diff --git a/cgen/doc/version.texi b/cgen/doc/version.texi new file mode 100644 index 00000000000..ef3c4e22488 --- /dev/null +++ b/cgen/doc/version.texi @@ -0,0 +1,3 @@ +@set UPDATED 31 July 2000 +@set EDITION 1.0 +@set VERSION 1.0 diff --git a/cgen/enum.scm b/cgen/enum.scm new file mode 100644 index 00000000000..3e4c9c94e14 --- /dev/null +++ b/cgen/enum.scm @@ -0,0 +1,391 @@ +; Enums. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Enums having attribute PREFIX have their symbols prepended with +; the enum class' name. +; Member PREFIX is always prepended to the symbol names. +; +; Enum values are looked up with `enum-lookup-val'. The value to search for +; has PREFIX prepended. +; +; Enums always have mode INT. + +(define <enum> + (class-make '<enum> + '(<ident>) + '(prefix vals) + nil) +) + +; FIXME: this make! method is required by <insn-enum> for some reason. +(method-make! + <enum> 'make! + (lambda (self name comment attrs prefix vals) + (elm-set! self 'name name) + (elm-set! self 'comment comment) + (elm-set! self 'attrs attrs) + (elm-set! self 'prefix prefix) + (elm-set! self 'vals vals) + self) +) + +(define enum-prefix (elm-make-getter <enum> 'prefix)) + +(method-make! <enum> 'enum-values (lambda (self) (elm-get self 'vals))) + +; Parse a list of enum name/value entries. +; PREFIX is prepended to each name. +; Elements are any of: symbol, (symbol), (symbol value) +; (symbol - attrs), (symbol value attrs). +; The `-' means use the next value. +; The result is the same list, except values are filled in where missing, +; and each symbol is prepended with `prefix'. + +(define (parse-enum-vals prefix vals) + ; Scan the value list, building up RES-VALS as we go. + ; Each element's value is 1+ the previous, unless there's an explicit value. + (let loop ((result nil) (last -1) (remaining vals)) + (if (null? remaining) + (reverse! result) + (let + ; Compute the numeric value the next entry will have. + ((val (if (and (pair? (car remaining)) + (not (null? (cdar remaining)))) + (if (eq? '- (cadar remaining)) + (+ last 1) + (cadar remaining)) + (+ last 1)))) + (if (eq? (car remaining) '-) + (loop result val (cdr remaining)) + (loop (cons (cons (symbol-append prefix + (if (pair? (car remaining)) + (caar remaining) + (car remaining))) + (cons val + ; Pass any attributes through unchanged. + (if (and (pair? (car remaining)) + (pair? (cdar remaining))) + (cddar remaining) + nil))) + result) + val + (cdr remaining)))))) +) + +; Convert the names in the result of parse-enum-vals to uppercase. + +(define (enum-vals-upcase vals) + (map (lambda (elm) + (cons (string->symbol (string-upcase (car elm))) (cdr elm))) + vals) +) + +; Parse an enum definition. + +; Utility of -enum-parse to parse the prefix. + +(define (-enum-parse-prefix errtxt prefix) + (if (symbol? prefix) + (set! prefix (symbol->string prefix))) + + (if (not (string? prefix)) + (parse-error errtxt "prefix is not a string" prefix)) + + ; Prefix must not contain lowercase chars (enforced style rule, sue me). + (if (any-true? (map char-lower-case? (string->list prefix))) + (parse-error errtxt "prefix must be uppercase" prefix)) + + prefix +) + +; This is the main routine for building an ifield object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. + +(define (-enum-parse errtxt name comment attrs prefix vals) + (logit 2 "Processing enum " name " ...\n") + + (let* ((name (parse-name name errtxt)) + (errtxt (string-append errtxt " " name))) + + (make <enum> + name + (parse-comment comment errtxt) + (atlist-parse attrs "enum" errtxt) + (-enum-parse-prefix errtxt prefix) + (parse-enum-vals prefix vals))) +) + +; Read an enum description +; This is the main routine for analyzing enums in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -enum-parse is invoked to create the `enum' object. + +(define (-enum-read errtxt . arg-list) + (let (; Current enum elements: + (name nil) ; name of field + (comment "") ; description of field + (attrs nil) ; attributes + (prefix "") ; prepended to each element's name + (values nil) ; enum values + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((prefix) (set! prefix (cadr arg))) + ((values) (set! values (cadr arg))) + (else (parse-error errtxt "invalid enum arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-enum-parse errtxt name comment attrs prefix values) + ) +) + +; Define an enum object, name/value pair list version. + +(define define-enum + (lambda arg-list + (let ((e (apply -enum-read (cons "define-enum" arg-list)))) + (current-enum-add! e) + e)) +) + +; Define an enum object, all arguments specified. + +(define (define-full-enum name comment attrs prefix vals) + (let ((e (-enum-parse "define-full-enum" name comment attrs prefix vals))) + (current-enum-add! e) + e) +) + +; Lookup SYM in all recorded enums. +; The result is (value . enum-obj) or #f if not found. + +(define (enum-lookup-val name) + (let loop ((elist (current-enum-list))) + (if (null? elist) + #f + (let ((e (assq name (send (car elist) 'enum-values)))) + ;(display e) (newline) + (if e + (begin + ; sanity check, ensure the enum has a value + (if (null? (cdr e)) (error "enum-lookup-val: enum missing value: " (car e))) + (cons (cadr e) (car elist))) + (loop (cdr elist))) + ) + ) + ) +) + +; Enums support code. + +; Return #t if VALS is a sequential list of enum values. +; VALS is a list of enums. e.g. ((sym1) (sym2 3) (sym3 '- attr1 (attr2 4))) +; FIXME: Doesn't handle gaps in specified values. +; e.g. (sym1 val1) sym2 (sym3 val3) + +(define (enum-sequential? vals) + (let loop ((last -1) (remaining vals)) + (if (null? remaining) + #t + (let ((val (if (and (pair? (car remaining)) + (not (null? (cdar remaining)))) + (cadar remaining) + (+ last 1)))) + (if (eq? val '-) + (loop (+ last 1) (cdr remaining)) + (if (not (= val (+ last 1))) + #f + (loop val (cdr remaining))))))) +) + +; Return C code to declare enum SYM with values VALS. +; COMMENT is inserted in "/* Enum declaration for <...>. */". +; PREFIX is added to each element of VALS. +; All enum symbols are uppercase. +; If the list of vals is sequential beginning at 0, don't output them. +; This simplifies the output and is necessary for sanitized values where +; some values may be cut out. +; VALS may have '- for the value, signifying use the next value as in C. + +(define (gen-enum-decl name comment prefix vals) + (logit 2 "Generating enum decl for " name " ...\n") + ; Build result up as a list and then flatten it into a string. + ; We could just return a string-list but that seems like too much to ask + ; of callers. + (string-list->string + (append! + (string-list + "/* Enum declaration for " comment ". */\n" + "typedef enum " + (string-downcase (gen-c-symbol name)) + " {") + (let loop ((n 0) ; `n' is used to track the number of entries per line only + (sequential? (enum-sequential? vals)) + (vals vals) + (result (list ""))) + (if (null? vals) + result + (let* ((e (car vals)) + (attrs (if (null? (cdr e)) nil (cddr e))) + (san-code (attr-value attrs 'sanitize #f)) + (san? (and san-code (not (eq? san-code 'none))))) + (loop + (if san? + 4 ; reset to beginning of line (but != 0) + (+ n 1)) + sequential? + (cdr vals) + (append! + result + (string-list + (if san? + (string-append "\n" + (if include-sanitize-marker? + ; split string to avoid removal + (string-append "/* start-" + "sanitize-" + san-code " */\n") + "") + " ") + "") + (string-upcase + (string-append + (if (and (not san?) (=? (remainder n 4) 0)) + "\n " + "") + (if (= n 0) + " " + ", ") + (gen-c-symbol prefix) + (gen-c-symbol (car e)) + (if (or sequential? (null? (cdr e)) (eq? '- (cadr e))) + "" + (string-append " = " + (if (number? (cadr e)) + (number->string (cadr e)) + (cadr e)))) + )) + (if (and san? include-sanitize-marker?) + ; split string to avoid removal + (string-append "\n/* end-" + "sanitize-" san-code " */") + ""))))))) + (string-list + "\n} " + (string-upcase (gen-c-symbol name)) + ";\n\n") + )) +) + +; Return a list of enum value definitions for gen-enum-decl. +; OBJ-LIST is a list of objects that support obj:name, obj-atlist. + +(define (gen-obj-list-enums obj-list) + (map (lambda (o) + (cons (obj:name o) (cons '- (atlist-attrs (obj-atlist o))))) + obj-list) +) + +; Return C code that declares[/defines] an enum. + +(method-make! + <enum> 'gen-decl + (lambda (self) + (gen-enum-decl (elm-get self 'name) + (elm-get self 'comment) + (if (has-attr? self 'PREFIX) + (string-append (elm-get self 'name) "_") + "") + (elm-get self 'vals))) +) + +; Return the C symbol of an enum value named VAL. + +(define (gen-enum-sym enum-obj val) + (string-upcase (gen-c-symbol (string-append (enum-prefix enum-obj) val))) +) + +; Instruction code enums. +; These associate an enum with an instruction field so that the enum values +; can be used in instruction field lists. + +(define <insn-enum> (class-make '<insn-enum> '(<enum>) '(fld) nil)) + +(method-make! + <insn-enum> 'make! + (lambda (self name comment attrs prefix fld vals) + (send (object-parent self <enum>) 'make! name comment attrs prefix vals) + (elm-set! self 'fld fld) + self + ) +) + +(define ienum:fld (elm-make-getter <insn-enum> 'fld)) + +; Same as enum-lookup-val except returned enum must be an insn-enum. + +(define (ienum-lookup-val name) + (let ((result (enum-lookup-val name))) + (if (and result (eq? (object-class-name (cdr result)) '<insn-enum>)) + result + #f)) +) + +; Define an insn enum, all arguments specified. + +(define (define-full-insn-enum name comment attrs prefix fld vals) + (let ((errtxt "define-full-insn-enum") + (fld-obj (current-ifld-lookup fld))) + + (if (not fld-obj) + (parse-error errtxt "unknown insn field" fld)) + + ; Create enum object and add it to the list of enums. + (let ((e (make <insn-enum> + (parse-name name errtxt) + (parse-comment comment errtxt) + (atlist-parse attrs "insn-enum" errtxt) + (-enum-parse-prefix errtxt prefix) + fld-obj + (parse-enum-vals prefix vals)))) + (current-enum-add! e) + e)) +) + +(define (enum-init!) + + (reader-add-command! 'define-enum + "\ +Define an enum, name/value pair list version. +" + nil 'arg-list define-enum) + (reader-add-command! 'define-full-enum + "\ +Define an enum, all arguments specified. +" + nil '(name comment attrs prefix vals) define-full-enum) + (reader-add-command! 'define-full-insn-enum + "\ +Define an instruction opcode enum, all arguments specified. +" + nil '(name comment attrs prefix ifld vals) + define-full-insn-enum) + + *UNSPECIFIED* +) + +(define (enum-finish!) + *UNSPECIFIED* +) diff --git a/cgen/fixup.scm b/cgen/fixup.scm new file mode 100644 index 00000000000..fe06241cd31 --- /dev/null +++ b/cgen/fixup.scm @@ -0,0 +1,38 @@ +; Fix up the current interpreter-du-jour to conform to what we've +; been working with. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; check for newer guile + +(if (symbol-bound? #f 'load-from-path) + (begin + (define (load file) + (begin + ;(load-from-path file) + (primitive-load-path file) + )) + ) +) + +; FIXME: to be deleted +(define =? =) +(define >=? >=) + +(if (not (symbol-bound? #f '%stat)) + (begin + (define %stat stat) + ) +) + +(if (symbol-bound? #f 'debug-enable) + (debug-enable 'backtrace) +) + +; Guile 1.3 has reverse!, Guile 1.2 has list-reverse!. +; CGEN uses reverse! +(if (and (not (symbol-bound? #f 'reverse!)) + (symbol-bound? #f 'list-reverse!)) + (define reverse! list-reverse!) +) diff --git a/cgen/fr30.cpu b/cgen/fr30.cpu new file mode 100644 index 00000000000..eb1d39788ab --- /dev/null +++ b/cgen/fr30.cpu @@ -0,0 +1,1845 @@ +; Fujitsu FR30 CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +(include "simplify.inc") + +; define-arch must appear first + +(define-arch + (name fr30) ; name of cpu family + (comment "Fujitsu FR30") + (default-alignment forced) + (insn-lsb0? #f) + (machs fr30) + (isas fr30) +) + +(define-isa + (name fr30) + (base-insn-bitsize 16) + (decode-assist (0 1 2 3 4 5 6 7)) ; Initial bitnumbers to decode insns by. + (liw-insns 1) ; The fr30 fetches 1 insn at a time. + (parallel-insns 1) ; The fr30 executes 1 insn at a time. +) + +(define-cpu + ; cpu names must be distinct from the architecture name and machine names. + ; The "b" suffix stands for "base" and is the convention. + ; The "f" suffix stands for "family" and is the convention. + (name fr30bf) + (comment "Fujitsu FR30 base family") + (endian big) + (word-bitsize 32) +) + +(define-mach + (name fr30) + (comment "Generic FR30 cpu") + (cpu fr30bf) +) + +; Model descriptions. +; +(define-model + (name fr30-1) (comment "fr30-1") (attrs) + (mach fr30) + + (pipeline all "" () ((fetch) (decode) (execute) (writeback))) + + ; `state' is a list of variables for recording model state + (state + ; bit mask of h-gr registers loaded from memory by previous insn + (load-regs UINT) + ; bit mask of h-gr registers loaded from memory by current insn + (load-regs-pending UINT) + ) + + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () ; state + ((Ri INT -1) (Rj INT -1)) ; inputs + ((Ri INT -1)) ; outputs + () ; profile action (default) + ) + (unit u-cti "Branch Unit" () + 1 1 ; issue done + () ; state + ((Ri INT -1)) ; inputs + ((pc)) ; outputs + () ; profile action (default) + ) + (unit u-load "Memory Load Unit" () + 1 1 ; issue done + () ; state + ((Rj INT -1) + ;(ld-mem AI) + ) ; inputs + ((Ri INT -1)) ; outputs + () ; profile action (default) + ) + (unit u-store "Memory Store Unit" () + 1 1 ; issue done + () ; state + ((Ri INT -1) (Rj INT -1)) ; inputs + () ; ((st-mem AI)) ; outputs + () ; profile action (default) + ) + (unit u-ldm "LDM Memory Load Unit" () + 1 1 ; issue done + () ; state + ((reglist INT)) ; inputs + () ; outputs + () ; profile action (default) + ) + (unit u-stm "STM Memory Store Unit" () + 1 1 ; issue done + () ; state + ((reglist INT)) ; inputs + () ; outputs + () ; profile action (default) + ) +) + +; The instruction fetch/execute cycle. +; +; This is how to fetch and decode an instruction. +; Leave it out for now + +; (define-extract (const SI 0)) + +; This is how to execute a decoded instruction. +; Leave it out for now + +; (define-execute (const SI 0)) + +; Instruction fields. +; +; Attributes: +; PCREL-ADDR: pc relative value (for reloc and disassembly purposes) +; ABS-ADDR: absolute address (for reloc and disassembly purposes?) +; RESERVED: bits are not used to decode insn, must be all 0 + +(dnf f-op1 "1st 4 bits of opcode" () 0 4) +(dnf f-op2 "2nd 4 bits of opcode" () 4 4) +(dnf f-op3 "3rd 4 bits of opcode" () 8 4) +(dnf f-op4 "4th 4 bits of opcode" () 12 4) +(dnf f-op5 "5th bit of opcode" () 4 1) +(dnf f-cc "condition code" () 4 4) +(dnf f-ccc "coprocessor calc code" () 16 8) +(dnf f-Rj "register Rj" () 8 4) +(dnf f-Ri "register Ri" () 12 4) +(dnf f-Rs1 "register Rs" () 8 4) +(dnf f-Rs2 "register Rs" () 12 4) +(dnf f-Rjc "register Rj" () 24 4) +(dnf f-Ric "register Ri" () 28 4) +(dnf f-CRj "coprocessor register" () 24 4) +(dnf f-CRi "coprocessor register" () 28 4) +(dnf f-u4 "4 bit 0 extended" () 8 4) +(dnf f-u4c "4 bit 0 extended" () 12 4) +(df f-i4 "4 bit sign extended" () 8 4 INT #f #f) +(df f-m4 "4 bit minus extended" () 8 4 UINT + ((value pc) (and WI value (const #xf))) + ; ??? On a 64 bit host this doesn't get completely sign extended + ; if the value is recorded in a long, as it is during extraction. + ; Various fixes exist, pick one. + ((value pc) (or WI value (sll WI (const -1) (const 4)))) +) +(dnf f-u8 "8 bit unsigned" () 8 8) +(dnf f-i8 "8 bit unsigned" () 4 8) + +(dnf f-i20-4 "upper 4 bits of i20" () 8 4) +(dnf f-i20-16 "lower 16 bits of i20" () 16 16) +(dnmf f-i20 "20 bit unsigned" () UINT + (f-i20-4 f-i20-16) + (sequence () ; insert + (set (ifield f-i20-4) (srl (ifield f-i20) (const 16))) + (set (ifield f-i20-16) (and (ifield f-i20) (const #xffff))) + ) + (sequence () ; extract + (set (ifield f-i20) (or (sll (ifield f-i20-4) (const 16)) + (ifield f-i20-16))) + ) +) + +(dnf f-i32 "32 bit immediate" (SIGN-OPT) 16 32) + +(df f-udisp6 "6 bit unsigned offset" () 8 4 UINT + ((value pc) (srl UWI value (const 2))) + ((value pc) (sll UWI value (const 2))) +) +(df f-disp8 "8 bit signed offset" () 4 8 INT #f #f) +(df f-disp9 "9 bit signed offset" () 4 8 INT + ((value pc) (sra WI value (const 1))) + ((value pc) (sll WI value (const 1))) +) +(df f-disp10 "10 bit signed offset" () 4 8 INT + ((value pc) (sra WI value (const 2))) + ((value pc) (sll WI value (const 2))) +) +(df f-s10 "10 bit signed offset" () 8 8 INT + ((value pc) (sra WI value (const 2))) + ((value pc) (sll WI value (const 2))) +) +(df f-u10 "10 bit unsigned offset" () 8 8 UINT + ((value pc) (srl UWI value (const 2))) + ((value pc) (sll UWI value (const 2))) +) +(df f-rel9 "9 pc relative signed offset" (PCREL-ADDR) 8 8 INT + ((value pc) (sra WI (sub WI value (add WI pc (const 2))) (const 1))) + ((value pc) (add WI (sll WI value (const 1)) (add WI pc (const 2)))) +) +(dnf f-dir8 "8 bit direct address" () 8 8) +(df f-dir9 "9 bit direct address" () 8 8 UINT + ((value pc) (srl UWI value (const 1))) + ((value pc) (sll UWI value (const 1))) +) +(df f-dir10 "10 bit direct address" () 8 8 UINT + ((value pc) (srl UWI value (const 2))) + ((value pc) (sll UWI value (const 2))) +) +(df f-rel12 "12 bit pc relative signed offset" (PCREL-ADDR) 5 11 INT + ((value pc) (sra WI (sub WI value (add WI pc (const 2))) (const 1))) + ((value pc) (add WI (sll WI value (const 1)) (add WI pc (const 2)))) +) + +(dnf f-reglist_hi_st "8 bit register mask for stm" () 8 8) +(dnf f-reglist_low_st "8 bit register mask for stm" () 8 8) +(dnf f-reglist_hi_ld "8 bit register mask for ldm" () 8 8) +(dnf f-reglist_low_ld "8 bit register mask for ldm" () 8 8) + +; Enums. + +; insn-op1: bits 0-3 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op1 "insn op1 enums" () OP1_ f-op1 + ("0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "A" "B" "C" "D" "E" "F") +) + +; insn-op2: bits 4-7 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op2 "insn op2 enums" () OP2_ f-op2 + ("0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "A" "B" "C" "D" "E" "F") +) + +; insn-op3: bits 8-11 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op3 "insn op3 enums" () OP3_ f-op3 + ("0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "A" "B" "C" "D" "E" "F") +) + +; insn-op4: bits 12-15 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op4 "insn op4 enums" () OP4_ f-op4 + ("0") +) + +; insn-op5: bit 4 (5th bit origin 0) +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op5 "insn op5 enums" () OP5_ f-op5 + ("0" "1") +) + +; insn-cc: condition codes +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-cc "insn cc enums" () CC_ f-cc + ("ra" "no" "eq" "ne" "c" "nc" "n" "p" "v" "nv" "lt" "ge" "le" "gt" "ls" "hi") +) + +; Hardware pieces. +; These entries list the elements of the raw hardware. +; They're also used to provide tables and other elements of the assembly +; language. + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-keyword + (name gr-names) + (print-name h-gr) + (prefix "") + (values (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15) + (ac 13) (fp 14) (sp 15)) +) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE CACHE-ADDR) + (type register WI (16)) + (indices extern-keyword gr-names) +) + +(define-keyword + (name cr-names) + (print-name h-cr) + (prefix "") + (values (cr0 0) (cr1 1) (cr2 2) (cr3 3) + (cr4 4) (cr5 5) (cr6 6) (cr7 7) + (cr8 8) (cr9 9) (cr10 10) (cr11 11) + (cr12 12) (cr13 13) (cr14 14) (cr15 15)) +) + +(define-hardware + (name h-cr) + (comment "coprocessor registers") + (attrs) + (type register WI (16)) + (indices extern-keyword cr-names) +) + +(define-keyword + (name dr-names) + (print-name h-dr) + (prefix "") + (values (tbr 0) (rp 1) (ssp 2) (usp 3) (mdh 4) (mdl 5)) +) + +(define-hardware + (name h-dr) + (comment "dedicated registers") + (type register WI (6)) + (indices extern-keyword dr-names) + (get (index) (c-call WI "@cpu@_h_dr_get_handler" index)) + (set (index newval) (c-call VOID "@cpu@_h_dr_set_handler" index newval)) +) + +(define-hardware + (name h-ps) + (comment "processor status") + (type register UWI) + (indices keyword "" ((ps 0))) + (get () (c-call UWI "@cpu@_h_ps_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_ps_set_handler" newval)) +) + +(dnh h-r13 "General Register 13 explicitly required" + () + (register WI) + (keyword "" ((r13 0))) + () () +) + +(dnh h-r14 "General Register 14 explicitly required" + () + (register WI) + (keyword "" ((r14 0))) + () () +) + +(dnh h-r15 "General Register 15 explicitly required" + () + (register WI) + (keyword "" ((r15 0))) + () () +) + +; These bits are actually part of the PS register but are accessed more +; often than the entire register, so define them directly. We can assemble +; the PS register from its components when necessary. + +(dsh h-nbit "negative bit" () (register BI)) +(dsh h-zbit "zero bit" () (register BI)) +(dsh h-vbit "overflow bit" () (register BI)) +(dsh h-cbit "carry bit" () (register BI)) +(dsh h-ibit "interrupt enable bit" () (register BI)) +(define-hardware + (name h-sbit) + (comment "stack bit") + (type register BI) + (get () (c-call BI "@cpu@_h_sbit_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_sbit_set_handler" newval)) +) +(dsh h-tbit "trace trap bit" () (register BI)) +(dsh h-d0bit "division 0 bit" () (register BI)) +(dsh h-d1bit "division 1 bit" () (register BI)) + +; These represent sub-registers within the program status register + +(define-hardware + (name h-ccr) + (comment "condition code bits") + (type register UQI) + (get () (c-call UQI "@cpu@_h_ccr_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_ccr_set_handler" newval)) +) +(define-hardware + (name h-scr) + (comment "system condition bits") + (type register UQI) + (get () (c-call UQI "@cpu@_h_scr_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_scr_set_handler" newval)) +) +(define-hardware + (name h-ilm) + (comment "interrupt level mask") + (type register UQI) + (get () (c-call UQI "@cpu@_h_ilm_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_ilm_set_handler" newval)) +) + +; Instruction Operands. +; These entries provide a layer between the assembler and the raw hardware +; description, and are used to refer to hardware elements in the semantic +; code. Usually there's a bit of over-specification, but in more complicated +; instruction sets there isn't. + +; FR30 specific operand attributes: + +(define-attr + (for operand) + (type boolean) + (name HASH-PREFIX) + (comment "immediates have an optional '#' prefix") +) + +; ??? Convention says this should be o-sr, but then the insn definitions +; should refer to o-sr which is clumsy. The "o-" could be implicit, but +; then it should be implicit for all the symbols here, but then there would +; be confusion between (f-)simm8 and (h-)simm8. +; So for now the rule is exactly as it appears here. + +(dnop Ri "destination register" () h-gr f-Ri) +(dnop Rj "source register" () h-gr f-Rj) +(dnop Ric "target register coproc insn" () h-gr f-Ric) +(dnop Rjc "source register coproc insn" () h-gr f-Rjc) +(dnop CRi "coprocessor register" () h-cr f-CRi) +(dnop CRj "coprocessor register" () h-cr f-CRj) +(dnop Rs1 "dedicated register" () h-dr f-Rs1) +(dnop Rs2 "dedicated register" () h-dr f-Rs2) +(dnop R13 "General Register 13" () h-r13 f-nil) +(dnop R14 "General Register 14" () h-r14 f-nil) +(dnop R15 "General Register 15" () h-r15 f-nil) +(dnop ps "Program Status register" () h-ps f-nil) +(dnop u4 "4 bit unsigned immediate" (HASH-PREFIX) h-uint f-u4) +(dnop u4c "4 bit unsigned immediate" (HASH-PREFIX) h-uint f-u4c) +(dnop u8 "8 bit unsigned immediate" (HASH-PREFIX) h-uint f-u8) +(dnop i8 "8 bit unsigned immediate" (HASH-PREFIX) h-uint f-i8) +(dnop udisp6 "6 bit unsigned immediate" (HASH-PREFIX) h-uint f-udisp6) +(dnop disp8 "8 bit signed immediate" (HASH-PREFIX) h-sint f-disp8) +(dnop disp9 "9 bit signed immediate" (HASH-PREFIX) h-sint f-disp9) +(dnop disp10 "10 bit signed immediate" (HASH-PREFIX) h-sint f-disp10) + +(dnop s10 "10 bit signed immediate" (HASH-PREFIX) h-sint f-s10) +(dnop u10 "10 bit unsigned immediate" (HASH-PREFIX) h-uint f-u10) +(dnop i32 "32 bit immediate" (HASH-PREFIX) h-uint f-i32) + +(define-operand + (name m4) + (comment "4 bit negative immediate") + (attrs HASH-PREFIX) + (type h-sint) + (index f-m4) + (handlers (print "m4")) +) + +(define-operand + (name i20) + (comment "20 bit immediate") + (attrs HASH-PREFIX) + (type h-uint) + (index f-i20) +) + +(dnop dir8 "8 bit direct address" () h-uint f-dir8) +(dnop dir9 "9 bit direct address" () h-uint f-dir9) +(dnop dir10 "10 bit direct address" () h-uint f-dir10) + +(dnop label9 "9 bit pc relative address" () h-iaddr f-rel9) +(dnop label12 "12 bit pc relative address" () h-iaddr f-rel12) + +(define-operand + (name reglist_low_ld) + (comment "8 bit low register mask for ldm") + (attrs) + (type h-uint) + (index f-reglist_low_ld) + (handlers (parse "low_register_list_ld") + (print "low_register_list_ld")) +) + +(define-operand + (name reglist_hi_ld) + (comment "8 bit high register mask for ldm") + (attrs) + (type h-uint) + (index f-reglist_hi_ld) + (handlers (parse "hi_register_list_ld") + (print "hi_register_list_ld")) +) + +(define-operand + (name reglist_low_st) + (comment "8 bit low register mask for stm") + (attrs) + (type h-uint) + (index f-reglist_low_st) + (handlers (parse "low_register_list_st") + (print "low_register_list_st")) +) + +(define-operand + (name reglist_hi_st) + (comment "8 bit high register mask for stm") + (attrs) + (type h-uint) + (index f-reglist_hi_st) + (handlers (parse "hi_register_list_st") + (print "hi_register_list_st")) +) + +(dnop cc "condition codes" () h-uint f-cc) +(dnop ccc "coprocessor calc" (HASH-PREFIX) h-uint f-ccc) + +(dnop nbit "negative bit" (SEM-ONLY) h-nbit f-nil) +(dnop vbit "overflow bit" (SEM-ONLY) h-vbit f-nil) +(dnop zbit "zero bit" (SEM-ONLY) h-zbit f-nil) +(dnop cbit "carry bit" (SEM-ONLY) h-cbit f-nil) +(dnop ibit "interrupt bit" (SEM-ONLY) h-ibit f-nil) +(dnop sbit "stack bit" (SEM-ONLY) h-sbit f-nil) +(dnop tbit "trace trap bit" (SEM-ONLY) h-tbit f-nil) +(dnop d0bit "division 0 bit" (SEM-ONLY) h-d0bit f-nil) +(dnop d1bit "division 1 bit" (SEM-ONLY) h-d1bit f-nil) + +(dnop ccr "condition code bits" (SEM-ONLY) h-ccr f-nil) +(dnop scr "system condition bits" (SEM-ONLY) h-scr f-nil) +(dnop ilm "interrupt level mask" (SEM-ONLY) h-ilm f-nil) + +; Instruction definitions. +; +; Notes: +; - dni is short for "define-normal-instruction" + +; FR30 specific insn attributes: + +(define-attr + (for insn) + (type boolean) + (name NOT-IN-DELAY-SLOT) + (comment "insn can't go in delay slot") +) + +; Sets zbit and nbit based on the value of x +; +(define-pmacro (set-z-and-n x) + (sequence () + (set zbit (eq x (const 0))) + (set nbit (lt x (const 0)))) +) + +; Binary integer instruction which sets status bits +; +(define-pmacro (binary-int-op name insn comment opc1 opc2 op arg1 arg2) + (dni name + (.str insn " " comment) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence () + (set vbit ((.sym op -oflag) arg2 arg1 (const 0))) + (set cbit ((.sym op -cflag) arg2 arg1 (const 0))) + (set arg2 (op arg2 arg1)) + (set-z-and-n arg2)) + () + ) +) + +; Binary integer instruction which does *not* set status bits +; +(define-pmacro (binary-int-op-n name insn comment opc1 opc2 op arg1 arg2) + (dni name + (.str insn " " comment) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (set arg2 (op arg2 arg1)) + () + ) +) + +; Binary integer instruction with carry which sets status bits +; +(define-pmacro (binary-int-op-c name insn comment opc1 opc2 op arg1 arg2) + (dni name + (.str insn " " comment) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence ((WI tmp)) + (set tmp ((.sym op c) arg2 arg1 cbit)) + (set vbit ((.sym op -oflag) arg2 arg1 cbit)) + (set cbit ((.sym op -cflag) arg2 arg1 cbit)) + (set arg2 tmp) + (set-z-and-n arg2)) + () + ) +) + +(binary-int-op add add "reg/reg" OP1_A OP2_6 add Rj Ri) +(binary-int-op addi add "immed/reg" OP1_A OP2_4 add u4 Ri) +(binary-int-op add2 add2 "immed/reg" OP1_A OP2_5 add m4 Ri) +(binary-int-op-c addc addc "reg/reg" OP1_A OP2_7 add Rj Ri) +(binary-int-op-n addn addn "reg/reg" OP1_A OP2_2 add Rj Ri) +(binary-int-op-n addni addn "immed/reg" OP1_A OP2_0 add u4 Ri) +(binary-int-op-n addn2 addn2 "immed/reg" OP1_A OP2_1 add m4 Ri) + +(binary-int-op sub sub "reg/reg" OP1_A OP2_C sub Rj Ri) +(binary-int-op-c subc subc "reg/reg" OP1_A OP2_D sub Rj Ri) +(binary-int-op-n subn subn "reg/reg" OP1_A OP2_E sub Rj Ri) + +; Integer compare instruction +; +(define-pmacro (int-cmp name insn comment opc1 opc2 arg1 arg2) + (dni name + (.str insn " " comment) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence ((WI tmp1)) + (set vbit (sub-oflag arg2 arg1 (const 0))) + (set cbit (sub-cflag arg2 arg1 (const 0))) + (set tmp1 (sub arg2 arg1)) + (set-z-and-n tmp1) + ) + () + ) +) + +(int-cmp cmp cmp "reg/reg" OP1_A OP2_A Rj Ri) +(int-cmp cmpi cmp "immed/reg" OP1_A OP2_8 u4 Ri) +(int-cmp cmp2 cmp2 "immed/reg" OP1_A OP2_9 m4 Ri) + +; Binary logical instruction +; +(define-pmacro (binary-logical-op name insn comment opc1 opc2 op arg1 arg2) + (dni name + (.str insn " " comment) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence () + (set arg2 (op arg2 arg1)) + (set-z-and-n arg2)) + () + ) +) + +(binary-logical-op and and "reg/reg" OP1_8 OP2_2 and Rj Ri) +(binary-logical-op or or "reg/reg" OP1_9 OP2_2 or Rj Ri) +(binary-logical-op eor eor "reg/reg" OP1_9 OP2_A xor Rj Ri) + +(define-pmacro (les-units model) ; les: load-exec-store + (model (unit u-exec) (unit u-load) (unit u-store)) +) + +; Binary logical instruction to memory +; +(define-pmacro (binary-logical-op-m name insn comment opc1 opc2 mode op arg1 arg2) + (dni name + (.str insn " " comment) + (NOT-IN-DELAY-SLOT) + (.str insn " $" arg1 ",@$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence ((mode tmp)) + (set mode tmp (op mode (mem mode arg2) arg1)) + (set-z-and-n tmp) + (set mode (mem mode arg2) tmp)) + ((les-units fr30-1)) + ) +) + +(binary-logical-op-m andm and "reg/mem" OP1_8 OP2_4 WI and Rj Ri) +(binary-logical-op-m andh andh "reg/mem" OP1_8 OP2_5 HI and Rj Ri) +(binary-logical-op-m andb andb "reg/mem" OP1_8 OP2_6 QI and Rj Ri) +(binary-logical-op-m orm or "reg/mem" OP1_9 OP2_4 WI or Rj Ri) +(binary-logical-op-m orh orh "reg/mem" OP1_9 OP2_5 HI or Rj Ri) +(binary-logical-op-m orb orb "reg/mem" OP1_9 OP2_6 QI or Rj Ri) +(binary-logical-op-m eorm eor "reg/mem" OP1_9 OP2_C WI xor Rj Ri) +(binary-logical-op-m eorh eorh "reg/mem" OP1_9 OP2_D HI xor Rj Ri) +(binary-logical-op-m eorb eorb "reg/mem" OP1_9 OP2_E QI xor Rj Ri) + +; Binary logical instruction to low half of byte in memory +; +(dni bandl + "bandl #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "bandl $u4,@$Ri" + (+ OP1_8 OP2_0 u4 Ri) + (set QI (mem QI Ri) + (and QI + (or QI u4 (const #xf0)) + (mem QI Ri))) + ((les-units fr30-1)) +) + +(dni borl + "borl #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "borl $u4,@$Ri" + (+ OP1_9 OP2_0 u4 Ri) + (set QI (mem QI Ri) (or QI u4 (mem QI Ri))) + ((les-units fr30-1)) +) + +(dni beorl + "beorl #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "beorl $u4,@$Ri" + (+ OP1_9 OP2_8 u4 Ri) + (set QI (mem QI Ri) (xor QI u4 (mem QI Ri))) + ((les-units fr30-1)) +) + +; Binary logical instruction to high half of byte in memory +; +(dni bandh + "bandh #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "bandh $u4,@$Ri" + (+ OP1_8 OP2_1 u4 Ri) + (set QI (mem QI Ri) + (and QI + (or QI (sll QI u4 (const 4)) (const #x0f)) + (mem QI Ri))) + ((les-units fr30-1)) +) + +(define-pmacro (binary-or-op-mh name insn opc1 opc2 op arg1 arg2) + (dni name + (.str name " #" arg1 ",@" args) + (NOT-IN-DELAY-SLOT) + (.str name " $" arg1 ",@$" arg2) + (+ opc1 opc2 arg1 arg2) + (set QI (mem QI arg2) + (insn QI + (sll QI arg1 (const 4)) + (mem QI arg2))) + ((les-units fr30-1)) + ) +) + +(binary-or-op-mh borh or OP1_9 OP2_1 or u4 Ri) +(binary-or-op-mh beorh xor OP1_9 OP2_9 xor u4 Ri) + +(dni btstl + "btstl #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "btstl $u4,@$Ri" + (+ OP1_8 OP2_8 u4 Ri) + (sequence ((QI tmp)) + (set tmp (and QI u4 (mem QI Ri))) + (set zbit (eq tmp (const 0))) + (set nbit (const 0))) + ((fr30-1 (unit u-load) (unit u-exec (cycles 2)))) +) + +(dni btsth + "btsth #u4,@Ri" + (NOT-IN-DELAY-SLOT) + "btsth $u4,@$Ri" + (+ OP1_8 OP2_9 u4 Ri) + (sequence ((QI tmp)) + (set tmp (and QI (sll QI u4 (const 4)) (mem QI Ri))) + (set zbit (eq tmp (const 0))) + (set nbit (lt tmp (const 0)))) + ((fr30-1 (unit u-load) (unit u-exec (cycles 2)))) +) + +(dni mul + "mul Rj,Ri" + (NOT-IN-DELAY-SLOT) + "mul $Rj,$Ri" + (+ OP1_A OP2_F Rj Ri) + (sequence ((DI tmp)) + (set tmp (mul DI (ext DI Rj) (ext DI Ri))) + (set (reg h-dr 5) (trunc WI tmp)) + (set (reg h-dr 4) (trunc WI (srl tmp (const 32)))) + (set nbit (lt (reg h-dr 5) (const 0))) + (set zbit (eq tmp (const DI 0))) + (set vbit (orif + (gt tmp (const DI #x7fffffff)) + (lt tmp (neg (const DI #x80000000)))))) + ((fr30-1 (unit u-exec (cycles 5)))) +) + +(dni mulu + "mulu Rj,Ri" + (NOT-IN-DELAY-SLOT) + "mulu $Rj,$Ri" + (+ OP1_A OP2_B Rj Ri) + (sequence ((DI tmp)) + (set tmp (mul DI (zext DI Rj) (zext DI Ri))) + (set (reg h-dr 5) (trunc WI tmp)) + (set (reg h-dr 4) (trunc WI (srl tmp (const 32)))) + (set nbit (lt (reg h-dr 4) (const 0))) + (set zbit (eq (reg h-dr 5) (const 0))) + (set vbit (ne (reg h-dr 4) (const 0)))) + ((fr30-1 (unit u-exec (cycles 5)))) +) + +(dni mulh + "mulh Rj,Ri" + (NOT-IN-DELAY-SLOT) + "mulh $Rj,$Ri" + (+ OP1_B OP2_F Rj Ri) + (sequence () + (set (reg h-dr 5) (mul (trunc HI Rj) (trunc HI Ri))) + (set nbit (lt (reg h-dr 5) (const 0))) + (set zbit (ge (reg h-dr 5) (const 0)))) + ((fr30-1 (unit u-exec (cycles 3)))) +) + +(dni muluh + "muluh Rj,Ri" + (NOT-IN-DELAY-SLOT) + "muluh $Rj,$Ri" + (+ OP1_B OP2_B Rj Ri) + (sequence () + (set (reg h-dr 5) (mul (and Rj (const #xffff)) + (and Ri (const #xffff)))) + (set nbit (lt (reg h-dr 5) (const 0))) + (set zbit (ge (reg h-dr 5) (const 0)))) + ((fr30-1 (unit u-exec (cycles 3)))) +) + +(dni div0s + "div0s Ri" + () + "div0s $Ri" + (+ OP1_9 OP2_7 OP3_4 Ri) + (sequence () + (set d0bit (lt (reg h-dr 5) (const 0))) + (set d1bit (xor d0bit (lt Ri (const 0)))) + (if (ne d0bit (const 0)) + (set (reg h-dr 4) (const #xffffffff)) + (set (reg h-dr 4) (const 0)))) + () +) + +(dni div0u + "div0u Ri" + () + "div0u $Ri" + (+ OP1_9 OP2_7 OP3_5 Ri) + (sequence () + (set d0bit (const 0)) + (set d1bit (const 0)) + (set (reg h-dr 4) (const 0))) + () +) + +(dni div1 + "div1 Ri" + () + "div1 $Ri" + (+ OP1_9 OP2_7 OP3_6 Ri) + (sequence ((WI tmp)) + (set (reg h-dr 4) (sll (reg h-dr 4) (const 1))) + (if (lt (reg h-dr 5) (const 0)) + (set (reg h-dr 4) (add (reg h-dr 4) (const 1)))) + (set (reg h-dr 5) (sll (reg h-dr 5) (const 1))) + (if (eq d1bit (const 1)) + (sequence () + (set tmp (add (reg h-dr 4) Ri)) + (set cbit (add-cflag (reg h-dr 4) Ri (const 0)))) + (sequence () + (set tmp (sub (reg h-dr 4) Ri)) + (set cbit (sub-cflag (reg h-dr 4) Ri (const 0))))) + (if (not (xor (xor d0bit d1bit) cbit)) + (sequence () + (set (reg h-dr 4) tmp) + (set (reg h-dr 5) (or (reg h-dr 5) (const 1))))) + (set zbit (eq (reg h-dr 4) (const 0)))) + () +) + +(dni div2 + "div2 Ri" + () + "div2 $Ri" + (+ OP1_9 OP2_7 OP3_7 Ri) + (sequence ((WI tmp)) + (if (eq d1bit (const 1)) + (sequence () + (set tmp (add (reg h-dr 4) Ri)) + (set cbit (add-cflag (reg h-dr 4) Ri (const 0)))) + (sequence () + (set tmp (sub (reg h-dr 4) Ri)) + (set cbit (sub-cflag (reg h-dr 4) Ri (const 0))))) + (if (eq tmp (const 0)) + (sequence () + (set zbit (const 1)) + (set (reg h-dr 4) (const 0))) + (set zbit (const 0)))) + () +) + +(dni div3 + "div3" + () + "div3" + (+ OP1_9 OP2_F OP3_6 OP4_0) + (if (eq zbit (const 1)) + (set (reg h-dr 5) (add (reg h-dr 5) (const 1)))) + () +) + +(dni div4s + "div4s" + () + "div4s" + (+ OP1_9 OP2_F OP3_7 OP4_0) + (if (eq d1bit (const 1)) + (set (reg h-dr 5) (neg (reg h-dr 5)))) + () +) + +(define-pmacro (leftshift-op name insn opc1 opc2 arg1 arg2 shift-expr) + (dni name + (.str insn " " arg1 "," arg2) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence ((WI shift)) + (set shift shift-expr) + (if (ne shift (const 0)) + (sequence () + (set cbit (ne (and arg2 + (sll (const 1) + (sub (const 32) shift))) + (const 0))) + (set arg2 (sll arg2 shift))) + (set cbit (const 0))) + (set nbit (lt arg2 (const 0))) + (set zbit (eq arg2 (const 0)))) + () + ) +) +(leftshift-op lsl lsl OP1_B OP2_6 Rj Ri (and Rj (const #x1f))) +(leftshift-op lsli lsl OP1_B OP2_4 u4 Ri u4) +(leftshift-op lsl2 lsl2 OP1_B OP2_5 u4 Ri (add u4 (const #x10))) + +(define-pmacro (rightshift-op name insn opc1 opc2 op arg1 arg2 shift-expr) + (dni name + (.str insn " " arg1 "," arg2) + () + (.str insn " $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (sequence ((WI shift)) + (set shift shift-expr) + (if (ne shift (const 0)) + (sequence () + (set cbit (ne (and arg2 + (sll (const 1) + (sub shift (const 1)))) + (const 0))) + (set arg2 (op arg2 shift))) + (set cbit (const 0))) + (set nbit (lt arg2 (const 0))) + (set zbit (eq arg2 (const 0)))) + () + ) +) +(rightshift-op lsr lsr OP1_B OP2_2 srl Rj Ri (and Rj (const #x1f))) +(rightshift-op lsri lsr OP1_B OP2_0 srl u4 Ri u4) +(rightshift-op lsr2 lsr2 OP1_B OP2_1 srl u4 Ri (add u4 (const #x10))) +(rightshift-op asr asr OP1_B OP2_A sra Rj Ri (and Rj (const #x1f))) +(rightshift-op asri asr OP1_B OP2_8 sra u4 Ri u4) +(rightshift-op asr2 asr2 OP1_B OP2_9 sra u4 Ri (add u4 (const #x10))) + +(dni ldi8 + "load 8 bit unsigned immediate" + () + "ldi:8 $i8,$Ri" + (+ OP1_C i8 Ri) + (set Ri i8) + () +) + +; Typing ldi:8 in in emacs is a pain. +(dnmi ldi8m "ldi:8 without the colon" + (NO-DIS) + "ldi8 $i8,$Ri" + (emit ldi8 i8 Ri) +) + +(dni ldi20 + "load 20 bit unsigned immediate" + (NOT-IN-DELAY-SLOT) + "ldi:20 $i20,$Ri" + (+ OP1_9 OP2_B Ri i20) + (set Ri i20) + ((fr30-1 (unit u-exec (cycles 2)))) +) + +; Typing ldi:20 in in emacs is a pain. +(dnmi ldi20m "ldi:20 without the colon" + (NO-DIS) + "ldi20 $i20,$Ri" + (emit ldi20 i20 Ri) +) + +(dni ldi32 + "load 32 bit immediate" + (NOT-IN-DELAY-SLOT) + "ldi:32 $i32,$Ri" + (+ OP1_9 OP2_F OP3_8 Ri i32) + (set Ri i32) + ((fr30-1 (unit u-exec (cycles 3)))) +) + +; Typing ldi:32 in in emacs is a pain. +(dnmi ldi32m "ldi:32 without the colon" + (NO-DIS) + "ldi32 $i32,$Ri" + (emit ldi32 i32 Ri) +) + +(define-pmacro (basic-ld name insn opc1 opc2 mode arg1 arg2) + (dni name + (.str name " @" arg1 "," arg2) + () + (.str name " @$" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (set arg2 (mem mode arg1)) + ((fr30-1 (unit u-load))) + ) +) + +(basic-ld ld ld OP1_0 OP2_4 WI Rj Ri) +(basic-ld lduh lduh OP1_0 OP2_5 UHI Rj Ri) +(basic-ld ldub ldub OP1_0 OP2_6 UQI Rj Ri) + +(define-pmacro (r13base-ld name insn opc1 opc2 mode arg1 arg2) + (dni name + (.str insn " @(R13," arg1 ")," arg2) + () + (.str insn " @($R13,$" arg1 "),$" arg2) + (+ opc1 opc2 arg1 arg2) + (set arg2 (mem mode (add arg1 (reg h-gr 13)))) + ((fr30-1 (unit u-load))) + ) +) + +(r13base-ld ldr13 ld OP1_0 OP2_0 WI Rj Ri) +(r13base-ld ldr13uh lduh OP1_0 OP2_1 UHI Rj Ri) +(r13base-ld ldr13ub ldub OP1_0 OP2_2 UQI Rj Ri) + +(define-pmacro (r14base-ld name insn opc1 mode arg1 arg2) + (dni name + (.str insn " @(R14," arg1 ")," arg2) + () + (.str insn " @($R14,$" arg1 "),$" arg2) + (+ opc1 arg1 arg2) + (set arg2 (mem mode (add arg1 (reg h-gr 14)))) + ((fr30-1 (unit u-load))) + ) +) + +(r14base-ld ldr14 ld OP1_2 WI disp10 Ri) +(r14base-ld ldr14uh lduh OP1_4 UHI disp9 Ri) +(r14base-ld ldr14ub ldub OP1_6 UQI disp8 Ri) + +(dni ldr15 + "ld @(R15,udisp6),Ri mem/reg" + () + "ld @($R15,$udisp6),$Ri" + (+ OP1_0 OP2_3 udisp6 Ri) + (set Ri (mem WI (add udisp6 (reg h-gr 15)))) + ((fr30-1 (unit u-load))) +) + +(dni ldr15gr + "ld @R15+,Ri" + () + "ld @$R15+,$Ri" + (+ OP1_0 OP2_7 OP3_0 Ri) + (sequence () + (set Ri (mem WI (reg h-gr 15))) + (if (ne (ifield f-Ri) (const 15)) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + ((fr30-1 (unit u-load))) +) + +; This insn loads a value from where r15 points into the target register and +; then increments r15. If the target register is also r15, then the post +; increment is not performed. +; +(dni ldr15dr + "ld @R15+,Rs2" + () + "ld @$R15+,$Rs2" + (+ OP1_0 OP2_7 OP3_8 Rs2) +; This seems more straight forward, but doesn't work due to a problem in +; cgen. We're trying to not increment r15 if it is the target register. +; (sequence () +; (set Rs2 (mem WI (reg h-gr 15))) +; (if (not (or (and (eq (ifield f-Rs2) (const 2)) +; (eq sbit (const 0))) +; (and (eq (ifield f-Rs2) (const 3)) +; (eq sbit (const 1))))) +; (set (reg h-gr 15) (add (reg h-gr 15) (const 4))) +; ) +; ) + (sequence ((WI tmp)) + (set tmp (mem WI (reg h-gr 15))) ; save in case target is r15 + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))) + (set Rs2 tmp)) + ((fr30-1 (unit u-load))) +) + +(dni ldr15ps + "ld @R15+,ps mem/reg" + (NOT-IN-DELAY-SLOT) + "ld @$R15+,$ps" + (+ OP1_0 OP2_7 OP3_9 OP4_0) + (sequence () + (set ps (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4)))) + ((fr30-1 (unit u-load))) +) + +(define-pmacro (basic-st name insn opc1 opc2 mode arg1 arg2) + (dni name + (.str name " " arg1 ",@" arg2) + () + (.str name " $" arg1 ",@$" arg2) + (+ opc1 opc2 arg1 arg2) + (set (mem mode arg2) arg1) + ((fr30-1 (unit u-store))) + ) +) + +(basic-st st st OP1_1 OP2_4 WI Ri Rj) +(basic-st sth sth OP1_1 OP2_5 HI Ri Rj) +(basic-st stb stb OP1_1 OP2_6 QI Ri Rj) + +(define-pmacro (r13base-st name insn opc1 opc2 mode arg1 arg2) + (dni name + (.str insn " " arg1 ",@(R13," arg2 ")") + () + (.str insn " $" arg1 ",@($R13,$" arg2 ")") + (+ opc1 opc2 arg1 arg2) + (set (mem mode (add arg2 (reg h-gr 13))) arg1) + ((fr30-1 (unit u-store))) + ) +) + +(r13base-st str13 st OP1_1 OP2_0 WI Ri Rj) +(r13base-st str13h sth OP1_1 OP2_1 HI Ri Rj) +(r13base-st str13b stb OP1_1 OP2_2 QI Ri Rj) + +(define-pmacro (r14base-st name insn opc1 mode arg1 arg2) + (dni name + (.str insn " " arg1 ",@(R14," arg2 ")") + () + (.str insn " $" arg1 ",@($R14,$" arg2 ")") + (+ opc1 arg1 arg2) + (set (mem mode (add arg2 (reg h-gr 14))) arg1) + ((fr30-1 (unit u-store))) + ) +) + +(r14base-st str14 st OP1_3 WI Ri disp10) +(r14base-st str14h sth OP1_5 HI Ri disp9) +(r14base-st str14b stb OP1_7 QI Ri disp8) + +(dni str15 + "st Ri,@(R15,udisp6) reg/mem" + () + "st $Ri,@($R15,$udisp6)" + (+ OP1_1 OP2_3 udisp6 Ri) + (set (mem WI (add (reg h-gr 15) udisp6)) Ri) + ((fr30-1 (unit u-store))) +) + +; These store insns predecrement r15 and then store the contents of the source +; register where r15 then points. If the source register is also r15, then the +; original value of r15 is stored. +; +(dni str15gr + "st Ri,@-R15 reg/mem" + () + "st $Ri,@-$R15" + (+ OP1_1 OP2_7 OP3_0 Ri) + (sequence ((WI tmp)) + (set tmp Ri) ; save in case it's r15 + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) tmp)) + ((fr30-1 (unit u-store))) +) + +(dni str15dr + "st Rs,@-R15 reg/mem" + () + "st $Rs2,@-$R15" + (+ OP1_1 OP2_7 OP3_8 Rs2) + (sequence ((WI tmp)) + (set tmp Rs2) ; save in case it's r15 + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) tmp)) + ((fr30-1 (unit u-store))) +) + +(dni str15ps + "st ps,@-R15 reg/mem" + () + "st $ps,@-$R15" + (+ OP1_1 OP2_7 OP3_9 OP4_0) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) ps)) + ((fr30-1 (unit u-store))) +) + +(define-pmacro (mov2gr name opc1 opc2 arg1 arg2) + (dni name + (.str "mov " arg1 "," arg2) + () + (.str "mov $" arg1 ",$" arg2) + (+ opc1 opc2 arg1 arg2) + (set arg2 arg1) + () + ) +) + +(mov2gr mov OP1_8 OP2_B Rj Ri) +(mov2gr movdr OP1_B OP2_7 Rs1 Ri) + +(dni movps + "mov ps,Ri reg/reg" + () + "mov $ps,$Ri" + (+ OP1_1 OP2_7 OP3_1 Ri) + (set Ri ps) + () +) + +(dni mov2dr + "mov Ri,Rs reg/reg" + () + "mov $Ri,$Rs1" + (+ OP1_B OP2_3 Rs1 Ri) + (set Rs1 Ri) + () +) + +(dni mov2ps + "mov Ri,ps reg/reg" + () + "mov $Ri,$ps" + (+ OP1_0 OP2_7 OP3_1 Ri) + (set ps Ri) + () +) + +(dni jmp + "jmp with no delay slot" + (NOT-IN-DELAY-SLOT) + "jmp @$Ri" + (+ OP1_9 OP2_7 OP3_0 Ri) + (set pc Ri) + ((fr30-1 (unit u-cti))) +) + +(dni jmpd "jmp with delay slot" + (NOT-IN-DELAY-SLOT) + "jmp:d @$Ri" + (+ OP1_9 OP2_F OP3_0 Ri) + (delay (const 1) + (set pc Ri)) + ((fr30-1 (unit u-cti))) +) + +; These versions which use registers must appear before the other +; versions which use relative addresses due to a problem in cgen +; - DB. +(dni callr + "call @Ri" + (NOT-IN-DELAY-SLOT) + "call @$Ri" + (+ OP1_9 OP2_7 OP3_1 Ri) + (sequence () + (set (reg h-dr 1) (add pc (const 2))) + (set pc Ri)) + ((fr30-1 (unit u-cti))) +) +(dni callrd + "call:d @Ri" + (NOT-IN-DELAY-SLOT) + "call:d @$Ri" + (+ OP1_9 OP2_F OP3_1 Ri) + (delay (const 1) + (sequence () + (set (reg h-dr 1) (add pc (const 4))) + (set pc Ri))) + ((fr30-1 (unit u-cti))) +) +; end of reordered insns + +(dni call + "call relative to pc" + (NOT-IN-DELAY-SLOT) + "call $label12" + (+ OP1_D OP5_0 label12) + (sequence () + (set (reg h-dr 1) (add pc (const 2))) + (set pc label12)) + ((fr30-1 (unit u-cti))) +) +(dni calld + "call relative to pc" + (NOT-IN-DELAY-SLOT) + "call:d $label12" + (+ OP1_D OP5_1 label12) + (delay (const 1) + (sequence () + (set (reg h-dr 1) (add pc (const 4))) + (set pc label12))) + ((fr30-1 (unit u-cti))) +) + +(dni ret + "return from subroutine" + (NOT-IN-DELAY-SLOT) + "ret" + (+ OP1_9 OP2_7 OP3_2 OP4_0) + (set pc (reg h-dr 1)) + ((fr30-1 (unit u-cti))) +) + +(dni ret:d + "return from subroutine with delay slot" + (NOT-IN-DELAY-SLOT) + "ret:d" + (+ OP1_9 OP2_F OP3_2 OP4_0) + (delay (const 1) + (set pc (reg h-dr 1))) + ((fr30-1 (unit u-cti))) +) + +(dni int + "interrupt" + (NOT-IN-DELAY-SLOT) + "int $u8" + (+ OP1_1 OP2_F u8) + (sequence () + ; This is defered to fr30_int because for the breakpoint case + ; we want to change as little of the machine state as possible. + ; Push PS onto the system stack + ;(set (reg h-dr 2) (sub (reg h-dr 2) (const 4))) + ;(set UWI (mem UWI (reg h-dr 2)) ps) + ; Push the return address onto the system stack + ;(set (reg h-dr 2) (sub (reg h-dr 2) (const 4))) + ;(set UWI (mem UWI (reg h-dr 2)) (add pc (const 2))) + ; Set status bits + ;(set ibit (const 0)) + ;(set sbit (const 0)) + + ; We still should indicate what is modified by this insn. + (clobber (reg h-dr 2)) + (clobber ibit) + (clobber sbit) + ; ??? (clobber memory)? + + ; fr30_int handles operating vs user mode + (set WI pc (c-call WI "fr30_int" pc u8)) + ) + ; This is more properly a cti, but branch stall calculation is different. + ((fr30-1 (unit u-exec (cycles 6)))) +) + +(dni inte + "interrupt for emulator" + (NOT-IN-DELAY-SLOT) + "inte" + (+ OP1_9 OP2_F OP3_3 OP4_0) + (sequence () + ; This is defered to fr30_inte because for the breakpoint case + ; we want to change as little of the machine state as possible. + ; Push PS onto the system stack + ;(set (reg h-dr 2) (sub (reg h-dr 2) (const 4))) + ;(set UWI (mem UWI (reg h-dr 2)) ps) + ; Push the return address onto the system stack + ;(set (reg h-dr 2) (sub (reg h-dr 2) (const 4))) + ;(set UWI (mem UWI (reg h-dr 2)) (add pc (const 2))) + ; Set status bits + ;(set ibit (const 0)) + ;(set ilm (const 4)) + + ; We still should indicate what is modified by this insn. + (clobber (reg h-dr 2)) + (clobber ibit) + (clobber ilm) + ; ??? (clobber memory)? + + ; fr30_int handles operating vs user mode + (set WI pc (c-call WI "fr30_inte" pc)) + ) + ; This is more properly a cti, but branch stall calculation is different. + ((fr30-1 (unit u-exec (cycles 6)))) +) + +(dni reti + "return from interrupt" + (NOT-IN-DELAY-SLOT) + "reti" + (+ OP1_9 OP2_7 OP3_3 OP4_0) + (if (eq sbit (const 0)) + (sequence () + ; Pop the return address from the system stack + (set UWI pc (mem UWI (reg h-dr 2))) + (set (reg h-dr 2) (add (reg h-dr 2) (const 4))) + ; Pop PS from the system stack + (set UWI ps (mem UWI (reg h-dr 2))) + (set (reg h-dr 2) (add (reg h-dr 2) (const 4))) + ) + (sequence () + ; Pop the return address from the user stack + (set UWI pc (mem UWI (reg h-dr 3))) + (set (reg h-dr 3) (add (reg h-dr 3) (const 4))) + ; Pop PS from the user stack + (set UWI ps (mem UWI (reg h-dr 3))) + (set (reg h-dr 3) (add (reg h-dr 3) (const 4))) + ) + ) + ; This is more properly a cti, but branch stall calculation is different. + ((fr30-1 (unit u-exec (cycles 4)))) +) + +; Conditional branches with and without delay slots +; +(define-pmacro (cond-branch cc condition) + (begin + (dni (.sym b cc d) + (.str (.sym b cc :d) " label9") + (NOT-IN-DELAY-SLOT) + (.str (.sym b cc :d) " $label9") + (+ OP1_F (.sym CC_ cc) label9) + (delay (const 1) + (if condition (set pc label9))) + ((fr30-1 (unit u-cti))) + ) + (dni (.sym b cc) + (.str (.sym b cc) " label9") + (NOT-IN-DELAY-SLOT) + (.str (.sym b cc) " $label9") + (+ OP1_E (.sym CC_ cc) label9) + (if condition (set pc label9)) + ((fr30-1 (unit u-cti))) + ) + ) +) + +(cond-branch ra (const BI 1)) +(cond-branch no (const BI 0)) +(cond-branch eq zbit) +(cond-branch ne (not zbit)) +(cond-branch c cbit) +(cond-branch nc (not cbit)) +(cond-branch n nbit) +(cond-branch p (not nbit)) +(cond-branch v vbit) +(cond-branch nv (not vbit)) +(cond-branch lt (xor vbit nbit)) +(cond-branch ge (not (xor vbit nbit))) +(cond-branch le (or (xor vbit nbit) zbit)) +(cond-branch gt (not (or (xor vbit nbit) zbit))) +(cond-branch ls (or cbit zbit)) +(cond-branch hi (not (or cbit zbit))) + +(define-pmacro (dir2r13 name insn opc1 opc2 mode arg1) + (dni name + (.str insn " @" arg1 ",R13") + () + (.str insn " @$" arg1 ",$R13") + (+ opc1 opc2 arg1) + (set (reg h-gr 13) (mem mode arg1)) + ((fr30-1 (unit u-load))) + ) +) + +(define-pmacro (dir2r13-postinc name insn opc1 opc2 mode arg1 incr) + (dni name + (.str insn " @" arg1 ",@R13+") + (NOT-IN-DELAY-SLOT) + (.str insn " @$" arg1 ",@$R13+") + (+ opc1 opc2 arg1) + (sequence () + (set (mem mode (reg h-gr 13)) (mem mode arg1)) + (set (reg h-gr 13) (add (reg h-gr 13) incr))) + ((fr30-1 (unit u-load) (unit u-store))) + ) +) + +(define-pmacro (r132dir name insn opc1 opc2 mode arg1) + (dni name + (.str insn " R13,@" arg1) + () + (.str insn " $R13,@$" arg1) + (+ opc1 opc2 arg1) + (set (mem mode arg1) (reg h-gr 13)) + ((fr30-1 (unit u-store))) + ) +) + +(define-pmacro (r13-postinc2dir name insn opc1 opc2 mode arg1 incr) + (dni name + (.str insn " @R13+,@" arg1) + (NOT-IN-DELAY-SLOT) + (.str insn " @$R13+,@$" arg1) + (+ opc1 opc2 arg1) + (sequence () + (set (mem mode arg1) (mem mode (reg h-gr 13))) + (set (reg h-gr 13) (add (reg h-gr 13) incr))) + ((fr30-1 (unit u-load) (unit u-store))) + ) +) + +; These versions which move from reg to mem must appear before the other +; versions which use immediate addresses due to a problem in cgen +; - DB. +(r132dir dmovr13 dmov OP1_1 OP2_8 WI dir10) +(r132dir dmovr13h dmovh OP1_1 OP2_9 HI dir9) +(r132dir dmovr13b dmovb OP1_1 OP2_A QI dir8) + +(r13-postinc2dir dmovr13pi dmov OP1_1 OP2_C WI dir10 (const 4)) +(r13-postinc2dir dmovr13pih dmovh OP1_1 OP2_D HI dir9 (const 2)) +(r13-postinc2dir dmovr13pib dmovb OP1_1 OP2_E QI dir8 (const 1)) + +(dni dmovr15pi + "dmov @R15+,@dir10" + (NOT-IN-DELAY-SLOT) + "dmov @$R15+,@$dir10" + (+ OP1_1 OP2_B dir10) + (sequence () + (set (mem WI dir10) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4)))) + ((fr30-1 (unit u-load) (unit u-store))) +) +; End of reordered insns. + +(dir2r13 dmov2r13 dmov OP1_0 OP2_8 WI dir10) +(dir2r13 dmov2r13h dmovh OP1_0 OP2_9 HI dir9) +(dir2r13 dmov2r13b dmovb OP1_0 OP2_A QI dir8) + +(dir2r13-postinc dmov2r13pi dmov OP1_0 OP2_C WI dir10 (const 4)) +(dir2r13-postinc dmov2r13pih dmovh OP1_0 OP2_D HI dir9 (const 2)) +(dir2r13-postinc dmov2r13pib dmovb OP1_0 OP2_E QI dir8 (const 1)) + +(dni dmov2r15pd + "dmov @dir10,@-R15" + (NOT-IN-DELAY-SLOT) + "dmov @$dir10,@-$R15" + (+ OP1_0 OP2_B dir10) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (mem WI dir10))) + ((fr30-1 (unit u-load) (unit u-store))) +) + +; Leave these insns as stubs for now, except for the increment of $Ri +; +(dni ldres + "ldres @Ri+,#u4" + () + "ldres @$Ri+,$u4" + (+ OP1_B OP2_C u4 Ri) + (set Ri (add Ri (const 4))) + () +) + +(dni stres + "stres #u4,@Ri+" + () + "stres $u4,@$Ri+" + (+ OP1_B OP2_D u4 Ri) + (set Ri (add Ri (const 4))) + () +) + +; Leave the coprocessor insns as stubs for now. +; +(define-pmacro (cop-stub name insn opc1 opc2 opc3 arg1 arg2) + (dni name + (.str insn " u4c,ccc,CRj," arg1 "," arg2) + (NOT-IN-DELAY-SLOT) + (.str insn " $u4c,$ccc,$" arg1 ",$" arg2) + (+ opc1 opc2 opc3 u4c ccc arg1 arg2) + (nop) ; STUB + () + ) +) + +(cop-stub copop copop OP1_9 OP2_F OP3_C CRj CRi) +(cop-stub copld copld OP1_9 OP2_F OP3_D Rjc CRi) +(cop-stub copst copst OP1_9 OP2_F OP3_E CRj Ric) +(cop-stub copsv copsv OP1_9 OP2_F OP3_F CRj Ric) + +(dni nop + "nop" + () + "nop" + (+ OP1_9 OP2_F OP3_A OP4_0) + (nop) + () +) + +(dni andccr + "andccr #u8" + () + "andccr $u8" + (+ OP1_8 OP2_3 u8) + (set ccr (and ccr u8)) + () +) + +(dni orccr + "orccr #u8" + () + "orccr $u8" + (+ OP1_9 OP2_3 u8) + (set ccr (or ccr u8)) + () +) + +(dni stilm + "stilm #u8" + () + "stilm $u8" + (+ OP1_8 OP2_7 u8) + (set ilm (and u8 (const #x1f))) + () +) + +(dni addsp + "addsp #s10" + () + "addsp $s10" + (+ OP1_A OP2_3 s10) + (set (reg h-gr 15) (add (reg h-gr 15) s10)) + () +) + +(define-pmacro (ext-op name opc1 opc2 opc3 op mode mask) + (dni name + (.str name " Ri") + () + (.str name " $Ri") + (+ opc1 opc2 opc3 Ri) + (set Ri (op WI (and mode Ri mask))) + () + ) +) + +(ext-op extsb OP1_9 OP2_7 OP3_8 ext QI (const #xff)) +(ext-op extub OP1_9 OP2_7 OP3_9 zext UQI (const #xff)) +(ext-op extsh OP1_9 OP2_7 OP3_A ext HI (const #xffff)) +(ext-op extuh OP1_9 OP2_7 OP3_B zext UHI (const #xffff)) + +(dni ldm0 + "ldm0 (reglist_low_ld)" + (NOT-IN-DELAY-SLOT) + "ldm0 ($reglist_low_ld)" + (+ OP1_8 OP2_C reglist_low_ld) + (sequence () + (if (and reglist_low_ld (const #x1)) + (sequence () + (set (reg h-gr 0) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x2)) + (sequence () + (set (reg h-gr 1) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x4)) + (sequence () + (set (reg h-gr 2) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x8)) + (sequence () + (set (reg h-gr 3) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x10)) + (sequence () + (set (reg h-gr 4) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x20)) + (sequence () + (set (reg h-gr 5) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x40)) + (sequence () + (set (reg h-gr 6) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_low_ld (const #x80)) + (sequence () + (set (reg h-gr 7) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + ) + ((fr30-1 (unit u-ldm))) +) + +(dni ldm1 + "ldm1 (reglist_hi_ld)" + (NOT-IN-DELAY-SLOT) + "ldm1 ($reglist_hi_ld)" + (+ OP1_8 OP2_D reglist_hi_ld) + (sequence () + (if (and reglist_hi_ld (const #x1)) + (sequence () + (set (reg h-gr 8) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x2)) + (sequence () + (set (reg h-gr 9) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x4)) + (sequence () + (set (reg h-gr 10) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x8)) + (sequence () + (set (reg h-gr 11) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x10)) + (sequence () + (set (reg h-gr 12) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x20)) + (sequence () + (set (reg h-gr 13) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x40)) + (sequence () + (set (reg h-gr 14) (mem WI (reg h-gr 15))) + (set (reg h-gr 15) (add (reg h-gr 15) (const 4))))) + (if (and reglist_hi_ld (const #x80)) + (set (reg h-gr 15) (mem WI (reg h-gr 15)))) + ) + ((fr30-1 (unit u-ldm))) +) + +(dni stm0 + "stm0 (reglist_low_st)" + (NOT-IN-DELAY-SLOT) + "stm0 ($reglist_low_st)" + (+ OP1_8 OP2_E reglist_low_st) + (sequence () + (if (and reglist_low_st (const #x1)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 7)))) + (if (and reglist_low_st (const #x2)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 6)))) + (if (and reglist_low_st (const #x4)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 5)))) + (if (and reglist_low_st (const #x8)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 4)))) + (if (and reglist_low_st (const #x10)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 3)))) + (if (and reglist_low_st (const #x20)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 2)))) + (if (and reglist_low_st (const #x40)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 1)))) + (if (and reglist_low_st (const #x80)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 0)))) + ) + ((fr30-1 (unit u-stm))) +) + +(dni stm1 + "stm1 (reglist_hi_st)" + (NOT-IN-DELAY-SLOT) + "stm1 ($reglist_hi_st)" + (+ OP1_8 OP2_F reglist_hi_st) + (sequence () + (if (and reglist_hi_st (const #x1)) + (sequence ((WI save-r15)) + (set save-r15 (reg h-gr 15)) + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) save-r15))) + (if (and reglist_hi_st (const #x2)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 14)))) + (if (and reglist_hi_st (const #x4)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 13)))) + (if (and reglist_hi_st (const #x8)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 12)))) + (if (and reglist_hi_st (const #x10)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 11)))) + (if (and reglist_hi_st (const #x20)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 10)))) + (if (and reglist_hi_st (const #x40)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 9)))) + (if (and reglist_hi_st (const #x80)) + (sequence () + (set (reg h-gr 15) (sub (reg h-gr 15) (const 4))) + (set (mem WI (reg h-gr 15)) (reg h-gr 8)))) + ) + ((fr30-1 (unit u-stm))) +) + +(dni enter + "enter #u10" + (NOT-IN-DELAY-SLOT) + "enter $u10" + (+ OP1_0 OP2_F u10) + (sequence ((WI tmp)) + (set tmp (sub (reg h-gr 15) (const 4))) + (set (mem WI tmp) (reg h-gr 14)) + (set (reg h-gr 14) tmp) + (set (reg h-gr 15) (sub (reg h-gr 15) u10))) + ((fr30-1 (unit u-exec (cycles 2)))) +) + +(dni leave + "leave" + () + "leave" + (+ OP1_9 OP2_F OP3_9 OP4_0) + (sequence () + (set (reg h-gr 15) (add (reg h-gr 14) (const 4))) + (set (reg h-gr 14) (mem WI (sub (reg h-gr 15) (const 4))))) + () +) + +(dni xchb + "xchb @Rj,Ri" + (NOT-IN-DELAY-SLOT) + "xchb @$Rj,$Ri" + (+ OP1_8 OP2_A Rj Ri) + (sequence ((WI tmp)) + (set tmp Ri) + (set Ri (mem UQI Rj)) + (set (mem UQI Rj) tmp)) + ((fr30-1 (unit u-load) (unit u-store))) +) diff --git a/cgen/fr30.opc b/cgen/fr30.opc new file mode 100644 index 00000000000..a30cb0ac641 --- /dev/null +++ b/cgen/fr30.opc @@ -0,0 +1,242 @@ +/* FR30 opcode support. -*- C -*- + Copyright (C) 2000 Red Hat, Inc. + This file is part of CGEN. */ + +/* This file is an addendum to fr30.cpu. Heavy use of C code isn't + appropriate in .cpu files, so it resides here. This especially applies + to assembly/disassembly where parsing/printing can be quite involved. + Such things aren't really part of the specification of the cpu, per se, + so .cpu files provide the general framework and .opc files handle the + nitty-gritty details as necessary. + + Each section is delimited with start and end markers. + + <arch>-opc.h additions use: "-- opc.h" + <arch>-opc.c additions use: "-- opc.c" + <arch>-asm.c additions use: "-- asm.c" + <arch>-dis.c additions use: "-- dis.c" + <arch>-ibd.h additions use: "-- ibd.h" +*/ + +/* -- opc.h */ + +/* ??? This can be improved upon. */ +#undef CGEN_DIS_HASH_SIZE +#define CGEN_DIS_HASH_SIZE 16 +#undef CGEN_DIS_HASH +#define CGEN_DIS_HASH(buffer, value) (((unsigned char *) (buffer))[0] >> 4) + +/* -- */ + +/* -- asm.c */ +/* Handle register lists for LDMx and STMx */ + +static int +parse_register_number (strp) + const char **strp; +{ + int regno; + if (**strp < '0' || **strp > '9') + return -1; /* error */ + regno = **strp - '0'; + ++*strp; + + if (**strp >= '0' && **strp <= '9') + { + regno = regno * 10 + (**strp - '0'); + ++*strp; + } + + return regno; +} + +static const char * +parse_register_list (cd, strp, opindex, valuep, high_low, load_store) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; + int high_low; /* 0 == high, 1 == low */ + int load_store; /* 0 == load, 1 == store */ +{ + int regno; + *valuep = 0; + while (**strp && **strp != ')') + { + if (**strp != 'R' && **strp != 'r') + break; + ++*strp; + + regno = parse_register_number (strp); + if (regno == -1) + return "Register number is not valid"; + if (regno > 7 && !high_low) + return "Register must be between r0 and r7"; + if (regno < 8 && high_low) + return "Register must be between r8 and r15"; + + if (high_low) + regno -= 8; + + if (load_store) /* mask is reversed for store */ + *valuep |= 0x80 >> regno; + else + *valuep |= 1 << regno; + + if (**strp == ',') + { + if (*(*strp + 1) == ')') + break; + ++*strp; + } + } + + if (!*strp || **strp != ')') + return "Register list is not valid"; + + return NULL; +} + +static const char * +parse_low_register_list_ld (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + return parse_register_list (cd, strp, opindex, valuep, 0/*low*/, 0/*load*/); +} + +static const char * +parse_hi_register_list_ld (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + return parse_register_list (cd, strp, opindex, valuep, 1/*high*/, 0/*load*/); +} + +static const char * +parse_low_register_list_st (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + return parse_register_list (cd, strp, opindex, valuep, 0/*low*/, 1/*store*/); +} + +static const char * +parse_hi_register_list_st (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + return parse_register_list (cd, strp, opindex, valuep, 1/*high*/, 1/*store*/); +} + +/* -- */ + +/* -- dis.c */ + +static void +print_register_list (dis_info, value, offset, load_store) + PTR dis_info; + long value; + long offset; + int load_store; /* 0 == load, 1 == store */ +{ + disassemble_info *info = dis_info; + int mask; + int index = 0; + char* comma = ""; + + if (load_store) + mask = 0x80; + else + mask = 1; + + if (value & mask) + { + (*info->fprintf_func) (info->stream, "r%i", index + offset); + comma = ","; + } + + for (index = 1; index <= 7; ++index) + { + if (load_store) + mask >>= 1; + else + mask <<= 1; + + if (value & mask) + { + (*info->fprintf_func) (info->stream, "%sr%i", comma, index + offset); + comma = ","; + } + } +} + +static void +print_hi_register_list_ld (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + print_register_list (dis_info, value, 8, 0/*load*/); +} + +static void +print_low_register_list_ld (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + print_register_list (dis_info, value, 0, 0/*load*/); +} + +static void +print_hi_register_list_st (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + print_register_list (dis_info, value, 8, 1/*store*/); +} + +static void +print_low_register_list_st (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + print_register_list (dis_info, value, 0, 1/*store*/); +} + +static void +print_m4 (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + disassemble_info *info = (disassemble_info *) dis_info; + (*info->fprintf_func) (info->stream, "%ld", value); +} +/* -- */ diff --git a/cgen/gas-test.scm b/cgen/gas-test.scm new file mode 100644 index 00000000000..1883aaee042 --- /dev/null +++ b/cgen/gas-test.scm @@ -0,0 +1,227 @@ +; CPU description file generator for the GAS testsuite. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; This is invoked to build allinsn.exp and a script to run to +; generate allinsn.s and allinsn.d. + +; Specify which application. +(set! APPLICATION 'GAS-TEST) + +; Called before/after the .cpu file has been read. + +(define (gas-test-init!) (opcodes-init!)) +(define (gas-test-finish!) (opcodes-finish!)) + +; Called after .cpu file has been read and global error checks are done. +; We use the `tmp' member to record the syntax split up into its components. + +(define (gas-test-analyze!) + (opcodes-analyze!) + (map (lambda (insn) + (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn)))) + (non-multi-insns (current-insn-list))) + *UNSPECIFIED* +) + +; Methods to compute test data. +; The result is a list of strings to be inserted in the assembler +; in the operand's position. + +(method-make! + <hw-asm> 'test-data + (lambda (self n) + ; FIXME: floating point support + (let ((signed (list 0 1 -1 2 -2)) + (unsigned (list 0 1 2 3 4)) + (mode (elm-get self 'mode))) + (map number->string + (list-take n + (if (eq? (mode:class mode) 'UINT) + unsigned + signed))))) +) + +(method-make! + <keyword> 'test-data + (lambda (self n) + (let* ((values (elm-get self 'values)) + (n (min n (length values)))) + ; FIXME: Need to handle mach variants. + (map car (list-take n values)))) +) + +(method-make! + <hw-address> 'test-data + (lambda (self n) + (let ((test-data '("foodata" "4" "footext" "-4"))) + (list-take n test-data))) +) + +(method-make! + <hw-iaddress> 'test-data + (lambda (self n) + (let ((test-data '("footext" "4" "foodata" "-4"))) + (list-take n test-data))) +) + +(method-make-forward! <hw-register> 'indices '(test-data)) +(method-make-forward! <hw-immediate> 'values '(test-data)) + +; This can't use method-make-forward! as we need to call op:type to +; resolve the hardware reference. + +(method-make! + <operand> 'test-data + (lambda (self n) + (send (op:type self) 'test-data n)) +) + +; Given an operand, return a set of N test data. +; e.g. For a keyword operand, return a random subset. +; For a number, return N numbers. + +(define (operand-test-data op n) + (send op 'test-data n) +) + +; Given the broken out assembler syntax string, return the list of operand +; objects. + +(define (extract-operands syntax-list) + (let loop ((result nil) (l syntax-list)) + (cond ((null? l) (reverse! result)) + ((object? (car l)) (loop (cons (car l) result) (cdr l))) + (else (loop result (cdr l))))) +) + +; Given a list of operands for an instruction, return the test set +; (all possible combinations). +; N is the number of testcases for each operand. +; The result has N to-the-power (length OP-LIST) elements. + +(define (build-test-set op-list n) + (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list)) + (len (length op-list))) + ; FIXME: Make slicker later. + (cond ((=? len 0) (list (list))) + ((=? len 1) test-data) + (else (list (map car test-data))))) +) + +; Given an assembler expression and a set of operands build a testcase. +; TEST-DATA is a list of strings, one element per operand. + +(define (build-asm-testcase syntax-list test-data) + (let loop ((result nil) (sl syntax-list) (td test-data)) + ;(display (list result sl td "\n")) + (cond ((null? sl) + (string-append "\t" + (apply string-append (reverse result)) + "\n")) + ((string? (car sl)) + (loop (cons (car sl) result) (cdr sl) td)) + (else (loop (cons (car td) result) (cdr sl) (cdr td))))) +) + +; Generate the testsuite for INSN. +; FIXME: This needs to be expanded upon. + +(define (gen-gas-test insn) + (logit 2 "Generating gas test data for " (obj:name insn) " ...\n") + (string-append + "\t.text\n" + "\t.global " (gen-sym insn) "\n" + (gen-sym insn) ":\n" + (let* ((syntax-list (insn-tmp insn)) + (op-list (extract-operands syntax-list)) + (test-set (build-test-set op-list 2))) + ;(display test-set) (newline) + (string-map (lambda (test-data) + (build-asm-testcase syntax-list test-data)) + test-set)) + ) +) + +; Generate the shell script that builds the .d file. +; .d files contain the objdump result that is used to see whether the +; testcase passed. +; We do this by running gas and objdump. +; Obviously this isn't quite right - bugs in gas or +; objdump - the things we're testing - will cause an incorrect testsuite to +; be built and thus the bugs will be missed. It is *not* intended that this +; be run immediately before running the testsuite! Rather, this is run to +; generate the testsuite which is then inspected for accuracy and checked +; into CVS. As bugs in the testsuite are found they are corrected by hand. +; Or if they're due to bugs in the generator the generator can be rerun and +; the output diff'd to ensure no errors have crept back in. +; The point of doing things this way is TO SAVE A HELL OF A LOT OF TYPING! +; Clearly some hand generated testcases will also be needed, but this +; provides a good test for each instruction. + +(define (cgen-build.sh) + (logit 1 "Generating gas-build.sh ...\n") + (string-append + "\ +#/bin/sh +# Generate test result data for " (current-arch-name) " GAS testing. +# This script is machine generated. +# It is intended to be run in the testsuite source directory. +# +# Syntax: build.sh /path/to/build/gas + +BUILD=$1 + +if [ ! -f $BUILD/as-new ] ; then + echo \"$BUILD is not a GAS build directory.\" + exit 1 +fi + +# Put results here, so we preserve the existing set for comparison. +rm -rf tmpdir +mkdir tmpdir +cd tmpdir + +function gentest { + rm -f a.out + $BUILD/as-new ${1}.s -o a.out + echo \"#as:\" >${1}.d + echo \"#objdump: -dr\" >>${1}.d + echo \"#name: $1\" >>${1}.d + $BUILD/../binutils/objdump -dr a.out | \ + sed -e 's/(/\\\\(/g' -e 's/)/\\\\)/g' -e 's/[+]/\\\\+/g' -e 's/[*]/\\\*/g' | \ + sed -e 's/^.*file format.*$/.*: +file format .*/' \ + >>${1}.d + rm -f a.out +} + +# Now come all the testcases. +cat > allinsn.s <<EOF + .data +foodata: .word 42 + .text +footext:\n" + (string-map (lambda (insn) + (gen-gas-test insn)) + (non-multi-insns (current-insn-list))) + "EOF\n" + "\n" + "# Finally, generate the .d file.\n" + "gentest allinsn\n" + ) +) + +; Generate the dejagnu allinsn.exp file that drives the tests. + +(define (cgen-allinsn.exp) + (logit 1 "Generating allinsn.exp ...\n") + (string-append + "\ +# " (string-upcase (current-arch-name)) " assembler testsuite. + +if [istarget " (current-arch-name) "*-*-*] { + run_dump_test \"allinsn\" +}\n" + ) +) diff --git a/cgen/hardware.scm b/cgen/hardware.scm new file mode 100644 index 00000000000..7f8d553a121 --- /dev/null +++ b/cgen/hardware.scm @@ -0,0 +1,1172 @@ +; Hardware descriptions. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; This is the base class for all hardware descriptions. +; The actual hardware objects inherit from this (e.g. register, immediate). +; This is used to describe registers, memory, and immediates. +; ??? Maybe other things as well, but this is all that's needed at present. +; ??? Eventually rename to <hardware> but not yet. + +(define <hardware-base> + (class-make '<hardware-base> + '(<ident>) + '( + ; Name used in semantics. + ; This is for cases where a particular hardware element is + ; sufficiently different on different mach's of an architecture + ; that it is defined separately for each case. The semantics + ; refer to this name (which means that one must use a different + ; mechanism if one wants both machs in the same semantic code). + sem-name + + ; The type, an object of class <array>. + ; (mode + scalar or vector length) + type + + ; Indexing support. + ; An object of class <hw-asm>, or a subclass of it, or + ; #f if there is no special indexing support. + ; For register banks, a table of register names. + ; ??? Same class as VALUES. + ; ??? There are currently no descriptions that require both an + ; INDICES and a VALUES specification. It might make sense to + ; combine them (which is how things used to be), but it is odd + ; to have them combined. + (indices . #f) + + ; Table of values. + ; An object of class <hw-asm>, or a subclass of it, or + ; #f if there is no special values support. + ; For immediates with special names, a table of names. + ; ??? Same class as INDICES. + (values . #f) + + ; Associative list of (symbol . "handler") entries. + ; Each entry maps an operation to its handler (which is up to + ; the application but is generally a function name). + (handlers . ()) + + ; Get/set handlers or #f to use the default. + (get . #f) + (set . #f) + + ; Associative list of get/set handlers for each supported mode, + ; or #f to use the default. + ; ??? An interesting idea, but not sure it's the best way + ; to go. Another way is to explicitly handle it in the insn + ; [complicates the RTL]. Another way is to handle this in + ; operand get/set handlers. Another way is to have virtual + ; regs for each non-default mode. Not sure which is better. + ;(getters . #f) + ;(setters . #f) + + ; List of <isa> objects that use this hardware element + ; or #f if not computed yet. + ; This is a derived from the ISA attribute and is for speed. + (isas-cache . #f) + ) + nil) +) + +; Accessors + +(define-getters <hardware-base> hw + (sem-name type indices values handlers + ; ??? These might be more properly named hw-get/hw-set, but those names + ; seem ambiguous. + (get . getter) (set . setter) + isas-cache) +) + +; Mode,rank,shape support. + +(method-make-forward! <hardware-base> 'type '(get-mode get-rank get-shape get-num-elms)) +(define (hw-mode hw) (send hw 'get-mode)) +(define (hw-rank hw) (send hw 'get-rank)) +(define (hw-shape hw) (send hw 'get-shape)) +(define (hw-num-elms hw) (send hw 'get-num-elms)) + +; Return default mode to reference HW in. + +(define (hw-default-mode hw) + (hw-mode hw) +) + +; Return a boolean indicating if X is a hardware object. +; ??? <hardware-base> to be renamed <hardware> in time. + +(define (hardware? x) (class-instance? <hardware-base> x)) + +; Return #t if HW is a scalar. + +(define (hw-scalar? hw) (= (hw-rank hw) 0)) + +; Return number of bits in an element of HW. + +(define (hw-bits hw) + (type-bits (hw-type hw)) +) + +; Generate the name of the enum for hardware object HW. +; This uses the semantic name, not obj:name. +; If HW is a symbol, it is already the semantic name. + +(define (hw-enum hw) + (if (symbol? hw) + (string-upcase (string-append "HW_" (gen-c-symbol hw))) + (string-upcase (string-append "HW_" (gen-c-symbol (hw-sem-name hw))))) +) + +; Return a boolean indicating if it's ok to reference SELF in mode +; NEW-MODE-NAME, index INDEX. +; Hardware types are required to override this method. +; VOID and DFLT are never valid for NEW-MODE-NAME. + +(method-make! + <hardware-base> 'mode-ok? + (lambda (self new-mode-name index) + (error "mode-ok? method not overridden:" (obj:name self))) +) + +(define (hw-mode-ok? hw new-mode-name index) + (send hw 'mode-ok? new-mode-name index) +) + +; Return mode to use for the index or #f if scalar. + +(method-make! + <hardware-base> 'get-index-mode + (lambda (self) + (error "get-index-mode method not overridden:" (obj:name self))) +) + +(define (hw-index-mode hw) (send hw 'get-index-mode)) + +; Compute the isas used by HW and cache the results. + +(method-make! + <hardware-base> 'get-isas + (lambda (self) + (or (elm-get self 'isas-cache) + (let* ((isas (obj-attr-value self 'ISA)) + (isa-objs (if (eq? isas 'all) (current-isa-list) + (map current-isa-lookup + (bitset-attr->list isas))))) + (elm-set! self 'isas-cache isa-objs) + isa-objs))) +) + +(define (hw-isas hw) (send hw 'get-isas)) + +; FIXME: replace pc?,memory?,register?,iaddress? with just one method. + +; Return boolean indicating if hardware element is the PC. + +(method-make! <hardware-base> 'pc? (lambda (self) #f)) + +; Return boolean indicating if hardware element is some kind of memory. +; ??? Need to allow multiple kinds of memory and therefore need to allow +; .cpu files to specify this (i.e. an attribute). We could use has-attr? +; here, or we could have the code that creates the object override this +; method if the MEMORY attribute is present. +; ??? Could also use a member instead of a method. + +(method-make! <hardware-base> 'memory? (lambda (self) #f)) +(define (memory? hw) (send hw 'memory?)) + +; Return boolean indicating if hardware element is some kind of register. + +(method-make! <hardware-base> 'register? (lambda (self) #f)) +(define (register? hw) (send hw 'register?)) + +; Return boolean indicating if hardware element is an address. + +(method-make! <hardware-base> 'address? (lambda (self) #f)) +(method-make! <hardware-base> 'iaddress? (lambda (self) #f)) +(define (address? hw) (send hw 'address?)) +(define (iaddress? hw) (send hw 'iaddress?)) + +; Assembler support. + +; Baseclass. + +(define <hw-asm> + (class-make '<hw-asm> '(<ident>) + '( + ; The mode to use. + ; A copy of the object's mode if we're in the "values" + ; member. If we're in the "indices" member this is typically + ; UINT. + mode + ) + nil) +) + +; Keywords. +; Keyword lists associate a name with a number and are used for things +; like register name tables (the `indices' field of a hw spec) and +; immediate value tables (the `values' field of a hw spec). +; +; TODO: For things like the sparc fp regs, have a quasi-keyword that is +; prefix plus number. This will save having to create a table of each +; register name. + +(define <keyword> + (class-make '<keyword> '(<hw-asm>) + '( + ; Name to use in generated code. + print-name + + ; Prefix of each name in VALUES, as a string. + prefix + + ; Associative list of values. + ; Each element is (name value [attrs]). + ; ??? May wish to allow calling a function to compute the + ; value at runtime. + values + ) + nil) +) + +; Accessors + +(define kw-mode (elm-make-getter <keyword> 'mode)) +(define kw-print-name (elm-make-getter <keyword> 'print-name)) +(define kw-prefix (elm-make-getter <keyword> 'prefix)) +(define kw-values (elm-make-getter <keyword> 'values)) + +; Parse a keyword spec. +; +; The syntax of VALUES is: (prefix ((name1 [value1 [(attr-list1)]]) ...)) +; PREFIX is a string prefix for each name. +; Each value is a number of mode MODE. +; ??? We have no problem handling any kind of number, we're Scheme. +; However, it's not clear yet how applications will want to handle it, but +; that is left to the application. Still, it might be preferable to impose +; some restrictions which can later be relaxed as necessary. + +(define (keyword-parse context name comment attrs mode print-name prefix values) + ; FIXME: parse values. + (let ((result (make <keyword> + (parse-name name context) + (parse-comment comment context) + (atlist-parse attrs "" context) + (parse-mode-name mode (string-append context ": mode")) + (parse-string (string-append context ": print-name") print-name) + (parse-string (string-append context ": prefix") prefix) + values))) + result) +) + +; Read a keyword description +; This is the main routine for analyzing a keyword description in the .cpu +; file. +; ARG-LIST is an associative list of field name and field value. +; keyword-parse is invoked to create the <keyword> object. + +(define (-keyword-read context . arg-list) + (let ((name #f) + (comment "") + (attrs nil) + (mode INT) + (print-name #f) + (prefix "") + (values nil) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mode) (set! mode (cadr arg))) + ((print-name) (set! print-name (cadr arg))) + ((prefix) (set! prefix (cadr arg))) + ((values) (set! values (cdr arg))) + (else (parse-error context "invalid hardware arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (keyword-parse context name comment attrs mode + (or print-name name) + prefix values) + ) +) + +; Define a keyword object, name/value pair list version. + +(define define-keyword + (lambda arg-list + (let ((kw (apply -keyword-read (cons "define-keyword" arg-list)))) + (if kw + (begin + (current-kw-add! kw) + ; Define an enum so the values are usable everywhere. + ; One use is giving names to register numbers and special constants + ; to make periphery C/C++ code more legible. + (define-full-enum (obj:name kw) (obj:comment kw) + (atlist-source-form (obj-atlist kw)) + (string-upcase (symbol-append (kw-print-name kw) '-)) + (kw-values kw)))) + kw)) +) + +; Parsing support. + +; List of hardware types. +; This maps names in the `type' entry of define-hardware to the class name. + +(define -hardware-types + '((register . <hw-register>) + (pc . <hw-pc>) + (memory . <hw-memory>) + (immediate . <hw-immediate>) + (address . <hw-address>) + (iaddress . <hw-iaddress>)) +) + +; Parse an inline keyword spec. +; These are keywords defined inside something else. +; CONTAINER is the <ident> object of the container. + +(define (-hw-parse-keyword context args container mode) + (if (!= (length args) 2) + (parse-error context "invalid keyword spec" args)) + + ; These are copied from our container object. + ; They're needed to output the table. + ; ??? This isn't quite right as the container may contain multiple keyword + ; instances. To be fixed in time. + (keyword-parse context (obj:name container) (obj:comment container) + ; PRIVATE: keyword table is implicitly defined and made + ; "static" (in the C sense). + (cons 'PRIVATE (atlist-source-form (obj-atlist container))) + mode + (obj:name container) ; print-name + (car args) ; prefix + (cadr args)) ; value +) + +; Parse an indices spec. +; CONTAINER is the <ident> object of the container. +; Currently there is only special support for keywords. +; Otherwise MODE is used. +; The syntax is: (keyword keyword-spec) - see <keyword> for details. + +(define (-hw-parse-indices errtxt indices container mode) + (if (null? indices) + (make <hw-asm> + (obj:name container) (obj:comment container) (obj-atlist container) + mode) + (begin + (if (not (list? indices)) + (parse-error errtxt "invalid indices spec" indices)) + (case (car indices) + ((keyword) (-hw-parse-keyword errtxt (cdr indices) container mode)) + ((extern-keyword) (begin + (if (null? (cdr indices)) + (parse-error errtxt "missing keyword name" + indices)) + (let ((kw (current-kw-lookup (cadr indices)))) + (if (not kw) + (parse-error errtxt "unknown keyword" + indices)) + kw))) + (else (parse-error errtxt "unknown indices type" (car indices)))))) +) + +; Parse a values spec. +; CONTAINER is the <ident> object of the container. +; Currently there is only special support for keywords. +; Otherwise MODE is used. +; The syntax is: (keyword keyword-spec) - see <keyword> for details. + +(define (-hw-parse-values errtxt values container mode) + (if (null? values) + (make <hw-asm> + (obj:name container) (obj:comment container) (obj-atlist container) + mode) + (begin + (if (not (list? values)) + (parse-error errtxt "invalid values spec" values)) + (case (car values) + ((keyword) (-hw-parse-keyword errtxt (cdr values) container mode)) + ((extern-keyword) (begin + (if (null? (cdr values)) + (parse-error errtxt "missing keyword name" + values)) + (let ((kw (current-kw-lookup (cadr values)))) + (if (not kw) + (parse-error errtxt "unknown keyword" + values)) + kw))) + (else (parse-error errtxt "unknown values type" (car values)))))) +) + +; Parse a handlers spec. +; Each element is (name "string"). + +(define (-hw-parse-handlers errtxt handlers) + (parse-handlers errtxt '(parse print) handlers) +) + +; Parse a getter spec. +; The syntax is (([index]) (expression)). +; Omit `index' for scalar objects. +; Externally they're specified as `get'. Internally we use `getter'. + +(define (-hw-parse-getter errtxt getter scalar?) + (if (null? getter) + #f ; use default + (let ((valid "((index) (expression))") + (scalar-valid "(() (expression))")) + (if (or (not (list? getter)) + (!= (length getter) 2) + (not (and (list? (car getter)) + (= (length (car getter)) (if scalar? 0 1))))) + (parse-error errtxt + (string-append "invalid getter, should be " + (if scalar? scalar-valid valid)) + getter)) + (if (not (rtx? (cadr getter))) + (parse-error errtxt "invalid rtx expression" getter)) + getter)) +) + +; Parse a setter spec. +; The syntax is (([index] newval) (expression)). +; Omit `index' for scalar objects. +; Externally they're specified as `set'. Internally we use `setter'. + +(define (-hw-parse-setter errtxt setter scalar?) + (if (null? setter) + #f ; use default + (let ((valid "((index newval) (expression))") + (scalar-valid "((newval) (expression))")) + (if (or (not (list? setter)) + (!= (length setter) 2) + (not (and (list? (car setter)) + (= (length (car setter)) (if scalar? 1 2))))) + (parse-error errtxt + (string-append "invalid setter, should be " + (if scalar? scalar-valid valid)) + setter)) + (if (not (rtx? (cadr setter))) + (parse-error errtxt "invalid rtx expression" setter)) + setter)) +) + +; Parse hardware description +; This is the main routine for building a hardware object from a hardware +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). +; +; ??? Might want to redo to handle hardware type specific specs more cleanly. +; E.g. <hw-immediate> shouldn't have to see get/set specs. + +(define (-hw-parse errtxt name comment attrs semantic-name type + indices values handlers get set layout) + (logit 2 "Processing hardware element " name " ...\n") + + (if (null? type) + (parse-error errtxt "missing hardware type" name)) + + ; Pick out name first 'cus we need it as a string(/symbol). + (let ((name (parse-name name "hardware")) + (class-name (assq-ref -hardware-types (car type))) + (atlist-obj (atlist-parse attrs "cgen_hw" errtxt))) + + (if (not class-name) + (parse-error errtxt "unknown hardware type" type)) + + (if (keep-atlist? atlist-obj #f) + + (let ((result (new (class-lookup class-name)))) + (send result 'set-name! name) + (send result 'set-comment! (parse-comment comment errtxt)) + (send result 'set-atlist! atlist-obj) + (elm-xset! result 'sem-name semantic-name) + (send result 'parse! errtxt + (cdr type) indices values handlers get set layout) + ; If this is a virtual reg, get/set specs must be provided. + (if (and (obj-has-attr? result 'VIRTUAL) + (not (and (hw-getter result) (hw-setter result)))) + (parse-error errtxt "virtual reg requires get/set specs" name)) + ; If get or set specs are specified, can't have CACHE-ADDR. + (if (and (obj-has-attr? result 'CACHE-ADDR) + (or (hw-getter result) (hw-setter result))) + (parse-error errtxt "can't have CACHE-ADDR with get/set specs" name)) + result) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read a hardware description +; This is the main routine for analyzing a hardware description in the .cpu +; file. +; ARG-LIST is an associative list of field name and field value. +; -hw-parse is invoked to create the <hardware> object. + +(define (-hw-read errtxt . arg-list) + (let ((name nil) ; name of hardware + (comment "") + (attrs nil) + (semantic-name nil) ; name used in semantics, default is `name' + (type nil) ; hardware type (register, immediate, etc.) + (indices nil) + (values nil) + (handlers nil) + (get nil) + (set nil) + (layout nil) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((semantic-name) (set! semantic-name (cadr arg))) + ((type) (set! type (cdr arg))) + ((indices) (set! indices (cdr arg))) + ((values) (set! values (cdr arg))) + ((handlers) (set! handlers (cdr arg))) + ((get) (set! get (cdr arg))) + ((set) (set! set (cdr arg))) + ((layout) (set! layout (cdr arg))) + (else (parse-error errtxt "invalid hardware arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-hw-parse errtxt name comment attrs + (if (null? semantic-name) name semantic-name) + type indices values handlers get set layout) + ) +) + +; Define a hardware object, name/value pair list version. + +(define define-hardware + (lambda arg-list + (let ((hw (apply -hw-read (cons "define-hardware" arg-list)))) + (if hw + (current-hw-add! hw)) + hw)) +) + +; Define a hardware object, all arguments specified. + +(define (define-full-hardware name comment attrs semantic-name type + indices values handlers get set layout) + (let ((hw (-hw-parse "define-full-hardware" + name comment attrs semantic-name type + indices values handlers get set layout))) + (if hw + (current-hw-add! hw)) + hw) +) + +; Main routine for modifying existing definitions. + +(define modify-hardware + (lambda arg-list + (let ((errtxt "modify-hardware")) + + ; FIXME: Experiment. This implements the :name/value style by + ; converting it to (name value). In the end there shouldn't be two + ; styles. People might prefer :name/value, but it's not as amenable + ; to macro processing (insert potshots regarding macro usage). + (if (keyword-list? (car arg-list)) + (set! arg-list (keyword-list->arg-list arg-list))) + + ; First find out which element. + ; There's no requirement that the name be specified first. + (let ((hw-spec (assq 'name arg-list))) + (if (not hw-spec) + (parse-error errtxt "hardware name not specified")) + + (let ((hw (current-hw-lookup (arg-list-symbol-arg errtxt hw-spec)))) + (if (not hw) + (parse-error errtxt "undefined hardware element" hw-spec)) + + ; Process the rest of the args now that we have the affected object. + (let loop ((args arg-list)) + (if (null? args) + #f ; done + (let ((arg-spec (car args))) + (case (car arg-spec) + ((name) #f) ; ignore, already processed + ((add-attrs) + (let ((atlist-obj (atlist-parse (cdr arg-spec) + "cgen_hw" errtxt))) + ; prepend attrs so new ones override existing ones + (obj-prepend-atlist! hw atlist-obj))) + (else + (parse-error errtxt "invalid/unsupported option" (car arg-spec)))) + (loop (cdr args)))))))) + + *UNSPECIFIED*) +) + +; Lookup a hardware object using its semantic name. +; The result is a list of elements with SEM-NAME. +; Callers must deal with cases where there is more than one. + +(define (current-hw-sem-lookup sem-name) + (find (lambda (hw) (eq? (hw-sem-name hw) sem-name)) + (current-hw-list)) +) + +; Same as current-hw-sem-lookup, but result is 1 hw element or #f if not +; found. An error is signalled if multiple hw elements are found. + +(define (current-hw-sem-lookup-1 sem-name) + (let ((hw-objs (current-hw-sem-lookup sem-name))) + (case (length hw-objs) + ((0) #f) + ((1) (car hw-objs)) + (else (error "ambiguous hardware reference" sem-name)))) +) + +; Basic hardware types. +; These inherit from `hardware-base'. +; ??? Might wish to allow each target to add more, but we provide enough +; examples to cover most cpus. + +; A register (or an array of them). + +(define <hw-register> (class-make '<hw-register> '(<hardware-base>) nil nil)) + +; Subroutine of -hw-create-[gs]etter-from-layout to validate a layout. +; Valid values: +; - 0 or 1 +; - (value length) +; - hardware-name + +(define (-hw-validate-layout errtxt layout width) + (if (not (list? layout)) + (parse-error errtxt "layout is not a list" layout)) + + (let loop ((layout layout) (shift 0)) + (if (null? layout) + (begin + ; Done. Now see if number of bits in layout matches total width. + (if (not (= shift width)) + (parse-error errtxt (string-append + "insufficient number of bits (need " + (number->string width) + ")") + shift))) + ; Validate next entry. + (let ((val (car layout))) + (cond ((number? val) + (if (not (memq val '(0 1))) + (parse-error errtxt + "non 0/1 layout entry requires length" + val)) + (loop (cdr layout) (1+ shift))) + ((pair? val) + (if (or (not (number? (car val))) + (not (pair? (cdr val))) + (not (number? (cadr val))) + (not (null? (cddr val)))) + (parse-error errtxt + "syntax error in layout, expecting `(value length)'" + val)) + (loop (cdr layout) (+ shift (cadr val)))) + ((symbol? val) + (let ((hw (current-hw-lookup val))) + (if (not hw) + (parse-error errtxt "unknown hardware element" val)) + (if (not (hw-scalar? hw)) + (parse-error errtxt "non-scalar hardware element" val)) + (loop (cdr layout) + (+ shift (hw-bits hw))))) + (else + (parse-error errtxt "bad layout element" val)))))) + *UNSPECIFIED* +) + +; Return the getter spec to use for LAYOUT. +; WIDTH is the width of the combined value in bits. +; +; Example: +; Assuming h-hw[123] are 1 bit registers, and width is 32 +; given ((0 29) h-hw1 h-hw2 h-hw3), return +; (() +; (or SI (sll SI (zext SI (reg h-hw1)) 2) +; (or SI (sll SI (zext SI (reg h-hw2)) 1) +; (zext SI (reg h-hw3))))) + +(define (-hw-create-getter-from-layout errtxt layout width) + (let ((add-to-res (lambda (result mode-name val shift) + (if (null? result) + (rtx-make 'sll mode-name val shift) + (rtx-make 'or mode-name + (rtx-make 'sll mode-name + (rtx-make 'zext mode-name val) + shift) + result)))) + (mode-name (obj:name (mode-find width 'UINT)))) + (let loop ((result nil) (layout (reverse layout)) (shift 0)) + (if (null? layout) + (list nil result) ; getter spec: (get () (expression)) + (let ((val (car layout))) + (cond ((number? val) + ; ignore if zero + (if (= val 0) + (loop result (cdr layout) (1+ shift)) + (loop (add-to-res result mode-name val shift) + (cdr layout) + (1+ shift)))) + ((pair? val) + ; ignore if zero + (if (= (car val) 0) + (loop result (cdr layout) (+ shift (cadr val))) + (loop (add-to-res result mode-name (car val) shift) + (cdr layout) + (+ shift (cadr val))))) + ((symbol? val) + (let ((hw (current-hw-lookup val))) + (loop (add-to-res result mode-name + (rtx-make 'reg val) + shift) + (cdr layout) + (+ shift (hw-bits hw))))) + (else + (assert (begin "bad layout element" #f)))))))) +) + +; Return the setter spec to use for LAYOUT. +; WIDTH is the width of the combined value in bits. +; +; Example: +; Assuming h-hw[123] are 1 bit registers, +; given (h-hw1 h-hw2 h-hw3), return +; ((val) +; (sequence () +; (set (reg h-hw1) (and (srl val 2) 1)) +; (set (reg h-hw2) (and (srl val 1) 1)) +; (set (reg h-hw3) (and (srl val 0) 1)) +; )) + +(define (-hw-create-setter-from-layout errtxt layout width) + (let ((mode-name (obj:name (mode-find width 'UINT)))) + (let loop ((sets nil) (layout (reverse layout)) (shift 0)) + (if (null? layout) + (list '(val) ; setter spec: (set (val) (expression)) + (apply rtx-make (cons 'sequence (cons nil sets)))) + (let ((val (car layout))) + (cond ((number? val) + (loop sets (cdr layout) (1+ shift))) + ((pair? val) + (loop sets (cdr layout) (+ shift (cadr val)))) + ((symbol? val) + (let ((hw (current-hw-lookup val))) + (loop (cons (rtx-make 'set + (rtx-make 'reg val) + (rtx-make 'and + (rtx-make 'srl 'val shift) + (1- (logsll 1 (hw-bits hw))))) + sets) + (cdr layout) + (+ shift (hw-bits hw))))) + (else + (assert (begin "bad layout element" #f)))))))) +) + +; Parse a register spec. +; .cpu syntax: (register mode [(dimension)]) +; or: (register (mode bits) [(dimension)]) + +(method-make! + <hw-register> 'parse! + (lambda (self errtxt type indices values handlers getter setter layout) + (if (or (null? type) + (> (length type) 2)) + (parse-error errtxt "invalid register spec" type)) + (if (and (= (length type) 2) + (or (not (list? (cadr type))) + (> (length (cadr type)) 1))) + (parse-error errtxt "bad register dimension spec" type)) + + ; Must parse and set type before analyzing LAYOUT. + (elm-set! self 'type (parse-type errtxt type)) + + ; LAYOUT is a shorthand way of specifying getter/setter specs. + ; For registers that are just a collection of other registers + ; (e.g. the status register in mips), it's easier to specify the + ; registers that make up the bigger register, rather than to specify + ; get/set specs. + ; We don't override any provided get/set specs though. + (if (not (null? layout)) + (let ((width (hw-bits self))) + (-hw-validate-layout errtxt layout width) + (if (null? getter) + (set! getter + (-hw-create-getter-from-layout errtxt layout width))) + (if (null? setter) + (set! setter + (-hw-create-setter-from-layout errtxt layout width))) + )) + + (elm-set! self 'indices (-hw-parse-indices errtxt indices self UINT)) + (elm-set! self 'values (-hw-parse-values errtxt values self + (send (elm-get self 'type) + 'get-mode))) + (elm-set! self 'handlers (-hw-parse-handlers errtxt handlers)) + (elm-set! self 'get (-hw-parse-getter errtxt getter (hw-scalar? self))) + (elm-set! self 'set (-hw-parse-setter errtxt setter (hw-scalar? self))) + *UNSPECIFIED*) +) + +; Return boolean indicating if hardware element is some kind of register. + +(method-make! <hw-register> 'register? (lambda (self) #t)) + +; Return a boolean indicating if it's ok to reference SELF in mode +; NEW-MODE-NAME, index INDEX. +; +; ??? INDEX isn't currently used. The intent is to use it if it's a known +; value, and otherwise assume for our purposes it's valid and leave any +; further error checking to elsewhere. +; +; ??? This method makes more sense if we support multiple modes via +; getters/setters. Maybe we will some day, so this is left as is for now. + +(method-make! + <hw-register> 'mode-ok? + (lambda (self new-mode-name index) + (let ((cur-mode (send self 'get-mode)) + (new-mode (mode:lookup new-mode-name))) + (if (mode:eq? new-mode-name cur-mode) + #t + ; ??? Subject to revisiting. + ; Only allow floats if same mode (which is handled above). + ; Only allow non-widening if ints. + ; On architectures where shortening/widening can refer to a + ; quasi-different register, it is up to the target to handle this. + ; See the comments for the getter/setter/getters/setters class + ; members. + (let ((cur-mode-class (mode:class cur-mode)) + (cur-bits (mode:bits cur-mode)) + (new-mode-class (mode:class new-mode)) + (new-bits (mode:bits new-mode))) + ; Compensate for registers defined with an unsigned mode. + (if (eq? cur-mode-class 'UINT) + (set! cur-mode-class 'INT)) + (if (eq? new-mode-class 'UINT) + (set! new-mode-class 'INT)) + (if (eq? cur-mode-class 'INT) + (and (eq? new-mode-class cur-mode-class) + (<= new-bits cur-bits)) + #f))))) +) + +; Return mode to use for the index or #f if scalar. + +(method-make! + <hw-register> 'get-index-mode + (lambda (self) + (if (scalar? (hw-type self)) + #f + UINT)) +) + +; The program counter (PC) hardware register. +; This is a separate class as the simulator needs a place to put special +; get/set methods. + +(define <hw-pc> (class-make '<hw-pc> '(<hw-register>) nil nil)) + +; Parse a pc spec. + +(method-make! + <hw-pc> 'parse! + (lambda (self errtxt type indices values handlers getter setter layout) + (if (not (null? type)) + (elm-set! self 'type (parse-type errtxt type)) + (elm-set! self 'type (make <scalar> (mode:lookup 'IAI)))) + (if (not (null? indices)) + (parse-error errtxt "indices specified for pc" indices)) + (if (not (null? values)) + (parse-error errtxt "values specified for pc" values)) + (if (not (null? layout)) + (parse-error errtxt "layout specified for pc" values)) + ; The initial value of INDICES, VALUES is #f which is what we want. + (elm-set! self 'handlers (-hw-parse-handlers errtxt handlers)) + (elm-set! self 'get (-hw-parse-getter errtxt getter (hw-scalar? self))) + (elm-set! self 'set (-hw-parse-setter errtxt setter (hw-scalar? self))) + *UNSPECIFIED*) +) + +; Indicate we're the pc. + +(method-make! <hw-pc> 'pc? (lambda (self) #t)) + +; Memory. + +(define <hw-memory> (class-make '<hw-memory> '(<hardware-base>) nil nil)) + +; Parse a memory spec. +; .cpu syntax: (memory mode [(dimension)]) +; or: (memory (mode bits) [(dimension)]) + +(method-make! + <hw-memory> 'parse! + (lambda (self errtxt type indices values handlers getter setter layout) + (if (or (null? type) + (> (length type) 2)) + (parse-error errtxt "invalid memory spec" type)) + (if (and (= (length type) 2) + (or (not (list? (cadr type))) + (> (length (cadr type)) 1))) + (parse-error errtxt "bad memory dimension spec" type)) + (if (not (null? layout)) + (parse-error errtxt "layout specified for memory" values)) + (elm-set! self 'type (parse-type errtxt type)) + ; Setting INDICES,VALUES here is mostly for experimentation at present. + (elm-set! self 'indices (-hw-parse-indices errtxt indices self AI)) + (elm-set! self 'values (-hw-parse-values errtxt values self + (send (elm-get self 'type) + 'get-mode))) + (elm-set! self 'handlers (-hw-parse-handlers errtxt handlers)) + (elm-set! self 'get (-hw-parse-getter errtxt getter (hw-scalar? self))) + (elm-set! self 'set (-hw-parse-setter errtxt setter (hw-scalar? self))) + *UNSPECIFIED*) +) + +; Return boolean indicating if hardware element is some kind of memory. + +(method-make! <hw-memory> 'memory? (lambda (self) #t)) + +; Return a boolean indicating if it's ok to reference SELF in mode +; NEW-MODE-NAME, index INDEX. + +(method-make! + <hw-memory> 'mode-ok? + (lambda (self new-mode-name index) + ; Allow any mode for now. + #t) +) + +; Return mode to use for the index or #f if scalar. + +(method-make! + <hw-memory> 'get-index-mode + (lambda (self) + AI) +) + +; Immediate values (numbers recorded in the insn). + +(define <hw-immediate> (class-make '<hw-immediate> '(<hardware-base>) nil nil)) + +; Parse an immediate spec. +; .cpu syntax: (immediate mode) +; or: (immediate (mode bits)) + +(method-make! + <hw-immediate> 'parse! + (lambda (self errtxt type indices values handlers getter setter layout) + (if (not (= (length type) 1)) + (parse-error errtxt "invalid immediate spec" type)) + (elm-set! self 'type (parse-type errtxt type)) + ; An array of immediates may be useful some day, but not yet. + (if (not (null? indices)) + (parse-error errtxt "indices specified for immediate" indices)) + (if (not (null? layout)) + (parse-error errtxt "layout specified for immediate" values)) + (elm-set! self 'values (-hw-parse-values errtxt values self + (send (elm-get self 'type) + 'get-mode))) + (elm-set! self 'handlers (-hw-parse-handlers errtxt handlers)) + (if (not (null? getter)) + (parse-error errtxt "getter specified for immediate" getter)) + (if (not (null? setter)) + (parse-error errtxt "setter specified for immediate" setter)) + *UNSPECIFIED*) +) + +; Return a boolean indicating if it's ok to reference SELF in mode +; NEW-MODE-NAME, index INDEX. + +(method-make! + <hw-immediate> 'mode-ok? + (lambda (self new-mode-name index) + (let ((cur-mode (send self 'get-mode)) + (new-mode (mode:lookup new-mode-name))) + (if (mode:eq? new-mode-name cur-mode) + #t + ; ??? Subject to revisiting. + ; Only allow floats if same mode (which is handled above). + ; For ints allow anything. + (let ((cur-mode-class (mode:class cur-mode)) + (new-mode-class (mode:class new-mode))) + (->bool (and (memq cur-mode-class '(INT UINT)) + (memq new-mode-class '(INT UINT)))))))) +) + +; Addresses. +; These are usually symbols. + +(define <hw-address> (class-make '<hw-address> '(<hardware-base>) nil nil)) + +(method-make! <hw-address> 'address? (lambda (self) #t)) + +; Parse an address spec. + +(method-make! + <hw-address> 'parse! + (lambda (self errtxt type indices values handlers getter setter layout) + (if (not (null? type)) + (parse-error errtxt "invalid address spec" type)) + (elm-set! self 'type (make <scalar> AI)) + (if (not (null? indices)) + (parse-error errtxt "indices specified for address" indices)) + (if (not (null? values)) + (parse-error errtxt "values specified for address" values)) + (if (not (null? layout)) + (parse-error errtxt "layout specified for address" values)) + (elm-set! self 'values (-hw-parse-values errtxt values self + (send (elm-get self 'type) + 'get-mode))) + (elm-set! self 'handlers (-hw-parse-handlers errtxt handlers)) + (if (not (null? getter)) + (parse-error errtxt "getter specified for address" getter)) + (if (not (null? setter)) + (parse-error errtxt "setter specified for address" setter)) + *UNSPECIFIED*) +) + +; Return a boolean indicating if it's ok to reference SELF in mode +; NEW-MODE-NAME, index INDEX. + +(method-make! + <hw-address> 'mode-ok? + (lambda (self new-mode-name index) + ; We currently don't allow referencing an address in any mode other than + ; the original mode. + (mode-compatible? 'samesize new-mode-name (send self 'get-mode))) +) + +; Instruction addresses. +; These are treated separately from normal addresses as the simulator +; may wish to treat them specially. +; FIXME: Doesn't use mode IAI. + +(define <hw-iaddress> (class-make '<hw-iaddress> '(<hw-address>) nil nil)) + +(method-make! <hw-iaddress> 'iaddress? (lambda (self) #t)) + +; Builtins, attributes, init/fini support. + +(define h-memory #f) +(define h-sint #f) +(define h-uint #f) +(define h-addr #f) +(define h-iaddr #f) + + +; Map a mode to a hardware object that can contain immediate values of that mode +(define (hardware-for-mode mode) + (cond ((mode:eq? mode 'AI) h-addr) + ((mode:eq? mode 'IAI) h-addr) + ((mode-signed? mode) h-sint) + ((mode-unsigned? mode) h-uint) + (else (error "Don't know h-object for mode " mode))) +) + + +; Called before reading a .cpu file in. + +(define (hardware-init!) + (reader-add-command! 'define-keyword + "\ +Define a keyword, name/value pair list version. +" + nil 'arg-list define-keyword) + (reader-add-command! 'define-hardware + "\ +Define a hardware element, name/value pair list version. +" + nil 'arg-list define-hardware) + (reader-add-command! 'define-full-hardware + "\ +Define a hardware element, all arguments specified. +" + nil '(name comment attrs semantic-name type + indices values handlers get set layout) + define-full-hardware) + (reader-add-command! 'modify-hardware + "\ +Modify a hardware element, name/value pair list version. +" + nil 'arg-list modify-hardware) + + *UNSPECIFIED* +) + +; Install builtin hardware objects. + +(define (hardware-builtin!) + ; Standard h/w attributes. + (define-attr '(for hardware) '(type boolean) '(name CACHE-ADDR) + '(comment "cache register address during insn extraction")) + ; FIXME: This should be deletable. + (define-attr '(for hardware) '(type boolean) '(name PC) + '(comment "the program counter")) + (define-attr '(for hardware) '(type boolean) '(name PROFILE) + '(comment "collect profiling data")) + + (let ((all (stringize (current-arch-isa-name-list) ","))) + ; ??? The program counter, h-pc, used to be defined here. + ; However, some targets need to modify it (e.g. provide special get/set + ; specs). There's still an outstanding issue of how to add things to + ; objects after the fact (e.g. model parameters to instructions), but + ; that's further down the road. + (set! h-memory (define-full-hardware 'h-memory "memory" + `((ISA ,all)) + ; Ensure memory not flagged as a scalar. + 'h-memory '(memory UQI (1)) nil nil nil + nil nil nil)) + (set! h-sint (define-full-hardware 'h-sint "signed integer" + `((ISA ,all)) + 'h-sint '(immediate (INT 32)) nil nil nil + nil nil nil)) + (set! h-uint (define-full-hardware 'h-uint "unsigned integer" + `((ISA ,all)) + 'h-uint '(immediate (UINT 32)) nil nil nil + nil nil nil)) + (set! h-addr (define-full-hardware 'h-addr "address" + `((ISA ,all)) + 'h-addr '(address) nil nil '((print "print_address")) + nil nil nil)) + ; Instruction addresses. + ; These are different because the simulator may want to do something + ; special with them, and some architectures treat them differently. + (set! h-iaddr (define-full-hardware 'h-iaddr "instruction address" + `((ISA ,all)) + 'h-iaddr '(iaddress) nil nil '((print "print_address")) + nil nil nil))) + + *UNSPECIFIED* +) + +; Called after a .cpu file has been read in. + +(define (hardware-finish!) + *UNSPECIFIED* +) diff --git a/cgen/i960.cpu b/cgen/i960.cpu new file mode 100644 index 00000000000..6bd641e1487 --- /dev/null +++ b/cgen/i960.cpu @@ -0,0 +1,1320 @@ +; Intel 80960 CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Misc CGEN related problems. + +; ??? CGEN assumes that the program counter is called PC. On the i960, it +; is called IP (Instruction Pointer). + +; ??? Try using (f-m3 1) instead of M3_1. + +; ??? Try using the RESERVED attribute for instruction fields. + +(include "simplify.inc") + + +; Architecture and cpu family definitions. + +; ??? This should be using (insn-lsb0? #t), but it doesn't work yet. + +(define-arch + (name i960) + (comment "Intel 80960 architecture") + (machs i960:ka_sa i960:ca) + (isas i960) +) + +(define-isa + (name i960) + (base-insn-bitsize 32) + (decode-assist (0 1 2 3 4 5 6 7)) + (liw-insns 1) + (parallel-insns 1) +) + +(define-cpu + (name i960base) + (comment "Intel 80960 cpu family") + (endian little) + (word-bitsize 32) +) + +(define-mach + (name i960:ka_sa) + (comment "I960 KA and SA processors") + (cpu i960base) +) + +; ??? Incomplete. Pipeline and unit info wrong. + +(define-model + (name i960KA) + (comment "I960 KA processor") + (mach i960:ka_sa) + (pipeline all "" () ((fetch) (decode) (execute) (writeback))) + (unit u-exec "Execution Unit" () 1 1 + () () () ()) +) + +(define-mach + (name i960:ca) + (comment "I960 CA processor") + (cpu i960base) +) + +; ??? Incomplete. Pipeline and unit info wrong. + +(define-model + (name i960CA) + (comment "I960 CA processor") + (mach i960:ca) + (pipeline all "" () ((fetch) (decode) (execute) (writeback))) + (unit u-exec "Execution Unit" () 1 1 + () () () ()) +) + +; Instruction fields. +; +; Attributes: +; PCREL-ADDR: pc relative value (for reloc and disassembly purposes) +; ABS-ADDR: absolute address (for reloc and disassembly purposes?) +; RESERVED: bits are not used to decode insn, must be all 0 + +; All of the fields for a REG format instruction. + +(dnf f-opcode "opcode" () 0 8) +(dnf f-srcdst "src/dst" () 8 5) +(dnf f-src2 "src2" () 13 5) +(dnf f-m3 "m3" () 18 1) +(dnf f-m2 "m2" () 19 1) +(dnf f-m1 "m1" () 20 1) +(dnf f-opcode2 "opcode2" () 21 4) +(dnf f-zero "zero" () 25 2) +(dnf f-src1 "src1" () 27 5) + +; Extra fields needed for a MEMA format instruction. + +(dnf f-abase "abase" () 13 5) +(dnf f-modea "modea" () 18 1) +(dnf f-zeroa "zeroa" () 19 1) +(dnf f-offset "offset" () 20 12) + +; Extra fields needed for a MEMB format instruction. + +(dnf f-modeb "modeb" () 18 4) +(dnf f-scale "scale" () 22 3) +(dnf f-zerob "zerob" () 25 2) +(dnf f-index "index" () 27 5) +(dnf f-optdisp "optional displacement" () 32 32) + +; Extra fields needed for a COBR format instruction. + +(dnf f-br-src1 "branch src1" () 8 5) +(dnf f-br-src2 "branch src2" () 13 5) +(dnf f-br-m1 "branch m1" () 18 1) +(df f-br-disp "branch displacement" (PCREL-ADDR) 19 11 INT + ((value pc) (sra WI (sub WI value pc) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) pc))) +(dnf f-br-zero "branch zero" () 30 2) + +; Extra fields needed for a CRTL format instruction. + +(df f-ctrl-disp "ctrl branch disp" (PCREL-ADDR) 8 22 INT + ((value pc) (sra WI (sub WI value pc) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) pc))) +(dnf f-ctrl-zero "ctrl branch zero" () 30 2) + + +; Enums. + +(define-pmacro (build-hex2 num) (.hex num 2)) + +; insn-opcode +(define-normal-insn-enum insn-opcode "insn opcode enums" () OPCODE_ f-opcode + (.map .upcase (.map build-hex2 (.iota 256))) ; "00" -> "FF" +) + +(define-normal-insn-enum insn-opcode2 "insn opcode2 enums" () OPCODE2_ + f-opcode2 + (.map .upcase (.map .hex (.iota 16))) ; "0" -> "F" +) + +(define-normal-insn-enum insn-m3 "insn m3 enums" () M3_ + f-m3 + ("0" "1") +) + +(define-normal-insn-enum insn-m2 "insn m3 enums" () M2_ + f-m2 + ("0" "1") +) + +(define-normal-insn-enum insn-m1 "insn m1 enums" () M1_ + f-m1 + ("0" "1") +) + +(define-normal-insn-enum insn-zero "insn zero enums" () ZERO_ + f-zero + ("0") +) + +(define-normal-insn-enum insn-modea "insn mode a enums" () MODEA_ + f-modea + ("OFFSET" "INDIRECT-OFFSET") +) + +(define-normal-insn-enum insn-zeroa "insn zero a enums" () ZEROA_ + f-zeroa + ("0") +) + +(define-normal-insn-enum insn-modeb "insn mode b enums" () MODEB_ + f-modeb + ("ILL0" "ILL1" "ILL2" "ILL3" "INDIRECT" "IP-DISP" "RES6" "INDIRECT-INDEX" + "ILL8" "ILL9" "ILL10" "ILL11" "DISP" "INDIRECT-DISP" "INDEX-DISP" + "INDIRECT-INDEX-DISP") +) + +(define-normal-insn-enum insn-zerob "insn zero b enums" () ZEROB_ + f-zerob + ("0") +) + +(define-normal-insn-enum insn-br-m1 "insn branch m1 enums" () BR_M1_ + f-br-m1 + ("0" "1") +) + +(define-normal-insn-enum insn-br-zero "insn branch zero enums" () BR_ZERO_ + f-br-zero + ("0") +) + +(define-normal-insn-enum insn-ctrl-zero "insn ctrl zero enums" () CTRL_ZERO_ + f-ctrl-zero + ("0") +) + + +; Hardware pieces + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE CACHE-ADDR) + (type register WI (32)) + (indices keyword "" + ((fp 31) (sp 1) + (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15) + (g0 16) (g1 17) (g2 18) (g3 19) (g4 20) (g5 21) (g6 22) (g7 23) + (g8 24) (g9 25) (g10 26) (g11 27) (g12 28) (g13 29) (g14 30) (g15 31) + )) +) + +; ??? This is actually part of the AC register. + +(define-hardware + (name h-cc) + (comment "condition code") + (attrs PROFILE CACHE-ADDR) + (type register WI) + (indices keyword "" ((cc 0))) +) + +;(define-hardware +; (name h-pc) +; (comment "program counter") +; (attrs PC) +; (type register WI) +; ; (handlers (print "ip")) +;) + +; ??? Incomplete. + + +; Instruction Operands. +; These entries provide a layer between the assembler and the raw hardware +; description, and are used to refer to hardware elements in the semantic +; code. Usually there's a bit of over-specification, but in more complicated +; instruction sets there isn't. + +; Operand fields for a REG format instruction. + +(dnop src1 "source register 1" () h-gr f-src1) +(dnop src2 "source register 2" () h-gr f-src2) +(dnop dst "source/dest register" () h-gr f-srcdst) + +(dnop lit1 "literal 1" () h-uint f-src1) +(dnop lit2 "literal 2" () h-uint f-src2) + +; Operand fields for a MEMA format instruction. + +(dnop st_src "store src" () h-gr f-srcdst) +(dnop abase "abase" () h-gr f-abase) +(dnop offset "offset" () h-uint f-offset) + +; Operand fields for a MEMB format instruction. + +(dnop scale "scale" () h-uint f-scale) +(dnop index "index" () h-gr f-index) +(dnop optdisp "optional displacement" () h-uint f-optdisp) + +; Operand fields for a COBR format instruction. + +(dnop br_src1 "branch src1" () h-gr f-br-src1) +(dnop br_src2 "branch src2" () h-gr f-br-src2) +(dnop br_disp "branch displacement" () h-iaddr f-br-disp) + +(dnop br_lit1 "branch literal 1" () h-uint f-br-src1) + +; Operand fields for a CRTL format instruction. + +(dnop ctrl_disp "ctrl branch disp" () h-iaddr f-ctrl-disp) + + +; Instruction definitions. + +; ??? Maybe I should just reverse the operands in the alu-op macro. + +(define-pmacro (divo-expr expr1 expr2) (udiv expr2 expr1)) +(define-pmacro (divi-expr expr1 expr2) (div expr2 expr1)) +(define-pmacro (remo-expr expr1 expr2) (umod expr2 expr1)) +(define-pmacro (remi-expr expr1 expr2) (mod expr2 expr1)) + +(define-pmacro (sub-expr expr1 expr2) (sub expr2 expr1)) + +(define-pmacro (notbit-expr expr1 expr2) + (xor (sll (const 1) expr1) expr2)) +(define-pmacro (andnot-expr expr1 expr2) + (and expr2 (inv expr1))) +(define-pmacro (setbit-expr expr1 expr2) + (or (sll (const 1) expr1) expr2)) +(define-pmacro (notand-expr expr1 expr2) + (and (inv expr2) expr1)) +(define-pmacro (nor-expr expr1 expr2) + (and (inv expr2) (inv expr1))) +(define-pmacro (xnor-expr expr1 expr2) + (inv (xor expr1 expr2))) +(define-pmacro (not-expr expr1 expr2) + (inv expr1)) +(define-pmacro (ornot-expr expr1 expr2) + (or expr2 (inv expr1))) +(define-pmacro (clrbit-expr expr1 expr2) + (and (inv (sll (const 1) expr1)) expr2)) + +; A shift of 32 or more shifts out all input bits. + +(define-pmacro (sll-expr expr1 expr2) + (cond WI + ((geu UWI expr1 (const 32)) (const 0)) + (else (sll expr2 expr1)))) +(define-pmacro (srl-expr expr1 expr2) + (cond WI + ((geu UWI expr1 (const 32)) (const 0)) + (else (srl expr2 expr1)))) +(define-pmacro (sra-expr expr1 expr2) + (cond WI + ((geu UWI expr1 (const 32)) (sra expr2 (const 31))) + (else (sra expr2 expr1)))) + +(define-pmacro (alu-op mnemonic opcode-op opcode2-op sem-op) + (begin + (dni mnemonic + (.str mnemonic " reg/reg") + () + (.str mnemonic " $src1, $src2, $dst") + (+ opcode-op dst src2 M3_0 M2_0 M1_0 opcode2-op ZERO_0 src1) + (set dst (sem-op src1 src2)) + () + ) + (dni (.sym mnemonic "1") + (.str mnemonic " lit/reg") + () + (.str mnemonic " $lit1, $src2, $dst") + (+ opcode-op dst src2 M3_0 M2_0 M1_1 opcode2-op ZERO_0 lit1) + (set dst (sem-op lit1 src2)) + () + ) + (dni (.sym mnemonic "2") + (.str mnemonic " reg/lit") + () + (.str mnemonic " $src1, $lit2, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_0 opcode2-op ZERO_0 src1) + (set dst (sem-op src1 lit2)) + () + ) + (dni (.sym mnemonic "3") + (.str mnemonic " lit/lit") + () + (.str mnemonic " $lit1, $lit2, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_1 opcode2-op ZERO_0 lit1) + (set dst (sem-op lit1 lit2)) + () + ) + ) +) + +(alu-op mulo OPCODE_70 OPCODE2_1 mul) +(alu-op remo OPCODE_70 OPCODE2_8 remo-expr) +(alu-op divo OPCODE_70 OPCODE2_B divo-expr) +(alu-op remi OPCODE_74 OPCODE2_8 remi-expr) +(alu-op divi OPCODE_74 OPCODE2_B divi-expr) + +(alu-op addo OPCODE_59 OPCODE2_0 add) +(alu-op subo OPCODE_59 OPCODE2_2 sub-expr) + +(alu-op notbit OPCODE_58 OPCODE2_0 notbit-expr) +(alu-op and OPCODE_58 OPCODE2_1 and) +(alu-op andnot OPCODE_58 OPCODE2_2 andnot-expr) +(alu-op setbit OPCODE_58 OPCODE2_3 setbit-expr) +(alu-op notand OPCODE_58 OPCODE2_4 notand-expr) +(alu-op xor OPCODE_58 OPCODE2_6 xor) +(alu-op or OPCODE_58 OPCODE2_7 or) +(alu-op nor OPCODE_58 OPCODE2_8 nor-expr) +(alu-op xnor OPCODE_58 OPCODE2_9 xnor-expr) +(alu-op not OPCODE_58 OPCODE2_A not-expr) +(alu-op ornot OPCODE_58 OPCODE2_B ornot-expr) +(alu-op clrbit OPCODE_58 OPCODE2_C clrbit-expr) + +; ??? Incomplete. Does not handle overflow for integer shifts. + +(alu-op shlo OPCODE_59 OPCODE2_C sll-expr) +(alu-op shro OPCODE_59 OPCODE2_8 srl-expr) +(alu-op shli OPCODE_59 OPCODE2_E sll-expr) +(alu-op shri OPCODE_59 OPCODE2_B sra-expr) + + +; ??? Does not verify alignment of dest reg. + +(define-pmacro (emul-expr dest expr1 expr2) + (sequence ((DI temp) (SI dregno)) + (set temp (mul DI (zext DI expr1) (zext DI expr2))) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set dest (trunc SI temp)) + (set (reg h-gr (add (index-of dest) (const 1))) + (trunc SI (srl temp (const 32)))))) + +; ??? Needless duplicate of alu-op. Should eliminate alu-op. + +(define-pmacro (alu2-op mnemonic opcode-op opcode2-op sem-op) + (begin + (dni mnemonic + (.str mnemonic " reg/reg") + () + (.str mnemonic " $src1, $src2, $dst") + (+ opcode-op dst src2 M3_0 M2_0 M1_0 opcode2-op ZERO_0 src1) + (sem-op dst src1 src2) + () + ) + (dni (.sym mnemonic "1") + (.str mnemonic " lit/reg") + () + (.str mnemonic " $lit1, $src2, $dst") + (+ opcode-op dst src2 M3_0 M2_0 M1_1 opcode2-op ZERO_0 lit1) + (sem-op dst lit1 src2) + () + ) + (dni (.sym mnemonic "2") + (.str mnemonic " reg/lit") + () + (.str mnemonic " $src1, $lit2, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_0 opcode2-op ZERO_0 src1) + (sem-op dst src1 lit2) + () + ) + (dni (.sym mnemonic "3") + (.str mnemonic " lit/lit") + () + (.str mnemonic " $lit1, $lit2, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_1 opcode2-op ZERO_0 lit1) + (sem-op dst lit1 lit2) + () + ) + ) +) + +(alu2-op emul OPCODE_67 OPCODE2_0 emul-expr) + + + +; ??? lit2 must be zero. +; ??? should verify multi-word reg alignment. + +(define-pmacro (mov-expr expr1 expr2) + (set expr1 expr2)) +(define-pmacro (movl-expr expr1 expr2) + (sequence ((SI dregno) (SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set sregno (ifield f-src1)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (reg h-gr (add (index-of expr2) (const 1)))))) +(define-pmacro (movllit-expr expr1 expr2) + (sequence ((SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (const 0)))) +(define-pmacro (movt-expr expr1 expr2) + (sequence ((SI dregno) (SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set sregno (ifield f-src1)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (reg h-gr (add (index-of expr2) (const 1)))) + (set (reg h-gr (add (index-of expr1) (const 2))) + (reg h-gr (add (index-of expr2) (const 2)))))) +(define-pmacro (movtlit-expr expr1 expr2) + (sequence ((SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (const 0)) + (set (reg h-gr (add (index-of expr1) (const 2))) + (const 0)))) +(define-pmacro (movq-expr expr1 expr2) + (sequence ((SI dregno) (SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set sregno (ifield f-src1)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (reg h-gr (add (index-of expr2) (const 1)))) + (set (reg h-gr (add (index-of expr1) (const 2))) + (reg h-gr (add (index-of expr2) (const 2)))) + (set (reg h-gr (add (index-of expr1) (const 3))) + (reg h-gr (add (index-of expr2) (const 3)))))) +(define-pmacro (movqlit-expr expr1 expr2) + (sequence ((SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set expr1 expr2) + (set (reg h-gr (add (index-of expr1) (const 1))) + (const 0)) + (set (reg h-gr (add (index-of expr1) (const 2))) + (const 0)) + (set (reg h-gr (add (index-of expr1) (const 3))) + (const 0)))) + +(define-pmacro (move-op mnemonic opcode-op opcode2-op sem-op semlit-op) + (begin + (dni mnemonic + (.str mnemonic " reg") + () + (.str mnemonic " $src1, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_0 opcode2-op ZERO_0 src1) + (sem-op dst src1) + () + ) + (dni (.sym mnemonic "1") + (.str mnemonic " lit") + () + (.str mnemonic " $lit1, $dst") + (+ opcode-op dst lit2 M3_0 M2_1 M1_1 opcode2-op ZERO_0 lit1) + (semlit-op dst lit1) + () + ) + ) +) + +(move-op mov OPCODE_5C OPCODE2_C mov-expr mov-expr) +(move-op movl OPCODE_5D OPCODE2_C movl-expr movllit-expr) +(move-op movt OPCODE_5E OPCODE2_C movt-expr movtlit-expr) +(move-op movq OPCODE_5F OPCODE2_C movq-expr movqlit-expr) + +; ??? This is very incomplete. This does not handle src1 or src2 as literals. +; This doesn't implement any of the effects of the instruction. +(dni modpc "modpc" + () + "modpc $src1, $src2, $dst" + (+ OPCODE_65 dst src1 M3_0 M2_0 M1_0 OPCODE2_5 ZERO_0 src2) + (set dst src2) + () +) + +; ??? This is very incomplete. This does not handle src1 or src2 as literals. +; This doesn't implement any of the effects of the instruction. +(dni modac "modac" + () + "modac $src1, $src2, $dst" + (+ OPCODE_64 dst src1 M3_0 M2_0 M1_0 OPCODE2_5 ZERO_0 src2) + (set dst src2) + () +) + +; ??? Incomplete. Only handles 8 of the 10 addressing modes. +; Does not handle sign/zero extend operations. Does not handle +; different modes. + +; ??? should verify multi-word reg alignment. + +; ??? index-index scale disasssembles wrong + +; ??? See also the store-op macro below. + +(define-pmacro (lda-expr expr1 expr2) + (set expr1 expr2)) + +(define-pmacro (ld-expr expr1 expr2) + (set expr1 (mem WI expr2))) +(define-pmacro (ldob-expr expr1 expr2) + (set expr1 (mem UQI expr2))) +(define-pmacro (ldos-expr expr1 expr2) + (set expr1 (mem UHI expr2))) +(define-pmacro (ldib-expr expr1 expr2) + (set expr1 (mem QI expr2))) +(define-pmacro (ldis-expr expr1 expr2) + (set expr1 (mem HI expr2))) +(define-pmacro (ldl-expr expr1 expr2) + (sequence ((WI temp) (SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set temp expr2) + (set expr1 (mem WI temp)) + (set (reg h-gr (add (index-of expr1) (const 1))) + (mem WI (add temp (const 4)))))) +(define-pmacro (ldt-expr expr1 expr2) + (sequence ((WI temp) (SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + (set temp expr2) + (set expr1 (mem WI temp)) + (set (reg h-gr (add (index-of expr1) (const 1))) + (mem WI (add temp (const 4)))) + (set (reg h-gr (add (index-of expr1) (const 2))) + (mem WI (add temp (const 8)))))) +(define-pmacro (ldq-expr expr1 expr2) + (sequence ((WI temp) (SI dregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set dregno (ifield f-srcdst)) + ; Evaluate the address first, for correctness, in case an address + ; reg will be loaded into. Also, makes the simulator faster. + (set temp expr2) + (set expr1 (mem WI temp)) + (set (reg h-gr (add (index-of expr1) (const 1))) + (mem WI (add temp (const 4)))) + (set (reg h-gr (add (index-of expr1) (const 2))) + (mem WI (add temp (const 8)))) + (set (reg h-gr (add (index-of expr1) (const 3))) + (mem WI (add temp (const 12)))))) + +(define-pmacro (load-op suffix opcode-op sem-op) + (begin + (dni (.sym ld suffix -offset) (.str "ld" suffix "-offset") + () + (.str "ld" suffix " $offset, $dst") + (+ opcode-op dst abase MODEA_OFFSET ZEROA_0 offset) + (sem-op dst offset) + () + ) + (dni (.sym ld suffix -indirect-offset) + (.str "ld" suffix "-indirect-offset") + () + (.str "ld" suffix " $offset($abase), $dst") + (+ opcode-op dst abase MODEA_INDIRECT-OFFSET ZEROA_0 offset) + (sem-op dst (add offset abase)) + () + ) + (dni (.sym ld suffix -indirect) (.str "ld" suffix "-indirect") + () + (.str "ld" suffix " ($abase), $dst") + (+ opcode-op dst abase MODEB_INDIRECT scale ZEROB_0 index) + (sem-op dst abase) + () + ) + (dni (.sym ld suffix -indirect-index) (.str "ld" suffix "-indirect-index") + () + (.str "ld" suffix " ($abase)[$index*S$scale], $dst") + (+ opcode-op dst abase MODEB_INDIRECT-INDEX scale ZEROB_0 index) + (sem-op dst (add abase (mul index (sll (const 1) scale)))) + () + ) + (dni (.sym ld suffix -disp) (.str "ld" suffix "-disp") + () + (.str "ld" suffix " $optdisp, $dst") + (+ opcode-op dst abase MODEB_DISP scale ZEROB_0 index optdisp) + (sem-op dst optdisp) + () + ) + (dni (.sym ld suffix -indirect-disp) (.str "ld" suffix "-indirect-disp") + () + (.str "ld" suffix " $optdisp($abase), $dst") + (+ opcode-op dst abase MODEB_INDIRECT-DISP scale ZEROB_0 index optdisp) + (sem-op dst (add optdisp abase)) + () + ) + (dni (.sym ld suffix -index-disp) (.str "ld" suffix "-index-disp") + () + (.str "ld" suffix " $optdisp[$index*S$scale], $dst") + (+ opcode-op dst abase MODEB_INDEX-DISP scale ZEROB_0 index optdisp) + (sem-op dst (add optdisp (mul index (sll (const 1) scale)))) + () + ) + (dni (.sym ld suffix -indirect-index-disp) + (.str "ld" suffix "-indirect-index-disp") + () + (.str "ld" suffix " $optdisp($abase)[$index*S$scale], $dst") + (+ opcode-op dst abase MODEB_INDIRECT-INDEX-DISP scale ZEROB_0 index optdisp) + (sem-op dst (add optdisp (add abase + (mul index (sll (const 1) scale))))) + () + ) + ) +) + +(load-op "a" OPCODE_8C lda-expr) + +(load-op "" OPCODE_90 ld-expr) +(load-op "ob" OPCODE_80 ldob-expr) +(load-op "os" OPCODE_88 ldos-expr) +(load-op "ib" OPCODE_C0 ldib-expr) +(load-op "is" OPCODE_C8 ldis-expr) +(load-op "l" OPCODE_98 ldl-expr) +(load-op "t" OPCODE_A0 ldt-expr) +(load-op "q" OPCODE_B0 ldq-expr) + +; ??? Incomplete. This is a near duplicate of the above load-op macro. + +; ??? For efficiency, should eval the address only once. See the load patterns +; above. + +(define-pmacro (st-expr expr1 expr2) + (set (mem WI expr1) expr2)) +(define-pmacro (stob-expr expr1 expr2) + (set (mem QI expr1) expr2)) +(define-pmacro (stos-expr expr1 expr2) + (set (mem HI expr1) expr2)) +(define-pmacro (stl-expr expr1 expr2) + (sequence ((SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set sregno (ifield f-srcdst)) + (set (mem WI expr1) expr2) + (set (mem WI (add expr1 (const 4))) + (reg h-gr (add (index-of expr2) (const 1)))))) +(define-pmacro (stt-expr expr1 expr2) + (sequence ((SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set sregno (ifield f-srcdst)) + (set (mem WI expr1) expr2) + (set (mem WI (add expr1 (const 4))) + (reg h-gr (add (index-of expr2) (const 1)))) + (set (mem WI (add expr1 (const 8))) + (reg h-gr (add (index-of expr2) (const 2)))))) +(define-pmacro (stq-expr expr1 expr2) + (sequence ((SI sregno)) + ; ??? Workaround cgen s-i-o-o bug. + (set sregno (ifield f-srcdst)) + (set (mem WI expr1) expr2) + (set (mem WI (add expr1 (const 4))) + (reg h-gr (add (index-of expr2) (const 1)))) + (set (mem WI (add expr1 (const 8))) + (reg h-gr (add (index-of expr2) (const 2)))) + (set (mem WI (add expr1 (const 12))) + (reg h-gr (add (index-of expr2) (const 3)))))) + +(define-pmacro (store-op suffix opcode-op sem-op) + (begin + (dni (.sym st suffix -offset) (.str "st" suffix "-offset") + () + (.str "st" suffix " $st_src, $offset") + (+ opcode-op st_src abase MODEA_OFFSET ZEROA_0 offset) + (sem-op offset st_src) + () + ) + (dni (.sym st suffix -indirect-offset) + (.str "st" suffix "-indirect-offset") + () + (.str "st" suffix " $st_src, $offset($abase)") + (+ opcode-op st_src abase MODEA_INDIRECT-OFFSET ZEROA_0 offset) + (sem-op (add offset abase) st_src) + () + ) + (dni (.sym st suffix -indirect) (.str "st" suffix "-indirect") + () + (.str "st" suffix " $st_src, ($abase)") + (+ opcode-op st_src abase MODEB_INDIRECT scale ZEROB_0 index) + (sem-op abase st_src) + () + ) + (dni (.sym st suffix -indirect-index) (.str "st" suffix "-indirect-index") + () + (.str "st" suffix " $st_src, ($abase)[$index*S$scale]") + (+ opcode-op st_src abase MODEB_INDIRECT-INDEX scale ZEROB_0 index) + (sem-op (add abase (mul index (sll (const 1) scale))) st_src) + () + ) + (dni (.sym st suffix -disp) (.str "st" suffix "-disp") + () + (.str "st" suffix " $st_src, $optdisp") + (+ opcode-op st_src abase MODEB_DISP scale ZEROB_0 index optdisp) + (sem-op optdisp st_src) + () + ) + (dni (.sym st suffix -indirect-disp) (.str "st" suffix "-indirect-disp") + () + (.str "st" suffix " $st_src, $optdisp($abase)") + (+ opcode-op st_src abase MODEB_INDIRECT-DISP scale ZEROB_0 index optdisp) + (sem-op (add optdisp abase) st_src) + () + ) + (dni (.sym st suffix -index-disp) (.str "st" suffix "-index-disp") + () + (.str "st" suffix " $st_src, $optdisp[$index*S$scale") + (+ opcode-op st_src abase MODEB_INDEX-DISP scale ZEROB_0 index optdisp) + (sem-op (add optdisp (mul index (sll (const 1) scale))) st_src) + () + ) + (dni (.sym st suffix -indirect-index-disp) + (.str "st" suffix "-indirect-index-disp") + () + (.str "st" suffix " $st_src, $optdisp($abase)[$index*S$scale]") + (+ opcode-op st_src abase MODEB_INDIRECT-INDEX-DISP scale ZEROB_0 index optdisp) + (sem-op (add optdisp (add abase (mul index (sll (const 1) scale)))) + st_src) + () + ) + ) +) + +(store-op "" OPCODE_92 st-expr) +(store-op "ob" OPCODE_82 stob-expr) +(store-op "os" OPCODE_8A stos-expr) +(store-op "l" OPCODE_9A stl-expr) +(store-op "t" OPCODE_A2 stt-expr) +(store-op "q" OPCODE_B2 stq-expr) + +; ??? Incomplete, does not set condition code register. + +; ??? Without these functions, I end up with a call to the undefined +; function EQUSI, because br_lit1 is an unsigned field. Should be a better +; way to solve this. + +(define-pmacro (eq-expr expr1 expr2) (eq WI expr1 expr2)) +(define-pmacro (ne-expr expr1 expr2) (ne WI expr1 expr2)) +(define-pmacro (ltu-expr expr1 expr2) (ltu UWI expr1 expr2)) +(define-pmacro (leu-expr expr1 expr2) (leu UWI expr1 expr2)) +(define-pmacro (gtu-expr expr1 expr2) (gtu UWI expr1 expr2)) +(define-pmacro (geu-expr expr1 expr2) (geu UWI expr1 expr2)) +(define-pmacro (lt-expr expr1 expr2) (lt WI expr1 expr2)) +(define-pmacro (le-expr expr1 expr2) (le WI expr1 expr2)) +(define-pmacro (gt-expr expr1 expr2) (gt WI expr1 expr2)) +(define-pmacro (ge-expr expr1 expr2) (ge WI expr1 expr2)) + +; ??? Does not handle shifts greater than 32 correctly. + +(define-pmacro (bbc-expr expr1 expr2) + (eq WI (and (sll (const 1) expr1) expr2) (const 0))) +(define-pmacro (bbs-expr expr1 expr2) + (ne WI (and (sll (const 1) expr1) expr2) (const 0))) + +(define-pmacro (cmp-op mnemonic opcode-op sem-op) + (begin + (dni (.sym mnemonic -reg) + (.str mnemonic " reg") + () + (.str mnemonic " $br_src1, $br_src2, $br_disp") + (+ opcode-op br_src1 br_src2 BR_M1_0 br_disp BR_ZERO_0) + (if (sem-op br_src1 br_src2) (set pc br_disp)) + () + ) + (dni (.sym mnemonic -lit) + (.str mnemonic " lit") + () + (.str mnemonic " $br_lit1, $br_src2, $br_disp") + (+ opcode-op br_lit1 br_src2 BR_M1_1 br_disp BR_ZERO_0) + (if (sem-op br_lit1 br_src2) (set pc br_disp)) + () + ) + ) +) + +(cmp-op "cmpobe" OPCODE_32 eq-expr) +(cmp-op "cmpobne" OPCODE_35 ne-expr) +(cmp-op "cmpobl" OPCODE_34 ltu-expr) +(cmp-op "cmpoble" OPCODE_36 leu-expr) +(cmp-op "cmpobg" OPCODE_31 gtu-expr) +(cmp-op "cmpobge" OPCODE_33 geu-expr) + +(cmp-op "cmpibe" OPCODE_3A eq-expr) +(cmp-op "cmpibne" OPCODE_3D ne-expr) +(cmp-op "cmpibl" OPCODE_3C lt-expr) +(cmp-op "cmpible" OPCODE_3E le-expr) +(cmp-op "cmpibg" OPCODE_39 gt-expr) +(cmp-op "cmpibge" OPCODE_3B ge-expr) + +(cmp-op "bbc" OPCODE_30 bbc-expr) +(cmp-op "bbs" OPCODE_37 bbs-expr) + +; ??? This is a near copy of alu-op, but without the dst field. +; ??? Should create fake operands instead of using h-cc. +; ??? M3 can be either 0 or 1. We only handle a value of 1 here. + +; ??? The else clause if not optional. + +(define-pmacro (cmpi-expr expr1 expr2) + (cond WI + ((lt WI expr1 expr2) (const 4)) + ((eq WI expr1 expr2) (const 2)) + ; gt: WI + (else (const 1)))) +(define-pmacro (cmpo-expr expr1 expr2) + (cond WI + ((ltu UWI expr1 expr2) (const 4)) + ((eq WI expr1 expr2) (const 2)) + ; gtu: UWI + (else (const 1)))) + +(define-pmacro (cc-op mnemonic opcode-op opcode2-op sem-op) + (begin + (dni mnemonic + (.str mnemonic " reg/reg") + () + (.str mnemonic " $src1, $src2") + (+ opcode-op dst src2 M3_1 M2_0 M1_0 opcode2-op ZERO_0 src1) + (set (reg h-cc 0) (sem-op src1 src2)) + () + ) + (dni (.sym mnemonic "1") + (.str mnemonic " lit/reg") + () + (.str mnemonic " $lit1, $src2") + (+ opcode-op dst src2 M3_1 M2_0 M1_1 opcode2-op ZERO_0 lit1) + (set (reg h-cc 0) (sem-op lit1 src2)) + () + ) + (dni (.sym mnemonic "2") + (.str mnemonic " reg/lit") + () + (.str mnemonic " $src1, $lit2") + (+ opcode-op dst lit2 M3_1 M2_1 M1_0 opcode2-op ZERO_0 src1) + (set (reg h-cc 0) (sem-op src1 lit2)) + () + ) + (dni (.sym mnemonic "3") + (.str mnemonic " lit/lit") + () + (.str mnemonic " $lit1, $lit2") + (+ opcode-op dst lit2 M3_1 M2_1 M1_1 opcode2-op ZERO_0 lit1) + (set (reg h-cc 0) (sem-op lit1 lit2)) + () + ) + ) +) + +(cc-op "cmpi" OPCODE_5A OPCODE2_1 cmpi-expr) +(cc-op "cmpo" OPCODE_5A OPCODE2_0 cmpo-expr) + +; ??? The M1 field should be ignored. + +(define-pmacro (testno-expr) + (eq WI (reg h-cc 0) (const 0))) +(define-pmacro (testg-expr) + (ne WI (and (reg h-cc 0) (const 1)) (const 0))) +(define-pmacro (teste-expr) + (ne WI (and (reg h-cc 0) (const 2)) (const 0))) +(define-pmacro (testge-expr) + (ne WI (and (reg h-cc 0) (const 3)) (const 0))) +(define-pmacro (testl-expr) + (ne WI (and (reg h-cc 0) (const 4)) (const 0))) +(define-pmacro (testne-expr) + (ne WI (and (reg h-cc 0) (const 5)) (const 0))) +(define-pmacro (testle-expr) + (ne WI (and (reg h-cc 0) (const 6)) (const 0))) +(define-pmacro (testo-expr) + (ne WI (and (reg h-cc 0) (const 7)) (const 0))) + + +(define-pmacro (test-op mnemonic opcode-op sem-op) + (dni (.sym mnemonic -reg) + (.str mnemonic " reg") + () + (.str mnemonic " $br_src1") + (+ opcode-op br_src1 br_src2 BR_M1_0 br_disp BR_ZERO_0) + (set br_src1 (sem-op)) + () + ) +) + +(test-op "testno" OPCODE_20 testno-expr) +(test-op "testg" OPCODE_21 testg-expr) +(test-op "teste" OPCODE_22 teste-expr) +(test-op "testge" OPCODE_23 testge-expr) +(test-op "testl" OPCODE_24 testl-expr) +(test-op "testne" OPCODE_25 testne-expr) +(test-op "testle" OPCODE_26 testle-expr) +(test-op "testo" OPCODE_27 testo-expr) + +(define-pmacro (branch-op mnemonic opcode-op sem-op) + (dni (.sym mnemonic) (.str mnemonic) + () + (.str mnemonic " $ctrl_disp") + (+ opcode-op ctrl_disp CTRL_ZERO_0) + (if (sem-op) (set pc ctrl_disp)) + () + ) +) + +(branch-op "bno" OPCODE_10 testno-expr) +(branch-op "bg" OPCODE_11 testg-expr) +(branch-op "be" OPCODE_12 teste-expr) +(branch-op "bge" OPCODE_13 testge-expr) +(branch-op "bl" OPCODE_14 testl-expr) +(branch-op "bne" OPCODE_15 testne-expr) +(branch-op "ble" OPCODE_16 testle-expr) +(branch-op "bo" OPCODE_17 testo-expr) + +(dni b "b" + () + "b $ctrl_disp" + (+ OPCODE_08 ctrl_disp CTRL_ZERO_0) + (set pc ctrl_disp) + () +) + +; ??? Incomplete. Only handles 5 of 10 addressing modes. +; Should be a macro. + +(dni bx-indirect-offset "bx-indirect-offset" + () + "bx $offset($abase)" + (+ OPCODE_84 dst abase MODEA_INDIRECT-OFFSET ZEROA_0 offset) + (set pc (add offset abase)) + () +) + +(dni bx-indirect "bx-indirect" + () + "bx ($abase)" + (+ OPCODE_84 dst abase MODEB_INDIRECT scale ZEROB_0 index) + (set pc abase) + () +) + +(dni bx-indirect-index "bx-indirect-index" + () + "bx ($abase)[$index*S$scale]" + (+ OPCODE_84 dst abase MODEB_INDIRECT-INDEX scale ZEROB_0 index) + (set pc (add abase (mul index (sll (const 1) scale)))) + () +) + +(dni bx-disp "bx-disp" + () + "bx $optdisp" + (+ OPCODE_84 dst abase MODEB_DISP scale ZEROB_0 index optdisp) + (set pc optdisp) + () +) + +(dni bx-indirect-disp "bx-indirect-disp" + () + "bx $optdisp($abase)" + (+ OPCODE_84 dst abase MODEB_INDIRECT-DISP scale ZEROB_0 index optdisp) + (set pc (add optdisp abase)) + () +) + +; ??? Incomplete. Only handles 3 of 10 addressing modes. Only handles +; one local register set. + +; ??? If we don't want all of the set-quiet calls, then we need to increase +; SIZE_TRACE_BUF in sim/common/cgen-trace.c. + +(dni callx-disp "callx-disp" + () + "callx $optdisp" + (+ OPCODE_86 dst abase MODEB_DISP scale ZEROB_0 index optdisp) + (sequence ((WI temp)) + (set temp (and (add (reg h-gr 1) (const 63)) (inv (const 63)))) + ; ??? This doesn't seem right. Why do I have to add 8?. + (set (reg h-gr 2) (add pc (const 8))) + ; Save current local reg set on stack. + (set-quiet (mem WI (add (reg h-gr 31) (const 0))) + (reg h-gr 0)) + (set-quiet (mem WI (add (reg h-gr 31) (const 4))) + (reg h-gr 1)) + (set-quiet (mem WI (add (reg h-gr 31) (const 8))) + (reg h-gr 2)) + (set-quiet (mem WI (add (reg h-gr 31) (const 12))) + (reg h-gr 3)) + (set-quiet (mem WI (add (reg h-gr 31) (const 16))) + (reg h-gr 4)) + (set-quiet (mem WI (add (reg h-gr 31) (const 20))) + (reg h-gr 5)) + (set-quiet (mem WI (add (reg h-gr 31) (const 24))) + (reg h-gr 6)) + (set-quiet (mem WI (add (reg h-gr 31) (const 28))) + (reg h-gr 7)) + (set-quiet (mem WI (add (reg h-gr 31) (const 32))) + (reg h-gr 8)) + (set-quiet (mem WI (add (reg h-gr 31) (const 36))) + (reg h-gr 9)) + (set-quiet (mem WI (add (reg h-gr 31) (const 40))) + (reg h-gr 10)) + (set-quiet (mem WI (add (reg h-gr 31) (const 44))) + (reg h-gr 11)) + (set-quiet (mem WI (add (reg h-gr 31) (const 48))) + (reg h-gr 12)) + (set-quiet (mem WI (add (reg h-gr 31) (const 52))) + (reg h-gr 13)) + (set-quiet (mem WI (add (reg h-gr 31) (const 56))) + (reg h-gr 14)) + (set-quiet (mem WI (add (reg h-gr 31) (const 60))) + (reg h-gr 15)) + (set pc optdisp) + ; Allocate new local reg set. + (set-quiet (reg h-gr 0) (const #xDEADBEEF)) + (set-quiet (reg h-gr 1) (const #xDEADBEEF)) + (set-quiet (reg h-gr 2) (const #xDEADBEEF)) + (set-quiet (reg h-gr 3) (const #xDEADBEEF)) + (set-quiet (reg h-gr 4) (const #xDEADBEEF)) + (set-quiet (reg h-gr 5) (const #xDEADBEEF)) + (set-quiet (reg h-gr 6) (const #xDEADBEEF)) + (set-quiet (reg h-gr 7) (const #xDEADBEEF)) + (set-quiet (reg h-gr 8) (const #xDEADBEEF)) + (set-quiet (reg h-gr 9) (const #xDEADBEEF)) + (set-quiet (reg h-gr 10) (const #xDEADBEEF)) + (set-quiet (reg h-gr 11) (const #xDEADBEEF)) + (set-quiet (reg h-gr 12) (const #xDEADBEEF)) + (set-quiet (reg h-gr 13) (const #xDEADBEEF)) + (set-quiet (reg h-gr 14) (const #xDEADBEEF)) + (set-quiet (reg h-gr 15) (const #xDEADBEEF)) + (set (reg h-gr 0) (reg h-gr 31)) + (set (reg h-gr 31) temp) + (set (reg h-gr 1) (add temp (const 64)))) + () +) + +; ??? This should be macro-ized somehow. + +; ??? This adds 4 to pc. The above pattern adds 8. + +(dni callx-indirect "callx-indirect" + () + "callx ($abase)" + (+ OPCODE_86 dst abase MODEB_INDIRECT scale ZEROB_0 index) + (sequence ((WI temp)) + (set temp (and (add (reg h-gr 1) (const 63)) (inv (const 63)))) + ; ??? This doesn't seem right. Why do I have to add 4?. + (set (reg h-gr 2) (add pc (const 4))) + ; Save current local reg set on stack. + (set-quiet (mem WI (add (reg h-gr 31) (const 0))) + (reg h-gr 0)) + (set-quiet (mem WI (add (reg h-gr 31) (const 4))) + (reg h-gr 1)) + (set-quiet (mem WI (add (reg h-gr 31) (const 8))) + (reg h-gr 2)) + (set-quiet (mem WI (add (reg h-gr 31) (const 12))) + (reg h-gr 3)) + (set-quiet (mem WI (add (reg h-gr 31) (const 16))) + (reg h-gr 4)) + (set-quiet (mem WI (add (reg h-gr 31) (const 20))) + (reg h-gr 5)) + (set-quiet (mem WI (add (reg h-gr 31) (const 24))) + (reg h-gr 6)) + (set-quiet (mem WI (add (reg h-gr 31) (const 28))) + (reg h-gr 7)) + (set-quiet (mem WI (add (reg h-gr 31) (const 32))) + (reg h-gr 8)) + (set-quiet (mem WI (add (reg h-gr 31) (const 36))) + (reg h-gr 9)) + (set-quiet (mem WI (add (reg h-gr 31) (const 40))) + (reg h-gr 10)) + (set-quiet (mem WI (add (reg h-gr 31) (const 44))) + (reg h-gr 11)) + (set-quiet (mem WI (add (reg h-gr 31) (const 48))) + (reg h-gr 12)) + (set-quiet (mem WI (add (reg h-gr 31) (const 52))) + (reg h-gr 13)) + (set-quiet (mem WI (add (reg h-gr 31) (const 56))) + (reg h-gr 14)) + (set-quiet (mem WI (add (reg h-gr 31) (const 60))) + (reg h-gr 15)) + ; We do this first, because abase might be a local reg. + (set pc abase) + ; Allocate new local reg set. + (set-quiet (reg h-gr 0) (const #xDEADBEEF)) + (set-quiet (reg h-gr 1) (const #xDEADBEEF)) + (set-quiet (reg h-gr 2) (const #xDEADBEEF)) + (set-quiet (reg h-gr 3) (const #xDEADBEEF)) + (set-quiet (reg h-gr 4) (const #xDEADBEEF)) + (set-quiet (reg h-gr 5) (const #xDEADBEEF)) + (set-quiet (reg h-gr 6) (const #xDEADBEEF)) + (set-quiet (reg h-gr 7) (const #xDEADBEEF)) + (set-quiet (reg h-gr 8) (const #xDEADBEEF)) + (set-quiet (reg h-gr 9) (const #xDEADBEEF)) + (set-quiet (reg h-gr 10) (const #xDEADBEEF)) + (set-quiet (reg h-gr 11) (const #xDEADBEEF)) + (set-quiet (reg h-gr 12) (const #xDEADBEEF)) + (set-quiet (reg h-gr 13) (const #xDEADBEEF)) + (set-quiet (reg h-gr 14) (const #xDEADBEEF)) + (set-quiet (reg h-gr 15) (const #xDEADBEEF)) + (set (reg h-gr 0) (reg h-gr 31)) + (set (reg h-gr 31) temp) + (set (reg h-gr 1) (add temp (const 64)))) + () +) + +; ??? This adds 4 to pc. + +; ??? This should be macro-ized somehow. + +(dni callx-indirect-offset "callx-indirect-offset" + () + "callx $offset($abase)" + (+ OPCODE_86 dst abase MODEA_INDIRECT-OFFSET ZEROA_0 offset) + (sequence ((WI temp)) + (set temp (and (add (reg h-gr 1) (const 63)) (inv (const 63)))) + ; ??? This doesn't seem right. Why do I have to add 4?. + (set (reg h-gr 2) (add pc (const 4))) + ; Save current local reg set on stack. + (set-quiet (mem WI (add (reg h-gr 31) (const 0))) + (reg h-gr 0)) + (set-quiet (mem WI (add (reg h-gr 31) (const 4))) + (reg h-gr 1)) + (set-quiet (mem WI (add (reg h-gr 31) (const 8))) + (reg h-gr 2)) + (set-quiet (mem WI (add (reg h-gr 31) (const 12))) + (reg h-gr 3)) + (set-quiet (mem WI (add (reg h-gr 31) (const 16))) + (reg h-gr 4)) + (set-quiet (mem WI (add (reg h-gr 31) (const 20))) + (reg h-gr 5)) + (set-quiet (mem WI (add (reg h-gr 31) (const 24))) + (reg h-gr 6)) + (set-quiet (mem WI (add (reg h-gr 31) (const 28))) + (reg h-gr 7)) + (set-quiet (mem WI (add (reg h-gr 31) (const 32))) + (reg h-gr 8)) + (set-quiet (mem WI (add (reg h-gr 31) (const 36))) + (reg h-gr 9)) + (set-quiet (mem WI (add (reg h-gr 31) (const 40))) + (reg h-gr 10)) + (set-quiet (mem WI (add (reg h-gr 31) (const 44))) + (reg h-gr 11)) + (set-quiet (mem WI (add (reg h-gr 31) (const 48))) + (reg h-gr 12)) + (set-quiet (mem WI (add (reg h-gr 31) (const 52))) + (reg h-gr 13)) + (set-quiet (mem WI (add (reg h-gr 31) (const 56))) + (reg h-gr 14)) + (set-quiet (mem WI (add (reg h-gr 31) (const 60))) + (reg h-gr 15)) + ; We do this first, because abase might be a local reg. + (set pc (add offset abase)) + ; Allocate new local reg set. + (set-quiet (reg h-gr 0) (const #xDEADBEEF)) + (set-quiet (reg h-gr 1) (const #xDEADBEEF)) + (set-quiet (reg h-gr 2) (const #xDEADBEEF)) + (set-quiet (reg h-gr 3) (const #xDEADBEEF)) + (set-quiet (reg h-gr 4) (const #xDEADBEEF)) + (set-quiet (reg h-gr 5) (const #xDEADBEEF)) + (set-quiet (reg h-gr 6) (const #xDEADBEEF)) + (set-quiet (reg h-gr 7) (const #xDEADBEEF)) + (set-quiet (reg h-gr 8) (const #xDEADBEEF)) + (set-quiet (reg h-gr 9) (const #xDEADBEEF)) + (set-quiet (reg h-gr 10) (const #xDEADBEEF)) + (set-quiet (reg h-gr 11) (const #xDEADBEEF)) + (set-quiet (reg h-gr 12) (const #xDEADBEEF)) + (set-quiet (reg h-gr 13) (const #xDEADBEEF)) + (set-quiet (reg h-gr 14) (const #xDEADBEEF)) + (set-quiet (reg h-gr 15) (const #xDEADBEEF)) + (set (reg h-gr 0) (reg h-gr 31)) + (set (reg h-gr 31) temp) + (set (reg h-gr 1) (add temp (const 64)))) + () +) + +; ??? Incomplete. Does not handle return status in PFP. + +(dni ret "ret" + () + "ret" + (+ OPCODE_0A ctrl_disp CTRL_ZERO_0) + (sequence () + (set (reg h-gr 31) (reg h-gr 0)) + (set-quiet (reg h-gr 0) + (mem WI (add (reg h-gr 31) (const 0)))) + (set-quiet (reg h-gr 1) + (mem WI (add (reg h-gr 31) (const 4)))) + (set-quiet (reg h-gr 2) + (mem WI (add (reg h-gr 31) (const 8)))) + (set-quiet (reg h-gr 3) + (mem WI (add (reg h-gr 31) (const 12)))) + (set-quiet (reg h-gr 4) + (mem WI (add (reg h-gr 31) (const 16)))) + (set-quiet (reg h-gr 5) + (mem WI (add (reg h-gr 31) (const 20)))) + (set-quiet (reg h-gr 6) + (mem WI (add (reg h-gr 31) (const 24)))) + (set-quiet (reg h-gr 7) + (mem WI (add (reg h-gr 31) (const 28)))) + (set-quiet (reg h-gr 8) + (mem WI (add (reg h-gr 31) (const 32)))) + (set-quiet (reg h-gr 9) + (mem WI (add (reg h-gr 31) (const 36)))) + (set-quiet (reg h-gr 10) + (mem WI (add (reg h-gr 31) (const 40)))) + (set-quiet (reg h-gr 11) + (mem WI (add (reg h-gr 31) (const 44)))) + (set-quiet (reg h-gr 12) + (mem WI (add (reg h-gr 31) (const 48)))) + (set-quiet (reg h-gr 13) + (mem WI (add (reg h-gr 31) (const 52)))) + (set-quiet (reg h-gr 14) + (mem WI (add (reg h-gr 31) (const 56)))) + (set-quiet (reg h-gr 15) + (mem WI (add (reg h-gr 31) (const 60)))) + (set pc (reg h-gr 2))) + () +) + +; ??? Incomplete, does not do any system operations. + +; ??? Should accept either reg or lit for src1. + +; ??? M3/M2 should not matter. + +(dni calls "calls" + () + "calls $src1" + (+ OPCODE_66 dst src2 M3_1 M2_1 M1_0 OPCODE2_0 ZERO_0 src1) + (set WI pc (c-call WI "i960_trap" pc src1)) + () +) + +; ??? Incomplete, does not do any system operations. + +; ??? M3/M2/M1 should not matter. + +(dni fmark "fmark" + () + "fmark" + (+ OPCODE_66 dst src2 M3_1 M2_1 M1_1 OPCODE2_C ZERO_0 src1) + (set WI pc (c-call WI "i960_breakpoint" pc)) + () +) + +; ??? Incomplete. This doesn't actually have to do anything, because we +; currently support only one set of local registers. + +; ??? The settings of the M1/2/3 bits shouldn't matter. + +(dni flushreg "flushreg" + () + "flushreg" + (+ OPCODE_66 dst src2 M3_1 M2_1 M1_1 OPCODE2_D ZERO_0 src1) + (nop) + () +) diff --git a/cgen/i960.opc b/cgen/i960.opc new file mode 100644 index 00000000000..acfc53dd4b6 --- /dev/null +++ b/cgen/i960.opc @@ -0,0 +1,32 @@ +/* Intel 80960 opcode support. -*- C -*- + Copyright (C) 2000 Red Hat, Inc. + This file is part of CGEN. */ + +/* This file is an addendum to i960.cpu. Heavy use of C code isn't + appropriate in .cpu files, so it resides here. This especially applies + to assembly/disassembly where parsing/printing can be quite involved. + Such things aren't really part of the specification of the cpu, per se, + so .cpu files provide the general framework and .opc files handle the + nitty-gritty details as necessary. + + Each section is delimited with start and end markers. + + <arch>-opc.h additions use: "-- opc.h" + <arch>-opc.c additions use: "-- opc.c" + <arch>-asm.c additions use: "-- asm.c" + <arch>-dis.c additions use: "-- dis.c" + <arch>-ibd.h additions use: "-- ibd.h" +*/ + +/* -- opc.h */ + +#undef CGEN_DIS_HASH_SIZE +#define CGEN_DIS_HASH_SIZE 256 +#undef CGEN_DIS_HASH +#define CGEN_DIS_HASH(buffer, value) ((unsigned char *) (buffer))[3] + +/* ??? Until cgen disassembler complete and functioning well, redirect back + to old disassembler. */ +#define CGEN_PRINT_INSN(od, pc, info) print_insn_i960_orig (pc, info) + +/* -- */ diff --git a/cgen/ia32.cpu b/cgen/ia32.cpu new file mode 100644 index 00000000000..4f8e84164cb --- /dev/null +++ b/cgen/ia32.cpu @@ -0,0 +1,917 @@ +; Intel IA32 CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; References: +; +; Intel486 Processor Family, Programmer's Reference Manual, Intel + +(include "simplify.inc") + +; define-arch must appear first + +(define-arch + (name ia32) ; name of cpu family + (comment "Intel IA32 (x86)") + (default-alignment unaligned) + (insn-lsb0? #t) + (machs i386 i486 pentium pentium-ii pentium-iii) ; ??? wip + (isas ia32) ; ??? separate 8086 isa? +) + +; Attributes. + +; Instruction set parameters. + +(define-isa + (name ia32) + + (default-insn-bitsize 8) + + ; Number of bytes of insn we can initially fetch. + (base-insn-bitsize 8) + + ; Used in computing bit numbers. + (default-insn-word-bitsize 32) + + ; Initial bitnumbers to decode insns by. + (decode-assist (0 1 2 3 4 5 6 7)) +) + +; Cpu family definitions. + +(define-cpu + ; cpu names must be distinct from the architecture name and machine names. + ; The "b" suffix stands for "base" and is the convention. + ; The "f" suffix stands for "family" and is the convention. + (name ia32bf) + (comment "Intel x86 base family") + (endian little) + (word-bitsize 32) +) + +(define-mach + (name pentium-ii) + (comment "Pentium II") + (cpu ia32bf) +) + +; Model descriptions. + +; The meaning of this value is wip but at the moment it's intended to describe +; the implementation (i.e. what -mtune=foo does in sparc gcc). +; ??? This is intended to be redesigned later. + +(define-model + (name pentium-ii) + (comment "Pentium II model") + (mach pentium-ii) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () ; state + () ; inputs + () ; outputs + () ; profile action (default) + ) +) + +; Instruction fields. + +; There currently doesn't exist shorthand macros for CISC ISA's, +; so define our own. +; DIF: define-ia32-field +; DNIF: define-normal-ia32-field + +(define-pmacro (dif x-name x-comment x-attrs x-word-offset x-word-length x-start x-length x-mode x-encode x-decode) + (define-ifield + (name x-name) + (comment x-comment) + (.splice attrs (.unsplice x-attrs)) + (word-offset x-word-offset) + (word-length x-word-length) + (start x-start) + (length x-length) + (mode x-mode) + (encode x-encode) + (decode x-decode) + ) +) + +(define-pmacro (dnif x-name x-comment x-attrs x-word-offset x-word-length x-start x-length) + (dif x-name x-comment x-attrs x-word-offset x-word-length x-start x-length + UINT #f #f) +) + +(dnif f-opcode "first insn byte" () 0 8 7 8) + +; The mod-r/m byte. +(dnif f-mod "mod field of mod-r/m byte" () 8 8 7 2) +(dnif f-reg/opcode "reg/opcode field of mod-r/m byte" () 8 8 5 3) +(dnif f-r/m "r/m field of mod-r/m byte" () 8 8 2 3) +(dsmf f-mod-r/m "entire mod-r/m byte" () (f-mod f-reg/opcode f-r/m)) + +(dnif f-simm8 "signed 8 bit immediate" () 8 8 7 8) +(dnif f-simm16 "signed 16 bit immediate" () 8 16 15 16) +(dnif f-simm32 "signed 32 bit immediate" () 8 32 31 32) + +(dnif f-disp8 "signed 8 bit displacement" () 8 8 7 8) +(dnif f-disp16 "signed 16 bit displacement" () 8 16 15 16) +(dnif f-disp32 "signed 32 bit displacement" () 8 32 31 32) + +(dnif f-rel8 "signed 8 bit pc-relative displacement" (PCREL-ADDR) 8 8 7 8) +(dnif f-rel16 "signed 16 bit pc-relative displacement" (PCREL-ADDR) 8 16 15 16) +(dnif f-rel32 "signed 32 bit pc-relative displacement" (PCREL-ADDR) 8 32 31 32) + +; The sib byte. +(dnif f-sib-ss "sib scale size" () 16 8 7 2) +(dnif f-sib-base "sib base reg" () 16 8 5 3) +(dnif f-sib-index "sib index reg" () 16 8 2 3) +(dsmf f-sib "entire sib byte" () (f-sib-ss f-sib-base f-sib-index)) + +; Enums. + +(define-pmacro (build-hex2 num) (.hex num 2)) + +; insn-opcode +; "00" ... "FF" +(define-normal-insn-enum insn-opcode "insn opcode enums" () OP_ f-opcode + (.map .upcase (.map build-hex2 (.iota 256))) +) + +; Hardware pieces. +; These entries list the elements of the raw hardware. +; They're also used to provide tables and other elements of the assembly +; language. +; +; ??? Sets of SP have extra-special semantics. + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-keyword + (name gr8-names) + (print-name h-gr8) + (prefix "%") + (values (al 0) (cl 1) (dl 2) (bl 3) (ah 4) (ch 5) (dh 6) (bh 7)) +) + +(define-hardware + (name h-gr8) + (comment "8 bit general registers") + (attrs VIRTUAL PROFILE) + (type register QI (8)) + (indices extern-keyword gr8-names) + (get (index) + (if (lt index 4) + (reg QI h-gr index) + (bitfield (reg h-gr (sub index 4)) 15 8))) + (set (index newval) + (if (lt index 4) + (set (bitfield (reg h-gr index) 7 8) newval) + (set (bitfield (reg h-gr (sub index 4)) 15 8) newval))) +) + +(define-keyword + (name gr16-names) + (print-name h-gr16) + (prefix "%") + (values (ax 0) (cx 1) (dx 2) (bx 3) (sp 4) (bp 5) (si 6) (di 7)) +) + +(define-hardware + (name h-gr16) + (comment "16 bit general registers") + (attrs VIRTUAL PROFILE) + (type register HI (8)) + (indices extern-keyword gr16-names) + (get (index) (reg HI h-gr index)) + (set (index newval) (set (bitfield (reg h-gr index) 15 16) newval)) +) + +(define-keyword + (name gr-names) + (print-name h-gr) + (prefix "%") + (values (eax 0) (ecx 1) (edx 2) (ebx 3) (esp 4) (ebp 5) (esi 6) (edi 7)) +) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE CACHE-ADDR) + (type register SI (8)) + (indices extern-keyword gr-names) +) + +(dsh h-cf "carry flag" () (register BI)) +(dsh h-sf "sign flag" () (register BI)) +(dsh h-of "overflow flag" () (register BI)) +(dsh h-zf "zero flag" () (register BI)) + +; Instruction Operands. + +; M32R specific operand attributes: +; - none yet + +; Some registers are refered to explicitly. +; ??? Might eventually be worth defining them all, but for now we just +; define the ones we need. +; ??? Another way to do this is to use pmacros. + +(dnop al "%al register" () h-gr8 0) +(dnop ax "%ax register" () h-gr16 0) +(dnop eax "%eax register" () h-gr 0) + +; Registers specified in the Reg/Opcode field of the r/m byte. + +(dnop reg8 "8 bit register" () h-gr8 f-reg/opcode) +(dnop reg16 "16 bit register" () h-gr16 f-reg/opcode) +(dnop reg32 "32 bit register" () h-gr f-reg/opcode) + +; Various numeric operands. + +(dnop simm8 "8 bit signed immediate" () h-sint f-simm8) +(dnop simm16 "16 bit signed immediate" () h-sint f-simm16) +(dnop simm32 "32 bit signed immediate" () h-sint f-simm32) + +(dnop disp8 "8 bit displacement" () h-sint f-disp8) +(dnop disp16 "16 bit displacement" () h-sint f-disp16) +(dnop disp32 "32 bit displacement" () h-sint f-disp32) + +(dnop rel8 "8 bit displacement" () h-iaddr f-rel8) +(dnop rel16 "16 bit displacement" () h-iaddr f-rel16) +(dnop rel32 "32 bit displacement" () h-iaddr f-rel32) + +; The condition code registers. + +(dnop cf "carry flag" () h-cf f-nil) +(dnop sf "sign flag" () h-sf f-nil) +(dnop of "overflow flag" () h-of f-nil) +(dnop zf "zero flag" () h-zf f-nil) + +; ModRM support. + +(dnop r/m-reg8 "8 bit register in r/m field" () h-gr8 f-r/m) +(dnop r/m-reg16 "16 bit register in r/m field" () h-gr16 f-r/m) +(dnop r/m-reg32 "32 bit register in r/m field" () h-gr f-r/m) + +(define-operand + (name mod-r/m-base-reg) + (comment "base register for mod-r/m addressing") + (mode SI) + (type h-gr) + (index f-r/m) +) + +(define-operand + (name sib-base) + (comment "base register for sib addressing") + (mode SI) + (type h-gr) + (index f-sib-base) +) + +(define-operand + (name sib-index) + (comment "index register for sib addressing") + (mode SI) + (type h-gr) + (index f-sib-index) +) + +; The mod-r/m and sib ifields. +; These are composed of several ifields and specify a set of choices +; (addressing modes) to choose from. + +(define-pmacro (diff x-name x-comment x-attrs x-start x-length x-follows x-mode) + "Define an ia32 ifield that follows another ifield." + (define-ifield + (name x-name) + (comment x-comment) + (.splice attrs (.unsplice x-attrs)) + (start x-start) + (length x-length) + (follows x-follows) + (mode x-mode) + ) +) + +; These must be defined before they're used and it makes sense to define +; the operand with the ifield (rather than follow the usual convention of +; defining all ifields first - not that that convention is necessarily the +; best). + +(dnif f-disp8-@16 "signed 8 bit displacement at offset 16" () 16 8 7 8) +(dnop disp8-@16 "signed 8 bit displacement at offset 16" () h-sint f-disp8-@16) + +(dnif f-disp32-@16 "signed 32 bit displacement at offset 16" () 16 32 31 32) +(dnop disp32-@16 "signed 32 bit displacement at offset 16" () h-sint f-disp32-@16) + +(dnif f-disp32-@24 "signed 32 bit displacement at offset 24" () 24 32 31 32) +(dnop disp32-@24 "signed 32 bit displacement at offset 24" () h-sint f-disp32-@24) + +; The sib operand, used by the mod-r/m operand. + +(dndo base+index*1 + SI + (sib-base sib-index) + "${sib-base}+${sib-index}" + f-sib + (+ (f-sib-ss 0) sib-base sib-index) + (andif (orif (ne f-mod 0) + (ne f-sib-base 5)) + (ne f-sib-index 4)) + (add sib-base sib-index) + () ; no setter +) + +(dndo base-1 + SI + (sib-base) + "${sib-base}" + f-sib + (+ (f-sib-ss 0) sib-base (f-sib-index 4)) + (orif (ne f-mod 0) + (ne f-sib-base 5)) + sib-base + () ; no setter +) + +(dndo index*1+disp32 + SI + (sib-index disp32) + "${disp32-@24}(${sib-index})" + f-sib + (+ (f-sib-ss 0) (f-sib-base 5) sib-index disp32-@24) + (andif (eq f-mod 0) + (ne f-sib-index 4)) + (add sib-index disp32-@24) + () ; no setter +) + +(dndo disp32-1 + SI + (disp32) + "${disp32-@24}" + f-sib + (+ (f-sib-ss 0) (f-sib-base 5) (f-sib-index 4) disp32-@24) + (eq f-mod 0) + disp32-@24 + () ; no setter +) + +(dndo base+index*2 + SI + (sib-base sib-index) + "${sib-base}+${sib-index}*2" + f-sib + (+ (f-sib-ss 1) sib-base sib-index) + (andif (orif (ne f-mod 0) + (ne f-sib-base 5)) + (ne f-sib-index 4)) + (add sib-base (mul sib-index 2)) + () ; no setter +) + +(dndo base-2 + SI + (sib-base) + "${sib-base}" + f-sib + (+ (f-sib-ss 1) sib-base (f-sib-index 4)) + () + sib-base + () ; no setter +) + +(dndo index*2+disp32 + SI + (sib-index disp32) + "${disp32-@24}(${sib-index})" + f-sib + (+ (f-sib-ss 1) (f-sib-base 5) sib-index disp32-@24) + (andif (eq f-mod 0) + (ne f-sib-index 4)) + (add (mul sib-index 2) disp32-@24) + () ; no setter +) + +(dndo disp32-2 + SI + (disp32) + "${disp32-@24}" + f-sib + (+ (f-sib-ss 1) (f-sib-base 5) (f-sib-index 4) disp32-@24) + (eq f-mod 0) + disp32-@24 + () ; no setter +) + +(dndo base+index*4 + SI + (sib-base sib-index) + "${sib-base}+${sib-index}*4" + f-sib + (+ (f-sib-ss 2) sib-base sib-index) + (andif (orif (ne f-mod 0) + (ne f-sib-base 5)) + (ne f-sib-index 4)) + (add sib-base (mul sib-index 4)) + () ; no setter +) + +(dndo base-4 + SI + (sib-base) + "${sib-base}" + f-sib + (+ (f-sib-ss 2) sib-base (f-sib-index 4)) + () + sib-base + () ; no setter +) + +(dndo index*4+disp32 + SI + (sib-index disp32) + "${disp32-@24}(${sib-index})" + f-sib + (+ (f-sib-ss 2) (f-sib-base 5) sib-index disp32-@24) + (andif (eq f-mod 0) + (ne f-sib-index 4)) + (add (mul sib-index 4) disp32-@24) + () ; no setter +) + +(dndo disp32-4 + SI + (disp32) + "${disp32-@24}" + f-sib + (+ (f-sib-ss 2) (f-sib-base 5) (f-sib-index 4) disp32-@24) + (eq f-mod 0) + disp32-@24 + () ; no setter +) + +(dndo base+index*8 + SI + (sib-base sib-index) + "${sib-base}+${sib-index}*8" + f-sib + (+ (f-sib-ss 3) sib-base sib-index) + (andif (orif (ne f-mod 0) + (ne f-sib-base 5)) + (ne f-sib-index 4)) + (add sib-base (mul sib-index 8)) + () ; no setter +) + +(dndo base-8 + SI + (sib-base) + "${sib-base}" + f-sib + (+ (f-sib-ss 3) sib-base (f-sib-index 4)) + () + sib-base + () ; no setter +) + +(dndo index*8+disp32 + SI + (sib-index disp32) + "${disp32-@24}(${sib-index})" + f-sib + (+ (f-sib-ss 3) (f-sib-base 5) sib-index disp32-@24) + (andif (eq f-mod 0) + (ne f-sib-index 4)) + (add (mul sib-index 8) disp32-@24) + () ; no setter +) + +(dndo disp32-8 + SI + (disp32) + "${disp32-@24}" + f-sib + (+ (f-sib-ss 3) (f-sib-base 5) (f-sib-index 4) disp32-@24) + (eq f-mod 0) + disp32-@24 + () ; no setter +) + +; Now define an "anyof" operand that puts it all together. + +(define-anyof-operand + (name sib) + (comment "base + scaled-index + displacement") + (mode SI) + ; Each choice must have the same base-ifield. + (choices base+index*1 + base-1 + index*1+disp32 + disp32-1 + base+index*2 + base-2 + index*2+disp32 + disp32-2 + base+index*4 + base-4 + index*4+disp32 + disp32-4 + base+index*8 + base-8 + index*8+disp32 + disp32-8 + ) +) + +; Additional ifields/operands used by the mod-r/m byte. +; It seems cleaner to define the operand with its ifield so they are. +; Maybe the rest should be organized similarily. +; Also, the ones that "follow" other ifields must be defined after the latter +; has been defined. + +(diff f-disp8-follows-sib "disp8 ifield after sib ifields" + () 7 8 sib INT +) +(dnop disp8-follows-sib "disp8 following sib" + () h-sint f-disp8-follows-sib +) + +(diff f-disp32-follows-sib "disp32 ifield after sib ifields" + () 31 32 sib INT +) +(dnop disp32-follows-sib "disp32 following sib" + () h-sint f-disp32-follows-sib +) + +; The complete mod-r/m operand, used by instructions. +; ??? The [] bracketing is for clarity. Match actual assembler later. +; blah blah blah intel vs at&t blah blah blah + +(define-pmacro (define-mod-r/m-choices x-mode x-r/m-reg) + (begin + (dndo (.sym @reg- x-mode) + x-mode + (mod-r/m-base-reg) + "[${mod-r/m-base-reg}]" + f-mod-r/m + (+ (f-mod 0) mod-r/m-base-reg) + (andif (ne f-r/m 4) (ne f-r/m 5)) + (mem x-mode mod-r/m-base-reg) + () + ) + (dndo (.sym @sib- x-mode) + x-mode + (sib) + "[$sib]" + f-mod-r/m + (+ (f-mod 0) (f-r/m 4) sib) + () + (mem x-mode sib) + () + ) + (dndo (.sym @disp32- x-mode) + x-mode + (disp32-@16) + "[${disp32-@16}]" + f-mod-r/m + (+ (f-mod 0) (f-r/m 5) disp32-@16) + () + (mem x-mode disp32-@16) + () + ) + (dndo (.sym @reg+disp8- x-mode) + x-mode + (mod-r/m-base-reg disp8) + "[${disp8-@16}(${mod-r/m-base-reg})]" + f-mod-r/m + (+ (f-mod 1) mod-r/m-base-reg disp8-@16) + (ne f-r/m 4) + (mem x-mode (add mod-r/m-base-reg disp8-@16)) + () + ) + (dndo (.sym @sib+disp8- x-mode) + x-mode + (sib disp8-follows-sib) + "[${disp8-follows-sib}($sib)]" + f-mod-r/m + (+ (f-mod 1) (f-r/m 4) sib disp8-follows-sib) + () + (mem x-mode (add sib disp8-follows-sib)) + () + ) + (dndo (.sym @reg+disp32- x-mode) + x-mode + (mod-r/m-base-reg disp32) + "[${disp32-@16}(${mod-r/m-base-reg})]" + f-mod-r/m + (+ (f-mod 2) mod-r/m-base-reg disp32-@16) + (ne f-r/m 4) + (mem x-mode (add mod-r/m-base-reg disp32-@16)) + () + ) + (dndo (.sym @sib+disp32- x-mode) + x-mode + (sib disp32-follows-sib) + "[${disp32-follows-sib}($sib)]" + f-mod-r/m + (+ (f-mod 2) (f-r/m 4) sib disp32-follows-sib) + () + (mem x-mode (add sib disp32-follows-sib)) + () + ) + (dndo (.sym reg- x-mode) + x-mode + (x-r/m-reg) + (.str "${" x-r/m-reg "}") + f-mod-r/m + (+ (f-mod 3) x-r/m-reg) + () + x-r/m-reg + () + ) + ) +) + +(define-pmacro (define-mod-r/m-operand x-name x-comment x-mode x-r/m-reg) + (begin + (define-mod-r/m-choices x-mode x-r/m-reg) + (define-anyof-operand + (name x-name) + (comment x-comment) + (mode x-mode) + ; Each choice must have the same base-ifield. + (choices (.sym @reg- x-mode) + (.sym @sib- x-mode) + (.sym @disp32- x-mode) + (.sym @reg+disp8- x-mode) + (.sym @sib+disp8- x-mode) + (.sym @reg+disp32- x-mode) + (.sym @sib+disp32- x-mode) + (.sym reg- x-mode) + )) + ) +) + +(define-mod-r/m-operand mod-r/m-8 "8 bit mod-r/m value" QI r/m-reg8) +(define-mod-r/m-operand mod-r/m-16 "16 bit mod-r/m value" HI r/m-reg16) +(define-mod-r/m-operand mod-r/m-32 "32 bit mod-r/m value" SI r/m-reg32) + +; Additional ifields/operands used by instructions. +; These "follow" the mod-r/m byte so must be defined afterwards. + +(diff f-simm8-follows-mod-r/m-8 "simm8 ifield after mod-r/m-8 ifields" + () 7 8 mod-r/m-8 INT +) +(dnop simm8-follows-mod-r/m-8 "simm8 following mod-r/m-8" + () h-sint f-simm8-follows-mod-r/m-8 +) + +(diff f-simm16-follows-mod-r/m-16 "simm16 ifield after mod-r/m-16 ifields" + () 15 16 mod-r/m-16 INT +) +(dnop simm16-follows-mod-r/m-16 "simm16 following mod-r/m-16" + () h-sint f-simm16-follows-mod-r/m-16 +) + +(diff f-simm32-follows-mod-r/m-32 "simm32 ifield after mod-r/m-32 ifields" + () 31 32 mod-r/m-32 INT +) +(dnop simm32-follows-mod-r/m-32 "simm32 following mod-r/m-32" + () h-sint f-simm32-follows-mod-r/m-32 +) + +(diff f-simm8-follows-mod-r/m-16 "simm8 ifield after mod-r/m-16 ifields" + () 7 8 mod-r/m-16 INT +) +(dnop simm8-follows-mod-r/m-16 "simm8 following mod-r/m-16" + () h-sint f-simm8-follows-mod-r/m-16 +) + +(diff f-simm8-follows-mod-r/m-32 "simm8 ifield after mod-r/m-32 ifields" + () 7 8 mod-r/m-32 INT +) +(dnop simm8-follows-mod-r/m-32 "simm8 following mod-r/m-32" + () h-sint f-simm8-follows-mod-r/m-32 +) + +; Some subroutines, to simplify the semantic specs. + +(define-pmacro (define-arith-subr x-name x-mode x-fn x-set-cc-fn) + (define-subr + (name x-name) + (mode VOID) + (args ((x-mode dst) (x-mode src1) (x-mode src2))) + (code (sequence ((x-mode arg1) + (x-mode arg2) + (x-mode result)) + (set arg1 src1) + (set arg2 src2) + (set result (x-fn arg1 arg2)) + (set dst result) + (x-set-cc-fn result arg1 arg2))) + ) +) + +(define-arith-subr add-QI QI add set-add-cc) +(define-arith-subr add-HI HI add set-add-cc) +(define-arith-subr add-SI SI add set-add-cc) + +; Instruction definitions. + +; IA32 specific instruction attributes: +; - none yet + +(dni nop + "nop" + () + "nop" + (+ OP_90) + (nop) + () +) + +; Add, subtract. +; +; ??? Insn naming puts destination before addend. Ok? + +(dni add-al-simm8 + "add 8 bit signed immediate to %al" + () + "FIXME" + (+ OP_04 simm8) + (sequence () + (set al (add al simm8)) + ; ??? condition codes + ) + () +) + +(dni add-ax-simm16 + "add 16 bit signed immediate to %ax" + () + "FIXME" + ; ??? Need something like ifield assertions to distinguish from + ; 32 bit case. + (+ OP_05 simm16) + (sequence () + (set ax (add ax simm16)) + ; ??? condition codes + ) + () +) + +(dni add-eax-simm32 + "add 32 bit signed immediate to %eax" + () + "FIXME" + (+ OP_05 simm32) + (sequence () + (set eax (add eax simm32)) + ; ??? condition codes + ) + () +) + +(dni add-r/m8-simm8 + "add 8 bit immediate" + () + "FIXME" + (+ OP_80 mod-r/m-8 simm8-follows-mod-r/m-8 (f-reg/opcode 0)) + (sequence () + (set mod-r/m-8 (add mod-r/m-8 simm8-follows-mod-r/m-8)) + ; ??? condition codes + ) + () +) + +(dni add-r/m16-simm16 + "add 16 bit immediate" + () + "FIXME" + ; ??? Need something akin to ifield-assertions to distinguish from + ; 32 bit version. + (+ OP_81 mod-r/m-16 simm16-follows-mod-r/m-16 (f-reg/opcode 0)) + (sequence () + (set mod-r/m-16 (add mod-r/m-16 simm16-follows-mod-r/m-16)) + ; ??? condition codes + ) + () +) + +(dni add-r/m32-simm32 + "add 32 bit immediate" + () + "FIXME" + (+ OP_81 mod-r/m-32 simm32-follows-mod-r/m-32 (f-reg/opcode 0)) + (sequence () + (set mod-r/m-32 (add mod-r/m-32 simm32-follows-mod-r/m-32)) + ; ??? condition codes + ) + () +) + +(dni add-r/m16-simm8 + "add 8 bit signed immediate to 16 bit value" + () + "FIXME" + ; ??? Need something akin to ifield-assertions to distinguish from + ; 32 bit version. + (+ OP_83 mod-r/m-16 simm8-follows-mod-r/m-16 (f-reg/opcode 0)) + (sequence () + (set mod-r/m-16 (add mod-r/m-16 (ext HI simm8-follows-mod-r/m-16))) + ; ??? condition codes + ) + () +) + +(dni add-r/m32-simm8 + "add 8 bit signed immediate to 32 bit value" + () + "FIXME" + (+ OP_83 mod-r/m-32 simm8-follows-mod-r/m-32 (f-reg/opcode 0)) + (sequence () + (set mod-r/m-32 (add mod-r/m-32 (ext SI simm8-follows-mod-r/m-32))) + ; ??? condition codes + ) + () +) + +(dni add-r/m8-reg8 + "add 8 bit reg to 8 bit r/m" + () + "FIXME" + (+ OP_00 mod-r/m-8 reg8) + (sequence () + (set mod-r/m-8 (add mod-r/m-8 reg8)) + ; ??? condition codes + ) + () +) + +(dni add-r/m16-reg16 + "add 16 bit reg to 16 bit r/m" + () + "FIXME" + ; ??? Need something akin to ifield-assertions to distinguish from + ; 32 bit version. + (+ OP_01 mod-r/m-16 reg16) + (sequence () + (set mod-r/m-16 (add mod-r/m-16 reg16)) + ; ??? condition codes + ) + () +) + +(dni add-r/m32-reg32 + "add 32 bit reg to 32 bit r/m" + () + "FIXME" + (+ OP_01 mod-r/m-32 reg32) + (sequence () + (set mod-r/m-32 (add mod-r/m-32 reg32)) + ; ??? condition codes + ) + () +) + +(dni add-reg8-r/m8 + "add 8 bit r/m to 8 bit reg" + () + "FIXME" + (+ OP_02 mod-r/m-8 reg8) + (sequence () + (set reg8 (add reg8 mod-r/m-8)) + ; ??? condition codes + ) + () +) + +(dni add-reg16-r/m16 + "add 16 bit r/m to 16 bit reg" + () + "FIXME" + ; ??? Need something akin to ifield-assertions to distinguish from + ; 32 bit version. + (+ OP_03 mod-r/m-16 reg16) + (sequence () + (set reg16 (add reg16 mod-r/m-16)) + ; ??? condition codes + ) + () +) + +(dni add-reg32-r/m32 + "add 32 bit r/m to 32 bit reg" + () + "FIXME" + (+ OP_03 mod-r/m-32 reg32) + (sequence () + (set reg32 (add reg32 mod-r/m-32)) + ; ??? condition codes + ) + () +) diff --git a/cgen/ia64.cpu b/cgen/ia64.cpu new file mode 100644 index 00000000000..270fdf4b224 --- /dev/null +++ b/cgen/ia64.cpu @@ -0,0 +1,2355 @@ +;;; Intel IA-64 CPU description. -*- Scheme -*- +;;; Copyright (C) 2000 Red Hat, Inc. +;;; This file is part of CGEN. +;;; See file COPYING.CGEN for details. + +(include "simplify.inc") + + +;;; Architecture and cpu family definitions. + +(define-arch + (name ia64) + (comment "Intel IA-64 architecture") + (insn-lsb0? #t) + (machs ia64) + (isas ia64) +) + +(define-isa + (name ia64) + + ;; Each instruction in the 128-bit bundle is 41 bits wide. + (base-insn-bitsize 41) + + ;; Each bundle is 3 insns wide. + (liw-insns 3) + + ;; ??? How to specify "lots", as that's what the architecture's + ;; stop bits means; + (parallel-insns 3) + + ;; Initial bit numbers to decode by. + (decode-assist (40 39 38 37)) +) + +(define-cpu + (name ia64) + (comment "Intel IA-64 family") + (insn-endian little) + (data-endian either) + (word-bitsize 64) +) + +(eval + (begin + ;; We need 64-bit host support. + (set! INT (mode:add! 'INT (mode:lookup 'DI))) + (set! UINT (mode:add! 'UINT (mode:lookup 'UDI))) + + ;; ??? This shouldn't be necessary, IMO. + (set! WI (mode:add! 'WI (mode:lookup 'DI))) + (set! UWI (mode:add! 'UWI (mode:lookup 'UDI))) + (set! AI (mode:add! 'AI (mode:lookup 'UDI))) + (set! IAI (mode:add! 'IAI (mode:lookup 'UDI))) + ) +) + + +(define-mach + (name ia64) + (comment "Intel IA-64 processors") + (cpu ia64) +) + +; ??? Incomplete. Pipeline and unit info wrong. + +(define-model + (name ia64_itanium) + (comment "Intel Itanium processor") + (mach ia64) + (pipeline all "" () ((fetch) (decode) (execute) (writeback))) + (unit u-exec "Execution Unit" () 1 1 + () () () ()) +) + +;;; Attributes. +;;; +;;; These are used to mark instructions so that we can decode the +;;; dependancy violation data in Intel's tables. + +(define-attr + (name FORMAT) + (for insn) + (type enum) + (attrs META) + (values UNKNOWN + + A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 + + I1 I2 I3 I4 I5 I6 I7 I8 I9 I10 + I11 I12 I13 I14 I15 I16 I17 I18 I19 I20 + I21 I22 I23 I24 I25 I26 I27 I28 I29 + + M1 M2 M3 M4 M5 M6 M7 M8 M9 M10 + M11 M12 M13 M14 M15 M16 M17 M18 M19 M20 + M21 M22 M23 M24 M25 M26 M27 M28 M29 M30 + M31 M32 M33 M34 M35 M36 M37 M38 M39 M40 + M41 M42 M43 M44 M45 M46 + + B1 B2 B3 B4 B5 B6 B7 B8 B9 + + F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 + F11 F12 F13 F14 F15 + ) + (default UNKNOWN) +) + +;; ??? NONE isn't a valid value, but non-FP insns obviously can't have +;; a valid value either. +(define-attr + (name FIELD-SF) + (for insn) + (type enum) + (attrs META) + (values NONE s0 s1 s2 s3) + (default NONE) +) + +(define-attr + (name FIELD-LFTYPE) + (for insn) + (type enum) + (attrs META) + (values NONE fault) + (default NONE) +) + +(define-attr + (name FIELD-CTYPE) + (for insn) + (type enum) + (attrs META) + (values NONE unc or and or.andcm orcm andcm and.orcm) + (default NONE) +) + +;; Field AR3 references a register field. +;; Field CR3 references a register field. +;; Field ireg references a register field. + +;;; ??? IA-64 specific instruction attributes: +;;; +;;; FIRST Must be at the beginning of an instruction group. +;;; SLOT2 Must be in slot 2 on a bundle. +;;; LAST Must be at the end of an instruction group. +;;; I_IN_MLI Insn is allowed in I slot of MLI. +;;; PRIV Privileged instruction. +;;; NO_PRED Insn cannot be predicated. + + +;;; Instruction fields. +;;; +;;; ??? This is confusing (at least to me) -- note that we specify the _top_ +;;; of the field and a length. +;;; +;;; ??? There are only two fields used nearly universally. But the +;;; instruction formats are very regular in the sense that the same +;;; field specifications are re-used many times. So we just have the +;;; raw fields here first. + +;; Fields used by most instructions. +(dnf f-opcode "major opcode" () 40 4) +(dnf f-qp "qualifying predicate" () 5 6) + +;; Random parts used by the 109 (!) instruction formats. +(dnf f-36-6 "6 @ 36" () 36 6) +(df f-36-1s "1 @ 36, signed" () 36 1 INT #f #f) +(dnf f-36-1 "1 @ 36" () 36 1) +(dnf f-35-9 "9 @ 35" () 35 9) +(dnf f-35-6 "6 @ 35" () 35 6) +(dnf f-35-3 "3 @ 35" () 35 3) +(dnf f-35-2 "2 @ 35" () 35 2) +(dnf f-35-1 "1 @ 35" () 35 1) +(dnf f-34-2 "2 @ 34" () 34 2) +(dnf f-33-1 "1 @ 33" () 33 1) +(dnf f-32-27 "27 @ 32" () 32 27) +(dnf f-32-20 "20 @ 32" () 32 20) +(dnf f-32-13 "13 @ 32" () 32 13) +(dnf f-32-9 "9 @ 32" () 32 9) +(dnf f-32-6 "6 @ 32" () 32 6) +(dnf f-32-4 "4 @ 32" () 32 4) +(dnf f-32-2 "2 @ 32" () 32 2) +(dnf f-32-1 "1 @ 32" () 32 1) +(dnf f-31-8 "8 @ 31" () 31 8) +(dnf f-31-2 "2 @ 31" () 31 2) +(dnf f-30-4 "4 @ 30" () 30 4) +(dnf f-30-19 "19 @ 30" () 30 19) +(dnf f-29-2 "2 @ 29" () 29 2) +(dnf f-28-2 "2 @ 28" () 28 2) +(dnf f-27-8 "8 @ 27" () 27 8) +(dnf f-27-4 "4 @ 27" () 27 4) +(dnf f-27-3 "3 @ 27" () 27 3) +(dnf f-27-1 "1 @ 27" () 27 1) +(dnf f-26-21 "21 @ 26" () 26 21) +(dnf f-26-11 "11 @ 26" () 26 11) +(dnf f-26-7 "7 @ 26" () 26 7) +(dnf f-26-5 "5 @ 26" () 26 5) +(dnf f-26-1 "1 @ 26" () 26 1) +(dnf f-25-20 "20 @ 25" () 25 20) +(dnf f-25-6 "6 @ 25" () 25 6) +(dnf f-24-5 "5 @ 24" () 24 5) +(dnf f-23-4 "4 @ 23" () 23 4) +(dnf f-23-1 "1 @ 23" () 23 1) +(dnf f-22-1 "1 @ 22" () 22 1) +(dnf f-21-2 "2 @ 21" () 21 2) +(dnf f-21-1 "1 @ 21" () 21 1) +(dnf f-20-1 "1 @ 20" () 20 1) +(dnf f-19-7 "7 @ 19" () 19 7) +(dnf f-19-6 "6 @ 19" () 19 6) +(dnf f-19-4 "4 @ 19" () 19 4) +(dnf f-19-1 "1 @ 19" () 19 1) +(dnf f-18-5 "5 @ 18" () 18 5) +(dnf f-15-3 "3 @ 15" () 15 3) +(dnf f-15-1 "1 @ 15" () 15 1) +(dnf f-14-2 "2 @ 14" () 14 2) +(dnf f-13-1 "1 @ 13" () 13 1) +(dnf f-12-7 "7 @ 12" () 12 7) +(dnf f-12-1 "1 @ 12" () 12 1) +(dnf f-11-6 "6 @ 11" () 11 6) +(dnf f-11-3 "3 @ 11" () 11 3) +(dnf f-8-3 "3 @ 8" () 8 3) + +;; The extra field for movl +(dnf f-81-41 "41 @ 81" () 81 41) + +;; Virtual fields of the broken up constants. +(dnmf fv-sint8 "i8 for A3 A8 I27 M30" + () INT + + (f-36-1s f-19-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint8) (const 7))) + (set (ifield f-19-7) (and (ifield fv-sint8) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint8) + (or (sll (ifield f-36-1s) (const 7)) + (ifield f-19-7))) + ) +) + +(dnmf fv-sint9a "i9 for M3 M8 M15" + () INT + (f-36-1s f-27-1 f-19-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint9a) (const 8))) + (set (ifield f-27-1) + (and (srl (ifield fv-sint9a) (const 7)) (const 1))) + (set (ifield f-19-7) (and (ifield fv-sint9a) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint9a) + (or (sll (ifield f-36-1s) (const 8)) + (or (sll (ifield f-27-1) (const 7)) + (ifield f-19-7)))) + ) +) + +(dnmf fv-sint9b "i9 for M5 M10" + () INT + (f-36-1s f-27-1 f-12-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint9b) (const 8))) + (set (ifield f-27-1) + (and (srl (ifield fv-sint9b) (const 7)) (const 1))) + (set (ifield f-12-7) (and (ifield fv-sint9b) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint9b) + (or (sll (ifield f-36-1s) (const 8)) + (or (sll (ifield f-27-1) (const 7)) + (ifield f-12-7)))) + ) +) + +(dnmf fv-sint14 "i14 for A4" + () INT + (f-36-1s f-32-6 f-19-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint14) (const 13))) + (set (ifield f-32-6) + (and (srl (ifield fv-sint14) (const 7)) (const #x3f))) + (set (ifield f-19-7) (and (ifield fv-sint14) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint14) + (or (sll (ifield f-36-1s) (const 13)) + (or (sll (ifield f-32-6) (const 7)) + (ifield f-19-7)))) + ) +) + +(dnmf fv-sint17 "mask17 for I23" + () INT + (f-36-1s f-31-8 f-12-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint17) (const 16))) + (set (ifield f-31-8) + (and (srl (ifield fv-sint17) (const 8)) (const #xff))) + (set (ifield f-12-7) + (and (srl (ifield fv-sint17) (const 1)) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint17) + (or (sll (ifield f-36-1s) (const 16)) + (or (sll (ifield f-31-8) (const 8)) + (ifield f-12-7)))) + ) +) + +(dnmf fv-sint22 "i22 for A5" + () INT + (f-36-1s f-35-9 f-26-5 f-19-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint22) (const 21))) + (set (ifield f-26-5) + (and (srl (ifield fv-sint22) (const 16)) (const #x1f))) + (set (ifield f-35-9) + (and (srl (ifield fv-sint22) (const 7)) (const #x1ff))) + (set (ifield f-19-7) (and (ifield fv-sint22) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint22) + (or (or (sll (ifield f-36-1s) (const 21)) + (sll (ifield f-26-5) (const 16))) + (or (sll (ifield f-35-9) (const 7)) + (ifield f-19-7)))) + ) +) + +(dnmf fv-sint44 "i44 for I24" + () INT + (f-36-1s f-32-27) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint44) (const 43))) + (set (ifield f-19-7) + (and (srl (ifield fv-sint44) (const 16)) + (const #x7ffffff))) + ) + (sequence () ; extract + (set (ifield fv-sint44) + (or (sll (ifield f-36-1s) (const 43)) + (sll (ifield f-32-27) (const 16)))) + ) +) + +(dnmf fv-sint64 "i64 for I18" + () INT + (f-81-41 f-36-1s f-35-9 f-26-5 f-21-1 f-19-7) + (sequence () ; insert + (set (ifield f-36-1s) (srl (ifield fv-sint64) (const 63))) + (set (ifield f-81-41) + (and (srl (ifield fv-sint64) (const 22)) + (const #x1fffffffff))) + (set (ifield f-21-1) + (and (srl (ifield fv-sint64) (const 21)) (const 1))) + (set (ifield f-26-5) + (and (srl (ifield fv-sint64) (const 16)) (const #x1f))) + (set (ifield f-35-9) + (and (srl (ifield fv-sint64) (const 7)) (const #x1ff))) + (set (ifield f-19-7) (and (ifield fv-sint64) (const #x7f))) + ) + (sequence () ; extract + (set (ifield fv-sint64) + (or (or (or (sll (ifield f-36-1s) (const 63)) + (sll (ifield f-81-41) (const 22))) + (or (sll (ifield f-21-1) (const 21)) + (sll (ifield f-26-5) (const 16)))) + (or (sll (ifield f-35-9) (const 7)) + (ifield f-19-7)))) + ) +) + +(dnmf fv-uint21 "u21 for I19 M37 F15" + () UINT + (f-36-1 f-25-20) + (sequence () ; insert + (set (ifield f-36-1) (srl (ifield fv-uint21) (const 20))) + (set (ifield f-25-20) (and (ifield fv-uint21) (const #xfffff))) + ) + (sequence () ; extract + (set (ifield fv-uint21) + (or (sll (ifield f-36-1) (const 20)) + (ifield f-25-20))) + ) +) + +(dnmf fv-uint24 "u24 for M44" + () UINT + (f-36-1 f-32-2 f-26-21) + (sequence () ; insert + (set (ifield f-36-1) (srl (ifield fv-uint24) (const 23))) + (set (ifield f-32-1) + (and (srl (ifield fv-uint24) (const 21)) (const 3))) + (set (ifield f-26-21) + (and (ifield fv-uint24) (const #x1fffff))) + ) + (sequence () ; extract + (set (ifield fv-uint24) + (or (sll (ifield f-36-1) (const 23)) + (or (sll (ifield f-32-2) (const 21)) + (ifield f-26-21)))) + ) +) + +(dnmf fv-tgt25a "target25 for I20 M20 M21" + (PCREL-ADDR) INT + (f-36-1s f-32-13 f-12-7) + (sequence () ; insert + ;; ??? Wherefore right shift. + (set (ifield f-36-1s) (srl (ifield fv-tgt25a) (const 20))) + (set (ifield f-32-13) + (and (srl (ifield fv-tgt25a) (const 7)) (const #x1fff))) + (set (ifield f-12-7) (and (ifield fv-tgt25a) (const #x7f))) + ) + (sequence () ; extract + ;; ??? Where will pc be added. + ;; ??? Wherefore left shift. + (set (ifield fv-tgt25a) + (or (sll (ifield f-36-1s) (const 20)) + (or (sll (ifield f-32-13) (const 7)) + (ifield f-12-7)))) + ) +) + +(dnmf fv-tgt25b "target25 for F14" + (PCREL-ADDR) INT + (f-36-1s f-25-20) + (sequence () ; insert + ;; ??? Wherefore right shift. + (set (ifield f-36-1s) (srl (ifield fv-tgt25b) (const 20))) + (set (ifield f-25-20) (and (ifield fv-tgt25b) (const #xfffff))) + ) + (sequence () ; extract + ;; ??? Where will pc be added. + ;; ??? Wherefore left shift. + (set (ifield fv-tgt25b) + (or (sll (ifield f-36-1) (const 20)) + (ifield f-25-20))) + ) +) + +(dnmf fv-tgt25c "target25 for M22 M23 B1 B2 B3 B6" + (PCREL-ADDR) INT + (f-36-1s f-32-20) + (sequence () ; insert + ;; ??? Wherefore right shift. + (set (ifield f-36-1s) (srl (ifield fv-tgt25c) (const 20))) + (set (ifield f-32-20) (and (ifield fv-tgt25c) (const #xfffff))) + ) + (sequence () ; extract + ;; ??? Where will pc be added. + ;; ??? Wherefore left shift. + (set (ifield fv-tgt25c) + (or (sll (ifield f-36-1s) (const 20)) + (ifield f-32-20))) + ) +) + +(dnmf fv-tag13a "tag13 for I21" + (PCREL-ADDR) INT + (f-32-9) + (sequence () ; insert + ;; ??? Wherefore right shift. + (set (ifield f-32-9) (and (ifield fv-tag13a (const #x1ff)))) + ) + (sequence () ; extract + ;; ??? Where will pc be added. + ;; ??? Wherefore left shift. + (set (ifield fv-tag13a) + (sub (xor (ifield f-32-9) (const #x100)) (const #x100))) + ) +) + +(dnmf fv-tag13b "tag13 for B6 B7" + (PCREL-ADDR) INT + (f-34-2 f-12-7) + (sequence () ; insert + ;; ??? Wherefore right shift. + (set (ifield f-34-2) + (and (sll (ifield fv-tag13b) (const 7)) (const 3))) + (set (ifield f-12-7) (and (ifield fv-tag13b) (const #x7f))) + ) + (sequence () ; extract + ;; ??? Where will pc be added. + ;; ??? Wherefore left shift. + (set (ifield fv-tag13a) + (or (sll (sub (xor (ifield f-34-2) (const 2)) + (const 2)) + (const 7)) + (ifield f-12-7))) + ) +) + +(dnmf fv-uint9 "u9 for F5" + () UINT + (f-34-2 f-26-7) + (sequence () ; insert + (set (ifield f-26-7) (srl (ifield fv-uint9) (const 2))) + (set (ifield f-34-2) (and (ifield fv-uint9) (const 3))) + ) + (sequence () ; extract + (set (ifield fv-uint9) + (or (sll (ifield f-26-7) (const 2)) + (ifield f-34-2))) + ) +) + +;; Fields with funny arithmetic + +(df f-count2a "count2 for A2" () 28 2 UINT + ((value pc) (sub WI value (const 1))) + ((value pc) (add WI value (const 1))) +) + +(df f-count2b "count2 for A10" () 28 2 UINT + ((value pc) + (if WI (le value (const 2)) + (sub WI value (const 1)) + (error "invalid value for field count2b"))) + ((value pc) (add WI value (const 1))) +) + +(df f-count2c "count2 for I1" () 31 2 UINT + ((value pc) + (cond WI + ((eq value (const 0)) (const 0)) + ((eq value (const 7)) (const 1)) + ((eq value (const 15)) (const 2)) + ((eq value (const 16)) (const 3)) + (else (error "invalid value for field count2c")))) + ((value pc) + (cond WI + ((eq value (const 0)) (const 0)) + ((eq value (const 1)) (const 7)) + ((eq value (const 2)) (const 15)) + ((eq value (const 3)) (const 16)))) +) + +(df f-ccount5 "ccount5 for I8" () 24 5 UINT + ((value pc) (sub WI (const 31) value)) + ((value pc) (sub WI (const 31) value)) +) + +(df f-len4 "len4 for I15" () 30 4 UINT + ((value pc) (sub WI value (const 1))) + ((value pc) (add WI value (const 1))) +) + +(df f-len6 "len6 for I11 I12 I13 I14" () 32 6 UINT + ((value pc) (sub WI value (const 1))) + ((value pc) (add WI value (const 1))) +) + +(df f-cpos6a "cpos6 for I12 I13" () 25 6 UINT + ((value pc) (sub WI (const 63) value)) + ((value pc) (sub WI (const 63) value)) +) + +(df f-cpos6b "cpos6 for I14" () 19 6 UINT + ((value pc) (sub WI (const 63) value)) + ((value pc) (sub WI (const 63) value)) +) + +(df f-cpos6c "cpos6 for I15" () 36 6 UINT + ((value pc) (sub WI (const 63) value)) + ((value pc) (sub WI (const 63) value)) +) + +(dnmf fv-inc3 "inc3 for M17" () INT + (f-15-1 f-14-2) + (sequence () ; insert + (set (ifield f-15-1) (lt (ifield fv-inc3) (const 0))) + (set (ifield f-14-2) (abs (ifield fv-inc3))) + (set (ifield f-14-2) + (cond ((eq (ifield f-14-2) (const 1)) (const 3)) + ((eq (ifield f-14-2) (const 4)) (const 2)) + ((eq (ifield f-14-2) (const 8)) (const 1)) + ((eq (ifield f-14-2) (const 16)) (const 0)) + (else (error "invalid value for field inc3")))) + ) + (sequence () ; extract + (set (ifield fv-inc3) + (mul (add (mul (neg (ifield f-15-1)) (const 2)) (const 1)) + (if (eq (ifield f-14-2) (const 3)) + (const 1) + (sll (const 1) (sub (const 4) + (ifield f-14-2)))))) + ) +) + +;;; Hardware pieces. +;;; +;;; These entries list the elements of the raw hardware. They're also +;;; used to provide tables and other elements of the assembly language. + +;; The normal h-uint only provides 32 bits of integer. +(dnh h-int64 "64-bit integer" () + (immediate (INT 64)) + () () () +) + +;; ??? Intel calls this if IP, but from experience with the i960 +;; simulator using the name "ip", we know that gdb reacts badly. +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-pmacro (build-decpair num) ((.dec num) num)) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs CACHE-ADDR) + (type register WI (128)) + (indices keyword "r" + (.map build-decpair (.iota 128))) +) + +;; ??? Skip GR NaTs for now, since we're not simulating. + +(define-hardware + (name h-fr) + (comment "floating-point registers") + (type register XF (128)) + (indices keyword "fr" + (.map build-decpair (.iota 128))) +) + +(define-hardware + (name h-br) + (comment "branch registers") + (attrs CACHE-ADDR) + (type register WI (8)) + (indices keyword "br" + (.map build-decpair (.iota 8))) +) + +(define-hardware + (name h-ar) + (comment "application registers") + (type register WI (128)) + (indices keyword "ar" + (.map build-decpair (.iota 128))) +) + +(define-hardware + (name h-pr) + (comment "predicate registers") + (type register BI (64)) + (indices keyword "pr" + (.map build-decpair (.iota 64))) +) + +(define-hardware + (name h-cr) + (comment "control registers") + (type register WI (128)) + (indices keyword "cr" + (.map build-decpair (.iota 128))) +) + +;; ??? CFM, PSR, PMD, CPUID + +;;; Instruction Operands. +;;; +;;; These entries provide a layer between the assembler and the raw +;;; hardware description, and are used to refer to hardware elements +;;; in the semantic code. Usually there's a bit of over-specification, +;;; but in more complicated instruction sets there isn't. + +(dnop qp "qualifying predicate" () h-pr f-qp) + +(dnop r1 "general register 1" () h-gr f-12-7) +(dnop r2 "general register 2" () h-gr f-19-7) +(dnop r3 "general register 3" () h-gr f-26-7) +(dnop r33 "general register 3 for A5" () h-gr f-21-2) + +(dnop f1 "floating-point register 1" () h-fr f-12-7) +(dnop f2 "floating-point register 2" () h-fr f-19-7) +(dnop f3 "floating-point register 3" () h-fr f-26-7) + +(dnop p1 "predicate register 1" () h-pr f-11-6) +(dnop p2 "predicate register 2" () h-pr f-32-6) + +(dnop b1 "branch register 1" () h-br f-8-3) +(dnop b2 "branch register 2" () h-br f-15-3) + +(dnop ar3 "application register 3" () h-ar f-26-7) +(dnop cr3 "control register 3" () h-cr f-26-7) + +(dnop imm1 "imm1 for I14" () h-int64 f-36-1s) +(dnop imm8 "imm8 for A3 A8 I27 M30" () h-int64 fv-sint8) +(dnop imm9a "imm9 for M3 M8 M15" () h-int64 fv-sint9a) +(dnop imm9b "imm9 for M5 M10" () h-int64 fv-sint9b) +(dnop imm14 "imm14 for A4" () h-int64 fv-sint14) +(dnop imm17 "mask17 for I23" () h-int64 fv-sint17) +(dnop imm21 "imm21 for I19" () h-int64 fv-uint21) +(dnop imm22 "imm22 for A5" () h-int64 fv-sint22) +(dnop imm44 "imm44 for I24" () h-int64 fv-sint44) +(dnop imm64 "imm64 for I18" () h-int64 fv-sint64) + +(dnop count2a "count2 for A2" () h-int64 f-count2a) +(dnop count2b "count2 for A10" () h-int64 f-count2b) +(dnop count2c "count2 for I1" () h-int64 f-count2c) +(dnop count5 "count5 for I6" () h-int64 f-18-5) +(dnop count6 "count6 for I10" () h-int64 f-32-6) +(dnop ccount5 "ccount5 for I8" () h-int64 f-ccount5) + +(dnop len4 "len4 for I15" () h-int64 f-len4) +(dnop len6 "len6 for I11 I12 I13 I14" () h-int64 f-len6) + +(dnop pos6 "pos6 for I11" () h-int64 f-19-6) +(dnop cpos6a "cpos6 for I12 I13" () h-int64 f-cpos6a) +(dnop cpos6b "cpos6 for I14" () h-int64 f-cpos6b) +(dnop cpos6c "cpos6 for I15" () h-int64 f-cpos6c) + +(dnop inc3 "inc3 for M17" () h-int64 fv-inc3) + +(define-operand + (name mbtype4) + (comment "mbtype4 type for I3") + (type h-int64) + (index f-23-4) + (handlers (parse "mbtype4") + (print "mbtype4")) +) + +(dnop mhtype8 "mhtype8 for I4" () h-int64 f-27-8) + +(dnop tgt25a "tgt25 for I20 M20 M21" () h-int64 fv-tgt25a) +(dnop tgt25b "tgt25 for F14" () h-int64 fv-tgt25b) +(dnop tgt25c "tgt25 for M22 M23 B1 B2 B3 B6" () h-int64 fv-tgt25c) + +(dnop tag13a "tag13 for I21" () h-int64 fv-tag13a) + +;; Completers + +(define-operand + (name ldhint) + (comment "ldhint completer") + (type h-int64) + (index f-29-2) + (handlers (parse "ldhint") + (print "ldhint")) +) + +(define-operand + (name sthint) + (comment "sthint completer") + (type h-int64) + (index f-29-2) + (handlers (parse "sthint") + (print "sthint")) +) + +(define-operand + (name movbr_mwh) + (comment "mwh completer for mov_br") + (type h-int64) + (index f-21-2) + (handlers (parse "mwh") + (print "mwh")) +) + +(define-operand + (name movbr_ih) + (comment "ih completer for mov_br") + (type h-int64) + (index f-23-1) + (handlers (parse "ih") + (print "ih")) +) + +(define-operand + (name lfhint) + (comment "lfhint for lfetch") + (type h-int64) + (index f-29-2) + (handlers (parse "lfhint") + (print "lfhint")) +) + +(define-operand + (name sorsolsof) + (comment "combined i,l,o,r for alloc") + (type h-int64) + (index f-30-19) + (handlers (parse "sorsolsof") + (print "sorsolsof")) +) + +;; These are architecturally ignored bits, as opposed to architecturally +;; reserved bits. I.e. we should assemble them in with zeros, but we should +;; ignore them when disassembling. + +(dnop ign_36_1 "ignore 1 @ 36" () h-int64 f-36-1) +(dnop ign_32_2 "ignore 2 @ 32" () h-int64 f-32-2) +(dnop ign_32_1 "ignore 1 @ 32" () h-int64 f-32-1) +(dnop ign_29_2 "ignore 2 @ 29" () h-int64 f-29-2) +(dnop ign_27_4 "ignore 4 @ 27" () h-int64 f-27-4) +(dnop ign_27_3 "ignore 3 @ 27" () h-int64 f-27-3) +(dnop ign_27_1 "ignore 1 @ 27" () h-int64 f-27-1) +(dnop ign_26_11 "ignore 11 @ 26" () h-int64 f-26-11) +(dnop ign_26_7 "ignore 7 @ 26" () h-int64 f-26-7) +(dnop ign_26_1 "ignore 1 @ 26" () h-int64 f-26-1) +(dnop ign_23_4 "ignore 4 @ 23" () h-int64 f-23-4) +(dnop ign_19_7 "ignore 7 @ 19" () h-int64 f-19-7) +(dnop ign_19_6 "ignore 6 @ 19" () h-int64 f-19-6) +(dnop ign_19_4 "ignore 4 @ 19" () h-int64 f-19-4) +(dnop ign_19_1 "ignore 1 @ 19" () h-int64 f-19-1) +(dnop ign_13_1 "ignore 1 @ 13" () h-int64 f-13-1) +(dnop ign_12_7 "ignore 7 @ 12" () h-int64 f-12-7) + +;; ??? Add more as needed. + +;;; "A" Format Instruction definitions. + +(define-pmacro (I-A1 mnemonic maybe-p1 op x2a ve x4 x2b) + (dni (.sym mnemonic maybe-p1) + (.str "Integer ALU, reg-reg, " mnemonic maybe-p1) + ((FORMAT A1)) + (.str mnemonic " $r1=$r2,$r3" maybe-p1) + (+ (f-opcode op) (f-35-2 x2a) (f-33-1 ve) (f-32-4 x4) (f-28-2 x2b) + ign_36_1 r3 r2 r1 qp) + () + () + ) +) + +(I-A1 add "" 8 0 0 0 0) +(I-A1 add ",1" 8 0 0 0 1) +(I-A1 sub "" 8 0 0 1 1) +(I-A1 sub ",1" 8 0 0 1 0) +(I-A1 addp4 "" 8 0 0 2 0) +(I-A1 and "" 8 0 0 3 0) +(I-A1 andcm "" 8 0 0 3 1) +(I-A1 or "" 8 0 0 3 2) +(I-A1 xor "" 8 0 0 3 3) + +(define-pmacro (I-A2 mnemonic op x2a ve x4) + (dni mnemonic + (.str "Shift Left and Add, " mnemonic) + ((FORMAT A2)) + (.str mnemonic " $r1=$r2,$count2a,$r3") + (+ (f-opcode op) (f-35-2 x2a) (f-33-1 ve) (f-32-4 x4) + ign_36_1 count2a r3 r2 r1 qp) + () + () + ) +) + +(I-A2 shladd 8 0 0 4) +(I-A2 shladdp4 8 0 0 6) + +(define-pmacro (I-A3 mnemonic op x2a ve x4 x2b) + (dni (.sym mnemonic "i") + (.str "Integer ALU, imm8-reg, " mnemonic) + ((FORMAT A3)) + (.str mnemonic " $r1=$imm8,$r3") + (+ (f-opcode op) (f-35-2 x2a) (f-33-1 ve) (f-32-4 x4) (f-28-2 x2b) + r3 imm8 r1 qp) + () + () + ) +) + +(I-A3 sub 8 0 0 9 1) +(I-A3 and 8 0 0 11 0) +(I-A3 andcm 8 0 0 11 1) +(I-A3 or 8 0 0 11 2) +(I-A3 xor 8 0 0 11 3) + +(define-pmacro (I-A4 mnemonic op x2a ve) + (dni (.str mnemonic "i") + (.str "Add imm14, " mnemonic) + ((FORMAT A4)) + (.str mnemonic " $r1=$imm14,$r3") + (+ (f-opcode op) (f-35-2 x2a) (f-33-1 ve) + r3 imm14 r1 qp) + () + () + ) +) + +(I-A4 adds 8 2 0) +(I-A4 addp4 8 3 0) + +(define-pmacro (I-A5 mnemonic op) + (dni (.str mnemonic) + (.str "Add imm22, " mnemonic) + ((FORMAT A5)) + (.str mnemonic " $r1=$imm22,$r33") + (+ (f-opcode op) imm22 r33 r1 qp) + () + () + ) +) + +(I-A5 addl 9) + +(define-pmacro (I-A6 mnemonic ctype-attr op x2 tb ta c) + (dni (.sym mnemonic) + (.str "Integer Compare, reg-reg, " mnemonic) + ((FORMAT A6) (FIELD-CTYPE ctype-attr)) + (.str mnemonic " $p1,$p2=$r2,$r3") + (+ (f-opcode op) (f-36-1 tb) (f-35-2 x2) (f-33-1 ta) (f-12-1 c) + p2 r3 r2 p1 qp) + () + () + ) +) + +(define-pmacro (I-A6-cmp-cond-ctype cmp cond ctype op x2 ta c) + (I-A6 (.sym cmp "." cond + (.eval (if (eq? (string-length ctype) 0) "" ".")) + ctype) + (.eval (if (eq? (string-length ctype) 0) 'NONE (string->symbol ctype))) + op 0 x2 ta c) +) + +(define-pmacro (I-A6-cmp cmp x2) + (begin + (I-A6-cmp-cond-ctype cmp lt "" 12 x2 0 0) + (I-A6-cmp-cond-ctype cmp ltu "" 13 x2 0 0) + (I-A6-cmp-cond-ctype cmp eq "" 14 x2 0 0) + + (I-A6-cmp-cond-ctype cmp lt "unc" 12 x2 0 1) + (I-A6-cmp-cond-ctype cmp ltu "unc" 13 x2 0 1) + (I-A6-cmp-cond-ctype cmp eq "unc" 14 x2 0 1) + + (I-A6-cmp-cond-ctype cmp eq "and" 12 x2 1 0) + (I-A6-cmp-cond-ctype cmp eq "or" 13 x2 1 0) + (I-A6-cmp-cond-ctype cmp eq "or.andcm" 14 x2 1 0) + + (I-A6-cmp-cond-ctype cmp ne "and" 12 x2 1 1) + (I-A6-cmp-cond-ctype cmp ne "or" 13 x2 1 1) + (I-A6-cmp-cond-ctype cmp ne "or.andcm" 14 x2 1 1) + ) +) + +(I-A6-cmp cmp 0) +(I-A6-cmp cmp4 1) + +(define-pmacro (I-A7 mnemonic ctype-attr op x2 tb ta c) + (dni (.sym mnemonic) + (.str "Integer Compare, zero-reg, " mnemonic) + ((FORMAT A7) (FIELD-CTYPE ctype-attr)) + (.str mnemonic " $p1,$p2=r0,$r3") + (+ (f-opcode op) (f-36-1 tb) (f-35-2 x2) (f-33-1 ta) (f-12-1 c) + p2 r3 (f-19-7 0) p1 qp) + () + () + ) +) + +(define-pmacro (I-A7-cmp-cond-ctype cmp cond ctype op x2 ta c) + (I-A7 (.sym cmp "." cond "." ctype) (.sym ctype) op x2 1 ta c) +) + +(define-pmacro (I-A7-cmp-cond cmp cond x2 ta c) + (begin + (I-A7-cmp-cond-ctype cmp cond and 12 x2 ta c) + (I-A7-cmp-cond-ctype cmp cond or 13 x2 ta c) + (I-A7-cmp-cond-ctype cmp cond andcm 14 x2 ta c) + ) +) + +(define-pmacro (I-A7-cmp cmp x2) + (begin + (I-A7-cmp-cond cmp gt x2 0 0) + (I-A7-cmp-cond cmp le x2 0 1) + (I-A7-cmp-cond cmp ge x2 1 0) + (I-A7-cmp-cond cmp lt x2 1 1) + ) +) + +(I-A7-cmp cmp 0) +(I-A7-cmp cmp4 1) + +(define-pmacro (I-A8 mnemonic ctype-attr op x2 ta c) + (dni (.sym mnemonic) + (.str "Integer Compare, imm8-reg, " mnemonic) + ((FORMAT A7) (FIELD-CTYPE ctype-attr)) + (.str mnemonic " $p1,$p2=$imm8,$r3") + (+ (f-opcode op) (f-35-2 x2) (f-33-1 ta) (f-12-1 c) + p2 r3 imm8 p1 qp) + () + () + ) +) + +(define-pmacro (I-A8-cmp-cond-ctype cmp cond ctype op x2 ta c) + (I-A8 (.sym cmp "." cond + (.eval (if (eq? (string-length ctype) 0) "" ".")) + ctype) + (.eval (if (eq? (string-length ctype) 0) 'NONE (string->symbol ctype))) + op x2 ta c) +) + +(define-pmacro (I-A8-cmp cmp x2) + (begin + (I-A8-cmp-cond-ctype cmp lt "" 12 x2 0 0) + (I-A8-cmp-cond-ctype cmp ltu "" 13 x2 0 0) + (I-A8-cmp-cond-ctype cmp eq "" 14 x2 0 0) + + (I-A8-cmp-cond-ctype cmp lt "unc" 12 x2 0 1) + (I-A8-cmp-cond-ctype cmp ltu "unc" 13 x2 0 1) + (I-A8-cmp-cond-ctype cmp eq "unc" 14 x2 0 1) + + (I-A8-cmp-cond-ctype cmp eq "and" 12 x2 1 0) + (I-A8-cmp-cond-ctype cmp eq "or" 12 x2 1 0) + (I-A8-cmp-cond-ctype cmp eq "or.andcm" 12 x2 1 0) + + (I-A8-cmp-cond-ctype cmp ne "and" 12 x2 1 1) + (I-A8-cmp-cond-ctype cmp ne "or" 12 x2 1 1) + (I-A8-cmp-cond-ctype cmp ne "or.andcm" 12 x2 1 1) + ) +) + +(I-A8-cmp cmp 2) +(I-A8-cmp cmp4 3) + +(define-pmacro (I-A9 mnemonic op x2a za zb x4 x2b) + (dni (.str mnemonic) + (.str "Multimetia ALU, " mnemonic) + ((FORMAT A9)) + (.str mnemonic " $r1=$r2,$r3") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-4 x4) + (f-28-2 x2b) r3 r2 r1 qp) + () + () + ) +) + +(I-A9 padd1 8 1 0 0 0 0) +(I-A9 padd2 8 1 0 1 0 0) +(I-A9 padd4 8 1 1 0 0 0) +(I-A9 padd1.sss 8 1 0 0 0 1) +(I-A9 padd2.sss 8 1 0 1 0 1) +(I-A9 padd1.uuu 8 1 0 0 0 2) +(I-A9 padd2.uuu 8 1 0 1 0 2) +(I-A9 padd1.uus 8 1 0 0 0 3) +(I-A9 padd2.uus 8 1 0 1 0 3) + +(I-A9 psub1 8 1 0 0 1 0) +(I-A9 psub2 8 1 0 1 1 0) +(I-A9 psub4 8 1 1 0 1 0) +(I-A9 psub1.sss 8 1 0 0 1 1) +(I-A9 psub2.sss 8 1 0 1 1 1) +(I-A9 psub1.uuu 8 1 0 0 1 2) +(I-A9 psub2.uuu 8 1 0 1 1 2) +(I-A9 psub1.uus 8 1 0 0 1 3) +(I-A9 psub2.uus 8 1 0 1 1 3) + +(I-A9 pavg1 8 1 0 0 2 2) +(I-A9 pavg2 8 1 0 1 2 2) +(I-A9 pavg1.raz 8 1 0 0 2 3) +(I-A9 pavg2.raz 8 1 0 1 2 3) + +(I-A9 pavgsub1 8 1 0 0 3 2) +(I-A9 pavgsub2 8 1 0 1 3 2) + +(I-A9 pcmp1.eq 8 1 0 0 9 0) +(I-A9 pcmp2.eq 8 1 0 1 9 0) +(I-A9 pcmp4.eq 8 1 1 0 9 0) +(I-A9 pcmp1.gt 8 1 0 0 9 1) +(I-A9 pcmp2.gt 8 1 0 1 9 1) +(I-A9 pcmp4.gt 8 1 1 0 9 1) + +(define-pmacro (I-A10 mnemonic op x2a za zb x4) + (dni mnemonic + (.str "Multimedia Shift and Add, " mnemonic) + ((FORMAT A10)) + (.str mnemonic " $r1=$r2,$count2b,$r3") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-4 x4) + count2b r3 r2 r1 qp) + () + () + ) +) + +(I-A10 pshladd2 8 1 0 1 4) +(I-A10 pshradd2 8 1 0 1 6) + +;;; "I" Format Instruction definitions. + +(define-pmacro (I-I1 mnemonic op za zb ve x2a x2b) + (dni mnemonic + (.str "Multimedia Multiply and Shift, " mnemonic) + ((FORMAT I1)) + (.str mnemonic " $r1=$r2,$r3,$count2c") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-29-2 x2b) count2c ign_27_1 r3 r2 r1 qp) + () + () + ) +) + +(I-I1 pmpyshr2 7 0 1 0 0 3) +(I-I1 pmpyshr2.u 7 0 1 0 0 1) + +(define-pmacro (I-I2 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Multimedia Multiply/Mix/Pack/Unpack, " mnemonic) + ((FORMAT I2)) + (.str mnemonic " $r1=$r2,$r3") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_1 r3 r2 r1 qp) + () + () + ) +) + +(I-I2 pmpy2.r 7 0 1 0 2 1 3) +(I-I2 pmpy2.l 7 0 1 0 2 3 3) + +(I-I2 mix1.r 7 0 0 0 2 0 2) +(I-I2 mix2.r 7 0 1 0 2 0 2) +(I-I2 mix4.r 7 1 0 0 2 0 2) +(I-I2 mix1.l 7 0 0 0 2 2 2) +(I-I2 mix2.l 7 0 1 0 2 2 2) +(I-I2 mix4.l 7 1 0 0 2 2 2) + +(I-I2 pack2.uss 7 0 1 0 2 0 0) +(I-I2 pack2.sss 7 0 1 0 2 2 0) +(I-I2 pack4.sss 7 1 0 0 2 2 0) + +(I-I2 unpack1.h 7 0 0 0 2 0 1) +(I-I2 unpack2.h 7 0 1 0 2 0 1) +(I-I2 unpack4.h 7 1 0 0 2 0 1) +(I-I2 unpack1.l 7 0 0 0 2 2 1) +(I-I2 unpack2.l 7 0 1 0 2 2 1) +(I-I2 unpack4.l 7 1 0 0 2 2 1) + +(I-I2 pmin1.u 7 0 0 0 2 1 0) +(I-I2 pmax1.u 7 0 0 0 2 1 1) +(I-I2 pmin2 7 0 1 0 2 3 0) +(I-I2 pmax2 7 0 1 0 2 3 1) + +(I-I2 psad1 7 0 0 0 2 3 2) + +(define-pmacro (I-I3 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Multimedia Mux1, " mnemonic) + ((FORMAT I3)) + (.str mnemonic " $r1=$r2,$mbtype4") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_4 mbtype4 r2 r1 qp) + () + () + ) +) + +(I-I3 mux1 7 0 0 0 3 2 2) + +(define-pmacro (I-I4 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Multimedia Mux2, " mnemonic) + ((FORMAT I4)) + (.str mnemonic " $r1=$r2,$mhtype8") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) mhtype8 r2 r1 qp) + () + () + ) +) + +(I-I4 mux2 7 0 1 0 3 2 2) + +(define-pmacro (I-I5 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Shift Right, variable, " mnemonic) + ((FORMAT I5)) + (.str mnemonic " $r1=$r3,$r2") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_1 r3 r2 r1 qp) + () + () + ) +) + +(I-I5 pshr2 7 0 1 0 0 2 0) +(I-I5 pshr4 7 1 0 0 0 2 0) +(I-I5 shr 7 1 1 0 0 2 0) + +(I-I5 pshr2.u 7 0 1 0 0 0 0) +(I-I5 pshr4.u 7 1 0 0 0 0 0) +(I-I5 shr.u 7 1 1 0 0 0 0) + +(define-pmacro (I-I6 mnemonic op za zb ve x2a x2b x2c) + (dni (.sym mnemonic "i") + (.str "Shift Right, fixed, " mnemonic) + ((FORMAT I6)) + (.str mnemonic " $r1=$r3,$count5") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_1 r3 ign_19_1 count5 ign_13_1 + r1 qp) + () + () + ) +) + +(I-I6 pshr2 7 0 1 0 1 3 0) +(I-I6 pshr4 7 1 0 0 1 3 0) +(I-I6 pshr2.u 7 0 1 0 1 1 0) +(I-I6 pshr4.u 7 1 0 0 1 1 0) + +(define-pmacro (I-I7 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Shift Left, variable, " mnemonic) + ((FORMAT I7)) + (.str mnemonic " $r1=$r2,$r3") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_1 r3 r2 r1 qp) + () + () + ) +) + +(I-I7 pshl2 7 0 1 0 0 0 1) +(I-I7 pshl4 7 1 0 0 0 0 1) +(I-I7 shl 7 1 1 0 0 0 1) + +(define-pmacro (I-I8 mnemonic op za zb ve x2a x2b x2c) + (dni (.sym mnemonic "i") + (.str "Shift Left, fixed, " mnemonic) + ((FORMAT I8)) + (.str mnemonic " $r1=$r2,$ccount5") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_3 ccount5 r2 r1 qp) + () + () + ) +) + +(I-I8 pshl2 7 0 1 0 0 0 1) +(I-I8 pshl4 7 1 0 0 0 0 1) + +(define-pmacro (I-I9 mnemonic op za zb ve x2a x2b x2c) + (dni mnemonic + (.str "Population Count, " mnemonic) + ((FORMAT I9)) + (.str mnemonic " $r1=$r3") + (+ (f-opcode op) (f-36-1 za) (f-35-2 x2a) (f-33-1 zb) (f-32-1 ve) + (f-31-2 x2c) (f-29-2 x2b) ign_27_1 r3 (f-19-7 0) r1 qp) + () + () + ) +) + +(I-I9 popcnt 7 0 1 0 1 1 2) + +(define-pmacro (I-I10 mnemonic op x2 x) + (dni mnemonic + (.str "Shift Right Pair, " mnemonic) + ((FORMAT I10)) + (.str mnemonic " $r1=$r2,$r3,$count6") + (+ (f-opcode op) ign_36_1 (f-35-2 x2) (f-33-1 x) count6 r3 r2 r1 qp) + () + () + ) +) + +(I-I10 shrp 5 3 0) + +(define-pmacro (I-I11 mnemonic op x2 x y) + (dni mnemonic + (.str "Extract, " mnemonic) + ((FORMAT I11)) + (.str mnemonic " $r1=$r3,$pos6,$len6") + (+ (f-opcode op) ign_36_1 (f-35-2 x2) (f-33-1 x) (f-13-1 y) + r3 pos6 len6 r1 qp) + () + () + ) +) + +(I-I11 extr.u 5 1 0 0) +(I-I11 extr 5 1 0 1) + +(define-pmacro (I-I12 mnemonic op x2 x y) + (dni mnemonic + (.str "Zero and Deposit, " mnemonic) + ((FORMAT I12)) + (.str mnemonic " $r1=$r2,$cpos6a,$len6") + (+ (f-opcode op) ign_36_1 (f-35-2 x2) (f-33-1 x) (f-26-1 y) + r2 cpos6a len6 r1 qp) + () + () + ) +) + +(I-I12 dep.z 5 1 1 0) + +(define-pmacro (I-I13 mnemonic op x2 x y) + (dni (.sym mnemonic "i") + (.str "Zero and Deposit Immediate, " mnemonic) + ((FORMAT I13)) + (.str mnemonic " $r1=$imm8,$cpos6a,$len6") + (+ (f-opcode op) (f-35-2 x2) (f-33-1 x) (f-26-1 y) + imm8 cpos6a len6 r1 qp) + () + () + ) +) + +(I-I13 dep.z 5 1 1 0) + +(define-pmacro (I-I14 mnemonic op x2 x) + (dni (.sym mnemonic "i") + (.str "Deposit Immediate, " mnemonic) + ((FORMAT I14)) + (.str mnemonic " $r1=$imm1,$r3,$cpos6b,$len6") + (+ (f-opcode op) (f-35-2 x2) (f-33-1 x) ign_13_1 + imm1 r3 cpos6b len6 r1 qp) + () + () + ) +) + +(I-I14 dep 5 3 1) + +(define-pmacro (I-I15 mnemonic op) + (dni mnemonic + (.str "Deposit, " mnemonic) + ((FORMAT I15)) + (.str mnemonic " $r1=$r2,$r3,$cpos6c,$len4") + (+ (f-opcode op) cpos6c len4 r2 r3 r1 qp) + () + () + ) +) + +(I-I15 dep 4) + +(define-pmacro (I-I16 mnemonic ctype-attr op x2 ta tb y c) + (dni mnemonic + (.str "Test Bit, " mnemonic) + ((FORMAT I16) (FIELD-CTYPE ctype-attr)) + (.str mnemonic " $p1,$p2=$r3,$pos6") + (+ (f-opcode op) (f-36-1 tb) (f-35-2 x2) (f-33-1 ta) (f-13-1 y) + (f-12-1 c) p2 r3 pos6 p1 qp) + () + () + ) +) + +(define-pmacro (I-I16-ctype mnemonic ctype op x2 ta tb y c) + (I-I16 (.sym mnemonic + (.eval (if (eq? (string-length ctype) 0) "" ".")) + ctype) + (.eval (if (eq? (string-length ctype) 0) 'NONE + (string->symbol ctype))) + op x2 ta tb y c) +) + +(I-I16-ctype tbit.z "" 5 0 0 0 0 0) +(I-I16-ctype tbit.z "unc" 5 0 0 0 0 1) +(I-I16-ctype tbit.z "and" 5 0 0 1 0 0) +(I-I16-ctype tbit.nz "and" 5 0 0 1 0 1) +(I-I16-ctype tbit.z "or" 5 0 1 0 0 0) +(I-I16-ctype tbit.nz "or" 5 0 1 0 0 1) +(I-I16-ctype tbit.z "or.andcm" 5 0 1 1 0 0) +(I-I16-ctype tbit.nz "or.andcm" 5 0 1 1 0 1) + +(define-pmacro (I-I17 mnemonic ctype-attr op x2 ta tb y c) + (dni mnemonic + (.str "Test Bit, " mnemonic) + ((FORMAT I17) (FIELD-CTYPE ctype-attr)) + (.str mnemonic " $p1,$p2=$r3") + (+ (f-opcode op) (f-36-1 tb) (f-35-2 x2) (f-33-1 ta) (f-13-1 y) + (f-12-1 c) p2 r3 ign_19_6 p1 qp) + () + () + ) +) + +(define-pmacro (I-I17-ctype mnemonic ctype op x2 ta tb y c) + (I-I17 (.sym mnemonic + (.eval (if (eq? (string-length ctype) 0) "" ".")) + ctype) + (.eval (if (eq? (string-length ctype) 0) 'NONE + (string->symbol ctype))) + op x2 ta tb y c) +) + +(I-I17-ctype tnat.z "" 5 0 0 0 0 0) +(I-I17-ctype tnat.z "unc" 5 0 0 0 0 1) +(I-I17-ctype tnat.z "and" 5 0 0 1 0 0) +(I-I17-ctype tnat.nz "and" 5 0 0 1 0 1) +(I-I17-ctype tnat.z "or" 5 0 1 0 0 0) +(I-I17-ctype tnat.nz "or" 5 0 1 0 0 1) +(I-I17-ctype tnat.z "or.andcm" 5 0 1 1 0 0) +(I-I17-ctype tnat.nz "or.andcm" 5 0 1 1 0 1) + +(define-pmacro (I-I18 mnemonic op vc) + (dni mnemonic + (.str "Move Long Immediate, " mnemonic) + ((FORMAT I18)) + (.str mnemonic " $r1=$imm64") + (+ (f-opcode op) (f-20-1 vc) r1 imm64 qp) + () + () + ) +) + +(I-I18 movl 6 0) + +(define-pmacro (I-I19 mnemonic op x3 x6) + (dni mnemonic + (.str "Break/Nop, " mnemonic) + ((FORMAT I19)) + (.str mnemonic " $imm21") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_26_1 imm21 qp) + () + () + ) +) + +(I-I19 break.i 0 0 0) +(I-I19 nop.i 0 0 1) + +(define-pmacro (I-I20 mnemonic op x3) + (dni mnemonic + (.str "Integer Speculation Check, " mnemonic) + ((FORMAT I20)) + (.str mnemonic " $r2,$tgt25a") + (+ (f-opcode op) (f-35-3 x3) tgt25a r2 qp) + () + () + ) +) + +(I-I20 chk.s.i 0 1) + +(define-pmacro (I-I21 mnemonic op x3 x) + (dni (.sym mnemonic _tbr) + (.str "Move to BR, " mnemonic) + ((FORMAT I21)) + (.str mnemonic + "$movbr_mwh$movbr_ih $b1=$r2,$tag13a") + (+ (f-opcode op) (f-35-3 x3) movbr_ih (f-22-1 x) movbr_mwh + (f-12-1 x) (f-11-3 x3) ign_36_1 b1 r2 tag13a qp) + () + () + ) +) + +(I-I21 mov 0 7 0) +(I-I21 mov.ret 0 7 1) + +(define-pmacro (I-I22 mnemonic op x3 x6) + (dni (.sym mnemonic _fbr) + (.str "Move from BR, " mnemonic) + ((FORMAT I22)) + (.str mnemonic " $r1=$b2") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 ign_26_11 + r1 b2 qp) + () + () + ) +) + +(I-I22 mov 0 0 #x31) + +(define-pmacro (I-I23 mnemonic op x3) + (dni (.sym mnemonic _tpr) + (.str "Move to PR, reg, " mnemonic) + ((FORMAT I23)) + (.str mnemonic " pr=$r2,$imm17") + (+ (f-opcode op) (f-35-3 x3) ign_32_1 ign_23_4 r2 imm17 qp) + () + () + ) +) + +(I-I23 mov 0 3) + +(define-pmacro (I-I24 mnemonic op x3) + (dni (.sym mnemonic _tpri) + (.str "Move to PR, imm, " mnemonic) + ((FORMAT I24)) + (.str mnemonic " pr.rot=$imm44") + (+ (f-opcode op) (f-35-3 x3) imm44 qp) + () + () + ) +) + +(I-I24 mov 0 2) + +(define-pmacro (I-I25 mnemonic src op x3 x6) + (dni (.sym mnemonic _f src) + (.str "Move from Pred/IP, " mnemonic) + ((FORMAT I25)) + (.str mnemonic " $r1=" src) + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_26_7 ign_19_7 r1 qp) + () + () + ) +) + +(I-I25 mov ip 0 0 #x30) +(I-I25 mov pr 0 0 #x33) + +(define-pmacro (I-I26 mnemonic op x3 x6) + (dni (.sym mnemonic _tar) + (.str "Move to AR, reg, " mnemonic) + ((FORMAT I26)) + (.str mnemonic " $ar3=$r2") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 ign_12_7 ar3 r2 qp) + () + () + ) +) + +(I-I26 mov.i 0 0 #x2A) + +(define-pmacro (I-I27 mnemonic op x3 x6) + (dni (.sym mnemonic _tari) + (.str "Move to AR, imm, " mnemonic) + ((FORMAT I27)) + (.str mnemonic " $ar3=$imm8") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_12_7 ar3 imm8 qp) + () + () + ) +) + +(I-I27 mov.i 0 0 #x0A) + +(define-pmacro (I-I28 mnemonic op x3 x6) + (dni (.sym mnemonic _far) + (.str "Move from AR, " mnemonic) + ((FORMAT I28)) + (.str mnemonic " $r1=$ar3") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 ign_19_7 ar3 r1 qp) + () + () + ) +) + +(I-I28 mov.i 0 0 #x32) + +(define-pmacro (I-I29 mnemonic op x3 x6) + (dni mnemonic + (.str "Sign/Zero Extend/Compute Zero Index, " mnemonic) + ((FORMAT I29)) + (.str mnemonic " $r1=$r3") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 ign_19_7 r3 r1 qp) + () + () + ) +) + +(I-I29 zxt1 0 0 #x10) +(I-I29 zxt2 0 0 #x11) +(I-I29 zxt4 0 0 #x12) + +(I-I29 sxt1 0 0 #x14) +(I-I29 sxt2 0 0 #x15) +(I-I29 sxt4 0 0 #x16) + +(I-I29 czx1.l 0 0 #x18) +(I-I29 czx2.l 0 0 #x19) +(I-I29 czx1.r 0 0 #x1C) +(I-I29 czx2.r 0 0 #x1D) + +;;; "M" Format Instruction definitions. + +(define-pmacro (apply-ildspec macro mnemonic x6-2) + (begin + (.apply macro (.splice mnemonic x6-2)) + (.apply macro (.splice (.sym mnemonic .s) (.eval (+ x6-2 #x04)))) + (.apply macro (.splice (.sym mnemonic .a) (.eval (+ x6-2 #x08)))) + (.apply macro (.splice (.sym mnemonic .sa) (.eval (+ x6-2 #x0C)))) + (.apply macro (.splice (.sym mnemonic .bias) (.eval (+ x6-2 #x10)))) + (.apply macro (.splice (.sym mnemonic .acq) (.eval (+ x6-2 #x14)))) + (.apply macro (.splice (.sym mnemonic .c.clr) (.eval (+ x6-2 #x20)))) + (.apply macro (.splice (.sym mnemonic .c.nc) (.eval (+ x6-2 #x24)))) + (.apply macro (.splice (.sym mnemonic .c.clr.acq) (.eval (+ x6-2 #x28)))) + ) +) + +(define-pmacro (I-M1 mnemonic op m x x6) + (dni mnemonic + (.str "Integer Load, " mnemonic) + ((FORMAT M1)) + (.str mnemonic "$ldhint $r1=[$r3]") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 r1 ign_19_7 qp) + () + () + ) +) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M1 mnemonic 4 0 0 x6)) + ld1 0) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M1 mnemonic 4 0 0 x6)) + ld2 1) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M1 mnemonic 4 0 0 x6)) + ld4 2) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M1 mnemonic 4 0 0 x6)) + ld8 3) + +(I-M1 ld8.fill 4 0 0 #x1B) + +(define-pmacro (I-M2 mnemonic op m x x6) + (dni (.sym mnemonic .ir) + (.str "Integer Load, incr reg, " mnemonic) + ((FORMAT M2)) + (.str mnemonic "$ldhint $r1=[$r3],$r2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 r2 r1 qp) + () + () + ) +) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M2 mnemonic 4 1 0 x6)) + ld1 0) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M2 mnemonic 4 1 0 x6)) + ld2 1) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M2 mnemonic 4 1 0 x6)) + ld4 2) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M2 mnemonic 4 1 0 x6)) + ld8 3) + +(I-M2 ld8.fill 4 1 0 #x1B) + +(define-pmacro (I-M3 mnemonic op x6) + (dni (.sym mnemonic .ii) + (.str "Integer Load, incr imm, " mnemonic) + ((FORMAT M3)) + (.str mnemonic "$ldhint $r1=[$r3],$imm9a") + (+ (f-opcode op) (f-35-6 x6) ldhint r3 imm9a r1 qp) + () + () + ) +) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M3 mnemonic 5 x6)) + ld1 0) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M3 mnemonic 5 x6)) + ld2 1) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M3 mnemonic 5 x6)) + ld4 2) + +(apply-ildspec + (.pmacro (mnemonic x6) + (I-M3 mnemonic 5 x6)) + ld8 3) + +(I-M3 ld8.fill 5 #x1B) + +(define-pmacro (apply-istspec macro mnemonic x6-2) + (begin + (.apply macro (.splice mnemonic x6-2)) + (.apply macro (.splice (.sym mnemonic .rel) (.eval (+ x6-2 #x04)))) + ) +) + +(define-pmacro (I-M4 mnemonic op m x x6) + (dni mnemonic + (.str "Integer Store, " mnemonic) + ((FORMAT M4)) + (.str mnemonic "$sthint [$r3]=$r2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + sthint r3 r2 ign_12_7 qp) + () + () + ) +) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M4 mnemonic 4 0 0 x6)) + st1 #x30) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M4 mnemonic 4 0 0 x6)) + st2 #x31) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M4 mnemonic 4 0 0 x6)) + st4 #x32) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M4 mnemonic 4 0 0 x6)) + st8 #x33) + +(I-M4 st8.spill 4 0 0 #x3B) + +(define-pmacro (I-M5 mnemonic op x6) + (dni (.sym mnemonic .ii) + (.str "Integer Store, incr imm, " mnemonic) + ((FORMAT M5)) + (.str mnemonic "$sthint [$r3]=$r2,$imm9b") + (+ (f-opcode op) (f-35-6 x6) sthint r3 imm9b r2 qp) + () + () + ) +) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M5 mnemonic 5 x6)) + st1 #x30) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M5 mnemonic 5 x6)) + st2 #x31) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M5 mnemonic 5 x6)) + st4 #x32) + +(apply-istspec + (.pmacro (mnemonic x6) + (I-M5 mnemonic 5 x6)) + st8 #x33) + +(I-M5 st8.spill 5 #x3B) + +(define-pmacro (apply-fldspec macro mnemonic x6-2) + (begin + (.apply macro (.splice mnemonic x6-2)) + (.apply macro (.splice (.sym mnemonic .s) (.eval (+ x6-2 #x04)))) + (.apply macro (.splice (.sym mnemonic .a) (.eval (+ x6-2 #x08)))) + (.apply macro (.splice (.sym mnemonic .sa) (.eval (+ x6-2 #x0C)))) + (.apply macro (.splice (.sym mnemonic .c.clr) (.eval (+ x6-2 #x20)))) + (.apply macro (.splice (.sym mnemonic .c.nc) (.eval (+ x6-2 #x24)))) + ) +) + +(define-pmacro (I-M6 mnemonic op m x x6) + (dni mnemonic + (.str "Floating-point Load, " mnemonic) + ((FORMAT M6)) + (.str mnemonic "$ldhint $f1=[$r3]") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 f1 ign_19_7 qp) + () + () + ) +) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M6 mnemonic 6 0 0 x6)) + ldfs 2) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M6 mnemonic 6 0 0 x6)) + ldfd 3) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M6 mnemonic 6 0 0 x6)) + ldf8 1) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M6 mnemonic 6 0 0 x6)) + ldfe 0) + +(I-M6 ldf.fill 6 0 0 #x1B) + +(define-pmacro (I-M7 mnemonic op m x x6) + (dni (.sym mnemonic .ir) + (.str "Floating-point Load, incr reg, " mnemonic) + ((FORMAT M7)) + (.str mnemonic "$ldhint $f1=[$r3],$r2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 r2 f1 qp) + () + () + ) +) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M7 mnemonic 6 1 0 x6)) + ldfs 2) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M7 mnemonic 6 1 0 x6)) + ldfd 3) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M7 mnemonic 6 1 0 x6)) + ldf8 1) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M7 mnemonic 6 1 0 x6)) + ldfe 0) + +(I-M7 ldf.fill 6 1 0 #x1B) + +(define-pmacro (I-M8 mnemonic op x6) + (dni (.sym mnemonic .ii) + (.str "Floating-point Load, incr imm, " mnemonic) + ((FORMAT M8)) + (.str mnemonic "$ldhint $f1=[$r3],$imm9a") + (+ (f-opcode op) (f-35-6 x6) ldhint r3 imm9a f1 qp) + () + () + ) +) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M8 mnemonic 7 x6)) + ldfs 2) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M8 mnemonic 7 x6)) + ldfd 3) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M8 mnemonic 7 x6)) + ldf8 1) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M8 mnemonic 7 x6)) + ldfe 0) + +(I-M8 ldf.fill 7 #x1B) + +(define-pmacro (I-M9 mnemonic op m x x6) + (dni mnemonic + (.str "Floating-point Store, " mnemonic) + ((FORMAT M9)) + (.str mnemonic "$sthint [$r3]=$f2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + sthint r3 f2 ign_12_7 qp) + () + () + ) +) + +(I-M9 stfs 6 0 0 #x32) +(I-M9 stfd 6 0 0 #x33) +(I-M9 stf8 6 0 0 #x31) +(I-M9 stfe 6 0 0 #x30) +(I-M9 stf.spill 6 0 0 #x3B) + +(define-pmacro (I-M10 mnemonic op x6) + (dni (.sym mnemonic .ii) + (.str "Floating-point Store, incr imm, " mnemonic) + ((FORMAT M10)) + (.str mnemonic "$sthint [$r3]=$f2,$imm9b") + (+ (f-opcode op) (f-35-6 x6) sthint r3 imm9b f2 qp) + () + () + ) +) + +(I-M10 stfs 7 #x32) +(I-M10 stfd 7 #x33) +(I-M10 stf8 7 #x31) +(I-M10 stfe 7 #x30) +(I-M10 stf.spill 7 #x3B) + +(define-pmacro (I-M11 mnemonic op m x x6) + (dni mnemonic + (.str "Floating-point Load Pair, " mnemonic) + ((FORMAT M11)) + (.str mnemonic "$ldhint $f1,$f2=[$r3]") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 f1 f2 qp) + () + () + ) +) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M11 mnemonic 6 0 1 x6)) + ldfps 2) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M11 mnemonic 6 0 1 x6)) + ldfpd 3) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M11 mnemonic 6 0 1 x6)) + ldfp8 1) + +(define-pmacro (I-M12 mnemonic n op m x x6) + (dni mnemonic + (.str "Floating-point Load Pair, incr imm, " mnemonic) + ((FORMAT M12)) + (.str mnemonic "$ldhint $f1,$f2=[$r3]," n) + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) ldhint (f-27-1 x) + r3 f1 f2 qp) + () + () + ) +) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M12 mnemonic 8 6 1 1 x6)) + ldfps 2) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M12 mnemonic 16 6 1 1 x6)) + ldfpd 3) + +(apply-fldspec + (.pmacro (mnemonic x6) + (I-M12 mnemonic 16 6 1 1 x6)) + ldfp8 1) + +(define-pmacro (apply-lftype macro mnemonic) + (begin + (.apply macro (.splice mnemonic NONE #x2C)) + (.apply macro (.splice (.sym mnemonic .excl) NONE #x2D)) + (.apply macro (.splice (.sym mnemonic .fault) fault #x2E)) + (.apply macro (.splice (.sym mnemonic .fault.excl) fault #x2F)) + ) +) + +(define-pmacro (I-M13 mnemonic fault-attr op m x x6) + (dni (.sym mnemonic) + (.str "Line Prefetch, " mnemonic) + ((FORMAT M13) (FIELD-LFTYPE fault-attr)) + (.str mnemonic "$lfhint [$r3]") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) lfhint (f-27-1 x) + r3 ign_19_7 ign_12_7 qp) + () + () + ) +) + +(apply-lftype + (.pmacro (mnemonic fault-attr x6) + (I-M13 mnemonic fault-attr 6 0 0 x6)) + lfetch) + +(define-pmacro (I-M14 mnemonic fault-attr op m x x6) + (dni (.sym mnemonic .ir) + (.str "Line Prefetch, incr reg" mnemonic) + ((FORMAT M14) (FIELD-LFTYPE fault-attr)) + (.str mnemonic "$lfhint [$r3],$r2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) lfhint (f-27-1 x) + r3 r2 ign_12_7 qp) + () + () + ) +) + +(apply-lftype + (.pmacro (mnemonic fault-attr x6) + (I-M14 mnemonic fault-attr 6 0 0 x6)) + lfetch) + +(define-pmacro (I-M15 mnemonic fault-attr op x6) + (dni (.sym mnemonic .ii) + (.str "Line Prefetch, incr imm" mnemonic) + ((FORMAT M15) (FIELD-LFTYPE fault-attr)) + (.str mnemonic "$lfhint [$r3],$imm9a") + (+ (f-opcode op) (f-35-6 x6) lfhint r3 imm9a ign_12_7 qp) + () + () + ) +) + +(apply-lftype + (.pmacro (mnemonic fault-attr x6) + (I-M15 mnemonic fault-attr 7 x6)) + lfetch) + +(define-pmacro (I-M16 mnemonic extra op m x x6) + (dni mnemonic + (.str "Exchange/Compare and Exchange, " mnemonic) + ((FORMAT M16)) + (.str mnemonic "$ldhint $r1=[$r3],$r2" extra) + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + ldhint r3 r2 r1 qp) + () + () + ) +) + +(I-M16 cmpxchg1.acq ",ar.ccv" 4 0 1 #x00) +(I-M16 cmpxchg2.acq ",ar.ccv" 4 0 1 #x01) +(I-M16 cmpxchg4.acq ",ar.ccv" 4 0 1 #x02) +(I-M16 cmpxchg8.acq ",ar.ccv" 4 0 1 #x03) + +(I-M16 cmpxchg1.rel ",ar.ccv" 4 0 1 #x04) +(I-M16 cmpxchg2.rel ",ar.ccv" 4 0 1 #x05) +(I-M16 cmpxchg4.rel ",ar.ccv" 4 0 1 #x06) +(I-M16 cmpxchg8.rel ",ar.ccv" 4 0 1 #x07) + +(I-M16 xchg1.rel "" 4 0 1 #x08) +(I-M16 xchg2.rel "" 4 0 1 #x09) +(I-M16 xchg4.rel "" 4 0 1 #x0A) +(I-M16 xchg8.rel "" 4 0 1 #x0B) + +(define-pmacro (I-M17 mnemonic op m x x6) + (dni mnemonic + (.str "Fetch and Add, " mnemonic) + ((FORMAT M17)) + (.str mnemonic "$ldhint $r1=[$r3],$inc3") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + ldhint r3 ign_19_4 inc3 r1 qp) + () + () + ) +) + +(I-M17 fetchadd4.acq 4 0 1 #x12) +(I-M17 fetchadd8.acq 4 0 1 #x13) +(I-M17 fetchadd4.rel 4 0 1 #x16) +(I-M17 fetchadd8.rel 4 0 1 #x17) + +(define-pmacro (I-M18 mnemonic op m x x6) + (dni mnemonic + (.str "Set FR, " mnemonic) + ((FORMAT M18)) + (.str mnemonic " $f1=$r2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + ign_26_7 ign_29_2 r2 f1 qp) + () + () + ) +) + +(I-M18 setf.sig 6 0 1 #x1C) +(I-M18 setf.exp 6 0 1 #x1D) +(I-M18 setf.s 6 0 1 #x1E) +(I-M18 setf.d 6 0 1 #x1F) + +(define-pmacro (I-M19 mnemonic op m x x6) + (dni mnemonic + (.str "Get FR, " mnemonic) + ((FORMAT M19)) + (.str mnemonic " $r1=$f2") + (+ (f-opcode op) (f-36-1 m) (f-35-6 x6) (f-27-1 x) + ign_26_7 ign_29_2 f2 r1 qp) + () + () + ) +) + +(I-M19 getf.sig 4 0 1 #x1C) +(I-M19 getf.exp 4 0 1 #x1D) +(I-M19 getf.s 4 0 1 #x1E) +(I-M19 getf.d 4 0 1 #x1F) + +(define-pmacro (I-M20 mnemonic op x3) + (dni mnemonic + (.str "Integer Speculation Check, " mnemonic) + ((FORMAT M20)) + (.str mnemonic " $r2,$tgt25a") + (+ (f-opcode op) (f-35-3 x3) r2 tgt25a qp) + () + () + ) +) + +(I-M20 chk.s.m 1 1) + +(define-pmacro (I-M21 mnemonic op x3) + (dni (.sym mnemonic .f) + (.str "Floating-point Speculation Check, " mnemonic) + ((FORMAT M21)) + (.str mnemonic " $f2,$tgt25a") + (+ (f-opcode op) (f-35-3 x3) f2 tgt25a qp) + () + () + ) +) + +(I-M21 chk.s 1 3) + +(define-pmacro (I-M22 mnemonic op x3) + (dni mnemonic + (.str "Integer Advanced Load Check, " mnemonic) + ((FORMAT M22)) + (.str mnemonic " $r1,$tgt25c") + (+ (f-opcode op) (f-35-3 x3) tgt25c r1 qp) + () + () + ) +) + +(I-M22 chk.a.nc 0 4) +(I-M22 chk.a.clr 0 5) + +(define-pmacro (I-M23 mnemonic op x3) + (dni (.sym mnemonic .f) + (.str "Floating-point Advanced Load Check, " mnemonic) + ((FORMAT M23)) + (.str mnemonic " $f1,$tgt25c") + (+ (f-opcode op) (f-35-3 x3) tgt25c f1 qp) + () + () + ) +) + +(I-M22 chk.a.nc 0 6) +(I-M22 chk.a.clr 0 7) + +(define-pmacro (I-M24 mnemonic op x3 x4 x2) + (dni mnemonic + (.str "Sync/Fence/Serialize/ALAT Control, " mnemonic) + ((FORMAT M24)) + (.str mnemonic) + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) + ign_36_1 ign_26_7 ign_19_7 ign_12_7 qp) + () + () + ) +) + +(I-M24 invala 0 0 0 1) +(I-M24 fwb 0 0 0 2) +(I-M24 mf 0 0 2 2) +(I-M24 mf.a 0 0 3 2) +(I-M24 srlz.d 0 0 0 3) +(I-M24 srlz.i 0 0 1 3) +(I-M24 sync.i 0 0 3 3) + +(define-pmacro (I-M25 mnemonic op x3 x4 x2) + (dni mnemonic + (.str "RSE Control, " mnemonic) + ((FORMAT M25)) + (.str mnemonic) + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) + ign_36_1 ign_26_7 ign_19_7 ign_12_7 (f-qp 0)) + () + () + ) +) + +(I-M25 flushrs 0 0 #xC 0) +(I-M25 loadrs 0 0 #xA 0) + +(define-pmacro (I-M26 mnemonic op x3 x4 x2) + (dni mnemonic + (.str "Integer ALAT Entry Invalidate, " mnemonic) + ((FORMAT M26)) + (.str mnemonic " $r1") + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) + ign_36_1 ign_26_7 ign_19_7 r1 qp) + () + () + ) +) + +(I-M26 invala.e 0 0 2 1) + +(define-pmacro (I-M27 mnemonic op x3 x4 x2) + (dni (.sym mnemonic .f) + (.str "Floating-point ALAT Entry Invalidate, " mnemonic) + ((FORMAT M27)) + (.str mnemonic " $f1") + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) + ign_36_1 ign_26_7 ign_19_7 f1 qp) + () + () + ) +) + +(I-M27 invala.e 0 0 3 1) + +(define-pmacro (I-M28 mnemonic op x3 x6) + (dni mnemonic + (.str "Flush Cache/Purge Translation Cache Entry, " mnemonic) + ((FORMAT M28)) + (.str mnemonic " $r3") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) + ign_36_1 r3 ign_19_7 ign_12_7 qp) + () + () + ) +) + +(I-M28 fc 1 0 #x30) +(I-M28 ptc.e 1 0 #x34) + +(define-pmacro (I-M29 mnemonic op x3 x6) + (dni (.sym mnemonic _tar) + (.str "Move to AR, reg, " mnemonic) + ((FORMAT M29)) + (.str mnemonic " $ar3=$r2") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) + ign_36_1 ar3 r2 ign_12_7 qp) + () + () + ) +) + +(I-M29 mov.m 1 0 #x2A) + +(define-pmacro (I-M30 mnemonic op x3 x4 x2) + (dni (.sym mnemonic _tari) + (.str "Move to AR, imm," mnemonic) + ((FORMAT M30)) + (.str mnemonic " $ar3=$imm8") + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) + ar3 imm8 ign_12_7 qp) + () + () + ) +) + +(I-M30 mov.m 0 0 8 2) + +(define-pmacro (I-M31 mnemonic op x3 x6) + (dni (.sym mnemonic _far) + (.str "Move from AR, " mnemonic) + ((FORMAT M31)) + (.str mnemonic " $r1=$ar3") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 ign_19_7 ar3 r1 qp) + () + () + ) +) + +(I-M31 mov.m 1 0 #x22) + +(define-pmacro (I-M32 mnemonic op x3 x6) + (dni (.sym mnemonic _tcr) + (.str "Move to CR, " mnemonic) + ((FORMAT M32)) + (.str mnemonic " $cr3=$r2") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) + ign_36_1 cr3 r2 ign_12_7 qp) + () + () + ) +) + +(I-M32 mov 1 0 #x2C) + +(define-pmacro (I-M33 mnemonic op x3 x6) + (dni (.sym mnemonic _fcr) + (.str "Move from CR, " mnemonic) + ((FORMAT M33)) + (.str mnemonic " $r1=$cr3") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) + ign_36_1 cr3 ign_19_7 r1 qp) + () + () + ) +) + +(I-M33 mov 1 0 #x24) + +(define-pmacro (I-M34 mnemonic op x3) + (dni mnemonic + (.str "Allocate Register Stack Frame, " mnemonic) + ((FORMAT M34)) + (.str mnemonic " $r1=ar.pfs,$sorsolsof") + (+ (f-opcode op) (f-35-3 x3) ign_36_1 ign_32_2 + sorsolsof r1 (f-qp 0)) + () + () + ) +) + +(I-M34 alloc 1 6) + +(define-pmacro (I-M35 mnemonic which op x3 x6) + (dni (.sym mnemonic _t which) + (.str "Move to PSR, " mnemonic) + ((FORMAT M35)) + (.str mnemonic " " which "=$r2") + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 + r2 ign_26_7 ign_12_7 qp) + () + () + ) +) + +(I-M35 mov psr.l 1 0 #x2D) +(I-M35 mov psr.um 1 0 #x29) + +(define-pmacro (I-M36 mnemonic which op x3 x6) + (dni (.sym mnemonic _f which) + (.str "Move from PSR, " mnemonic) + ((FORMAT M35)) + (.str mnemonic " $r1=" which) + (+ (f-opcode op) (f-35-3 x3) (f-32-6 x6) ign_36_1 + ign_26_7 ign_19_7 r1 qp) + () + () + ) +) + +(I-M36 mov psr 1 0 #x25) +(I-M36 mov psr.um 1 0 #x21) + +(define-pmacro (I-M37 mnemonic op x3 x4 x2) + (dni mnemonic + (.str "Break/Nop, " mnemonic) + ((FORMAT M37)) + (.str mnemonic " $imm21") + (+ (f-opcode op) (f-35-3 x3) (f-32-2 x2) (f-30-4 x4) ign_26_1 imm21 qp) + () + () + ) +) + +(I-M37 break.m 0 0 0 0) +(I-M37 nop.m 0 0 1 0) + diff --git a/cgen/ifield.scm b/cgen/ifield.scm new file mode 100644 index 00000000000..0a47f022391 --- /dev/null +++ b/cgen/ifield.scm @@ -0,0 +1,1164 @@ +; Instruction fields. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; The `<ifield>' class. +; (pronounced "I-field") +; +; These describe raw data, little semantic content is attributed to them. +; The goal being to avoid interfering with future applications. +; +; FIXME: Move start, word-offset, word-length into the instruction format? +; - would require proper ordering of fields in insns, but that's ok. +; (??? though the sparc64 description shows a case where its useful to +; not have to worry about instruction ordering - different versions of an +; insn take different fields and these fields are passed via a macro) +; +; ??? One could treat all ifields as being unsigned. They could be thought of +; as indices into a table of values, be they signed, unsigned, floating point, +; whatever. Just an idea. +; +; ??? Split into two? One for definition, and one for value. + +(define <ifield> + (class-make '<ifield> + '(<ident>) + '( + ; The mode the raw value is to be interpreted in. + mode + + ; A <bitrange> object. + ; This contains the field's offset, start, length, word-length, + ; and orientation (msb==0, lsb==0). The orientation is + ; recorded to keep the <bitrange> object self-contained. + ; Endianness is not recorded. + bitrange + + ; Argument to :follows, as an object. + ; FIXME: wip + (follows . #f) + + ; ENCODE/DECODE operate on the raw value, absent of any context + ; save `pc' and mode of field. + ; If #f, no special processing is required. + ; ??? It's not clear where the best place to process fields is. + ; An earlier version had insert/extract fields in operands to + ; handle more complicated cases. Following the goal of + ; incremental complication, the special handling for m32r's + ; f-disp8 field is handled entirely here, rather than partially + ; here and partially in the operand. + encode decode + + ; Value of field, if there is one. + ; Possible types are: integer, <operand>, ??? + value + ) + nil) +) + +; {value},{follows} are missing on purpose +; {value} is handled specially. +; {follows} is rarely used +(method-make-make! <ifield> '(name comment attrs mode bitrange encode decode)) + +; Accessor fns +; ??? `value' is treated specially, needed anymore? + +(define-getters <ifield> ifld (mode encode decode follows)) + +(define-setters <ifield> ifld (follows)) + +; internal fn +(define -ifld-bitrange (elm-make-getter <ifield> 'bitrange)) + +(define (ifld-word-offset f) (bitrange-word-offset (-ifld-bitrange f))) +(define (ifld-word-length f) (bitrange-word-length (-ifld-bitrange f))) + +; Return the mode of the value passed to the encode rtl. +; This is the mode of the result of the decode rtl. + +(define (ifld-encode-mode f) + (if (ifld-decode f) + ; cadr/cadr gets WI in ((value pc) (sra WI ...)) + (mode:lookup (cadr (cadr (ifld-decode f)))) + (ifld-mode f)) +) + +; Return the mode of the value passed to the decode rtl. +; This is the mode of the field. + +(define (ifld-decode-mode f) (ifld-mode f)) + +; Return start of ifield. +; WORD-LEN is the length of the word in which to compute the value or +; #f meaning to use the default length (recorded with the bitrange). +; WORD-LEN is present for architectures like the m32r where there are insns +; smaller than the base insn size (LIW). +; ??? Not sure it'll be applicable to other LIW architectures. The m32r is +; rather easy as the insns are 16 and 32 bits. +; ??? Another way to do this would be to either set the base-insn-size for +; the m32r to be 16 bits, or to add a new field to hold the insn-word-size +; and set it to 16 for the m32r. The problem here is that there is no +; canonicalization that works regardless of whether a "word" is shortened +; or lengthened. + +(method-make-virtual! + <ifield> 'field-start + (lambda (self word-len) + (let* ((bitrange (-ifld-bitrange self)) + (lsb0? (bitrange-lsb0? bitrange)) + (recorded-word-len (bitrange-word-length bitrange)) + (wanted-word-len (or word-len recorded-word-len))) + ; Note that this is only intended for situations like the m32r. + ; If it doesn't work elsewhere, it may be that you need to + ; do things different (use two fields instead of one). + (cond ((= wanted-word-len recorded-word-len) + (bitrange-start bitrange)) + ((< wanted-word-len recorded-word-len) + ; smaller word wanted + (if lsb0? + (- (bitrange-start bitrange) (- recorded-word-len + wanted-word-len)) + (bitrange-start bitrange))) + (else + ; larger word wanted + (if lsb0? + (+ (bitrange-start bitrange) (- wanted-word-len + recorded-word-len)) + (bitrange-start bitrange)))))) +) + +(define (ifld-start ifld word-len) + (send ifld 'field-start word-len) +) + +(method-make-virtual! + <ifield> 'field-length + (lambda (self) + (bitrange-length (elm-get self 'bitrange))) +) + +(define (ifld-length f) (send f 'field-length)) + +; FIXME: It might make things more "readable" if enum values were preserved in +; their symbolic form and the get-field-value method did the lookup. + +(method-make! + <ifield> 'get-field-value + (lambda (self) + (elm-get self 'value)) +) +(define (ifld-get-value self) + (send self 'get-field-value) +) +(method-make! + <ifield> 'set-field-value! + (lambda (self new-val) + (elm-set! self 'value new-val)) +) +(define (ifld-set-value! self new-val) + (send self 'set-field-value! new-val) +) + +; Return a boolean indicating if X is an <ifield>. + +(define (ifield? x) (class-instance? <ifield> x)) + +; Return ilk of field. +; ("ilk" sounds klunky but "type" is too ambiguous. Here "ilk" means +; the kind of the hardware element, enum, etc.) +; The result is a character string naming the field type. + +(define (ifld-ilk fld) + (let ((value (elm-xget fld 'value))) + ; ??? One could require that the `value' field always be an object. + ; I can't get too worked up over it yet. + (if (object? value) + (obj:name value) ; send's message 'get-name to fetch object's `name' + "#")) ; # -> "it's a number" +) + +; Generate the name of the enum for instruction field ifld. +; If PREFIX? is present and #f, the @ARCH@_ prefix is omitted. + +(define (ifld-enum ifld . prefix?) + (string-upcase (string-append (if (or (null? prefix?) (car prefix?)) + "@ARCH@_" + "") + (gen-sym ifld))) +) + +; Return a boolean indicating if ifield F is an opcode field +; (has a constant value). + +(define (ifld-constant? f) + (number? (ifld-get-value f)) +; (and (number? (ifld-get-value f)) +; (if option:reserved-as-opcode? +; #t +; (not (has-attr? f 'RESERVED)))) +) + +; Return a boolean indicating if ifield F is an operand. +; FIXME: Should check for operand? or some such. + +(define (ifld-operand? f) (not (number? (ifld-get-value f)))) + +; Return known value table for rtx-simplify of <ifield> list ifld-list. + +(define (ifld-known-values ifld-list) + (let ((constant-iflds (find ifld-constant? (collect ifld-base-ifields ifld-list)))) + (map (lambda (f) + (cons (obj:name f) + (rtx-make-const 'INT (ifld-get-value f)))) + constant-iflds)) +) + +; Return mask to use for a field in <bitrange> CONTAINER. +; If the bitrange is outside the range of the field, return 0. +; If CONTAINER is #f, use the recorded bitrange. +; BASE-LEN, if non-#f, overrides the base insn length of the insn. +; BASE-LEN is present for architectures like the m32r where there are insns +; smaller than the base insn size (LIW). +; +; Simplifying restrictions [to be relaxed as necessary]: +; - the field must either be totally contained within CONTAINER or totally +; outside it, partial overlaps aren't handled +; - CONTAINER must be an integral number of bytes, beginning on a +; byte boundary [simplifies things] +; - both SELF's bitrange and CONTAINER must have the same word length +; - LSB0? of SELF's bitrange and CONTAINER must be the same + +(method-make! + <ifield> 'field-mask + (lambda (self base-len container) + (let* ((container (or container (-ifld-bitrange self))) + (bitrange (-ifld-bitrange self)) + (recorded-word-length (bitrange-word-length bitrange)) + (word-offset (bitrange-word-offset bitrange))) + (let ((lsb0? (bitrange-lsb0? bitrange)) + (start (bitrange-start bitrange)) + (length (bitrange-length bitrange)) + (word-length (or (and (= word-offset 0) base-len) + recorded-word-length)) + (container-word-offset (bitrange-word-offset container)) + (container-word-length (bitrange-word-length container))) + (cond + ; must be same lsb0 + ((not (eq? lsb0? (bitrange-lsb0? container))) + (error "field-mask: different lsb0? values")) + ((not (= word-length container-word-length)) + 0) + ; container occurs after? + ((<= (+ word-offset word-length) container-word-offset) + 0) + ; container occurs before? + ((>= word-offset (+ container-word-offset container-word-length)) + 0) + (else + (word-mask start length word-length lsb0? #f)))))) +) + +(define (ifld-mask ifld base-len container) + (send ifld 'field-mask base-len container) +) + +; Return VALUE inserted into the field's position. +; BASE-LEN, if non-#f, overrides the base insn length of the insn. +; BASE-LEN is present for architectures like the m32r where there are insns +; smaller than the base insn size (LIW). + +(method-make! + <ifield> 'field-value + (lambda (self base-len value) + (let* ((bitrange (-ifld-bitrange self)) + (recorded-word-length (bitrange-word-length bitrange)) + (word-offset (bitrange-word-offset bitrange)) + (word-length (or (and (= word-offset 0) base-len) + recorded-word-length))) + (word-value (ifld-start self base-len) + (bitrange-length bitrange) + word-length + (bitrange-lsb0? bitrange) #f + value))) +) + +; FIXME: confusion with ifld-get-value. +(define (ifld-value f base-len value) + (send f 'field-value base-len value) +) + +; Return a list of ifields required to compute <ifield> F's value. +; Normally this is just F itself. For multi-ifields it will be more. +; ??? It can also be more if F's value is derived from other fields but +; that isn't supported yet. + +(method-make! + <ifield> 'needed-iflds + (lambda (self) + (list self)) +) + +(define (ifld-needed-iflds f) + (send f 'needed-iflds) +) + +; Extract <ifield> IFLD's value out of VALUE in <insn> INSN. +; VALUE is the entire insn's value if it fits in a word, or is a list +; of values, one per word (not implemented, sigh). +; ??? The instruction's format should specify where the word boundaries are. + +(method-make! + <ifield> 'field-extract + (lambda (self insn value) + (let ((base-len (insn-base-mask-length insn))) + (word-extract (ifld-start self base-len) + (ifld-length self) + base-len + (ifld-lsb0? self) + #f ; start is msb + value))) +) + +(define (ifld-extract ifld value insn) + (send ifld 'field-extract value insn) +) + +; Return a boolean indicating if bit 0 is the least significant bit. + +(method-make! + <ifield> 'field-lsb0? + (lambda (self) + (bitrange-lsb0? (-ifld-bitrange self))) +) + +(define (ifld-lsb0? f) (send f 'field-lsb0?)) + +; Return the minimum value of a field. + +(method-make! + <ifield> 'min-value + (lambda (self) + (case (mode:class (ifld-mode self)) + ((INT) (- (integer-expt 2 (- (ifld-length self) 1)))) + ((UINT) 0) + (else (error "unsupported mode class" (mode:class (ifld-mode self)))))) +) + +; Return the maximum value of a field. + +(method-make! + <ifield> 'max-value + (lambda (self) + (case (mode:class (ifld-mode self)) + ((INT) (- (integer-expt 2 (- (ifld-length self) 1)) 1)) + ((UINT) (- (integer-expt 2 (ifld-length self)) 1)) + (else (error "unsupported mode class" (mode:class (ifld-mode self)))))) +) + +; Create a copy of field F with value VALUE. +; VALUE is either ... ??? + +(define (ifld-new-value f value) + (let ((new-f (object-copy-top f))) + (ifld-set-value! new-f value) + new-f) +) + +; Change the offset of the word containing an ifield to {word-offset}. + +(method-make! + <ifield> 'set-word-offset! + (lambda (self word-offset) + (let ((bitrange (object-copy-top (-ifld-bitrange self)))) + (bitrange-set-word-offset! bitrange word-offset) + (elm-set! self 'bitrange bitrange) + *UNSPECIFIED*)) +) +(define (ifld-set-word-offset! f word-offset) + (send f 'set-word-offset! word-offset) +) + +; Return a copy of F with new {word-offset}. + +(define (ifld-new-word-offset f word-offset) + (let ((new-f (object-copy-top f))) + (ifld-set-word-offset! new-f word-offset) + new-f) +) + +; Return the bit offset of the word after the word <ifield> F is in. +; What a `word' here is defined by F in its bitrange. + +(method-make! + <ifield> 'next-word + (lambda (self) + (let ((br (-ifld-bitrange f))) + (bitrange-next-word br))) +) + +(define (ifld-next-word f) (send f 'next-word)) + +; Return a boolean indicating if <ifield> F1 precedes <ifield> F2. +; FIXME: Move into a method as different subclasses will need +; different handling. + +(define (ifld-precedes? f1 f2) + (let ((br1 (-ifld-bitrange f1)) + (br2 (-ifld-bitrange f2))) + (cond ((< (bitrange-word-offset br1) (bitrange-word-offset br2)) + #t) + ((= (bitrange-word-offset br1) (bitrange-word-offset br2)) + (begin + (assert (eq? (bitrange-lsb0? br1) (bitrange-lsb0? br2))) + (assert (= (bitrange-word-length br1) (bitrange-word-length br1))) + ; ??? revisit + (if (bitrange-lsb0? br1) + (> (bitrange-start br1) (bitrange-start br2)) + (< (bitrange-start br1) (bitrange-start br2))))) + (else + #f))) +) + +; Parse an ifield definition. +; This is the main routine for building an ifield object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). +; +; Two forms of specification are supported, loosely defined as the RISC way +; and the CISC way. The reason for the distinction is to simplify ifield +; specification of RISC-like cpus. +; Note that VLIW's are another way. These are handled like the RISC way, with +; the possible addition of instruction framing (which is, surprise surprise, +; wip). +; +; RISC: +; WORD-OFFSET and WORD-LENGTH are #f. Insns are assumed to be N copies of +; (isa-default-insn-word-bitsize). WORD-OFFSET is computed from START. +; START is the offset in bits from the start of the insn. +; FLENGTH is the length of the field in bits. +; +; CISC: +; WORD-OFFSET is the offset in bits from the start to the first byte of the +; word containing the ifield. +; WORD-LENGTH is the length in bits of the word containing the ifield. +; START is the starting bit number in the word. Bit numbering is taken from +; (current-arch-insn-lsb0?). +; FLENGTH is the length in bits of the ifield. It is named that way to avoid +; collision with the proc named `length'. +; +; FIXME: More error checking. + +(define (-ifield-parse errtxt name comment attrs + word-offset word-length start flength follows + mode encode decode) + (logit 2 "Processing ifield " name " ...\n") + + (let* ((name (parse-name name errtxt)) + (atlist (atlist-parse attrs "cgen_ifld" errtxt)) + (isas (bitset-attr->list (atlist-attr-value atlist 'ISA #f)))) + + ; Ensure only one isa specified. + (if (!= (length isas) 1) + (parse-error errtxt "can only specify 1 isa" attrs)) + + (if (not (eq? (->bool word-offset) + (->bool word-length))) + (parse-error errtxt "either both or neither of word-offset,word-length can be specified")) + + (if (keep-isa-atlist? atlist #f) + + (let ((isa (current-isa-lookup (car isas))) + (word-offset (and word-offset + (parse-number errtxt word-offset '(0 . 256)))) + (word-length (and word-length + (parse-number errtxt word-length '(0 . 128)))) + ; ??? 0.127 for now + (start (parse-number errtxt start '(0 . 127))) + ; ??? 0.127 for now + (flength (parse-number errtxt flength '(0 . 127))) + (lsb0? (current-arch-insn-lsb0?)) + (mode-obj (parse-mode-name mode errtxt)) + (follows-obj (-ifld-parse-follows errtxt follows)) + ) + + ; Calculate the <bitrange> object. + ; FIXME: word-offset/word-length computation needs work. + ; Move positional info to format? + (let ((bitrange + (if word-offset + ; CISC + (make <bitrange> + word-offset start flength word-length lsb0?) + ; RISC + (let* ((default-insn-word-bitsize + (isa-default-insn-word-bitsize isa)) + (word-offset + (- start + (remainder start + default-insn-word-bitsize))) + (start (remainder start default-insn-word-bitsize))) + (make <bitrange> + word-offset + start + flength + (if lsb0? + (* (quotient (+ start 1 + (- default-insn-word-bitsize 1)) + default-insn-word-bitsize) + default-insn-word-bitsize) + (* (quotient (+ start flength + (- default-insn-word-bitsize 1)) + default-insn-word-bitsize) + default-insn-word-bitsize)) + lsb0?)))) + ) + + (let ((result + (make <ifield> + name + (parse-comment comment errtxt) + atlist + mode-obj + bitrange + (-ifld-parse-encode errtxt encode) + (-ifld-parse-decode errtxt decode)))) + (if follows-obj + (ifld-set-follows! result follows-obj)) + result))) + + ; Else ignore entry. + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read an instruction field description. +; This is the main routine for analyzing instruction fields in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -ifield-parse is invoked to create the <ifield> object. + +(define (-ifield-read errtxt . arg-list) + (let (; Current ifield elements: + (name nil) + (comment "") + (attrs nil) + (word-offset #f) + (word-length #f) + (start 0) + ; FIXME: Hobbit computes the wrong symbol for `length' + ; in the `case' expression below because there is a local var + ; of the same name ("__1" gets appended to the symbol name). + ; As a workaround we name it "length-". + (length- 0) + (follows #f) + (mode 'UINT) + (encode #f) + (decode #f) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mode) (set! mode (cadr arg))) + ((word-offset) (set! word-offset (cadr arg))) + ((word-length) (set! word-length (cadr arg))) + ((start) (set! start (cadr arg))) + ((length) (set! length- (cadr arg))) + ((follows) (set! follows (cadr arg))) + ((encode) (set! encode (cdr arg))) + ((decode) (set! decode (cdr arg))) + (else (parse-error errtxt "invalid ifield arg" arg))) + (loop (cdr arg-list))))) + + ; See if encode/decode were specified as "unspecified". + ; This happens with shorthand macros. + (if (and (pair? encode) + (eq? (car encode) #f)) + (set! encode #f)) + (if (and (pair? decode) + (eq? (car decode) #f)) + (set! decode #f)) + + ; Now that we've identified the elements, build the object. + (-ifield-parse errtxt name comment attrs + word-offset word-length start length- follows + mode encode decode) + ) +) + +; Parse a `follows' spec. + +(define (-ifld-parse-follows errtxt follows) + (if follows + (let ((follows-obj (current-op-lookup follows))) + (if (not follows-obj) + (parse-error errtxt "unknown operand to follow" follows)) + follows-obj) + #f) +) + +; Do common parts of <ifield> encode/decode processing. + +(define (-ifld-parse-encode-decode errtxt which value) + (if value + (begin + (if (or (not (list? value)) + (not (= (length value) 2)) + (not (list? (car value))) + (not (= (length (car value)) 2)) + (not (list? (cadr value)))) + (parse-error errtxt + (string-append "bad ifield " which " spec") + value)) + (if (or (not (> (length (cadr value)) 2)) + (not (mode:lookup (cadr (cadr value))))) + (parse-error errtxt + (string-append which " expression must have a mode") + value)))) + value +) + +; Parse an <ifield> encode spec. + +(define (-ifld-parse-encode errtxt encode) + (-ifld-parse-encode-decode errtxt "encode" encode) +) + +; Parse an <ifield> decode spec. + +(define (-ifld-parse-decode errtxt decode) + (-ifld-parse-encode-decode errtxt "decode" decode) +) + +; Define an instruction field object, name/value pair list version. + +(define define-ifield + (lambda arg-list + (let ((f (apply -ifield-read (cons "define-ifield" arg-list)))) + (if f + (current-ifld-add! f)) + f)) +) + +; Define an instruction field object, all arguments specified. +; ??? Leave out word-offset,word-length,follows for now (RISC version). +; Not sure whether to add another function or leave CISC cpu's to define +; a shorthand macro if they want. + +(define (define-full-ifield name comment attrs start length mode encode decode) + (let ((f (-ifield-parse "define-full-ifield" name comment attrs + #f #f start length #f mode encode decode))) + (if f + (current-ifld-add! f)) + f) +) + +(define (-ifield-add-commands!) + (reader-add-command! 'define-ifield + "\ +Define an instruction field, name/value pair list version. +" + nil 'arg-list define-ifield) + (reader-add-command! 'define-full-ifield + "\ +Define an instruction field, all arguments specified. +" + nil '(name comment attrs start length mode encode decode) + define-full-ifield) + (reader-add-command! 'define-multi-ifield + "\ +Define an instruction multi-field, name/value pair list version. +" + nil 'arg-list define-multi-ifield) + (reader-add-command! 'define-full-multi-ifield + "\ +Define an instruction multi-field, all arguments specified. +" + nil '(name comment attrs mode subflds insert extract) + define-full-multi-ifield) + + *UNSPECIFIED* +) + +; Instruction fields consisting of multiple parts. + +(define <multi-ifield> + (class-make '<multi-ifield> + '(<ifield>) + '( + ; List of <ifield> objects. + subfields + ; rtl to set SUBFIELDS from self + insert + ; rtl to set self from SUBFIELDS + extract + ) + nil) +) + +; Accessors + +(define-getters <multi-ifield> multi-ifld + (subfields insert extract) +) + +; Return a boolean indicating if X is an <ifield>. + +(define (multi-ifield? x) (class-instance? <multi-ifield> x)) + +(define (non-multi-ifields ifld-list) + (find (lambda (ifld) (not (multi-ifield? ifld))) ifld-list) +) + +(define (non-derived-ifields ifld-list) + (find (lambda (ifld) (not (derived-ifield? ifld))) ifld-list) +) + + +; Return the starting bit number of the first field. + +(method-make-virtual! + <multi-ifield> 'field-start + (lambda (self word-len) + (apply min (map (lambda (f) (ifld-start f #f)) (elm-get self 'subfields)))) +) + +; Return the total length. + +(method-make-virtual! + <multi-ifield> 'field-length + (lambda (self) + (apply + (map ifld-length (elm-get self 'subfields)))) +) + +; Return the bit offset of the word after the last word SELF is in. +; What a `word' here is defined by subfields in their bitranges. + +(method-make! + <multi-ifield> 'next-word + (lambda (self) + (apply max (map (lambda (f) + (bitrange-next-word (-ifld-bitrange f))) + (multi-ifld-subfields self)))) +) + +; Return mask of field in bitrange CONTAINER. + +(method-make! + <multi-ifield> 'field-mask + (lambda (self base-len container) + (apply + (map (lambda (f) (ifld-mask f base-len container)) (elm-get self 'subfields)))) +) + +; Return VALUE inserted into the field's position. +; The value is spread out over the various subfields in sorted order. +; We assume the subfields have been sorted by starting bit position. + +(method-make! + <multi-ifield> 'field-value + (lambda (self base-len value) + (apply + (map (lambda (f) (ifld-value f base-len value)) (elm-get self 'subfields)))) +) + +; Return a list of ifields required to compute the field's value. + +(method-make! + <multi-ifield> 'needed-iflds + (lambda (self) + (cons self (elm-get self 'subfields))) +) + +; Extract <ifield> IFLD's value out of VALUE in <insn> INSN. +; VALUE is the entire insn's value if it fits in a word, or is a list +; of values, one per word (not implemented, sigh). +; ??? The instruction's format should specify where the word boundaries are. + +(method-make! + <multi-ifield> 'field-extract + (lambda (self insn value) + (let* ((subflds (sort-ifield-list (elm-get self 'subfields) + (not (ifld-lsb0? self)))) + (subvals (map (lambda (subfld) + (ifld-extract subfld insn value)) + subflds)) + ) + ; We have each subfield's value, now concatenate them. + (letrec ((plus-scan (lambda (lengths current) + ; do the -1 drop here as it's easier + (if (null? (cdr lengths)) + nil + (cons current + (plus-scan (cdr lengths) + (+ current (car lengths)))))))) + (apply + (map logsll + subvals + (plus-scan (map ifld-length subflds) 0)))))) +) + +; Return a boolean indicating if bit 0 is the least significant bit. + +(method-make! + <multi-ifield> 'field-lsb0? + (lambda (self) + (ifld-lsb0? (car (elm-get self 'subfields)))) +) + +; Multi-ifield parsing. + +; Subroutine of -multi-ifield-parse to build the default insert expression. + +(define (-multi-ifield-make-default-insert container-name subfields) + (let* ((lengths (map ifld-length subfields)) + (shifts (cons 0 (list-tail-drop 1 (plus-scan (cons 0 lengths)))))) + ; Build RTL expression to shift and mask each ifield into right spot. + (let ((exprs (map (lambda (f length shift) + (rtx-make 'and (rtx-make 'srl container-name shift) + (mask length))) + subfields lengths shifts))) + ; Now set each ifield with their respective values. + (apply rtx-make (cons 'sequence + (cons nil + (map (lambda (f expr) + (rtx-make-set f expr)) + subfields exprs)))))) +) + +; Subroutine of -multi-ifield-parse to build the default extract expression. + +(define (-multi-ifield-make-default-extract container-name subfields) + (let* ((lengths (map ifld-length subfields)) + (shifts (cons 0 (list-tail-drop 1 (plus-scan (cons 0 lengths)))))) + ; Build RTL expression to shift and mask each ifield into right spot. + (let ((exprs (map (lambda (f length shift) + (rtx-make 'sll (rtx-make 'and (obj:name f) + (mask length)) + shift)) + subfields lengths shifts))) + ; Now set {container-name} with all the values or'd together. + (rtx-make-set container-name + (rtx-combine 'or exprs)))) +) + +; Parse a multi-ifield spec. +; This is the main routine for building the object from the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). + +(define (-multi-ifield-parse errtxt name comment attrs mode subfields insert extract encode decode) + (logit 2 "Processing multi-ifield element " name " ...\n") + + (let ((name (parse-name name errtxt)) + (result (new <multi-ifield>)) + (subfields (map (lambda (subfld) + (let ((f (current-ifld-lookup subfld))) + (if (not f) + (parse-error errtxt "unknown ifield" subfld)) + f)) + subfields))) + + (elm-xset! result 'name name) + (elm-xset! result 'comment (parse-comment comment errtxt)) + ; multi-ifields are always VIRTUAL + (elm-xset! result 'attrs + (atlist-parse (cons 'VIRTUAL attrs) "multi-ifield" errtxt)) + (elm-xset! result 'mode (parse-mode-name mode errtxt)) + (elm-xset! result 'encode (-ifld-parse-encode errtxt encode)) + (elm-xset! result 'decode (-ifld-parse-encode errtxt decode)) + (if insert + (elm-xset! result 'insert insert) + (elm-xset! result 'insert + (-multi-ifield-make-default-insert name subfields))) + (if extract + (elm-xset! result 'extract extract) + (elm-xset! result 'extract + (-multi-ifield-make-default-extract name subfields))) + (elm-xset! result 'subfields subfields) + + result) +) + +; Read an instruction multi-ifield. + +(define (-multi-ifield-read errtxt . arg-list) + (let (; Current multi-ifield elements: + (name nil) + (comment "") + (attrs nil) + (mode 'UINT) + (subflds nil) + (insert #f) + (extract #f) + (encode #f) + (decode #f) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mode) (set! mode (cadr arg))) + ((subfields) (set! subflds (cdr arg))) + ((insert) (set! insert (cadr arg))) + ((extract) (set! extract (cadr arg))) + ((encode) (set! encode (cdr arg))) + ((decode) (set! decode (cdr arg))) + (else (parse-error errtxt "invalid ifield arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-multi-ifield-parse errtxt name comment attrs mode subflds insert extract encode decode) + ) +) + +; Define an instruction multi-field object, name/value pair list version. + +(define define-multi-ifield + (lambda arg-list + (let ((f (apply -multi-ifield-read (cons "define-multi-ifield" arg-list)))) + (current-ifld-add! f) + f)) +) + +; Define an instruction multi-field object, all arguments specified. + +(define (define-full-multi-ifield name comment attrs mode subflds insert extract) + (let ((f (-multi-ifield-parse "define-full-multi-ifield" name comment attrs + mode subflds insert extract #f #f))) + (current-ifld-add! f) + f) +) + +; Derived ifields (ifields based on one or more other ifields). +; These support the complicated requirements of CISC instructions +; where one "ifield" is actually a placeholder for an addressing mode +; which can consist of several ifields. +; These are also intended to support other complex ifield usage. +; +; Derived ifields are (currently) always machine generated from other +; elements of the description file so there is no reader support. +; +; ??? experimental and wip! +; ??? These are kind of like multi-ifields but I don't want to disturb them +; while this is still experimental. + +(define <derived-ifield> + (class-make '<derived-ifield> + '(<ifield>) + '( + ; Operand that uses this ifield. + ; Unlike other ifields, derived ifields have a one-to-one + ; correspondence with the operand that uses them. + ; ??? Not true in -anyof-merge-subchoices. + owner + + ; List of ifields that make up this ifield. + subfields + ) + nil) +) + +(method-make! + <derived-ifield> 'make! + (lambda (self name comment attrs owner subfields) + (elm-set! self 'name name) + (elm-set! self 'comment comment) + (elm-set! self 'attrs attrs) + (elm-set! self 'mode UINT) + (elm-set! self 'bitrange (make <bitrange> 0 0 0 0 #f)) + (elm-set! self 'owner owner) + (elm-set! self 'subfields subfields) + self) +) + +; Accessors. + +(define-getters <derived-ifield> derived-ifield (owner subfields)) + +(define-setters <derived-ifield> derived-ifield (owner subfields)) + +(define (derived-ifield? x) (class-instance? <derived-ifield> x)) + +; Return a boolean indicating if F is a derived ifield with a derived operand +; for a value. +; ??? The former might imply the latter so some simplification may be possible. + +(define (ifld-derived-operand? f) + (and (derived-ifield? f) + (derived-operand? (ifld-get-value f))) +) + +; Return the bit offset of the word after the last word SELF is in. +; What a `word' here is defined by subfields in their bitranges. + +(method-make! + <derived-ifield> 'next-word + (lambda (self) + (apply max (map (lambda (f) + (bitrange-next-word (-ifld-bitrange f))) + (derived-ifield-subfields self)))) +) + + +; Traverse the ifield to collect all base (non-derived) ifields used in it. +(define (ifld-base-ifields ifld) + (cond ((derived-ifield? ifld) (collect (lambda (subfield) (ifld-base-ifields subfield)) + (derived-ifield-subfields ifld))) + ; ((multi-ifield? ifld) (collect (lambda (subfield) (ifld-base-ifields subfield)) + ; (multi-ifld-subfields ifld))) + (else (list ifld))) +) + + + +; Misc. utilities. + +; Sort a list of fields (sorted by the starting bit number). +; This must be carefully defined to pass through Hobbit. +; (define foo (if x bar baz)) is ok. +; (if x (define foo bar) (define foo baz)) is not ok. +; +; ??? Usually there aren't that many fields and the range of values is fixed, +; so I think this needn't use a general purpose sort routine (should it become +; an issue). + +(define sort-ifield-list + (if (and (defined? 'cgh-qsort) (defined? 'cgh-qsort-int-cmp)) + (lambda (fld-list up?) + (cgh-qsort fld-list + (if up? + (lambda (a b) + (cgh-qsort-int-cmp (ifld-start a #f) + (ifld-start b #f))) + (lambda (a b) + (- (cgh-qsort-int-cmp (ifld-start a #f) + (ifld-start b #f))))))) + (lambda (fld-list up?) + (sort fld-list + (if up? + (lambda (a b) (< (ifld-start a #f) + (ifld-start b #f))) + (lambda (a b) (> (ifld-start a #f) + (ifld-start b #f))))))) +) + +; Return a boolean indicating if field F extends beyond the base insn. + +(define (ifld-beyond-base? f base-bitsize total-bitsize) + ; old way + ;(< base-bitsize (+ (ifld-start f total-bitsize) (ifld-length f))) + (> (ifld-word-offset f) 0) +) + +; Return the mode of the decoded value of <ifield> F. +; ??? This is made easy because we require the decode expression to have +; an explicit mode. + +(define (ifld-decode-mode f) + (if (not (elm-bound? f 'decode)) + (ifld-mode f) + (let ((d (ifld-decode f))) + (if d + (mode:lookup (cadr (cadr d))) + (ifld-mode f)))) +) + +; Return <hardware> object to use to hold value of <ifield> F. +; i.e. one of h-uint, h-sint. +; NB: Should be defined in terms of `hardware-for-mode'. +(define (ifld-hw-type f) + (case (mode:class (ifld-mode f)) + ((INT) h-sint) + ((UINT) h-uint) + (else (error "unsupported mode class" (mode:class (ifld-mode f))))) +) + +; Builtin fields, attributes, init/fini support. + +; The f-nil field is a placeholder when building operands out of hardware +; elements that aren't indexed by an instruction field (scalars). +(define f-nil #f) + +(define (ifld-nil? f) + (eq? (obj:name f) 'f-nil) +) + +; The f-anyof field is a placeholder when building "anyof" operands. +(define f-anyof #f) + +(define (ifld-anyof? f) + (eq? (obj:name f) 'f-anyof) +) + +; Return a boolean indicating if F is an anyof ifield with an anyof operand +; for a value. +; ??? The former implies the latter so some simplification is possible. + +(define (ifld-anyof-operand? f) + (and (ifld-anyof? f) + (anyof-operand? (ifld-get-value f))) +) + +; Called before loading the .cpu file to initialize. + +(define (ifield-init!) + (-ifield-add-commands!) + + *UNSPECIFIED* +) + +; Called before loading the .cpu file to create any builtins. + +(define (ifield-builtin!) + ; Standard ifield attributes. + ; ??? Some of these can be combined into one, booleans are easier to + ; work with. + (define-attr '(for ifield operand) '(type boolean) '(name PCREL-ADDR) + '(comment "pc relative address")) + (define-attr '(for ifield operand) '(type boolean) '(name ABS-ADDR) + '(comment "absolute address")) + (define-attr '(for ifield) '(type boolean) '(name RESERVED) + '(comment "field is reserved")) + (define-attr '(for ifield operand) '(type boolean) '(name SIGN-OPT) + '(comment "value is signed or unsigned")) + ; ??? This is an internal attribute for implementation purposes only. + ; To be revisited. + (define-attr '(for ifield operand) '(type boolean) '(name SIGNED) + '(comment "value is unsigned")) + ; Also (defined elsewhere): VIRTUAL + + (set! f-nil (make <ifield> 'f-nil "empty ifield" + atlist-empty + UINT + (make <bitrange> 0 0 0 0 #f) + #f #f)) ; encode/decode + (current-ifld-add! f-nil) + + (set! f-anyof (make <ifield> 'f-anyof "placeholder for anyof operands" + atlist-empty + UINT + (make <bitrange> 0 0 0 0 #f) + #f #f)) ; encode/decode + (current-ifld-add! f-anyof) + + *UNSPECIFIED* +) + +; Called after the .cpu file has been read in. + +(define (ifield-finish!) + *UNSPECIFIED* +) diff --git a/cgen/iformat.scm b/cgen/iformat.scm new file mode 100644 index 00000000000..1717f38d2c9 --- /dev/null +++ b/cgen/iformat.scm @@ -0,0 +1,614 @@ +; Instruction formats. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Instruction formats are computed after the .cpu file has been read in. +; ??? May also wish to allow programmer to specify formats, but not sure this +; will complicate things more than it simplifies them, so it's defered. +; +; Two kinds of formats are defined here: iformat and sformat. +; (pronounced "I-format" and "S-format") +; +; Iformats are the instruction format as specified by the instructions' fields, +; and are the machine computed version of the generally known notion of an +; "instruction format". No semantic information is attributed to iformats. +; +; Sformats are the same as iformats except that semantics are used to +; distinguish them. For example, if an operand is refered to in one mode by +; one instruction and in a different mode by another instruction, then these +; two insns would have different sformats but the same iformat. Sformats +; are used in simulator extraction code to collapse the number of cases that +; must be handled. They can also be used to collapse the number of cases +; in the modeling code. +; +; The "base length" is the length of the insn that is initially fetched for +; decoding purposes. +; Formats are fixed in length. For variable instruction length architectures +; there are separate formats for each insn's possible length. + +(define <iformat> + (class-make '<iformat> + '(<ident>) + ; From <ident>: + ; - NAME is derived from number, but we might have user + ; specified formats someday [though I wouldn't add them + ; without a clear need]. + ; - COMMENT is the assembler syntax of an example insn that + ; uses the format. + '( + ; Index into the iformat table. + number + + ; Sort key, used to determine insns with identical formats. + key + + ; List of <ifield> objects. + ifields + + ; min (insn-length, base-insn-size) + mask-length + + ; total length of insns with this format + length + + ; mask of base part + mask + + ; An example insn that uses the format. + eg-insn + ) + nil) +) + +; Accessor fns. + +(define-getters <iformat> ifmt + (number key ifields mask-length length mask eg-insn) +) + +; Traverse the ifield list to collect all base (non-derived) ifields used in it. +(define (ifields-base-ifields ifld-list) + (collect (lambda (ifld) + (ifld-base-ifields ifld)) + ifld-list) +) + +; Return enum cgen_fmt_type value for FMT. +; ??? Not currently used. + +(define (ifmt-enum fmt) + (string-append "@CPU@_" (string-upcase (gen-sym fmt))) +) + +; Given FLD-LIST, compute the length of the insn in bits. +; This is done by adding up all the field sizes. +; All bits must be represent exactly once. + +(define (compute-insn-length fld-list) + (apply + (map ifld-length (collect ifld-base-ifields fld-list))) +) + +; Given FLD-LIST, compute the base length in bits. +; Computing the min of state-base-insn-bitsize and the total-length +; is for [V]LIW instruction sets. + +(define (compute-insn-base-mask-length fld-list) + (min (state-base-insn-bitsize) (compute-insn-length fld-list)) +) + +; Given FLD-LIST, compute the bitmask of constant values in the base part +; of the insn (i.e. the opcode field). +; +; FIXME: Need to add support for constant fields appearing outside the base +; insn. One way would be to record with each insn the value for each constant +; field. That would allow code to straightforwardly fetch it. Another would +; be to only record constant values appearing outside the base insn. +; +; See also (insn-value). +; +(define (compute-insn-base-mask fld-list) + (let* ((mask-len (compute-insn-base-mask-length fld-list)) + (lsb0? (ifld-lsb0? (car fld-list))) + (mask-bitrange (make <bitrange> + 0 ; word-offset + (if lsb0? (- mask-len 1) 0) ; start + mask-len ; length + mask-len ; word-length + lsb0?))) + (apply + + (map (lambda (fld) (ifld-mask fld mask-len mask-bitrange)) + ; Find the fields that have constant values. + (find ifld-constant? (collect ifld-base-ifields fld-list))) + ) + ) +) + +; Return the <iformat> search key for a sorted field list. +; This determines how iformats differ from each other. +; It also speeds up searching as the search key can be anything +; (though at present searching isn't as fast as it could be). +; INSN is passed so that we can include its sanytize attribute, if present, +; so sanytized sources work (needed formats don't disappear). + +(define (-ifmt-search-key insn sorted-ifld-list) + (string-map (lambda (ifld) + (string-append " (" + (or (obj-attr-value insn 'sanitize) + "-nosan-") + " " + (obj:name ifld) + " " + (ifld-ilk ifld) + ")")) + sorted-ifld-list) +) + +; Create an <iformat> object for INSN. +; INDEX is the ordinal to assign to the result or -1 if unknown. +; SEARCH-KEY is the search key used to determine the iformat's uniqueness. +; IFLDS is a sorted list of INSN's ifields. + +(define (ifmt-build insn index search-key iflds) + (make <iformat> + (symbol-append 'ifmt- (obj:name insn)) + (string-append "e.g. " (insn-syntax insn)) + atlist-empty + index + search-key + iflds + (compute-insn-base-mask-length iflds) + (compute-insn-length iflds) + (compute-insn-base-mask iflds) + insn) +) + +; Sformats. + +(define <sformat> + (class-make '<sformat> + '(<ident>) + ; From <ident>: + ; - NAME is derived from number. + ; - COMMENT is the assembler syntax of an example insn that + ; uses the format. + '( + ; Index into the sformat table. + number + + ; Sort key, used to determine insns with identical formats. + key + + ; Non-#f if insns with this format are cti insns. + cti? + + ; IN-OPS is a list of input operands. + ; OUT-OPS is a list of output operands. + ; These are used to distinguish the format from others, + ; so that the extract and read operations can be based on the + ; sformat. + ; The extract fns use this data to record the necessary + ; information for profiling [which isn't necessarily a property + ; of the field list]. We could have one extraction function + ; per instruction, but there's a *lot* of duplicated code, and + ; the semantic operands rarely contribute to extra formats. + ; The parallel execution support uses this data to record the + ; input (or output) values based on the instruction format, + ; again cutting down on duplicated code. + in-ops + out-ops + + ; Length of all insns with this format. + ; Since insns with different iformats can have the same sformat + ; we need to ensure ifield extraction works among the various + ; iformats. We do this by ensuring all insns with the same + ; sformat have the same length. + length + + ; Cached list of all ifields used. + ; This can be derived from IN-OPS/OUT-OPS but is computed once + ; and cached here for speed. + iflds + + ; An example insn that uses the format. + ; This is used for debugging purposes, but also to help get + ; sanytization (spelled wrong on purpose) right. + eg-insn + + ; <sformat-argbuf> entry + ; FIXME: Temporary location, to be moved elsewhere + (sbuf . #f) + ) + nil) +) + +; Accessor fns. + +(define-getters <sformat> sfmt + (number key cti? in-ops out-ops length iflds eg-insn sbuf) +) + +(define-setters <sformat> sfmt (sbuf)) + +(method-make-make! <sformat> + '(name comment attrs + number key cti? in-ops out-ops length iflds eg-insn) +) + +; Return the <sformat> search key for a sorted field list and semantic +; operands. +; This determines how sformats differ from each other. +; It also speeds up searching as the search key can be anything +; (though at present searching isn't as fast as it could be). +; +; INSN is passed so that we can include its sanytize attribute, if present, +; so sanytized sources work (needed formats don't disappear). +; SORTED-USED-IFLDS is a sorted list of ifields used by SEM-{IN,OUT}-OPS. +; Note that it is not the complete set of ifields used by INSN. +; +; We assume INSN's <iformat> has been recorded. +; +; Note: It's important to minimize the number of created sformats. It keeps +; the generated code smaller (and sometimes faster - more usable common +; fragments in pbb simulators). Don't cause spurious differences. + +(define (-sfmt-search-key insn cti? sorted-used-iflds sem-in-ops sem-out-ops) + (let ((op-key (lambda (op) + (string-append " (" + (or (obj-attr-value insn 'sanitize) + "-nosan-") + " " + (obj:name op) + ; ??? Including memory operands currently + ; isn't necessary and it can account for some + ; spurious differences. On the other hand + ; leaving it out doesn't seem like the right + ; thing to do. + (if (memory? (op:type op)) + "" + (string-append " " + (obj:name (op:mode op)))) + ; CGEN_OPERAND_INSTANCE_COND_REF is stored + ; with the operand in the operand instance + ; table thus formats must be distinguished + ; by this. + (if (op:cond? op) " cond" "") + ")"))) + ) + (list + cti? + (insn-length insn) + (string-map (lambda (ifld) + (string-append " (" (obj:name ifld) " " (ifld-ilk ifld) ")")) + sorted-used-iflds) + (string-map op-key + sem-in-ops) + (string-map op-key + sem-out-ops) + )) +) + +; Create an <sformat> object for INSN. +; INDEX is the ordinal to assign to the result or -1 if unknown. +; SEARCH-KEY is the search key used to determine the sformat's uniqueness. +; {IN,OUT}-OPS are lists of INSN's input/output operands. +; SORTED-USED-IFLDS is a sorted list of ifields used by {IN,OUT}-OPS. +; Note that it is not the complete set of ifields used by INSN. +; +; We assume INSN's <iformat> has already been recorded. + +(define (sfmt-build insn index search-key cti? in-ops out-ops sorted-used-iflds) + (make <sformat> + (symbol-append 'sfmt- (obj:name insn)) + (string-append "e.g. " (insn-syntax insn)) + atlist-empty + index + search-key + cti? + in-ops + out-ops + (insn-length insn) + sorted-used-iflds + insn) +) + +; Sort IFLDS by dependencies and then by starting bit number. + +(define (-sfmt-order-iflds iflds) + (let ((up? + ; ??? Something like this is preferable. + ;(not (ifld-lsb0? (car ifld-list))) + (not (current-arch-insn-lsb0?)))) + (let loop ((independent nil) (dependent nil) (iflds iflds)) + (cond ((null? iflds) + (append (sort-ifield-list independent up?) + (sort-ifield-list dependent up?))) + ; FIXME: quick hack. + ((multi-ifield? (car iflds)) + (loop independent (cons (car iflds) dependent) (cdr iflds))) + (else + (loop (cons (car iflds) independent) dependent (cdr iflds)))))) +) + +; Return a sorted list of ifields used by IN-OPS, OUT-OPS. +; The ifields are sorted by dependencies and then by start bit. +; The important points are to help distinguish sformat's by the ifields used +; and to put ifields that others depend on first. + +(define (-sfmt-used-iflds in-ops out-ops) + (let ((in-iflds (map op-iflds-used in-ops)) + (out-iflds (map op-iflds-used out-ops))) + (let ((all-iflds (nub (append (apply append in-iflds) + (apply append out-iflds)) + obj:name))) + (-sfmt-order-iflds all-iflds))) +) + +; The format descriptor is used to sort formats. +; This is a utility class internal to this file. +; There is one instance per insn. + +(define <fmt-desc> + (class-make '<fmt-desc> + nil + '( + ; #t if insn is a cti insn + cti? + + ; sorted list of insn's ifields + iflds + + ; computed set of input/output operands + in-ops out-ops + + ; set of ifields used by IN-OPS,OUT-OPS. + used-iflds + + ; computed set of attributes + attrs + ) + nil) +) + +; Accessors. + +(define-getters <fmt-desc> -fmt-desc + (cti? iflds in-ops out-ops used-iflds attrs) +) + +; Compute an iformat descriptor used to build an <iformat> object for INSN. +; +; If COMPUTE-SFORMAT? is #t compile the semantics and compute the semantic +; format (same as instruction format except that operands are used to +; distinguish insns). +; Attributes derivable from the semantics are also computed. +; This is all done at the same time to minimize the number of times the +; semantic code is traversed. +; +; The result is (descriptor compiled-semantics attrs). +; `descriptor' is #f for insns with an empty field list +; (this happens for virtual insns). +; `compiled-semantics' is #f if COMPUTE-SFORMAT? is #f. +; `attrs' is an <attr-list> object of attributes derived from the semantics. +; +; ??? We never traverse the semantics of virtual insns. + +(define (ifmt-analyze insn compute-sformat?) + ; First sort by starting bit number the list of fields in INSN. + (let ((sorted-ifields + (sort-ifield-list (insn-iflds insn) + ; ??? Something like this is preferable, but + ; if the first insn is a virtual insn there are + ; no fields. + ;(not (ifld-lsb0? (car (insn-iflds insn)))) + (not (current-arch-insn-lsb0?)) + ))) + + (if (null? sorted-ifields) + + ; Field list is unspecified. + (list #f #f atlist-empty) + + ; FIXME: error checking (e.g. missing or overlapping bits) + (let* (; A list of the various bits of semantic code. + (sems (list (insn-semantics insn))) + ; Compute list of input and output operands if asked for. + (sem-ops (if compute-sformat? + (semantic-compile #f ; FIXME: context + insn sems) + (csem-make #f #f #f + (if (insn-semantics insn) + (semantic-attrs #f ; FIXME: context + insn sems) + atlist-empty)))) + ) + (let ((compiled-sems (csem-code sem-ops)) + (in-ops (csem-inputs sem-ops)) + (out-ops (csem-outputs sem-ops)) + (attrs (csem-attrs sem-ops)) + (cti? (or (atlist-cti? (csem-attrs sem-ops)) + (insn-cti? insn)))) + (list (make <fmt-desc> + cti? sorted-ifields in-ops out-ops + (if (and in-ops out-ops) + (-sfmt-used-iflds in-ops out-ops) + #f) + attrs) + compiled-sems + attrs))))) +) + +; Subroutine of ifmt-compute!, to simplify it. +; Lookup INSN's iformat in IFMT-LIST and if not found add it. +; FMT-DESC is INSN's <fmt-desc> object. +; IFMT-LIST is append!'d to and the found iformat is stored in INSN. + +(define (-ifmt-lookup-ifmt! insn fmt-desc ifmt-list) + (let* ((search-key (-ifmt-search-key insn (-fmt-desc-iflds fmt-desc))) + (ifmt (find-first (lambda (elm) + (equal? (ifmt-key elm) search-key)) + ifmt-list))) + + (if ifmt + + ; Format was found, use it. + (begin + (logit 3 "Using iformat " (number->string (ifmt-number ifmt)) ".\n") + (insn-set-ifmt! insn ifmt) + ) + + ; Format wasn't found, create new entry. + (let* ((ifmt-index (length ifmt-list)) + (ifmt (ifmt-build insn ifmt-index search-key + (ifields-base-ifields (-fmt-desc-iflds fmt-desc))))) + (logit 3 "Creating iformat " (number->string ifmt-index) ".\n") + (insn-set-ifmt! insn ifmt) + (append! ifmt-list (list ifmt)) + ) + )) + + *UNSPECIFIED* +) + +; Subroutine of ifmt-compute!, to simplify it. +; Lookup INSN's sformat in SFMT-LIST and if not found add it. +; FMT-DESC is INSN's <fmt-desc> object. +; SFMT-LIST is append!'d to and the found sformat is stored in INSN. +; +; We assume INSN's <iformat> has already been recorded. + +(define (-ifmt-lookup-sfmt! insn fmt-desc sfmt-list) + (let* ((search-key (-sfmt-search-key insn (-fmt-desc-cti? fmt-desc) + (-fmt-desc-used-iflds fmt-desc) + (-fmt-desc-in-ops fmt-desc) + (-fmt-desc-out-ops fmt-desc))) + (sfmt (find-first (lambda (elm) + (equal? (sfmt-key elm) search-key)) + sfmt-list))) + + (if sfmt + + ; Format was found, use it. + (begin + (logit 3 "Using sformat " (number->string (sfmt-number sfmt)) ".\n") + (insn-set-sfmt! insn sfmt) + ) + + ; Format wasn't found, create new entry. + (let* ((sfmt-index (length sfmt-list)) + (sfmt (sfmt-build insn sfmt-index search-key + (-fmt-desc-cti? fmt-desc) + (-fmt-desc-in-ops fmt-desc) + (-fmt-desc-out-ops fmt-desc) + (-fmt-desc-used-iflds fmt-desc)))) + (logit 3 "Creating sformat " (number->string sfmt-index) ".\n") + (insn-set-sfmt! insn sfmt) + (append! sfmt-list (list sfmt)) + ) + )) + + *UNSPECIFIED* +) + +; Main entry point. + +; Given a list of insns, compute the set of instruction formats, semantic +; formats, semantic attributes, and compiled semantics for each insn. +; +; The computed <iformat> object is stored in the `ifmt' field of each insn. +; +; Attributes derived from the semantic code are added to the insn's attributes, +; but they don't override any prespecified values. +; +; If COMPUTE-SFORMAT? is #t, the computed <sformat> object is stored in the +; `sfmt' field of each insn, and the processed semantic code is stored in the +; `compiled-semantics' field of each insn. +; +; The `fmt-desc' field of each insn is used to store an <fmt-desc> object +; which contains the search keys, sorted field list, input-operands, and +; output-operands, and is not used outside this procedure. +; +; The result is a list of two lists: the set of computed iformats, and the +; set of computed sformats. +; +; *** This is the most expensive calculation in CGEN. *** +; *** (mainly because of the detailed semantic parsing) *** + +(define (ifmt-compute! insn-list compute-sformat?) + (logit 2 "Computing instruction formats and analyzing semantics ...\n") + + ; First analyze each insn, storing the result in fmt-desc. + ; If asked to, convert the semantic code to a compiled form to simplify more + ; intelligent processing of it later. + + (for-each (lambda (insn) + (logit 3 "Scanning operands of " (obj:name insn) ": " + (insn-syntax insn) " ...\n") + (let ((sem-ops (ifmt-analyze insn compute-sformat?))) + (insn-set-fmt-desc! insn (car sem-ops)) + (if (and compute-sformat? (cadr sem-ops)) + (let ((compiled-sems (cadr sem-ops))) + (insn-set-compiled-semantics! insn (car compiled-sems)))) + (obj-set-atlist! insn + (atlist-append (obj-atlist insn) + (caddr sem-ops))) + )) + insn-list) + + ; Now for each insn, look up the ifield list in the format table (and if not + ; found add it), and set the ifmt/sfmt elements of the insn. + + (let* ((empty-ifmt (make <iformat> + 'ifmt-empty + "empty iformat for unspecified field list" + atlist-empty ; attrs + -1 ; number + #f ; key + nil ; fields + 0 ; mask-length + 0 ; length + 0 ; mask + #f)) ; eg-insn + (empty-sfmt (make <sformat> + 'sfmt-empty + "empty sformat for unspecified field list" + atlist-empty ; attrs + -1 ; number + #f ; key + #f ; cti? + nil ; sem-in-ops + nil ; sem-out-ops + 0 ; length + nil ; used iflds + #f)) ; eg-insn + (ifmt-list (list empty-ifmt)) + (sfmt-list (list empty-sfmt)) + ) + + (for-each (lambda (insn) + (logit 3 "Processing format for " (obj:name insn) ": " + (insn-syntax insn) " ...\n") + + (let ((fmt-desc (insn-fmt-desc insn))) + + (if fmt-desc + + (begin + ; Must compute <iformat> before <sformat>, the latter + ; needs the former. + (-ifmt-lookup-ifmt! insn fmt-desc ifmt-list) + (if compute-sformat? + (-ifmt-lookup-sfmt! insn fmt-desc sfmt-list))) + + ; No field list present, use empty format. + (begin + (insn-set-ifmt! insn empty-ifmt) + (if compute-sformat? + (insn-set-sfmt! insn empty-sfmt)))))) + + (non-multi-insns insn-list)) + + ; Done. Return the computed iformat and sformat lists. + (list ifmt-list sfmt-list) + ) +) diff --git a/cgen/insn.scm b/cgen/insn.scm new file mode 100644 index 00000000000..bb39a7f6b39 --- /dev/null +++ b/cgen/insn.scm @@ -0,0 +1,958 @@ +; Instruction definitions. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Class to hold an insn. + +(define <insn> + (class-make '<insn> + '(<ident>) + '( + ; Used to explicitly specify mnemonic, now it's computed from + ; syntax string. ??? Might be useful as an override someday. + ;mnemonic + + ; Instruction syntax string. + syntax + + ; The insn fields as specified in the .cpu file. + ; Also contains values for constant fields. + iflds + (iflds-values . #f) ; Lazily computed cache + + ; RTL source of assertions of ifield values or #f if none. + ; This is used, for example, by the decoder to help + ; distinguish what would otherwise be an ambiguity in the + ; specification. It is also used by decode-split support. + ; ??? It could also be used the the assembler/disassembler + ; some day. + (ifield-assertion . #f) + + ; The <fmt-desc> of the insn. + ; This is used to help calculate the ifmt,sfmt members. + fmt-desc + + ; The <iformat> of the insn. + ifmt + + ; The <sformat> of the insn. + sfmt + + ; Temp slot for use by applications. + ; ??? Will go away in time. + tmp + + ; Instruction semantics. + ; This is the rtl in source form or #f if there is none. + ; + ; There are a few issues (ick, I hate that word) to consider + ; here: + ; - some apps don't need the trap checks (e.g. SIGSEGV) + ; - some apps treat the pieces in different ways + ; - the simulator tries to merge common fragments among insns + ; to reduce code size in a pbb simulator + ; + ; Some insns don't have any semantics at all, they are defined + ; in another insn [akin to anonymous patterns in gcc]. wip. + ; + ; ??? GCC-like apps will need a new field to allow specifying + ; the semantics if a different value is needed. wip. + ; ??? May wish to put this and the compiled forms in a + ; separate class. + ; ??? Contents of trap expressions is wip. It will probably + ; be a sequence with an #:errchk modifier or some such. + (semantics . #f) + + ; The processed form of the above. + ; Each element of rtl is replaced with the associated object. + (compiled-semantics . #f) + + ; The mapping of the semantics onto the host. + ; FIXME: Not sure what its value will be. + ; Another thing that will be needed is [in some cases] a more + ; simplified version of the RTL for use by apps like compilers. + ; Perhaps that's what this will become. + host-semantics + + ; The function unit usage of the instruction. + timing + ) + nil) +) + +(method-make-make! <insn> + '(name comment attrs syntax iflds ifield-assertion + semantics timing) +) + +; Accessor fns + +(define-getters <insn> insn + (syntax iflds ifield-assertion fmt-desc ifmt sfmt tmp + semantics compiled-semantics host-semantics timing) +) + +(define-setters <insn> insn + (fmt-desc ifmt sfmt ifield-assertion compiled-semantics) +) + +; Return a boolean indicating if X is an <insn>. + +(define (insn? x) (class-instance? <insn> x)) + +; Return a list of the machs that support INSN. + +(define (insn-machs insn) + nil ; ??? wip +) + +; Return the length of INSN in bits. + +(define (insn-length insn) + (ifmt-length (insn-ifmt insn)) +) + +; Return the length of INSN in bytes. + +(define (insn-length-bytes insn) + (bits->bytes (insn-length insn)) +) + +; Return instruction mnemonic. +; This is computed from the syntax string. +; The mnemonic, as we define it, is everything up to, but not including, the +; first space or '$'. +; FIXME: Rename to syntax-mnemonic, and take a syntax string argument. + +(define (insn-mnemonic insn) + (letrec ((mnem-len (lambda (str len) + (cond ((= (string-length str) 0) len) + ((char=? #\space (string-ref str 0)) len) + ((char=? #\$ (string-ref str 0)) len) + (else (mnem-len (string-drop1 str) (+ len 1))))))) + (string-take (mnem-len (insn-syntax insn) 0) (insn-syntax insn))) +) + +; Return enum cgen_insn_types value for INSN. + +(define (insn-enum insn) + (string-upcase (string-append "@ARCH@_INSN_" (gen-sym insn))) +) + +; Return enum for insn named INSN-NAME. +; This is needed for the `invalid' insn, there is no object for it. +; [Though obviously having such an object seems like a good idea.] + +(define (gen-insn-enum insn-name) + (string-upcase (string-append "@ARCH@_INSN_" (gen-c-symbol insn-name))) +) + +; Insns with derived operands (see define-derived-operand). +; ??? These are [currently] recorded separately to minimize impact on existing +; code while the design is worked out. +; +; The class is called <multi-insn> because the insn has multiple variants, +; one for each combination of "anyof" alternatives. +; Internally we create one <insn> per alternative. The theory is that this +; will remain an internal implementation issue. When appropriate applications +; will collapse the number of insns in a way that is appropriate for them. +; +; ??? Another way to do this is with insn templates. One problem the current +; way has is that it requires each operand's assembler syntax to be self +; contained (one way to fix this is to use "fake" operands like before). +; Insn templates needn't have this problem. On the other hand insn templates +; [seem to] require more description file entries. +; +; ??? This doesn't use all of the members of <insn>. +; The <multi-insn> class is wip, but should eventually reorganize <insn>. +; This reorganization might also take into account real, virtual, etc. insns. + +(define <multi-insn> + (class-make '<multi-insn> + '(<insn>) + '( + ; An <insn> is created for each combination of "anyof" + ; alternatives. They are recorded with other insns, but a + ; list of them is recorded here as well. + ; This is #f if the sub-insns haven't been instantiated yet. + (sub-insns . #f) + ) + nil) +) + +(method-make-make! <multi-insn> + '(name comment attrs syntax iflds ifield-assertion + semantics timing) +) + +(define-getters <multi-insn> multi-insn (sub-insns)) + +; Return a boolean indicating if X is a <multi-insn>. + +(define (multi-insn? x) (class-instance? <multi-insn> x)) + +; Subroutine of -sub-insn-make! to create the ifield list. +; Return encoding of {insn} with each element of {anyof-operands} replaced +; with {new-values}. +; {value-names} is a list of names of {anyof-operands}. + +(define (-sub-insn-ifields insn anyof-operands value-names new-values) + ; (debug-repl-env insn anyof-operands value-names new-values) + + ; Delete ifields of {anyof-operands} and add those for {new-values}. + (let ((iflds + (append! + ; Delete ifields in {anyof-operands}. + (find (lambda (f) + (not (and (ifld-anyof-operand? f) + (memq (obj:name (ifld-get-value f)) + value-names)))) + (insn-iflds insn)) + ; Add ifields for {new-values}. + (map derived-encoding new-values))) + + ; Return the last ifield of OWNER in IFLD-LIST. + ; OWNER is the object that owns the <ifield> we want. + ; For ifields, the owner is the ifield itself. + ; For operands, the owner is the operand. + ; For derived operands, the owner is the "anyof" parent. + ; IFLD-LIST is an unsorted list of <ifield> elements. + (find-preceder + (lambda (ifld-list owner) + ;(debug-repl-env ifld-list owner) + (cond ((ifield? owner) + owner) + ((anyof-operand? owner) + ; This is the interesting case. The instantiated choice of + ; {owner} is in {ifld-list}. We have to find it. + (let* ((name (obj:name owner)) + (result + (find-first (lambda (f) + (and (derived-ifield? f) + (anyof-instance? (derived-ifield-owner f)) + (eq? name (obj:name (anyof-instance-parent (derived-ifield-owner f)))))) + ifld-list))) + ;(debug-repl-env ifld-list owner) + (assert result) + result)) + ((operand? owner) ; derived operands are handled here too + (let ((result (op-ifield owner))) + (assert result) + result)) + (else + (error "`owner' not <ifield>, <operand>, or <derived-operand>"))))) + ) + + ; Resolve any `follows' specs. + ; Bad worst case performance but ifield lists aren't usually that long. + ; FIXME: Doesn't handle A following B following C. + (map (lambda (f) + (let ((follows (ifld-follows f))) + (if follows + (let ((preceder (find-preceder iflds follows))) + (ifld-new-word-offset f (ifld-next-word preceder))) + f))) + iflds)) +) + + +; Subroutine of multi-insn-instantiate! to instantiate one insn. +; INSN is the parent insn. +; ANYOF-OPERANDS is a list of the <anyof-operand>'s of INSN. +; NEW-VALUES is a list of the value to use for each corresponding element in +; ANYOF-OPERANDS. Each element is a <derived-operand>. + +(define (-sub-insn-make! insn anyof-operands new-values) + ;(debug-repl-env insn anyof-operands new-values) + (assert (= (length anyof-operands) (length new-values))) + (assert (all-true? (map anyof-operand? anyof-operands))) + (assert (all-true? (map derived-operand? new-values))) + (logit 3 "Instantiating " + (obj:name insn) + ":" + (string-map (lambda (op newval) + (string-append " " + (obj:name op) + "=" + (obj:name newval))) + anyof-operands new-values) + " ...\n") + +; (if (eq? '@sib+disp8-QI-disp32-8 +; (obj:name (car new-values))) +; (debug-repl-env insn anyof-operands new-values)) + + (let* ((value-names (map obj:name anyof-operands)) + (ifields (-sub-insn-ifields insn anyof-operands value-names new-values)) + (known-values (ifld-known-values ifields))) + + ; Don't create insn if ifield assertions fail. + (if (all-true? (map (lambda (op) + (anyof-satisfies-assertions? op known-values)) + new-values)) + + (let ((sub-insn + (make <insn> + (apply symbol-append + (cons (obj:name insn) + (map (lambda (anyof) + (symbol-append '- (obj:name anyof))) + new-values))) + (obj:comment insn) + (obj-atlist insn) + (-anyof-merge-syntax (insn-syntax insn) + value-names new-values) + ifields + (insn-ifield-assertion insn) ; FIXME + (anyof-merge-semantics (insn-semantics insn) + value-names new-values) + (insn-timing insn) + ))) + (logit 3 " instantiated.\n") + (current-insn-add! sub-insn)) + + (begin + logit 3 " failed ifield assertions.\n"))) + + *UNSPECIFIED* +) + +; Instantiate all sub-insns of MULTI-INSN. +; ??? Might be better to return the list of insns, rather than add them to +; the global list, and leave it to the caller to add them. + +(define (multi-insn-instantiate! multi-insn) + (logit 2 "Instantiating " (obj:name multi-insn) " ...\n") + + ; We shouldn't get called more than once. + ; ??? Though we could ignore second and subsequent calls. + (assert (not (multi-insn-sub-insns multi-insn))) + + (let ((iflds (insn-iflds multi-insn))) + + ; What we want to create here is the set of all "anyof" alternatives. + ; From that we create one <insn> per alternative. + + (let ((anyof-iflds (find ifld-anyof-operand? iflds))) + + (assert (all-true? (map anyof-operand? (map ifld-get-value anyof-iflds)))) + ;(display (obj:name multi-insn) (current-error-port)) + ;(display " anyof: " (current-error-port)) + ;(display (map obj:name (map ifld-get-value anyof-iflds)) (current-error-port)) + ;(newline (current-error-port)) + + ; Iterate over all combinations. + ; TODO is a list with one element for each <anyof-operand>. + ; Each element is in turn a list of all choices (<derived-operands>'s) + ; for the <anyof-operand>. Note that some of these values may be + ; derived from nested <anyof-operand>'s. + ; ??? anyof-all-choices should cache the results. + ; ??? Need to cache results of assertion processing in addition or + ; instead of anyof-all-choices. + + (let* ((anyof-operands (map ifld-get-value anyof-iflds)) + (todo (map anyof-all-choices anyof-operands)) + (lengths (map length todo)) + (total (apply * lengths))) + ; ??? One might prefer a `do' loop here, but every time I see one I + ; have to spend too long remembering its syntax. + (let loop ((i 0)) + (if (< i total) + (let* ((indices (split-value lengths i)) + (anyof-instances (map list-ref todo indices))) + ;(display "derived: " (current-error-port)) + ;(display (map obj:name anyof-instances) (current-error-port)) + ;(newline (current-error-port)) + (-sub-insn-make! multi-insn anyof-operands anyof-instances) + (loop (+ i 1)))))))) + + *UNSPECIFIED* +) + +; Parse an instruction description. +; This is the main routine for building an insn object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if insn isn't for selected mach(s). + +(define (-insn-parse errtxt name comment attrs syntax fmt ifield-assertion + semantics timing) + (logit 2 "Processing insn " name " ...\n") + + (let ((name (parse-name name errtxt)) + (atlist-obj (atlist-parse attrs "cgen_insn" errtxt))) + + (if (keep-atlist? atlist-obj #f) + + (let ((ifield-assertion (if (not (null? ifield-assertion)) + ifield-assertion + #f)) + (semantics (if (not (null? semantics)) + semantics + #f)) + (format (-parse-insn-format (string-append errtxt " format") + fmt)) + (comment (parse-comment comment errtxt)) + ; If there are no semantics, mark this as an alias. + ; ??? Not sure this makes sense for multi-insns. + (atlist-obj (if semantics + atlist-obj + (atlist-cons (bool-attr-make 'ALIAS #t) + atlist-obj))) + (syntax (parse-syntax syntax errtxt)) + (timing (parse-insn-timing errtxt timing)) + ) + + (if (anyof-operand-format? format) + + (make <multi-insn> + name comment atlist-obj + syntax + format + ifield-assertion + semantics + timing) + + (make <insn> + name comment atlist-obj + syntax + format + ifield-assertion + semantics + timing))) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read an instruction description. +; This is the main routine for analyzing instructions in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -insn-parse is invoked to create the <insn> object. + +(define (insn-read errtxt . arg-list) + (let ((name nil) + (comment "") + (attrs nil) + (syntax nil) + (fmt nil) + (ifield-assertion nil) + (semantics nil) + (timing nil) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((syntax) (set! syntax (cadr arg))) + ((format) (set! fmt (cadr arg))) + ((ifield-assertion) (set! ifield-assertion (cadr arg))) + ((semantics) (set! semantics (cadr arg))) + ((timing) (set! timing (cdr arg))) + (else (parse-error errtxt "invalid insn arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-insn-parse errtxt name comment attrs syntax fmt ifield-assertion + semantics timing) + ) +) + +; Define an instruction object, name/value pair list version. + +(define define-insn + (lambda arg-list + (let ((i (apply insn-read (cons "define-insn" arg-list)))) + (if i + (current-insn-add! i)) + i)) +) + +; Define an instruction object, all arguments specified. + +(define (define-full-insn name comment attrs syntax fmt ifield-assertion + semantics timing) + (let ((i (-insn-parse "define-full-insn" name comment attrs + syntax fmt ifield-assertion + semantics timing))) + (if i + (current-insn-add! i)) + i) +) + +; Parsing support. + +; Parse an insn syntax field. +; SYNTAX is either a string or a list of strings, each element of which may +; in turn be a list of strings. +; ??? Not sure this extra flexibility is worth it yet. + +(define (parse-syntax syntax errtxt) + (cond ((list? syntax) + (string-map (lambda (elm) (parse-syntax elm errtxt)) syntax)) + ((or (string? syntax) (symbol? syntax)) + syntax) + (else (parse-error errtxt "improper syntax" syntax))) +) + +; Subroutine of -parse-insn-format to parse a symbol ifield spec. + +(define (-parse-insn-format-symbol errtxt sym) + ;(debug-repl-env sym) + (let ((op (current-op-lookup sym))) + (if op + (cond ((derived-operand? op) + ; There is a one-to-one relationship b/w derived operands and + ; the associated derived ifield. + (let ((ifld (op-ifld op))) + (assert (derived-ifield? ifld)) + ifld)) + ((anyof-operand? op) + (ifld-new-value f-anyof op)) + (else + (let ((ifld (op-ifield op))) + (ifld-new-value ifld op)))) + ; An insn-enum? + (let ((e (ienum-lookup-val sym))) + (if e + (ifld-new-value (ienum:fld (cdr e)) (car e)) + (parse-error errtxt "bad format element" sym))))) +) + +; Subroutine of -parse-insn-format to parse an (ifield-name value) ifield spec. +; +; The last element is the ifield's value. It must be an integer. +; ??? Whether it can be negative is still unspecified. +; ??? While there might be a case where allowing floating point values is +; desirable, supporting them would require precise conversion routines. +; They should be rare enough that we instead punt. +; +; ??? May wish to support something like "(% startbit bitsize value)". +; +; ??? Error messages need improvement, but that's generally true of cgen. + +(define (-parse-insn-format-ifield-spec errtxt ifld ifld-spec) + (if (!= (length ifld-spec) 2) + (parse-error errtxt "bad ifield format, should be (ifield-name value)" ifld-spec)) + + (let ((value (cadr ifld-spec))) + ; ??? This use to allow (ifield-name operand-name). That's how + ; `operand-name' elements are handled, but there's no current need + ; to handle (ifield-name operand-name). + (if (not (integer? value)) + (parse-error errtxt "ifield value not an integer" ifld-spec)) + (ifld-new-value ifld value)) +) + +; Subroutine of -parse-insn-format to parse an +; (ifield-name value) ifield spec. +; ??? There is room for growth in the specification syntax here. +; Possibilities are (ifield-name|operand-name [options] [value]). + +(define (-parse-insn-format-list errtxt spec) + (let ((ifld (current-ifld-lookup (car spec)))) + (if ifld + (-parse-insn-format-ifield-spec errtxt ifld spec) + (parse-error errtxt "unknown ifield" spec))) +) + +; Given an insn format field from a .cpu file, replace it with a list of +; ifield objects with the values assigned. +; +; An insn format field is a list of ifields that make up the instruction. +; All bits must be specified, including reserved bits +; [at present no checking is made of this, but the rule still holds]. +; +; A normal entry begins with `+' and then consist of the following: +; - operand name +; - (ifield-name [options] value) +; - (operand-name [options] [value]) +; - insn ifield enum +; +; Example: (+ OP1_ADD (f-res2 0) dr src1 (f-src2 1) (f-res1 #xea)) +; +; where OP1_ADD is an enum, dr and src1 are operands, and f-src2 and f-res1 +; are ifield's. The `+' allows for future extension. +; +; The other form of entry begins with `=' and is followed by an instruction +; name that has the same format. The specified instruction must already be +; defined. Instructions with this form typically also include an +; `ifield-assertion' spec to keep them separate. +; +; An empty field list is ok. This means it's unspecified. +; VIRTUAL insns have this. +; +; This is one of the more important routines to be efficient. +; It's called for each instruction, and is one of the more expensive routines +; in insn parsing. + +(define (-parse-insn-format errtxt fld-list) + (if (null? fld-list) + nil ; field list unspecified + (case (car fld-list) + ((+) (map (lambda (fld) + (let ((f (if (string? fld) + (string->symbol fld) + fld))) + (cond ((symbol? f) + (-parse-insn-format-symbol errtxt f)) + ((and (list? f) + ; ??? This use to allow <ifield> objects + ; in the `car' position. Checked for below. + (symbol? (car f))) + (-parse-insn-format-list errtxt f)) + (else + (if (and (list? f) + (ifield? (car f))) + (parse-error errtxt "FIXME: <ifield> object in format spec")) + (parse-error errtxt "bad format element" f))))) + (cdr fld-list))) + ((=) (begin + (if (or (!= (length fld-list) 2) + (not (symbol? (cadr fld-list)))) + (parse-error errtxt + "bad `=' format spec, should be `(= insn-name)'" + fld-list)) + (let ((insn (current-insn-lookup (cadr fld-list)))) + (if (not insn) + (parse-error errtxt "unknown insn" (cadr fld-list))) + (insn-iflds insn)))) + (else + (parse-error errtxt "format must begin with `+' or `='" fld-list)) + )) +) + +; Return a boolean indicating if IFLD-LIST contains anyof operands. + +(define (anyof-operand-format? ifld-list) + (any-true? (map (lambda (f) + (or (ifld-anyof? f) + (derived-ifield? f))) + ifld-list)) +) + +; Insn utilities. +; ??? multi-insn support wip, may require changes here. + +; Return a boolean indicating if INSN is an alias insn. + +(define (insn-alias? insn) + (obj-has-attr? insn 'ALIAS) +) + +; Return a list of instructions that are not aliases in INSN-LIST. + +(define (non-alias-insns insn-list) + (find (lambda (insn) + (not (insn-alias? insn))) + insn-list) +) + +; Return a boolean indicating if INSN is a "real" INSN +; (not ALIAS and not VIRTUAL and not a <multi-insn>). + +(define (insn-real? insn) + (let ((atlist (obj-atlist insn))) + (and (not (atlist-has-attr? atlist 'ALIAS)) + (not (atlist-has-attr? atlist 'VIRTUAL)) + (not (multi-insn? insn)))) +) + +; Return a list of real instructions in INSN-LIST. + +(define (real-insns insn-list) + (find insn-real? insn-list) +) + +; Return a boolean indicating if INSN is a virtual insn. + +(define (insn-virtual? insn) + (obj-has-attr? insn 'VIRTUAL) +) + +; Return a list of virtual instructions in INSN-LIST. + +(define (virtual-insns insn-list) + (find insn-virtual? insn-list) +) + +; Return a list of non-alias/non-pbb insns in INSN-LIST. + +(define (non-alias-pbb-insns insn-list) + (find (lambda (insn) + (let ((atlist (obj-atlist insn))) + (and (not (atlist-has-attr? atlist 'ALIAS)) + (not (atlist-has-attr? atlist 'PBB))))) + insn-list) +) + +; Return a list of multi-insns in INSN-LIST. + +(define (multi-insns insn-list) + (find multi-insn? insn-list) +) + +; And the opposite: + +(define (non-multi-insns insn-list) + (find (lambda (insn) (not (multi-insn? insn))) insn-list) +) + + +; Filter out instructions whose ifield patterns are strict subsets of +; another. For decoding purpose, it is sufficient to consider the +; more general cousin. + +(define (filter-harmlessly-ambiguous-insns insn-list) + (logit 3 "Filtering " (length insn-list) " instructions.\n") + (find (lambda (insn) + (let* ((i-mask (insn-base-mask insn)) + (i-mask-len (insn-base-mask-length insn)) + (i-value (insn-value insn)) + (superset-insn (find-first + (lambda (insn2) ; insn2: possible supermatch (fewer mask bits) + (let ((i2-mask (insn-base-mask insn2)) + (i2-mask-len (insn-base-mask-length insn2)) + (i2-value (insn-value insn2))) + (and (not (eq? insn insn2)) + (= i-mask-len i2-mask-len) + (mask-superset? i2-mask i2-value i-mask i-value)))) + insn-list)) + (keep? (not superset-insn))) + (if (not keep?) + (logit 2 + "Instruction " (obj:name insn) "ambiguity-filtered by " + (obj:name superset-insn) "\n")) + keep?)) + insn-list) +) + + +; Helper function for above: does (m1,v1) match a superset of (m2,v2) ? +; +; eg> mask-superset? #b1100 #b1000 #b1110 #b1010 -> #t +; eg> mask-superset? #b1100 #b1000 #b1010 #b1010 -> #f +; eg> mask-superset? #b1100 #b1000 #b1110 #b1100 -> #f +(define (mask-superset? m1 v1 m2 v2) + (let ((result + (and (= (cg-logand m1 m2) m1) + (= (cg-logand m1 v1) (cg-logand m1 v2))))) + (if result (logit 4 + "(" (number->string m1 16) "," (number->string v1 16) ")" + " contains " + "(" (number->string m2 16) "," (number->string v2 16) ")" + "\n")) + result) +) + + + + +; Return a boolean indicating if INSN is a cti [control transfer insn]. +; This includes SKIP-CTI insns even though they don't terminate a basic block. +; ??? SKIP-CTI insns are wip, waiting for more examples of how they're used. + +(define (insn-cti? insn) + (atlist-cti? (obj-atlist insn)) +) + +; Return a boolean indicating if INSN can be executed in parallel. +; Such insns are required to have enum attribute PARALLEL != NO. +; This is worded specifically to allow the PARALLEL attribute to have more +; than just NO/YES values (should a target want to do so). +; This specification may not be sufficient, but the intent is explicit. + +(define (insn-parallel? insn) + (let ((atval (obj-attr-value insn 'PARALLEL))) + (and atval (not (eq? atval 'NO)))) +) + +; Return a list of the insns that support parallel execution in INSN-LIST. + +(define (parallel-insns insn-list) + (find insn-parallel? insn-list) +) + +; Instruction field utilities. + +; Return a boolean indicating if INSN has ifield named F-NAME. + +(define (insn-has-ifield? insn f-name) + (->bool (object-assq f-name (insn-iflds insn))) +) + +; Insn opcode value utilities. + +; Given INSN, return the length in bits of the base mask (insn-base-mask). + +(define (insn-base-mask-length insn) + (ifmt-mask-length (insn-ifmt insn)) +) + +; Given INSN, return the bitmask of constant values (the opcode field) +; in the base part. + +(define (insn-base-mask insn) + (ifmt-mask (insn-ifmt insn)) +) + +; Given INSN, return the sum of the constant values in the insn +; (i.e. the opcode field). +; +; See also (compute-insn-base-mask). +; +(define (insn-value insn) + (if (elm-get insn 'iflds-values) + (elm-get insn 'iflds-values) + (let* ((base-len (insn-base-mask-length insn)) + (value (apply + + (map (lambda (fld) (ifld-value fld base-len (ifld-get-value fld))) + (find ifld-constant? + (collect ifld-base-ifields (insn-iflds insn)))) + ))) + (elm-set! insn 'iflds-values value) + value) + ) + ) + +; Insn operand utilities. + +; Lookup operand SEM-NAME in INSN. + +(define (insn-lookup-op insn sem-name) + (or (op:lookup-sem-name (sfmt-in-ops (insn-sfmt insn)) sem-name) + (op:lookup-sem-name (sfmt-out-ops (insn-sfmt insn)) sem-name)) +) + +; Insn syntax utilities. + +; Create a list of syntax strings broken up into a list of characters and +; operand objects. + +(define (syntax-break-out syntax) + (let ((result nil)) + ; ??? The style of the following could be more Scheme-like. Later. + (let loop () + (if (> (string-length syntax) 0) + (begin + (cond + ; Handle escaped syntax metacharacters + ((char=? #\\ (string-ref syntax 0)) + (set! result (cons (substring syntax 0 1) result)) + (set! result (cons (substring syntax 1 1) result)) + (set! syntax (string-drop 2 syntax))) + ; Handle operand reference + ((char=? #\$ (string-ref syntax 0)) + ; Extract the symbol from the string, get the operand. + (if (char=? #\{ (string-ref syntax 1)) + (let ((n (string-index syntax #\}))) + (set! result (cons (current-op-lookup + (string->symbol + (substring syntax 2 n))) + result)) + (set! syntax (string-drop (+ 1 n) syntax))) + (let ((n (id-len (string-drop1 syntax)))) + (set! result (cons (current-op-lookup + (string->symbol + (substring syntax 1 (+ 1 n)))) + result)) + (set! syntax (string-drop (+ 1 n) syntax))))) + ; Handle everything else + (else (set! result (cons (substring syntax 0 1) result)) + (set! syntax (string-drop1 syntax)))) + (loop)))) + (reverse result)) + ) + +; Given a list of syntax elements (e.g. the result of syntax-break-out), +; create a syntax string. + +(define (syntax-make elements) + (apply string-append + (map (lambda (e) + (cond ((char? e) + (string "\\" e)) + ((string? e) + e) + (else + (assert (operand? e)) + (string-append "${" (obj:name e) "}")))) + elements)) +) + +; Called before a .cpu file is read in. + +(define (insn-init!) + (reader-add-command! 'define-insn + "\ +Define an instruction, name/value pair list version. +" + nil 'arg-list define-insn) + (reader-add-command! 'define-full-insn + "\ +Define an instruction, all arguments specified. +" + nil '(name comment attrs syntax fmt ifield-assertion semantics timing) + define-full-insn) + + *UNSPECIFIED* +) + +; Called before a . cpu file is read in to install any builtins. + +(define (insn-builtin!) + ; Standard insn attributes. + ; ??? Some of these can be combined into one. + + (define-attr '(for insn) '(type boolean) '(name UNCOND-CTI) '(comment "unconditional cti")) + + (define-attr '(for insn) '(type boolean) '(name COND-CTI) '(comment "conditional cti")) + + ; SKIP-CTI: one or more immediately following instructions are conditionally + ; executed (or skipped) + (define-attr '(for insn) '(type boolean) '(name SKIP-CTI) '(comment "skip cti")) + + ; DELAY-SLOT: insn has one or more delay slots (wip) + (define-attr '(for insn) '(type boolean) '(name DELAY-SLOT) '(comment "insn has a delay slot")) + + ; RELAXABLE: Insn has one or more identical but larger variants. + ; The assembler tries this one first and then the relaxation phase + ; switches to the larger ones as necessary. + ; All insns of identical behaviour have a RELAX_FOO attribute that groups + ; them together. + ; FIXME: This is a case where we need one attribute with several values. + ; Presently each RELAX_FOO will use up a bit. + (define-attr '(for insn) '(type boolean) '(name RELAXABLE) '(comment "insn is relaxable")) + + ; RELAX: Large relaxable variant. Avoided by assembler in first pass. + ; FIXME: Rename this to RELAXED. + (define-attr '(for insn) '(type boolean) '(name RELAX) '(comment "relaxed form of insn")) + + ; NO-DIS: For macro insns, do not use during disassembly. + (define-attr '(for insn) '(type boolean) '(name NO-DIS) '(comment "don't use for disassembly")) + + ; PBB: Virtual insn used for PBB support. + (define-attr '(for insn) '(type boolean) '(name PBB) '(comment "virtual insn used for PBB support")) + + ; DECODE-SPLIT: insn resulted from decode-split processing + (define-attr '(for insn) '(type boolean) '(name DECODE-SPLIT) '(comment "insn split from another insn for decoding purposes") '(attrs META)) + + ; Also (defined elsewhere): + ; VIRTUAL: Helper insn used by the simulator. + + *UNSPECIFIED* +) + +; Called after the .cpu file has been read in. + +(define (insn-finish!) + *UNSPECIFIED* +) diff --git a/cgen/m32r.cpu b/cgen/m32r.cpu new file mode 100644 index 00000000000..047e257bfae --- /dev/null +++ b/cgen/m32r.cpu @@ -0,0 +1,2088 @@ +; Mitsubishi M32R CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +(include "simplify.inc") + +; FIXME: Delete sign extension of accumulator results. +; Sign extension is done when accumulator is read. + +; define-arch must appear first + +(define-arch + (name m32r) ; name of cpu family + (comment "Mitsubishi M32R") + (default-alignment aligned) + (insn-lsb0? #f) + (machs m32r m32rx) + (isas m32r) +) + +; Attributes. + +; An attribute to describe which pipeline an insn runs in. +(define-attr + (for insn) + (type enum) + (name PIPE) + (comment "parallel execution pipeline selection") + (values NONE O S OS) +) +; A derived attribute that says which insns can be executed in parallel +; with others. This is a required attribute for architectures with +; parallel execution. +(define-attr + (for insn) + (type enum) + (name PARALLEL) + (attrs META) ; do not define in any generated file for now + (values NO YES) + (default (if (eq-attr (current-insn) PIPE NONE) (symbol NO) (symbol YES))) +) + +; Instruction set parameters. + +(define-isa + (name m32r) + + ; This is 32 because 16 bit insns always appear as pairs. + ; ??? See if this can go away. It's only used by the disassembler (right?) + ; to decide how long an unknown insn is. One value isn't sufficient (e.g. if + ; on a 16 bit (and not 32 bit) boundary, will only want to advance pc by 16.) + (default-insn-bitsize 32) + + ; Number of bytes of insn we can initially fetch. + ; The M32R is tricky in that insns are either two 16-bit insns + ; (executed sequentially or in parallel) or one 32-bit insn. + ; So on one hand the base insn size is 16 bits, but on another it's 32. + ; 32 is chosen because: + ; - if the chip were ever bi-endian it is believed that the byte order would + ; be based on 32 bit quantities + ; - 32 bit insns are always aligned on 32 bit boundaries + ; - the pc will never stop on a 16 bit (and not 32 bit) boundary + ; [well actually it can, but there are no branches to such places] + (base-insn-bitsize 32) + + ; Used in computing bit numbers. + (default-insn-word-bitsize 32) + + ; The m32r fetches 2 insns at a time. + (liw-insns 2) + + ; While the m32r can execute insns in parallel, the base mach can't + ; (other than nop). The base mach is greatly handicapped by this, but + ; we still need to cleanly handle it. + (parallel-insns 2) + + ; Initial bitnumbers to decode insns by. + (decode-assist (0 1 2 3 8 9 10 11)) + + ; Classification of instructions that fit in the various frames. + ; wip, not currently used + (insn-types (long ; name + 31 ; length + (eq-attr (current-insn) LENGTH 31) ; matching insns + (0 1 2 7 8 9 10) ; decode-assist + ) + (short + 15 + (eq-attr (current-insn) LENGTH 15) ; matching insns + (0 1 2 7 8 9 10) + ) + ) + + ; Instruction framing. + ; Each m32r insn is either one 32 bit insn, two 16 bit insns executed + ; serially (left->right), or two 16 bit insns executed parallelly. + ; wip, not currently used + (frame long32 ; name + ((long)) ; list of insns in frame, plus constraint + "$0" ; assembler + (+ (1 1) (31 $0)) ; value + (sequence () (execute $0)) ; action + ) + (frame serial2x16 + ((short) + (short)) + "$0 -> $1" + (+ (1 0) (15 $0) (1 0) (15 $1)) + (sequence () + (execute $0) + (execute $1)) + ) + (frame parallel2x16 + ((short (eq-attr (current-insn) PIPE "O,BOTH")) + (short (eq-attr (current-insn) PIPE "S,BOTH"))) + "$0 || $1" + (+ (1 0) (15 $0) (1 1) (15 $1)) + (parallel () + (execute $0) + (execute $1)) + ) +) + +; Cpu family definitions. + +; ??? define-cpu-family [and in general "cpu-family"] might be clearer than +; define-cpu. +; ??? Have define-arch provide defaults for architecture that define-cpu can +; then override [reduces duplication in define-cpu]. +; ??? Another way to go is to delete cpu-families entirely and have one mach +; able to inherit things from another mach (would also need the ability to +; not only override specific inherited things but also disable some, +; e.g. if an insn wasn't supported). + +(define-cpu + ; cpu names must be distinct from the architecture name and machine names. + ; The "b" suffix stands for "base" and is the convention. + ; The "f" suffix stands for "family" and is the convention. + (name m32rbf) + (comment "Mitsubishi M32R base family") + (endian big) + (word-bitsize 32) + ; Override isa spec (??? keeps things simpler, though it was more true + ; in the early days and not so much now). + (parallel-insns 1) +) + +(define-cpu + (name m32rxf) + (comment "Mitsubishi M32Rx family") + (endian big) + (word-bitsize 32) + ; Generated files have an "x" suffix. + (file-transform "x") +) + +(define-mach + (name m32r) + (comment "Generic M32R cpu") + (cpu m32rbf) +) + +(define-mach + (name m32rx) + (comment "M32RX cpu") + (cpu m32rxf) +) + +; Model descriptions. + +; The meaning of this value is wip but at the moment it's intended to describe +; the implementation (i.e. what -mtune=foo does in sparc gcc). +; +; Notes while wip: +; - format of pipeline entry: +; (pipeline name (stage1-name ...) (stage2-name ...) ...) +; The contents of a stage description is wip. +; - each mach must have at least one model +; - the default model must be the first one +;- maybe have `retire' support update total cycle count to handle current +; parallel insn cycle counting problems + +(define-model + (name m32r/d) (comment "m32r/d") (attrs) + (mach m32r) + + ;(prefetch) + ;(retire) + + (pipeline p-non-mem "" () ((fetch) (decode) (execute) (writeback))) + (pipeline p-mem "" () ((fetch) (decode) (execute) (memory) (writeback))) + + ; `state' is a list of variables for recording model state + (state + ; bit mask of h-gr registers, =1 means value being loaded from memory + (h-gr UINT) + ) + + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () ; state + ((sr INT -1) (dr INT -1)) ; inputs + ((dr INT -1)) ; outputs + () ; profile action (default) + ) + (unit u-cmp "Compare Unit" () + 1 1 ; issue done + () ; state + ((src1 INT -1) (src2 INT -1)) ; inputs + () ; outputs + () ; profile action (default) + ) + (unit u-mac "Multiply/Accumulate Unit" () + 1 1 ; issue done + () ; state + ((src1 INT -1) (src2 INT -1)) ; inputs + () ; outputs + () ; profile action (default) + ) + (unit u-cti "Branch Unit" () + 1 1 ; issue done + () ; state + ((sr INT -1)) ; inputs + ((pc)) ; outputs + () ; profile action (default) + ) + (unit u-load "Memory Load Unit" () + 1 1 ; issue done + () ; state + ((sr INT) + ;(ld-mem AI) + ) ; inputs + ((dr INT)) ; outputs + () ; profile action (default) + ) + (unit u-store "Memory Store Unit" () + 1 1 ; issue done + () ; state + ((src1 INT) (src2 INT)) ; inputs + () ; ((st-mem AI)) ; outputs + () ; profile action (default) + ) +) + +(define-model + (name test) (comment "test") (attrs) + (mach m32r) + (pipeline all "" () ((fetch) (decode) (execute) (writeback))) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () () () ()) +) + +; Each mach must have at least one model. + +(define-model + (name m32rx) (comment "m32rx") (attrs) + (mach m32rx) + + ; ??? It's 6 stages but I forget the details right now. + (pipeline p-o "" () ((fetch) (decode) (execute) (writeback))) + (pipeline p-s "" () ((fetch) (decode) (execute) (writeback))) + (pipeline p-o-mem "" () ((fetch) (decode) (execute) (memory) (writeback))) + + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () ; state + ((sr INT -1) (dr INT -1)) ; inputs + ((dr INT -1)) ; outputs + () ; profile action (default) + ) + (unit u-cmp "Compare Unit" () + 1 1 ; issue done + () ; state + ((src1 INT -1) (src2 INT -1)) ; inputs + () ; outputs + () ; profile action (default) + ) + (unit u-mac "Multiply/Accumulate Unit" () + 1 1 ; issue done + () ; state + ((src1 INT -1) (src2 INT -1)) ; inputs + () ; outputs + () ; profile action (default) + ) + (unit u-cti "Branch Unit" () + 1 1 ; issue done + () ; state + ((sr INT -1)) ; inputs + ((pc)) ; outputs + () ; profile action (default) + ) + (unit u-load "Memory Load Unit" () + 1 1 ; issue done + () ; state + ((sr INT)) ; inputs + ((dr INT)) ; outputs + () ; profile action (default) + ) + (unit u-store "Memory Store Unit" () + 1 1 ; issue done + () ; state + ((src1 INT) (src2 INT)) ; inputs + () ; outputs + () ; profile action (default) + ) +) + +; The instruction fetch/execute cycle. +; This is split into two parts as sometimes more than one instruction is +; decoded at once. +; The `const SI' argument to decode/execute is used to distinguish +; multiple instructions processed at the same time (e.g. m32r). +; +; ??? This is wip, and not currently used. +; ??? Needs to be moved to define-isa. + +; This is how to fetch and decode an instruction. + +;(define-extract +; (sequence VOID +; (if VOID (ne AI (and AI pc (const AI 3)) (const AI 0)) +; (sequence VOID +; (set-quiet USI (scratch UHI insn1) (ifetch UHI pc)) +; (decode VOID pc (and UHI insn1 (const UHI #x7fff)) +; (const SI 0))) +; (sequence VOID +; (set-quiet USI (scratch USI insn) (ifetch USI pc)) +; (if VOID (ne USI (and USI insn (const USI #x80000000)) +; (const USI 0)) +; (decode VOID pc (srl USI insn (const WI 16)) (const SI 0)) +; (sequence VOID +; ; ??? parallel support +; (decode VOID pc (srl USI insn (const WI 16)) +; (const SI 0)) +; (decode VOID (add AI pc (const AI 2)) +; (and USI insn (const WI #x7fff)) +; (const SI 1)))))) +; ) +;) + +; This is how to execute a decoded instruction. + +;(define-execute +; (sequence VOID () ; () is empty option list +; ((AI new_pc)) +; (set AI new_pc (execute: AI (const 0)) #:quiet) +; (set AI pc new_pc #:direct) +; ) +;) + +; FIXME: It might simplify things to separate the execute process from the +; one that updates the PC. + +; Instruction fields. +; +; Attributes: +; PCREL-ADDR: pc relative value (for reloc and disassembly purposes) +; ABS-ADDR: absolute address (for reloc and disassembly purposes?) +; RESERVED: bits are not used to decode insn, must be all 0 +; RELOC: there is a relocation associated with this field (experiment) + +(define-attr + (for ifield operand) + (type boolean) + (name RELOC) + (comment "there is a reloc associated with this field (experiment)") +) + +(dnf f-op1 "op1" () 0 4) +(dnf f-op2 "op2" () 8 4) +(dnf f-cond "cond" () 4 4) +(dnf f-r1 "r1" () 4 4) +(dnf f-r2 "r2" () 12 4) +(df f-simm8 "simm8" () 8 8 INT #f #f) +(df f-simm16 "simm16" () 16 16 INT #f #f) +(dnf f-shift-op2 "shift op2" () 8 3) +(dnf f-uimm4 "uimm4" () 12 4) +(dnf f-uimm5 "uimm5" () 11 5) +(dnf f-uimm16 "uimm16" () 16 16) +(dnf f-uimm24 "uimm24" (ABS-ADDR RELOC) 8 24) +(dnf f-hi16 "high 16 bits" (SIGN-OPT) 16 16) +(df f-disp8 "disp8, slot unknown" (PCREL-ADDR RELOC) 8 8 INT + ((value pc) (sra WI (sub WI value (and WI pc (const -4))) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) (and WI pc (const -4))))) +(df f-disp16 "disp16" (PCREL-ADDR RELOC) 16 16 INT + ((value pc) (sra WI (sub WI value pc) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) pc))) +(df f-disp24 "disp24" (PCREL-ADDR RELOC) 8 24 INT + ((value pc) (sra WI (sub WI value pc) (const 2))) + ((value pc) (add WI (sll WI value (const 2)) pc))) + +(dnf f-op23 "op2.3" () 9 3) +(dnf f-op3 "op3" () 14 2) +(dnf f-acc "acc" () 8 1) +(dnf f-accs "accs" () 12 2) +(dnf f-accd "accd" () 4 2) +(dnf f-bits67 "bits67" () 6 2) +(dnf f-bit14 "bit14" () 14 1) + +(define-ifield (name f-imm1) (comment "1 bit immediate, 0->1 1->2") + (attrs) + (start 15) (length 1) + (encode (value pc) (sub WI value (const WI 1))) + (decode (value pc) (add WI value (const WI 1))) +) + +; Enums. + +; insn-op1: bits 0-3 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op1 "insn format enums" () OP1_ f-op1 + ("0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "10" "11" "12" "13" "14" "15") +) + +; insn-op2: bits 8-11 +; FIXME: should use die macro or some such +(define-normal-insn-enum insn-op2 "op2 enums" () OP2_ f-op2 + ("0" "1" "2" "3" "4" "5" "6" "7" + "8" "9" "10" "11" "12" "13" "14" "15") +) + +; Hardware pieces. +; These entries list the elements of the raw hardware. +; They're also used to provide tables and other elements of the assembly +; language. + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(dnh h-hi16 "high 16 bits" () + (immediate (UINT 16)) + () () () +) + +; These two aren't technically needed. +; They're here for illustration sake mostly. +; Plus they cause the value to be stored in the extraction buffers to only +; be 16 bits wide (vs 32 or 64). Whoopie ding. But it's fun. +(dnh h-slo16 "signed low 16 bits" () + (immediate (INT 16)) + () () () +) +(dnh h-ulo16 "unsigned low 16 bits" () + (immediate (UINT 16)) + () () () +) + +(define-keyword + (name gr-names) + (print-name h-gr) + (prefix "") + (values (fp 13) (lr 14) (sp 15) + (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15)) +) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE CACHE-ADDR) + (type register WI (16)) + (indices extern-keyword gr-names) +) + +(define-keyword + (name cr-names) + (print-name h-cr) + (prefix "") + (values (psw 0) (cbr 1) (spi 2) (spu 3) + (bpc 6) (bbpsw 8) (bbpc 14) + (cr0 0) (cr1 1) (cr2 2) (cr3 3) + (cr4 4) (cr5 5) (cr6 6) (cr7 7) + (cr8 8) (cr9 9) (cr10 10) (cr11 11) + (cr12 12) (cr13 13) (cr14 14) (cr15 15)) +) + +(define-hardware + (name h-cr) + (comment "control registers") + (type register UWI (16)) + (indices extern-keyword cr-names) + (get (index) (c-call UWI "@cpu@_h_cr_get_handler" index)) + (set (index newval) (c-call VOID "@cpu@_h_cr_set_handler" index newval)) +) + +; The actual accumulator is only 56 bits. +; The top 8 bits are sign extended from bit 8 (when counting msb = bit 0). +; To simplify the accumulator instructions, no attempt is made to keep the +; top 8 bits properly sign extended (currently there's no point since they +; all ignore them). When the value is read it is properly sign extended +; [in the `get' handler]. +(define-hardware + (name h-accum) + (comment "accumulator") + (type register DI) + (get () (c-call DI "@cpu@_h_accum_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_accum_set_handler" newval)) +) + +; FIXME: Revisit after sanitization can be removed. Remove h-accum. +(define-hardware + (name h-accums) + (comment "accumulators") + (attrs (MACH m32rx)) + (type register DI (2)) + (indices keyword "" ((a0 0) (a1 1))) + ; get/set so a0 accesses are redirected to h-accum. + ; They're also so reads can properly sign extend the value. + ; FIXME: Needn't be a function call. + (get (index) (c-call DI "@cpu@_h_accums_get_handler" index)) + (set (index newval) (c-call VOID "@cpu@_h_accums_set_handler" index newval)) +) + +; For condbit operand. FIXME: Need to allow spec of get/set of operands. +; Having this separate from h-psw keeps the parts that use it simpler +; [since they greatly outnumber those that use h-psw]. +(dsh h-cond "condition bit" () (register BI)) + +; The actual values of psw,bpsw,bbpsw are recorded here to allow access +; to them as a unit. +(define-hardware + (name h-psw) + (comment "psw part of psw") + (type register UQI) + ; get/set to handle cond bit. + ; FIXME: missing: use's and clobber's + ; FIXME: remove c-call? + (get () (c-call UQI "@cpu@_h_psw_get_handler")) + (set (newval) (c-call VOID "@cpu@_h_psw_set_handler" newval)) +) +(dsh h-bpsw "backup psw" () (register UQI)) +(dsh h-bbpsw "backup bpsw" () (register UQI)) + +; FIXME: Later make add get/set specs and support SMP. +(dsh h-lock "lock" () (register BI)) + +; Instruction Operands. +; These entries provide a layer between the assembler and the raw hardware +; description, and are used to refer to hardware elements in the semantic +; code. Usually there's a bit of over-specification, but in more complicated +; instruction sets there isn't. + +; M32R specific operand attributes: + +(define-attr + (for operand) + (type boolean) + (name HASH-PREFIX) + (comment "immediates have an optional '#' prefix") +) + +; ??? Convention says this should be o-sr, but then the insn definitions +; should refer to o-sr which is clumsy. The "o-" could be implicit, but +; then it should be implicit for all the symbols here, but then there would +; be confusion between (f-)simm8 and (h-)simm8. +; So for now the rule is exactly as it appears here. + +(dnop sr "source register" () h-gr f-r2) +(dnop dr "destination register" () h-gr f-r1) +;; The assembler relies upon the fact that dr and src1 are the same field. +;; FIXME: Revisit. +(dnop src1 "source register 1" () h-gr f-r1) +(dnop src2 "source register 2" () h-gr f-r2) +(dnop scr "source control register" () h-cr f-r2) +(dnop dcr "destination control register" () h-cr f-r1) + +(dnop simm8 "8 bit signed immediate" (HASH-PREFIX) h-sint f-simm8) +(dnop simm16 "16 bit signed immediate" (HASH-PREFIX) h-sint f-simm16) +(dnop uimm4 "4 bit trap number" (HASH-PREFIX) h-uint f-uimm4) +(dnop uimm5 "5 bit shift count" (HASH-PREFIX) h-uint f-uimm5) +(dnop uimm16 "16 bit unsigned immediate" (HASH-PREFIX) h-uint f-uimm16) + +(dnop imm1 "1 bit immediate" ((MACH m32rx) HASH-PREFIX) h-uint f-imm1) +(dnop accd "accumulator destination register" ((MACH m32rx)) h-accums f-accd) +(dnop accs "accumulator source register" ((MACH m32rx)) h-accums f-accs) +(dnop acc "accumulator reg (d)" ((MACH m32rx)) h-accums f-acc) + +; slo16,ulo16 are used in both with-hash-prefix/no-hash-prefix cases. +; e.g. add3 r3,r3,#1 and ld r3,@(4,r4). We could use HASH-PREFIX. +; Instead we create a fake operand `hash'. The m32r is an illustration port, +; so we often try out various ways of doing things. + +(define-operand (name hash) (comment "# prefix") (attrs) + (type h-sint) ; doesn't really matter + (index f-nil) + (handlers (parse "hash") (print "hash")) +) + +; For high(foo),shigh(foo). +(define-operand + (name hi16) + (comment "high 16 bit immediate, sign optional") + (attrs) + (type h-hi16) + (index f-hi16) + (handlers (parse "hi16")) +) + +; For low(foo),sda(foo). +(define-operand + (name slo16) + (comment "16 bit signed immediate, for low()") + (attrs) + (type h-slo16) + (index f-simm16) + (handlers (parse "slo16")) +) + +; For low(foo). +(define-operand + (name ulo16) + (comment "16 bit unsigned immediate, for low()") + (attrs) + (type h-ulo16) + (index f-uimm16) + (handlers (parse "ulo16")) +) + +(dnop uimm24 "24 bit address" (HASH-PREFIX) h-addr f-uimm24) + +(define-operand + (name disp8) + (comment "8 bit displacement") + (attrs RELAX) + (type h-iaddr) + (index f-disp8) + ; ??? Early experiments had insert/extract fields here. + ; Moving these to f-disp8 made things cleaner, but may wish to re-introduce + ; fields here to handle more complicated cases. +) + +(dnop disp16 "16 bit displacement" () h-iaddr f-disp16) +(dnop disp24 "24 bit displacement" (RELAX) h-iaddr f-disp24) + +; These hardware elements are refered to frequently. + +(dnop condbit "condition bit" (SEM-ONLY) h-cond f-nil) +(dnop accum "accumulator" (SEM-ONLY) h-accum f-nil) + +; Instruction definitions. +; +; Notes while wip: +; - dni is a cover macro to the real "this is an instruction" keyword. +; The syntax of the real one is yet to be determined. +; At the lowest level (i.e. the "real" one) it will probably take a variable +; list of arguments where each argument [perhaps after the standard three of +; name, comment, attrs] is "(keyword arg-to-keyword)". This syntax is simple +; and yet completely upward extensible. And given the macro facility, one +; needn't code at that low a level so even though it'll be more verbose than +; necessary it won't matter. This same reasoning can be applied to most +; types of entries in this file. + +; M32R specific instruction attributes: + +; FILL-SLOT: Need next insn to begin on 32 bit boundary. +; (A "slot" as used here is a 32 bit quantity that can either be filled with +; one 32 bit insn or two 16 bit insns which go in the "left bin" and "right +; bin" where the left bin is the one with a lower address). + +(define-attr + (for insn) + (type boolean) + (name FILL-SLOT) + (comment "fill right bin with `nop' if insn is in left bin") +) + +(define-attr + (for insn) + (type boolean) + (name SPECIAL) + (comment "non-public m32rx insn") +) + +(define-pmacro (bin-op mnemonic op2-op sem-op imm-prefix imm) + (begin + (dni mnemonic + (.str mnemonic " reg/reg") + ((PIPE OS)) + (.str mnemonic " $dr,$sr") + (+ OP1_0 op2-op dr sr) + (set dr (sem-op dr sr)) + () + ) + (dni (.sym mnemonic "3") + (.str mnemonic " reg/" imm) + () + (.str mnemonic "3 $dr,$sr," imm-prefix "$" imm) + (+ OP1_8 op2-op dr sr imm) + (set dr (sem-op sr imm)) + () + ) + ) +) +(bin-op add OP2_10 add "$hash" slo16) +; sub isn't present because sub3 doesn't exist. +(bin-op and OP2_12 and "" uimm16) +(bin-op or OP2_14 or "$hash" ulo16) +(bin-op xor OP2_13 xor "" uimm16) + +(dni addi "addi" + ((PIPE OS)) + ; #.: experiment + #.(string-append "addi " "$dr,$simm8") + (+ OP1_4 dr simm8) + (set dr (add dr simm8)) + ((m32r/d (unit u-exec)) + (m32rx (unit u-exec))) +) + +(dni addv "addv" + ((PIPE OS)) + "addv $dr,$sr" + (+ OP1_0 OP2_8 dr sr) + (parallel () + (set dr (add dr sr)) + (set condbit (add-oflag dr sr (const 0)))) + () +) + +(dni addv3 "addv3" + () + "addv3 $dr,$sr,$simm16" + (+ OP1_8 OP2_8 dr sr simm16) + (parallel () + (set dr (add sr simm16)) + (set condbit (add-oflag sr simm16 (const 0)))) + () +) + +(dni addx "addx" + ((PIPE OS)) + "addx $dr,$sr" + (+ OP1_0 OP2_9 dr sr) + (parallel () + (set dr (addc dr sr condbit)) + (set condbit (add-cflag dr sr condbit))) + () +) + +(dni bc8 "bc with 8 bit displacement" + (COND-CTI (PIPE O)) + "bc.s $disp8" + (+ OP1_7 (f-r1 12) disp8) + (if condbit (set pc disp8)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bc8r "relaxable bc8" + (COND-CTI RELAXABLE (PIPE O)) + "bc $disp8" + (emit bc8 disp8) +) + +(dni bc24 "bc with 24 bit displacement" + (COND-CTI) + "bc.l $disp24" + (+ OP1_15 (f-r1 12) disp24) + (if condbit (set pc disp24)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bc24r "relaxable bc24" + (COND-CTI RELAX) + "bc $disp24" + (emit bc24 disp24) +) + +(dni beq "beq" + (COND-CTI) + "beq $src1,$src2,$disp16" + (+ OP1_11 OP2_0 src1 src2 disp16) + (if (eq src1 src2) (set pc disp16)) + ((m32r/d (unit u-cti) (unit u-cmp (cycles 0))) + (m32rx (unit u-cti) (unit u-cmp (cycles 0)))) +) + +(define-pmacro (cbranch sym comment op2-op comp-op) + (dni sym comment (COND-CTI) + (.str sym " $src2,$disp16") + (+ OP1_11 op2-op (f-r1 0) src2 disp16) + (if (comp-op src2 (const WI 0)) (set pc disp16)) + ((m32r/d (unit u-cti) (unit u-cmp (cycles 0))) + (m32rx (unit u-cti) (unit u-cmp (cycles 0)))) + ) +) +(cbranch beqz "beqz" OP2_8 eq) +(cbranch bgez "bgez" OP2_11 ge) +(cbranch bgtz "bgtz" OP2_13 gt) +(cbranch blez "blez" OP2_12 le) +(cbranch bltz "bltz" OP2_10 lt) +(cbranch bnez "bnez" OP2_9 ne) + +(dni bl8 "bl with 8 bit displacement" + (UNCOND-CTI FILL-SLOT (PIPE O)) + "bl.s $disp8" + (+ OP1_7 (f-r1 14) disp8) + (sequence () + (set (reg h-gr 14) + (add (and pc (const -4)) (const 4))) + (set pc disp8)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bl8r "relaxable bl8" + (UNCOND-CTI FILL-SLOT RELAXABLE (PIPE O)) + "bl $disp8" + (emit bl8 disp8) +) + +(dni bl24 "bl with 24 bit displacement" + (UNCOND-CTI) + "bl.l $disp24" + (+ OP1_15 (f-r1 14) disp24) + (sequence () + (set (reg h-gr 14) (add pc (const 4))) + (set pc disp24)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bl24r "relaxable bl24" + (UNCOND-CTI RELAX) + "bl $disp24" + (emit bl24 disp24) +) + +(dni bcl8 "bcl with 8 bit displacement" + (COND-CTI FILL-SLOT (MACH m32rx) (PIPE O)) + "bcl.s $disp8" + (+ OP1_7 (f-r1 8) disp8) + (if condbit + (sequence () + (set (reg h-gr 14) + (add (and pc (const -4)) + (const 4))) + (set pc disp8))) + ((m32rx (unit u-cti))) +) + +(dnmi bcl8r "relaxable bcl8" + (COND-CTI FILL-SLOT (MACH m32rx) (PIPE O) RELAXABLE) + "bcl $disp8" + (emit bcl8 disp8) +) + +(dni bcl24 "bcl with 24 bit displacement" + (COND-CTI (MACH m32rx)) + "bcl.l $disp24" + (+ OP1_15 (f-r1 8) disp24) + (if condbit + (sequence () + (set (reg h-gr 14) (add pc (const 4))) + (set pc disp24))) + ((m32rx (unit u-cti))) +) + +(dnmi bcl24r "relaxable bcl24" + (COND-CTI (MACH m32rx) RELAX) + "bcl $disp24" + (emit bcl24 disp24) +) + +(dni bnc8 "bnc with 8 bit displacement" + (COND-CTI (PIPE O)) + "bnc.s $disp8" + (+ OP1_7 (f-r1 13) disp8) + (if (not condbit) (set pc disp8)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bnc8r "relaxable bnc8" + (COND-CTI RELAXABLE (PIPE O)) + "bnc $disp8" + (emit bnc8 disp8) +) + +(dni bnc24 "bnc with 24 bit displacement" + (COND-CTI) + "bnc.l $disp24" + (+ OP1_15 (f-r1 13) disp24) + (if (not condbit) (set pc disp24)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bnc24r "relaxable bnc24" + (COND-CTI RELAX) + "bnc $disp24" + (emit bnc24 disp24) +) + +(dni bne "bne" + (COND-CTI) + "bne $src1,$src2,$disp16" + (+ OP1_11 OP2_1 src1 src2 disp16) + (if (ne src1 src2) (set pc disp16)) + ((m32r/d (unit u-cti) (unit u-cmp (cycles 0))) + (m32rx (unit u-cti) (unit u-cmp (cycles 0)))) +) + +(dni bra8 "bra with 8 bit displacement" + (UNCOND-CTI FILL-SLOT (PIPE O)) + "bra.s $disp8" + (+ OP1_7 (f-r1 15) disp8) + (set pc disp8) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bra8r "relaxable bra8" + (UNCOND-CTI FILL-SLOT RELAXABLE (PIPE O)) + "bra $disp8" + (emit bra8 disp8) +) + +(dni bra24 "bra with 24 displacement" + (UNCOND-CTI) + "bra.l $disp24" + (+ OP1_15 (f-r1 15) disp24) + (set pc disp24) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dnmi bra24r "relaxable bra24" + (UNCOND-CTI RELAX) + "bra $disp24" + (emit bra24 disp24) +) + +(dni bncl8 "bncl with 8 bit displacement" + (COND-CTI FILL-SLOT (MACH m32rx) (PIPE O)) + "bncl.s $disp8" + (+ OP1_7 (f-r1 9) disp8) + (if (not condbit) + (sequence () + (set (reg h-gr 14) + (add (and pc (const -4)) + (const 4))) + (set pc disp8))) + ((m32rx (unit u-cti))) +) + +(dnmi bncl8r "relaxable bncl8" + (COND-CTI FILL-SLOT (MACH m32rx) (PIPE O) RELAXABLE) + "bncl $disp8" + (emit bncl8 disp8) +) + +(dni bncl24 "bncl with 24 bit displacement" + (COND-CTI (MACH m32rx)) + "bncl.l $disp24" + (+ OP1_15 (f-r1 9) disp24) + (if (not condbit) + (sequence () + (set (reg h-gr 14) (add pc (const 4))) + (set pc disp24))) + ((m32rx (unit u-cti))) +) + +(dnmi bncl24r "relaxable bncl24" + (COND-CTI (MACH m32rx) RELAX) + "bncl $disp24" + (emit bncl24 disp24) +) + +(dni cmp "cmp" + ((PIPE OS)) + "cmp $src1,$src2" + (+ OP1_0 OP2_4 src1 src2) + (set condbit (lt src1 src2)) + ((m32r/d (unit u-cmp)) + (m32rx (unit u-cmp))) +) + +(dni cmpi "cmpi" + () + "cmpi $src2,$simm16" + (+ OP1_8 (f-r1 0) OP2_4 src2 simm16) + (set condbit (lt src2 simm16)) + ((m32r/d (unit u-cmp)) + (m32rx (unit u-cmp))) +) + +(dni cmpu "cmpu" + ((PIPE OS)) + "cmpu $src1,$src2" + (+ OP1_0 OP2_5 src1 src2) + (set condbit (ltu src1 src2)) + ((m32r/d (unit u-cmp)) + (m32rx (unit u-cmp))) +) + +(dni cmpui "cmpui" + () + "cmpui $src2,$simm16" + (+ OP1_8 (f-r1 0) OP2_5 src2 simm16) + (set condbit (ltu src2 simm16)) + ((m32r/d (unit u-cmp)) + (m32rx (unit u-cmp))) +) + +(dni cmpeq "cmpeq" + ((MACH m32rx) (PIPE OS)) + "cmpeq $src1,$src2" + (+ OP1_0 OP2_6 src1 src2) + (set condbit (eq src1 src2)) + ((m32rx (unit u-cmp))) +) + +(dni cmpz "cmpz" + ((MACH m32rx) (PIPE OS)) + "cmpz $src2" + (+ OP1_0 OP2_7 (f-r1 0) src2) + (set condbit (eq src2 (const 0))) + ((m32rx (unit u-cmp))) +) + +(dni div "div" + () + "div $dr,$sr" + (+ OP1_9 OP2_0 dr sr (f-simm16 0)) + (if (ne sr (const 0)) (set dr (div dr sr))) + ((m32r/d (unit u-exec (cycles 37))) + (m32rx (unit u-exec (cycles 37)))) +) + +(dni divu "divu" + () + "divu $dr,$sr" + (+ OP1_9 OP2_1 dr sr (f-simm16 0)) + (if (ne sr (const 0)) (set dr (udiv dr sr))) + ((m32r/d (unit u-exec (cycles 37))) + (m32rx (unit u-exec (cycles 37)))) +) + +(dni rem "rem" + () + "rem $dr,$sr" + (+ OP1_9 OP2_2 dr sr (f-simm16 0)) + ; FIXME: Check rounding direction. + (if (ne sr (const 0)) (set dr (mod dr sr))) + ((m32r/d (unit u-exec (cycles 37))) + (m32rx (unit u-exec (cycles 37)))) +) + +(dni remu "remu" + () + "remu $dr,$sr" + (+ OP1_9 OP2_3 dr sr (f-simm16 0)) + ; FIXME: Check rounding direction. + (if (ne sr (const 0)) (set dr (umod dr sr))) + ((m32r/d (unit u-exec (cycles 37))) + (m32rx (unit u-exec (cycles 37)))) +) + +(dni divh "divh" + ((MACH m32rx)) + "divh $dr,$sr" + (+ OP1_9 OP2_0 dr sr (f-simm16 #x10)) + (if (ne sr (const 0)) (set dr (div (ext WI (trunc HI dr)) sr))) + ((m32rx (unit u-exec (cycles 21)))) +) + +(dni jc "jc" + (COND-CTI (MACH m32rx) (PIPE O) SPECIAL) + "jc $sr" + (+ OP1_1 (f-r1 12) OP2_12 sr) + (if condbit (set pc (and sr (const -4)))) + ((m32rx (unit u-cti))) +) + +(dni jnc "jnc" + (COND-CTI (MACH m32rx) (PIPE O) SPECIAL) + "jnc $sr" + (+ OP1_1 (f-r1 13) OP2_12 sr) + (if (not condbit) (set pc (and sr (const -4)))) + ((m32rx (unit u-cti))) +) + +(dni jl "jl" + (UNCOND-CTI FILL-SLOT (PIPE O)) + "jl $sr" + (+ OP1_1 (f-r1 14) OP2_12 sr) + (parallel () + (set (reg h-gr 14) + (add (and pc (const -4)) (const 4))) + (set pc (and sr (const -4)))) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(dni jmp "jmp" + (UNCOND-CTI (PIPE O)) + "jmp $sr" + (+ OP1_1 (f-r1 15) OP2_12 sr) + (set pc (and sr (const -4))) + ; The above works now so this kludge has been commented out. + ; It's kept around because the f-r1 reference in the semantic part + ; should work. + ; FIXME: kludge, instruction decoding not finished. + ; But this should work, so that's another FIXME. + ;(sequence VOID (if VOID (eq SI f-r1 (const SI 14)) + ; FIXME: abuf->insn should be a macro of some sort. + ;(sequence VOID + ; (if VOID (eq SI (c-code SI "((abuf->insn >> 8) & 15)") + ; (const SI 14)) + ; (set WI (reg WI h-gr 14) + ; (add WI (and WI pc (const WI -4)) (const WI 4)))) + ; (set WI pc sr)) + ((m32r/d (unit u-cti)) + (m32rx (unit u-cti))) +) + +(define-pmacro (no-ext-expr mode expr) expr) +(define-pmacro (ext-expr mode expr) (ext mode expr)) +(define-pmacro (zext-expr mode expr) (zext mode expr)) + +(define-pmacro (load-op suffix op2-op mode ext-op) + (begin + (dni (.sym ld suffix) (.str "ld" suffix) + ((PIPE O)) + (.str "ld" suffix " $dr,@$sr") + (+ OP1_2 op2-op dr sr) + (set dr (ext-op WI (mem mode sr))) + ((m32r/d (unit u-load)) + (m32rx (unit u-load))) + ) + (dnmi (.sym ld suffix "-2") (.str "ld" suffix "-2") + (NO-DIS (PIPE O)) + (.str "ld" suffix " $dr,@($sr)") + (emit (.sym ld suffix) dr sr)) + (dni (.sym ld suffix -d) (.str "ld" suffix "-d") + () + (.str "ld" suffix " $dr,@($slo16,$sr)") + (+ OP1_10 op2-op dr sr slo16) + (set dr (ext-op WI (mem mode (add sr slo16)))) + ((m32r/d (unit u-load (cycles 2))) + (m32rx (unit u-load (cycles 2)))) + ) + (dnmi (.sym ld suffix -d2) (.str "ld" suffix "-d2") + (NO-DIS) + (.str "ld" suffix " $dr,@($sr,$slo16)") + (emit (.sym ld suffix -d) dr sr slo16)) + ) +) +(load-op "" OP2_12 WI no-ext-expr) +(load-op b OP2_8 QI ext-expr) +(load-op h OP2_10 HI ext-expr) +(load-op ub OP2_9 QI zext-expr) +(load-op uh OP2_11 HI zext-expr) + +(dni ld-plus "ld+" + ((PIPE O)) + "ld $dr,@$sr+" + (+ OP1_2 dr OP2_14 sr) + (parallel () + ; wip: memory addresses in profiling support + ;(set dr (name ld-mem (mem WI sr))) + (set dr (mem WI sr)) + (set sr (add sr (const 4)))) + ; Note: `pred' is the constraint. Also useful here is (ref name) + ; and returns true if operand <name> was referenced + ; (where "referenced" means _read_ if input operand and _written_ if + ; output operand). + ; args to unit are "unit-name (name1 value1) ..." + ; - cycles(done),issue,pred are also specified this way + ; - if unspecified, default is used + ; - for ins/outs, extra arg is passed that says what was specified + ; - this is AND'd with `written' for outs + ((m32r/d (unit u-load (pred (const 1))) + (unit u-exec (in sr #f) (in dr sr) (out dr sr) (cycles 0) (pred (const 1)))) + (m32rx (unit u-load) + (unit u-exec (in sr #f) (in dr sr) (out dr sr) (cycles 0) (pred (const 1)))) + ) +) + +(dnmi pop "pop" + () + "pop $dr" + (emit ld-plus dr (sr 15)) ; "ld %0,@sp+" +) + +(dni ld24 "ld24" + () + "ld24 $dr,$uimm24" + (+ OP1_14 dr uimm24) + (set dr uimm24) + () +) + +; ldi8 appears before ldi16 so we try the shorter version first + +(dni ldi8 "ldi8" + ((PIPE OS)) + "ldi8 $dr,$simm8" + (+ OP1_6 dr simm8) + (set dr simm8) + () +) + +(dnmi ldi8a "ldi8 alias" + ((PIPE OS)) + "ldi $dr,$simm8" + (emit ldi8 dr simm8) +) + +(dni ldi16 "ldi16" + () + "ldi16 $dr,$hash$slo16" + (+ OP1_9 OP2_15 (f-r2 0) dr slo16) + (set dr slo16) + () +) + +(dnmi ldi16a "ldi16 alias" + () + "ldi $dr,$hash$slo16" + (emit ldi16 dr slo16) +) + +(dni lock "lock" + ((PIPE O)) + "lock $dr,@$sr" + (+ OP1_2 OP2_13 dr sr) + (sequence () + (set (reg h-lock) (const BI 1)) + (set dr (mem WI sr))) + ((m32r/d (unit u-load)) + (m32rx (unit u-load))) +) + +(dni machi "machi" + ( + ; (MACH m32r) is a temporary hack. This insn collides with machi-a + ; in the simulator so disable it for m32rx. + (MACH m32r) (PIPE S) + ) + "machi $src1,$src2" + (+ OP1_3 OP2_4 src1 src2) + ; FIXME: TRACE_RESULT will print the wrong thing since we + ; alter one of the arguments. + (set accum + (sra DI + (sll DI + (add DI + accum + (mul DI + (ext DI (and WI src1 (const #xffff0000))) + (ext DI (trunc HI (sra WI src2 (const 16)))))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni machi-a "machi-a" + ((MACH m32rx) (PIPE S)) + "machi $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 4) src2) + (set acc + (sra DI + (sll DI + (add DI + acc + (mul DI + (ext DI (and WI src1 (const #xffff0000))) + (ext DI (trunc HI (sra WI src2 (const 16)))))) + (const 8)) + (const 8))) + ((m32rx (unit u-mac))) +) + +(dni maclo "maclo" + ((MACH m32r) (PIPE S)) + "maclo $src1,$src2" + (+ OP1_3 OP2_5 src1 src2) + (set accum + (sra DI + (sll DI + (add DI + accum + (mul DI + (ext DI (sll WI src1 (const 16))) + (ext DI (trunc HI src2)))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni maclo-a "maclo-a" + ((MACH m32rx) (PIPE S)) + "maclo $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 5) src2) + (set acc + (sra DI + (sll DI + (add DI + acc + (mul DI + (ext DI (sll WI src1 (const 16))) + (ext DI (trunc HI src2)))) + (const 8)) + (const 8))) + ((m32rx (unit u-mac))) +) + +(dni macwhi "macwhi" + ((MACH m32r) (PIPE S)) + "macwhi $src1,$src2" + (+ OP1_3 OP2_6 src1 src2) + (set accum + (sra DI + (sll DI + (add DI + accum + (mul DI + (ext DI src1) + (ext DI (trunc HI (sra WI src2 (const 16)))))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni macwhi-a "macwhi-a" + ((MACH m32rx) (PIPE S) SPECIAL) + "macwhi $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 6) src2) + ; Note that this doesn't do the sign extension, which is correct. + (set acc + (add acc + (mul (ext DI src1) + (ext DI (trunc HI (sra src2 (const 16))))))) + ((m32rx (unit u-mac))) +) + +(dni macwlo "macwlo" + ((MACH m32r) (PIPE S)) + "macwlo $src1,$src2" + (+ OP1_3 OP2_7 src1 src2) + (set accum + (sra DI + (sll DI + (add DI + accum + (mul DI + (ext DI src1) + (ext DI (trunc HI src2)))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni macwlo-a "macwlo-a" + ((MACH m32rx) (PIPE S) SPECIAL) + "macwlo $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 7) src2) + ; Note that this doesn't do the sign extension, which is correct. + (set acc + (add acc + (mul (ext DI src1) + (ext DI (trunc HI src2))))) + ((m32rx (unit u-mac))) +) + +(dni mul "mul" + ((PIPE S)) + "mul $dr,$sr" + (+ OP1_1 OP2_6 dr sr) + (set dr (mul dr sr)) + ((m32r/d (unit u-exec (cycles 4))) + (m32rx (unit u-exec (cycles 4)))) +) + +(dni mulhi "mulhi" + ((MACH m32r) (PIPE S)) + "mulhi $src1,$src2" + (+ OP1_3 OP2_0 src1 src2) + (set accum + (sra DI + (sll DI + (mul DI + (ext DI (and WI src1 (const #xffff0000))) + (ext DI (trunc HI (sra WI src2 (const 16))))) + (const 16)) + (const 16))) + ((m32r/d (unit u-mac))) +) + +(dni mulhi-a "mulhi-a" + ((MACH m32rx) (PIPE S)) + "mulhi $src1,$src2,$acc" + (+ OP1_3 (f-op23 0) src1 acc src2) + (set acc + (sra DI + (sll DI + (mul DI + (ext DI (and WI src1 (const #xffff0000))) + (ext DI (trunc HI (sra WI src2 (const 16))))) + (const 16)) + (const 16))) + ((m32rx (unit u-mac))) +) + +(dni mullo "mullo" + ((MACH m32r) (PIPE S)) + "mullo $src1,$src2" + (+ OP1_3 OP2_1 src1 src2) + (set accum + (sra DI + (sll DI + (mul DI + (ext DI (sll WI src1 (const 16))) + (ext DI (trunc HI src2))) + (const 16)) + (const 16))) + ((m32r/d (unit u-mac))) +) + +(dni mullo-a "mullo-a" + ((MACH m32rx) (PIPE S)) + "mullo $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 1) src2) + (set acc + (sra DI + (sll DI + (mul DI + (ext DI (sll WI src1 (const 16))) + (ext DI (trunc HI src2))) + (const 16)) + (const 16))) + ((m32rx (unit u-mac))) +) + +(dni mulwhi "mulwhi" + ((MACH m32r) (PIPE S)) + "mulwhi $src1,$src2" + (+ OP1_3 OP2_2 src1 src2) + (set accum + (sra DI + (sll DI + (mul DI + (ext DI src1) + (ext DI (trunc HI (sra WI src2 (const 16))))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni mulwhi-a "mulwhi-a" + ((MACH m32rx) (PIPE S) SPECIAL) + "mulwhi $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 2) src2) + ; Note that this doesn't do the sign extension, which is correct. + (set acc + (mul (ext DI src1) + (ext DI (trunc HI (sra src2 (const 16)))))) + ((m32rx (unit u-mac))) +) + +(dni mulwlo "mulwlo" + ((MACH m32r) (PIPE S)) + "mulwlo $src1,$src2" + (+ OP1_3 OP2_3 src1 src2) + (set accum + (sra DI + (sll DI + (mul DI + (ext DI src1) + (ext DI (trunc HI src2))) + (const 8)) + (const 8))) + ((m32r/d (unit u-mac))) +) + +(dni mulwlo-a "mulwlo-a" + ((MACH m32rx) (PIPE S) SPECIAL) + "mulwlo $src1,$src2,$acc" + (+ OP1_3 src1 acc (f-op23 3) src2) + ; Note that this doesn't do the sign extension, which is correct. + (set acc + (mul (ext DI src1) + (ext DI (trunc HI src2)))) + ((m32rx (unit u-mac))) +) + +(dni mv "mv" + ((PIPE OS)) + "mv $dr,$sr" + (+ OP1_1 OP2_8 dr sr) + (set dr sr) + () +) + +(dni mvfachi "mvfachi" + ((MACH m32r) (PIPE S)) + "mvfachi $dr" + (+ OP1_5 OP2_15 (f-r2 0) dr) + (set dr (trunc WI (sra DI accum (const 32)))) + ((m32r/d (unit u-exec (cycles 2)))) +) + +(dni mvfachi-a "mvfachi-a" + ((MACH m32rx) (PIPE S)) + "mvfachi $dr,$accs" + (+ OP1_5 dr OP2_15 accs (f-op3 0)) + (set dr (trunc WI (sra DI accs (const 32)))) + ((m32rx (unit u-exec (cycles 2)))) +) + +(dni mvfaclo "mvfaclo" + ((MACH m32r) (PIPE S)) + "mvfaclo $dr" + (+ OP1_5 OP2_15 (f-r2 1) dr) + (set dr (trunc WI accum)) + ((m32r/d (unit u-exec (cycles 2)))) +) + +(dni mvfaclo-a "mvfaclo-a" + ((MACH m32rx) (PIPE S)) + "mvfaclo $dr,$accs" + (+ OP1_5 dr OP2_15 accs (f-op3 1)) + (set dr (trunc WI accs)) + ((m32rx (unit u-exec (cycles 2)))) +) + +(dni mvfacmi "mvfacmi" + ((MACH m32r) (PIPE S)) + "mvfacmi $dr" + (+ OP1_5 OP2_15 (f-r2 2) dr) + (set dr (trunc WI (sra DI accum (const 16)))) + ((m32r/d (unit u-exec (cycles 2)))) +) + +(dni mvfacmi-a "mvfacmi-a" + ((MACH m32rx) (PIPE S)) + "mvfacmi $dr,$accs" + (+ OP1_5 dr OP2_15 accs (f-op3 2)) + (set dr (trunc WI (sra DI accs (const 16)))) + ((m32rx (unit u-exec (cycles 2)))) +) + +(dni mvfc "mvfc" + ((PIPE O)) + "mvfc $dr,$scr" + (+ OP1_1 OP2_9 dr scr) + (set dr scr) + () +) + +(dni mvtachi "mvtachi" + ((MACH m32r) (PIPE S)) + "mvtachi $src1" + (+ OP1_5 OP2_7 (f-r2 0) src1) + (set accum + (or DI + (and DI accum (const DI #xffffffff)) + (sll DI (ext DI src1) (const 32)))) + ((m32r/d (unit u-exec (in sr src1)))) +) + +(dni mvtachi-a "mvtachi-a" + ((MACH m32rx) (PIPE S)) + "mvtachi $src1,$accs" + (+ OP1_5 src1 OP2_7 accs (f-op3 0)) + (set accs + (or DI + (and DI accs (const DI #xffffffff)) + (sll DI (ext DI src1) (const 32)))) + ((m32rx (unit u-exec (in sr src1)))) +) + +(dni mvtaclo "mvtaclo" + ((MACH m32r) (PIPE S)) + "mvtaclo $src1" + (+ OP1_5 OP2_7 (f-r2 1) src1) + (set accum + (or DI + (and DI accum (const DI #xffffffff00000000)) + (zext DI src1))) + ((m32r/d (unit u-exec (in sr src1)))) +) + +(dni mvtaclo-a "mvtaclo-a" + ((MACH m32rx) (PIPE S)) + "mvtaclo $src1,$accs" + (+ OP1_5 src1 OP2_7 accs (f-op3 1)) + (set accs + (or DI + (and DI accs (const DI #xffffffff00000000)) + (zext DI src1))) + ((m32rx (unit u-exec (in sr src1)))) +) + +(dni mvtc "mvtc" + ((PIPE O)) + "mvtc $sr,$dcr" + (+ OP1_1 OP2_10 dcr sr) + (set dcr sr) + () +) + +(dni neg "neg" + ((PIPE OS)) + "neg $dr,$sr" + (+ OP1_0 OP2_3 dr sr) + (set dr (neg sr)) + () +) + +(dni nop "nop" + ((PIPE OS)) + "nop" + (+ OP1_7 OP2_0 (f-r1 0) (f-r2 0)) + (c-code VOID "PROFILE_COUNT_FILLNOPS (current_cpu, abuf->addr);\n") + ; FIXME: quick hack: parallel nops don't contribute to cycle count. + ; Other kinds of nops do however (which we currently ignore). + ((m32r/d (unit u-exec (cycles 0))) + (m32rx (unit u-exec (cycles 0)))) +) + +(dni not "not" + ((PIPE OS)) + "not $dr,$sr" + (+ OP1_0 OP2_11 dr sr) + (set dr (inv sr)) + () +) + +(dni rac "rac" + ((MACH m32r) (PIPE S)) + "rac" + (+ OP1_5 OP2_9 (f-r1 0) (f-r2 0)) + (sequence ((DI tmp1)) + (set tmp1 (sll DI accum (const 1))) + (set tmp1 (add DI tmp1 (const DI #x8000))) + (set accum + (cond DI + ((gt tmp1 (const DI #x00007fffffff0000)) + (const DI #x00007fffffff0000)) + ((lt tmp1 (const DI #xffff800000000000)) + (const DI #xffff800000000000)) + (else (and tmp1 (const DI #xffffffffffff0000))))) + ) + ((m32r/d (unit u-mac))) +) + +(dni rac-dsi "rac-dsi" + ((MACH m32rx) (PIPE S)) + "rac $accd,$accs,$imm1" + (+ OP1_5 accd (f-bits67 0) OP2_9 accs (f-bit14 0) imm1) + (sequence ((DI tmp1)) + (set tmp1 (sll accs imm1)) + (set tmp1 (add tmp1 (const DI #x8000))) + (set accd + (cond DI + ((gt tmp1 (const DI #x00007fffffff0000)) + (const DI #x00007fffffff0000)) + ((lt tmp1 (const DI #xffff800000000000)) + (const DI #xffff800000000000)) + (else (and tmp1 (const DI #xffffffffffff0000))))) + ) + ((m32rx (unit u-mac))) +) + +(dnmi rac-d "rac-d" + ((MACH m32rx) (PIPE S)) + "rac $accd" + (emit rac-dsi accd (f-accs 0) (f-imm1 0)) +) + +(dnmi rac-ds "rac-ds" + ((MACH m32rx) (PIPE S)) + "rac $accd,$accs" + (emit rac-dsi accd accs (f-imm1 0)) +) + + +(dni rach "rach" + ((MACH m32r) (PIPE S)) + "rach" + (+ OP1_5 OP2_8 (f-r1 0) (f-r2 0)) + (sequence ((DI tmp1)) + ; Lop off top 8 bits. + ; The sign bit we want to use is bit 55 so the 64 bit value + ; isn't properly signed which we deal with in the if's below. + (set tmp1 (and accum (const DI #xffffffffffffff))) + (if (andif (ge tmp1 (const DI #x003fff80000000)) + (le tmp1 (const DI #x7fffffffffffff))) + (set tmp1 (const DI #x003fff80000000)) + ; else part + (if (andif (ge tmp1 (const DI #x80000000000000)) + (le tmp1 (const DI #xffc00000000000))) + (set tmp1 (const DI #xffc00000000000)) + (set tmp1 (and (add accum (const DI #x40000000)) + (const DI #xffffffff80000000))))) + (set tmp1 (sll tmp1 (const 1))) + ; Sign extend top 8 bits. + (set accum + ; FIXME: 7? + (sra DI (sll DI tmp1 (const 7)) (const 7))) + ) + ((m32r/d (unit u-mac))) +) + +(dni rach-dsi "rach-dsi" + ((MACH m32rx) (PIPE S)) + "rach $accd,$accs,$imm1" + (+ OP1_5 accd (f-bits67 0) OP2_8 accs (f-bit14 0) imm1) + (sequence ((DI tmp1)) + (set tmp1 (sll accs imm1)) + (set tmp1 (add tmp1 (const DI #x80000000))) + (set accd + (cond DI + ((gt tmp1 (const DI #x00007fff00000000)) + (const DI #x00007fff00000000)) + ((lt tmp1 (const DI #xffff800000000000)) + (const DI #xffff800000000000)) + (else (and tmp1 (const DI #xffffffff00000000))))) + ) + ((m32rx (unit u-mac))) +) + +(dnmi rach-d "rach-d" + ((MACH m32rx) (PIPE S)) + "rach $accd" + (emit rach-dsi accd (f-accs 0) (f-imm1 0)) +) + +(dnmi rach-ds "rach-ds" + ((MACH m32rx) (PIPE S)) + "rach $accd,$accs" + (emit rach-dsi accd accs (f-imm1 0)) +) + +(dni rte "rte" + (UNCOND-CTI (PIPE O)) + "rte" + (+ OP1_1 OP2_13 (f-r1 0) (f-r2 6)) + (sequence () + ; pc = bpc & -4 + (set pc (and (reg h-cr 6) (const -4))) + ; bpc = bbpc + (set (reg h-cr 6) (reg h-cr 14)) + ; psw = bpsw + (set (reg h-psw) (reg h-bpsw)) + ; bpsw = bbpsw + (set (reg h-bpsw) (reg h-bbpsw)) + ) + () +) + +(dni seth "seth" + () + "seth $dr,$hash$hi16" + (+ OP1_13 OP2_12 dr (f-r2 0) hi16) + (set dr (sll WI hi16 (const 16))) + () +) + +(define-pmacro (shift-op sym op2-r-op op2-3-op op2-i-op sem-op) + (begin + (dni sym sym ((PIPE O)) + (.str sym " $dr,$sr") + (+ OP1_1 op2-r-op dr sr) + (set dr (sem-op dr (and sr (const 31)))) + () + ) + (dni (.sym sym "3") sym () + (.str sym "3 $dr,$sr,$simm16") + (+ OP1_9 op2-3-op dr sr simm16) + (set dr (sem-op sr (and WI simm16 (const 31)))) + () + ) + (dni (.sym sym "i") sym ((PIPE O)) + (.str sym "i $dr,$uimm5") + (+ OP1_5 (f-shift-op2 op2-i-op) dr uimm5) + (set dr (sem-op dr uimm5)) + () + ) + ) +) +(shift-op sll OP2_4 OP2_12 2 sll) +(shift-op sra OP2_2 OP2_10 1 sra) +(shift-op srl OP2_0 OP2_8 0 srl) + +(define-pmacro (store-op suffix op2-op mode) + (begin + (dni (.sym st suffix) (.str "st" suffix) + ((PIPE O)) + (.str "st" suffix " $src1,@$src2") + (+ OP1_2 op2-op src1 src2) + (set mode (mem mode src2) src1) + ((m32r/d (unit u-store (cycles 1))) + (m32rx (unit u-store (cycles 1)))) + ) + (dnmi (.sym st suffix "-2") (.str "st" suffix "-2") + (NO-DIS (PIPE O)) + (.str "st" suffix " $src1,@($src2)") + (emit (.sym st suffix) src1 src2)) + (dni (.sym st suffix -d) (.str "st" suffix "-d") + () + (.str "st" suffix " $src1,@($slo16,$src2)") + (+ OP1_10 op2-op src1 src2 slo16) + (set mode (mem mode (add src2 slo16)) src1) + ((m32r/d (unit u-store (cycles 2))) + (m32rx (unit u-store (cycles 2)))) + ) + (dnmi (.sym st suffix -d2) (.str "st" suffix "-d2") + (NO-DIS) + (.str "st" suffix " $src1,@($src2,$slo16)") + (emit (.sym st suffix -d) src1 src2 slo16)) + ) +) +(store-op "" OP2_4 WI) +(store-op b OP2_0 QI) +(store-op h OP2_2 HI) + +(dni st-plus "st+" + ((PIPE O)) + "st $src1,@+$src2" + (+ OP1_2 OP2_6 src1 src2) + ; This has to be coded carefully to avoid an "earlyclobber" of src2. + (sequence ((WI new-src2)) + (set new-src2 (add WI src2 (const WI 4))) + (set (mem WI new-src2) src1) + (set src2 new-src2)) + ((m32r/d (unit u-store) + (unit u-exec (in dr src2) (out dr src2) (cycles 0))) + (m32rx (unit u-store) + (unit u-exec (in dr src2) (out dr src2) (cycles 0))) + ) +) + +(dni st-minus "st-" + ((PIPE O)) + "st $src1,@-$src2" + (+ OP1_2 OP2_7 src1 src2) + ; This is the original way. It doesn't work for parallel execution + ; because of the earlyclobber of src2. + ;(sequence () + ; (set src2 (sub src2 (const 4))) + ; (set (mem WI src2) src1)) + (sequence ((WI new-src2)) + (set new-src2 (sub src2 (const 4))) + (set (mem WI new-src2) src1) + (set src2 new-src2)) + ((m32r/d (unit u-store) + (unit u-exec (in dr src2) (out dr src2) (cycles 0))) + (m32rx (unit u-store) + (unit u-exec (in dr src2) (out dr src2) (cycles 0))) + ) +) + +(dnmi push "push" () + "push $src1" + (emit st-minus src1 (src2 15)) ; "st %0,@-sp" +) + +(dni sub "sub" + ((PIPE OS)) + "sub $dr,$sr" + (+ OP1_0 OP2_2 dr sr) + (set dr (sub dr sr)) + () +) + +(dni subv "sub:rv" + ((PIPE OS)) + "subv $dr,$sr" + (+ OP1_0 OP2_0 dr sr) + (parallel () + (set dr (sub dr sr)) + (set condbit (sub-oflag dr sr (const 0)))) + () +) + +(dni subx "sub:rx" + ((PIPE OS)) + "subx $dr,$sr" + (+ OP1_0 OP2_1 dr sr) + (parallel () + (set dr (subc dr sr condbit)) + (set condbit (sub-cflag dr sr condbit))) + () +) + +(dni trap "trap" + (UNCOND-CTI FILL-SLOT (PIPE O)) + "trap $uimm4" + (+ OP1_1 OP2_15 (f-r1 0) uimm4) + (sequence () + ; bbpc = bpc + (set (reg h-cr 14) (reg h-cr 6)) + ; Set bpc to the return address. Actually it's not quite the + ; return address as RTE rounds the address down to a word + ; boundary. + (set (reg h-cr 6) (add pc (const 4))) + ; bbpsw = bpsw + (set (reg h-bbpsw) (reg h-bpsw)) + ; bpsw = psw + (set (reg h-bpsw) (reg h-psw)) + ; sm is unchanged, ie,c are set to zero. + (set (reg h-psw) (and (reg h-psw) (const #x80))) + ; m32r_trap handles operating vs user mode + (set WI pc (c-call WI "m32r_trap" pc uimm4)) + ) + () +) + +(dni unlock "unlock" + ((PIPE O)) + "unlock $src1,@$src2" + (+ OP1_2 OP2_5 src1 src2) + (sequence () + (if (reg h-lock) + (set (mem WI src2) src1)) + (set (reg h-lock) (const BI 0))) + ((m32r/d (unit u-load)) + (m32rx (unit u-load))) +) + +; Saturate into byte. +(dni satb "satb" + ((MACH m32rx)) + "satb $dr,$sr" + (+ OP1_8 dr OP2_6 sr (f-uimm16 #x0300)) + (set dr + ; FIXME: min/max would simplify this nicely of course. + (cond WI + ((ge sr (const 127)) (const 127)) + ((le sr (const -128)) (const -128)) + (else sr))) + () +) + +; Saturate into half word. +(dni sath "sath" + ((MACH m32rx)) + "sath $dr,$sr" + (+ OP1_8 dr OP2_6 sr (f-uimm16 #x0200)) + (set dr + (cond WI + ((ge sr (const 32767)) (const 32767)) + ((le sr (const -32768)) (const -32768)) + (else sr))) + () +) + +; Saturate word. +(dni sat "sat" + ((MACH m32rx) SPECIAL) + "sat $dr,$sr" + (+ OP1_8 dr OP2_6 sr (f-uimm16 0)) + (set dr + (if WI condbit + (if WI (lt sr (const 0)) + (const #x7fffffff) + (const #x80000000)) + sr)) + () +) + +; Parallel compare byte zeros. +; Set C bit in condition register if any byte in source register is zero. +(dni pcmpbz "pcmpbz" + ((MACH m32rx) (PIPE OS) SPECIAL) + "pcmpbz $src2" + (+ OP1_0 (f-r1 3) OP2_7 src2) + (set condbit + (cond BI + ((eq (and src2 (const #xff)) (const 0)) (const BI 1)) + ((eq (and src2 (const #xff00)) (const 0)) (const BI 1)) + ((eq (and src2 (const #xff0000)) (const 0)) (const BI 1)) + ((eq (and src2 (const #xff000000)) (const 0)) (const BI 1)) + (else (const BI 0)))) + ((m32rx (unit u-cmp))) +) + +; Add accumulators +(dni sadd "sadd" + ((MACH m32rx) (PIPE S)) + "sadd" + (+ OP1_5 (f-r1 0) OP2_14 (f-r2 4)) + (set (reg h-accums 0) + (add (sra (reg h-accums 1) (const 16)) + (reg h-accums 0))) + ((m32rx (unit u-mac))) +) + +; Multiply and add into accumulator 1 +(dni macwu1 "macwu1" + ((MACH m32rx) (PIPE S)) + "macwu1 $src1,$src2" + (+ OP1_5 src1 OP2_11 src2) + (set (reg h-accums 1) + (sra DI + (sll DI + (add DI + (reg h-accums 1) + (mul DI + (ext DI src1) + (ext DI (and src2 (const #xffff))))) + (const 8)) + (const 8))) + ((m32rx (unit u-mac))) +) + +; Multiply and subtract from accumulator 0 +(dni msblo "msblo" + ((MACH m32rx) (PIPE S)) + "msblo $src1,$src2" + (+ OP1_5 src1 OP2_13 src2) + (set accum + (sra DI + (sll DI + (sub accum + (sra DI + (sll DI + (mul DI + (ext DI (trunc HI src1)) + (ext DI (trunc HI src2))) + (const 32)) + (const 16))) + (const 8)) + (const 8))) + ((m32rx (unit u-mac))) +) + +; Multiply into accumulator 1 +(dni mulwu1 "mulwu1" + ((MACH m32rx) (PIPE S)) + "mulwu1 $src1,$src2" + (+ OP1_5 src1 OP2_10 src2) + (set (reg h-accums 1) + (sra DI + (sll DI + (mul DI + (ext DI src1) + (ext DI (and src2 (const #xffff)))) + (const 16)) + (const 16))) + ((m32rx (unit u-mac))) +) + +; Multiply and add into accumulator 1 +(dni maclh1 "maclh1" + ((MACH m32rx) (PIPE S)) + "maclh1 $src1,$src2" + (+ OP1_5 src1 OP2_12 src2) + (set (reg h-accums 1) + (sra DI + (sll DI + (add DI + (reg h-accums 1) + (sll DI + (ext DI + (mul SI + (ext SI (trunc HI src1)) + (sra SI src2 (const SI 16)))) + (const 16))) + (const 8)) + (const 8))) + ((m32rx (unit u-mac))) +) + +; skip instruction if C +(dni sc "sc" + ((MACH m32rx) (PIPE O) SPECIAL) + "sc" + (+ OP1_7 (f-r1 4) OP2_0 (f-r2 1)) + (skip (zext INT condbit)) + () +) + +; skip instruction if not C +(dni snc "snc" + ((MACH m32rx) (PIPE O) SPECIAL) + "snc" + (+ OP1_7 (f-r1 5) OP2_0 (f-r2 1)) + (skip (zext INT (not condbit))) + () +) diff --git a/cgen/m32r.opc b/cgen/m32r.opc new file mode 100644 index 00000000000..601ca58d121 --- /dev/null +++ b/cgen/m32r.opc @@ -0,0 +1,264 @@ +/* M32R opcode support. -*- C -*- + Copyright (C) 2000 Red Hat, Inc. + This file is part of CGEN. */ + +/* This file is an addendum to m32r.cpu. Heavy use of C code isn't + appropriate in .cpu files, so it resides here. This especially applies + to assembly/disassembly where parsing/printing can be quite involved. + Such things aren't really part of the specification of the cpu, per se, + so .cpu files provide the general framework and .opc files handle the + nitty-gritty details as necessary. + + Each section is delimited with start and end markers. + + <arch>-opc.h additions use: "-- opc.h" + <arch>-opc.c additions use: "-- opc.c" + <arch>-asm.c additions use: "-- asm.c" + <arch>-dis.c additions use: "-- dis.c" + <arch>-ibd.h additions use: "-- ibd.h" +*/ + +/* -- opc.h */ + +#undef CGEN_DIS_HASH_SIZE +#define CGEN_DIS_HASH_SIZE 256 +#undef CGEN_DIS_HASH +#define X(b) (((unsigned char *) (b))[0] & 0xf0) +#define CGEN_DIS_HASH(buffer, value) \ +(X (buffer) | \ + (X (buffer) == 0x40 || X (buffer) == 0xe0 || X (buffer) == 0x60 || X (buffer) == 0x50 ? 0 \ + : X (buffer) == 0x70 || X (buffer) == 0xf0 ? (((unsigned char *) (buffer))[0] & 0xf) \ + : X (buffer) == 0x30 ? ((((unsigned char *) (buffer))[1] & 0x70) >> 4) \ + : ((((unsigned char *) (buffer))[1] & 0xf0) >> 4))) + +/* -- */ + +/* -- asm.c */ + +/* Handle '#' prefixes (i.e. skip over them). */ + +static const char * +parse_hash (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + if (**strp == '#') + ++*strp; + return NULL; +} + +/* Handle shigh(), high(). */ + +static const char * +parse_hi16 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (**strp == '#') + ++*strp; + + if (strncasecmp (*strp, "high(", 5) == 0) + { + *strp += 5; + errmsg = cgen_parse_address (cd, strp, opindex, BFD_RELOC_M32R_HI16_ULO, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + if (errmsg == NULL + && result_type == CGEN_PARSE_OPERAND_RESULT_NUMBER) + value >>= 16; + *valuep = value; + return errmsg; + } + else if (strncasecmp (*strp, "shigh(", 6) == 0) + { + *strp += 6; + errmsg = cgen_parse_address (cd, strp, opindex, BFD_RELOC_M32R_HI16_SLO, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + if (errmsg == NULL + && result_type == CGEN_PARSE_OPERAND_RESULT_NUMBER) + value = (value >> 16) + (value & 0x8000 ? 1 : 0); + *valuep = value; + return errmsg; + } + + return cgen_parse_unsigned_integer (cd, strp, opindex, valuep); +} + +/* Handle low() in a signed context. Also handle sda(). + The signedness of the value doesn't matter to low(), but this also + handles the case where low() isn't present. */ + +static const char * +parse_slo16 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (**strp == '#') + ++*strp; + + if (strncasecmp (*strp, "low(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (cd, strp, opindex, BFD_RELOC_M32R_LO16, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + if (errmsg == NULL + && result_type == CGEN_PARSE_OPERAND_RESULT_NUMBER) + value &= 0xffff; + *valuep = value; + return errmsg; + } + + if (strncasecmp (*strp, "sda(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (cd, strp, opindex, BFD_RELOC_M32R_SDA16, + NULL, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + *valuep = value; + return errmsg; + } + + return cgen_parse_signed_integer (cd, strp, opindex, valuep); +} + +/* Handle low() in an unsigned context. + The signedness of the value doesn't matter to low(), but this also + handles the case where low() isn't present. */ + +static const char * +parse_ulo16 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (**strp == '#') + ++*strp; + + if (strncasecmp (*strp, "low(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (cd, strp, opindex, BFD_RELOC_M32R_LO16, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + if (errmsg == NULL + && result_type == CGEN_PARSE_OPERAND_RESULT_NUMBER) + value &= 0xffff; + *valuep = value; + return errmsg; + } + + return cgen_parse_unsigned_integer (cd, strp, opindex, valuep); +} + +/* -- */ + +/* -- dis.c */ + +/* Immediate values are prefixed with '#'. */ + +#define CGEN_PRINT_NORMAL(cd, info, value, attrs, pc, length) \ +do { \ + if (CGEN_BOOL_ATTR ((attrs), CGEN_OPERAND_HASH_PREFIX)) \ + (*info->fprintf_func) (info->stream, "#"); \ +} while (0) + +/* Handle '#' prefixes as operands. */ + +static void +print_hash (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + disassemble_info *info = (disassemble_info *) dis_info; + (*info->fprintf_func) (info->stream, "#"); +} + +#undef CGEN_PRINT_INSN +#define CGEN_PRINT_INSN my_print_insn + +static int +my_print_insn (cd, pc, info) + CGEN_CPU_DESC cd; + bfd_vma pc; + disassemble_info *info; +{ + char buffer[CGEN_MAX_INSN_SIZE]; + char *buf = buffer; + int status; + int buflen = (pc & 3) == 0 ? 4 : 2; + + /* Read the base part of the insn. */ + + status = (*info->read_memory_func) (pc, buf, buflen, info); + if (status != 0) + { + (*info->memory_error_func) (status, pc, info); + return -1; + } + + /* 32 bit insn? */ + if ((pc & 3) == 0 && (buf[0] & 0x80) != 0) + return print_insn (cd, pc, info, buf, buflen); + + /* Print the first insn. */ + if ((pc & 3) == 0) + { + if (print_insn (cd, pc, info, buf, 2) == 0) + (*info->fprintf_func) (info->stream, UNKNOWN_INSN_MSG); + buf += 2; + } + + if (buf[0] & 0x80) + { + /* Parallel. */ + (*info->fprintf_func) (info->stream, " || "); + buf[0] &= 0x7f; + } + else + (*info->fprintf_func) (info->stream, " -> "); + + /* The "& 3" is to pass a consistent address. + Parallel insns arguably both begin on the word boundary. + Also, branch insns are calculated relative to the word boundary. */ + if (print_insn (cd, pc & ~ (bfd_vma) 3, info, buf, 2) == 0) + (*info->fprintf_func) (info->stream, UNKNOWN_INSN_MSG); + + return (pc & 3) ? 2 : 4; +} + +/* -- */ diff --git a/cgen/m68k.cpu b/cgen/m68k.cpu new file mode 100644 index 00000000000..5a614dd0f2b --- /dev/null +++ b/cgen/m68k.cpu @@ -0,0 +1,253 @@ +; Motorola M68000 family CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; NOTE: this file is still strictly WORK-IN-PROGRESS. + +(include "simplify.inc") + +(define-arch + (name m68k) + (comment "Motorola M68000 architecture") + (insn-lsb0? #t) + (machs m68k16) + (isas basic) +) + +(define-isa + (name basic) + (comment "Basic M68K instruction set") + (default-insn-word-bitsize 16) + (default-insn-bitsize 16) + (base-insn-bitsize 16) + (decode-assist (15 14 13 12)) +) + +(define-cpu + (name m68k) + (comment "Motorola M68000 family") + (endian big) + (word-bitsize 32) +) + +(define-mach + (name m68k16) + (comment "Motorola M68000 (16-bit bus)") + (cpu m68k) + (isas basic) +) + +(define-model + (name mc68000) + (comment "Motorola MC68000 microprocessor") + (mach m68k16) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () () () ()) +) + +; Hardware elements. + +(dnh h-pc "program counter" (PC PROFILE (ISA basic)) (pc) () () ()) + +(dsh h-ccr "condition code register" () (register HI)) + +(define-keyword + (name dr-names) + (print-name h-dr) + (prefix "") + (values (d0 0) (d1 1) (d2 2) (d3 3) (d4 4) (d5 5) (d6 6) (d7 7)) +) + +(define-keyword + (name ar-names) + (print-name h-ar) + (prefix "") + (values (a0 0) (a1 1) (a2 2) (a3 3) (a4 4) (a5 5) (a6 6) (a7 7) + (sp 7)) +) + +(define-hardware + (name h-dr) + (comment "data registers") + (attrs (ISA basic) CACHE-ADDR) + (type register SI (8)) + (indices extern-keyword dr-names) +) + +(define-hardware + (name h-ar) + (comment "address registers") + (attrs (ISA basic) CACHE-ADDR) + (type register SI (8)) + (indices extern-keyword ar-names) +) + +; FIXME: need three shadowed A7 registers here for: +; * User stack pointer (USP) +; * Interrupt stack pointer (ISP) +; * Master stack pointer (MSP). +; These can be omitted for now since we intend to only do user mode. +; c.f. arm.cpu for tips on how to do this. ARM shadows some registers +; depending on any of its five operating modes. + + +; Instruction fields. + +(define-pmacro (d68f x-name x-comment x-attrs x-word-offset x-word-length + x-start x-length x-mode x-encode x-decode) + (define-ifield + (name x-name) + (comment x-comment) + (.splice attrs (.unsplice x-attrs)) + (word-offset x-word-offset) + (word-length x-word-length) + (start x-start) + (length x-length) + (mode x-mode) + (encode x-encode) + (decode x-decode) + ) +) + +(define-pmacro (dn68f x-name x-comment x-attrs x-word-offset + x-word-length x-start x-length) + (d68f x-name x-comment x-attrs x-word-offset x-word-length x-start + x-length UINT #f #f) +) + +(d68f f-simm8 "signed 8 bit immediate" () 16 16 7 8 INT #f #f) +(d68f f-simm16 "signed 16 bit immediate" () 16 16 15 16 INT #f #f) +(d68f f-simm32 "signed 32 bit immediate" () 16 32 31 32 INT #f #f) + +(dn68f f-uimm8 "unsigned 8 bit immediate" () 16 16 7 8) +(dn68f f-uimm16 "unsigned 16 bit immediate" () 16 16 15 16) +(dn68f f-iumm32 "unsigned 32 bit immediate" () 16 32 31 32) + +(dn68f f-imm8-filler "unused part of 8 bit immediate" () 16 16 15 8) + +(dn68f f-15-4 "4 bits at bit 15" () 0 16 15 4) +(dn68f f-15-12 "12 bits at bit 15" () 0 16 15 12) +(dn68f f-15-13 "13 bits at bit 15" () 0 16 15 13) +(dn68f f-15-16 "16 bits at bit 15" () 0 16 15 16) +(dn68f f-8-1 "1 bit at bit 8" () 0 16 8 1) + +(dnf f-rx "register Rx field" () 11 3) +(dnf f-ry "register Ry field" () 2 3) +(dnf f-opmode "operation mode" () 7 5) +(dnf f-vector "vector field" () 3 4) + +(dnf f-imm8 "immediate constant (8 bits)" () 7 8) + +; Operands. +(dnop rx "register Rx operand" () h-uint f-rx) +(dnop reg-@2 "general reg number (at bit 2)" () h-uint f-rx) +(dnop reg-@11 "general reg number (at bit 11)" () h-uint f-ry) +(dnop ry "register Ry operand" () h-uint f-ry) +(dnop vector "trap vector operand" () h-uint f-vector) +(dnop imm8 "immediate constant (8 bits)" () h-uint f-imm8) + +; Instructions. + +(dni nop "no operation" () + "nop" + (+ (f-15-16 #x4E71)) + (nop) + () +) + +(dni exg-data "exchange data registers" () + "FIXME" + (+ (f-15-4 #xC) rx (f-8-1 1) (f-opmode 8) ry) + (sequence ((SI temp)) + (set temp (reg h-dr rx)) + (set (reg h-dr rx) (reg h-dr ry)) + (set (reg h-dr ry) temp)) + () +) + +(dni exg-addr "exchange address registers" () + "FIXME" + (+ (f-15-4 #xC) rx (f-8-1 1) (f-opmode 9) ry) + (sequence ((SI temp)) + (set temp (reg h-ar rx)) + (set (reg h-ar rx) (reg h-ar ry)) + (set (reg h-ar ry) temp)) + () +) + +(dni exg-data-addr "exchange data and address register" () + "FIXME" + (+ (f-15-4 #xC) rx (f-8-1 1) (f-opmode #x11) ry) + (sequence ((SI temp)) + (set temp (reg h-dr rx)) + (set (reg h-dr rx) (reg h-ar ry)) + (set (reg h-ar ry) temp)) + () +) + +(dni illegal "illegal instruction" () + "FIXME" + (+ (f-15-16 #x4AFC)) + (nop) + () +) + +(dni moveq "move quick" () + "FIXME" + (+ (f-15-4 7) reg-@2 (f-8-1 0) imm8) + ; FIXME: set condition codes. + (sequence () + (set (reg h-dr reg-@2) (ext SI imm8))) + () +) + +(dni reset "reset external devices" () + "FIXME" + (+ (f-15-16 #x4E70)) + (nop) + () +) + +(dni rte "return from exception" () + "FIXME" + (+ (f-15-16 #x4E73)) + (nop) + () +) + +(dni rtr "return and restore condition codes" () + "FIXME" + (+ (f-15-16 #x4E77)) + (nop) + () +) + +(dni rts "return from subroutine" () + "RTS" + (+ (f-15-16 #x4E75)) + (nop) + () +) + +(dni trap "trap" () + "FIXME" + (+ (f-15-12 #x4E4) vector) + (nop) + () +) + +(dni trapv "trap on overflow" () + "FIXME" + (+ (f-15-16 #x4E76)) + (nop) + () +) + +(dni unlk "unlink" () + "FIXME" + (+ (f-15-13 #x9CB) reg-@2) + (nop) + () +) diff --git a/cgen/mach.scm b/cgen/mach.scm new file mode 100644 index 00000000000..6069788d897 --- /dev/null +++ b/cgen/mach.scm @@ -0,0 +1,1473 @@ +; CPU architecture description. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Top level class that records everything about a cpu. +; FIXME: Rename this to something else and rename <arch-data> to <arch> +; for consistency with other classes (define-foo -> <foo> object). + +(define <arch> + (class-make '<arch> + nil + '( + ; An object of type <arch-data>. + data + (attr-list . (() . ())) + (enum-list . ()) + (kw-list . ()) + (isa-list . ()) + (cpu-list . ()) + (mach-list . ()) + (model-list . ()) + (ifld-list . ()) + (hw-list . ()) + (op-list . ()) + (ifmt-list . ()) + (sfmt-list . ()) + (insn-list . ()) + (minsn-list . ()) + (subr-list . ()) + (insn-extract . #f) ; FIXME: wip (and move elsewhere) + (insn-execute . #f) ; FIXME: wip (and move elsewhere) + + ; standard values derived from the input data + derived + + ; #t if instructions have been analyzed + (insns-analyzed? . #f) + ; #t if semantics were included in the analysis + (semantics-analyzed? . #f) + ; #t if alias insns were included in the analysis + (aliases-analyzed? . #f) + ) + nil) +) + +; Accessors. +; Each getter is arch-foo. +; Each setter is arch-set-foo!. + +(define-getters <arch> arch + (data + attr-list enum-list kw-list + isa-list cpu-list mach-list model-list + ifld-list hw-list op-list ifmt-list sfmt-list + insn-list minsn-list subr-list + derived + insns-analyzed? semantics-analyzed? aliases-analyzed? + ) +) +(define-setters <arch> arch + (data + attr-list enum-list kw-list + isa-list cpu-list mach-list model-list + ifld-list hw-list op-list ifmt-list sfmt-list + insn-list minsn-list subr-list + derived + insns-analyzed? semantics-analyzed? aliases-analyzed? + ) +) + +; Class for recording things specified in `define-arch'. +; This simplifies define-arch as the global arch object CURRENT-ARCH +; must exist before loading the .cpu file. + +(define <arch-data> + (class-make '<arch-data> + '(<ident>) + '( + ; Default alignment of memory operations. + ; One of aligned, unaligned, forced. + default-alignment + + ; Orientation of insn bit numbering (#f->msb=0, #t->lsb=0). + insn-lsb0? + + ; List of all machs. + ; Each element is pair of (mach-name . sanitize-key) + ; where sanitize-key is #f if there is none. + ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah + machs + + ; List of all isas (instruction set architecture). + ; Each element is a pair of (isa-name . sanitize-key) + ; where sanitize-key is #f if there is none. + ; There is usually just one. ARM has two (arm, thumb). + ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah + isas + + ; ??? Defaults for other things should be here. + ) + nil) +) + +(define-getters <arch-data> adata + (default-alignment insn-lsb0? machs isas) +) + +; Add, list, lookup accessors for <arch>. +; +; For the lookup routines, the result is the object or #f if not found. +; For some, if X is already an object, return that. + +(define (current-arch-name) (obj:name (arch-data CURRENT-ARCH))) + +(define (current-arch-comment) (obj:comment (arch-data CURRENT-ARCH))) + +(define (current-arch-atlist) (obj-atlist (arch-data CURRENT-ARCH))) + +(define (current-arch-default-alignment) + (adata-default-alignment (arch-data CURRENT-ARCH))) + +(define (current-arch-insn-lsb0?) + (adata-insn-lsb0? (arch-data CURRENT-ARCH))) + +(define (current-arch-mach-name-list) + (map car (adata-machs (arch-data CURRENT-ARCH))) +) + +(define (current-arch-isa-name-list) + (map car (adata-isas (arch-data CURRENT-ARCH))) +) + +; Attributes. +; Recorded as a pair of lists. +; The car is a list of <attribute> objects. +; The cdr is an associative list of (name . <attribute>) elements, for lookup. +; Could use a hash table except that there currently aren't that many. + +(define (current-attr-list) (car (arch-attr-list CURRENT-ARCH))) +(define (current-attr-add! a) + (let ((adata (arch-attr-list CURRENT-ARCH))) + ; Build list in normal order so we don't have to reverse it at the end + ; (since our format is non-trivial). + (if (null? (car adata)) + (arch-set-attr-list! CURRENT-ARCH + (cons (cons a nil) + (acons (obj:name a) a nil))) + (begin + (append! (car adata) (cons a nil)) + (append! (cdr adata) (acons (obj:name a) a nil))))) + *UNSPECIFIED* +) +(define (current-attr-lookup attr-name) + (assq-ref (cdr (arch-attr-list CURRENT-ARCH)) attr-name) +) + +; Enums. + +(define (current-enum-list) (arch-enum-list CURRENT-ARCH)) +(define (current-enum-add! e) + (arch-set-enum-list! CURRENT-ARCH (cons e (arch-enum-list CURRENT-ARCH))) +) +(define (current-enum-lookup enum-name) + (object-assq enum-name (current-enum-list)) +) + +; Keywords. + +(define (current-kw-list) (arch-kw-list CURRENT-ARCH)) +(define (current-kw-add! kw) + (arch-set-kw-list! CURRENT-ARCH (cons kw (arch-kw-list CURRENT-ARCH))) +) +(define (current-kw-lookup kw-name) + (object-assq kw-name (current-kw-list)) +) + +; Instruction sets. + +(define (current-isa-list) (arch-isa-list CURRENT-ARCH)) +(define (current-isa-add! i) + (arch-set-isa-list! CURRENT-ARCH (cons i (arch-isa-list CURRENT-ARCH))) +) +(define (current-isa-lookup isa-name) + (object-assq isa-name (current-isa-list)) +) + +; Cpu families. + +(define (current-cpu-list) (arch-cpu-list CURRENT-ARCH)) +(define (current-cpu-add! c) + (arch-set-cpu-list! CURRENT-ARCH (cons c (arch-cpu-list CURRENT-ARCH))) +) +(define (current-cpu-lookup cpu-name) + (object-assq cpu-name (current-cpu-list)) +) + +; Machines. + +(define (current-mach-list) (arch-mach-list CURRENT-ARCH)) +(define (current-mach-add! m) + (arch-set-mach-list! CURRENT-ARCH (cons m (arch-mach-list CURRENT-ARCH))) +) +(define (current-mach-lookup mach-name) + (object-assq mach-name (current-mach-list)) +) + +; Models. + +(define (current-model-list) (arch-model-list CURRENT-ARCH)) +(define (current-model-add! m) + (arch-set-model-list! CURRENT-ARCH (cons m (arch-model-list CURRENT-ARCH))) +) +(define (current-model-lookup model-name) + (object-assq model-name (current-model-list)) +) + +; Hardware elements. + +(define (current-hw-list) (arch-hw-list CURRENT-ARCH)) +(define (current-hw-add! hw) + (arch-set-hw-list! CURRENT-ARCH (cons hw (arch-hw-list CURRENT-ARCH))) +) +(define (current-hw-lookup hw) + (if (object? hw) + hw + ; This doesn't use object-assq on purpose. Hardware objects handle + ; get-name specially. + (find-first (lambda (hw-obj) (eq? (send hw-obj 'get-name) hw)) + (current-hw-list))) +) + +; Instruction fields. + +(define (current-ifld-list) (map cdr (arch-ifld-list CURRENT-ARCH))) +(define (current-ifld-add! f) + (arch-set-ifld-list! CURRENT-ARCH + (acons (obj:name f) f (arch-ifld-list CURRENT-ARCH))) +) +(define (current-ifld-lookup x) + (if (ifield? x) + x + (assq-ref (arch-ifld-list CURRENT-ARCH) x)) +) + +; Operands. + +(define (current-op-list) (map cdr (arch-op-list CURRENT-ARCH))) +(define (current-op-add! op) + (arch-set-op-list! CURRENT-ARCH + (acons (obj:name op) op (arch-op-list CURRENT-ARCH))) +) +(define (current-op-lookup name) + (assq-ref (arch-op-list CURRENT-ARCH) name) +) + +; Instruction field formats. + +(define (current-ifmt-list) (arch-ifmt-list CURRENT-ARCH)) + +; Semantic formats (akin to ifmt's, except includes semantics to distinguish +; insns). + +(define (current-sfmt-list) (arch-sfmt-list CURRENT-ARCH)) + +; Instructions. + +(define (current-raw-insn-list) (arch-insn-list CURRENT-ARCH)) +(define (current-insn-list) (map cdr (arch-insn-list CURRENT-ARCH))) +(define (current-insn-add! i) + (arch-set-insn-list! CURRENT-ARCH + (acons (obj:name i) i (arch-insn-list CURRENT-ARCH))) +) +(define (current-insn-lookup name) + (assq-ref (arch-insn-list CURRENT-ARCH) name) +) + +; Return the insn in the `car' position of INSN-LIST. + +(define insn-list-car cdar) + +; Splice INSN into INSN-LIST after (car INSN-LIST). +; This is useful when creating machine generating insns - it's useful to +; keep them close to their progenitor. +; The result is the same list, but beginning at the spliced-in insn. + +(define (insn-list-splice! insn-list insn) + (set-cdr! insn-list (acons (obj:name insn) insn (cdr insn-list))) + (cdr insn-list) +) + +; Macro instructions. + +(define (current-minsn-list) (map cdr (arch-minsn-list CURRENT-ARCH))) +(define (current-minsn-add! m) + (arch-set-minsn-list! CURRENT-ARCH + (acons (obj:name m) m (arch-minsn-list CURRENT-ARCH))) +) +(define (current-minsn-lookup name) + (assq-ref (arch-minsn-list CURRENT-ARCH) name) +) + +; rtx subroutines. + +(define (current-subr-list) (map cdr (arch-subr-list CURRENT-ARCH))) +(define (current-subr-add! m) + (arch-set-subr-list! CURRENT-ARCH + (acons (obj:name m) m (arch-subr-list CURRENT-ARCH))) +) +(define (current-subr-lookup name) + (assq-ref (arch-subr-list CURRENT-ARCH) name) +) + +; Arch parsing support. + +; Parse an alignment spec. + +(define (-arch-parse-alignment errtxt alignment) + (if (memq alignment '(aligned unaligned forced)) + alignment + (parse-error errtxt "invalid alignment" alignment)) +) + +; Parse an arch mach spec. +; The value is a list of mach names or (mach-name sanitize-key) elements. +; The result is a list of (mach-name . sanitize-key) elements. + +(define (-arch-parse-machs errtxt machs) + (for-each (lambda (m) + (if (or (symbol? m) + (and (list? m) (= (length m) 2) + (symbol? (car m)) (symbol? (cadr m)))) + #t ; ok + (parse-error errtxt "bad arch mach spec" m))) + machs) + (map (lambda (m) + (if (symbol? m) + (cons m #f) + (cons (car m) (cadr m)))) + machs) +) + +; Parse an arch isa spec. +; The value is a list of isa names or (isa-name sanitize-key) elements. +; The result is a list of (isa-name . sanitize-key) elements. + +(define (-arch-parse-isas errtxt isas) + (for-each (lambda (m) + (if (or (symbol? m) + (and (list? m) (= (length m) 2) + (symbol? (car m)) (symbol? (cadr m)))) + #t ; ok + (parse-error errtxt "bad arch isa spec" m))) + isas) + (map (lambda (m) + (if (symbol? m) + (cons m #f) + (cons (car m) (cadr m)))) + isas) +) + +; Parse an architecture description +; This is the main routine for building an arch object from a cpu +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. + +(define (-arch-parse context name comment attrs + default-alignment insn-lsb0? + machs isas) + (logit 2 "Processing arch " name " ...\n") + (make <arch-data> + (parse-name name context) + (parse-comment comment context) + (atlist-parse attrs "arch" context) + (-arch-parse-alignment context default-alignment) + (parse-boolean context insn-lsb0?) + (-arch-parse-machs context machs) + (-arch-parse-isas context isas)) +) + +; Read an architecture description. +; This is the main routine for analyzing an arch description in the .cpu file. +; ARG-LIST is an associative list of field name and field value. +; parse-arch is invoked to create the `arch' object. + +(define -arch-read + (lambda arg-list + (let ((context "arch-read") + ; <arch-data> object members and default values + (name "unknown") + (comment "") + (attrs nil) + (default-alignment 'aligned) + (insn-lsb0? #f) + (machs #f) + (isas #f) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((default-alignment) (set! default-alignment (cadr arg))) + ((insn-lsb0?) (set! insn-lsb0? (cadr arg))) + ((machs) (set! machs (cdr arg))) + ((isas) (set! isas (cdr arg))) + (else (parse-error context "invalid arch arg" arg))) + (loop (cdr arg-list))))) + ; Ensure required fields are present. + (if (not machs) + (parse-error context "missing machs spec")) + (if (not isas) + (parse-error context "missing isas spec")) + ; Now that we've identified the elements, build the object. + (-arch-parse context name comment attrs default-alignment insn-lsb0? + machs isas) + ) + ) +) + +; Define an arch object, name/value pair list version. + +(define define-arch + (lambda arg-list + (let ((a (apply -arch-read arg-list))) + (arch-set-data! CURRENT-ARCH a) + (def-mach-attr! (adata-machs a)) + (keep-mach-validate!) + (def-isa-attr! (adata-isas a)) + (keep-isa-validate!) + ; Install the builtin objects now that we have an arch, and now that + ; attributes MACH and ISA exist. + (reader-install-builtin!) + a)) +) + +; Mach/isa processing. + +; Create the MACH attribute. +; MACHS is the canonicalized machs spec to define-arch: (name . sanitize-key). + +(define (def-mach-attr! machs) + (let ((mach-enums (append + '((base)) + (map (lambda (mach) + (cons (car mach) + (cons '- + (if (cdr mach) + (list (cons 'sanitize (cdr mach))) + nil)))) + machs) + '((max))))) + (define-attr '(type bitset) '(name MACH) + '(comment "machine type selection") + '(default base) (cons 'values mach-enums)) + ) + + *UNSPECIFIED* +) + +; Return #t if MACH is supported by OBJ. +; This is done by looking for the MACH attribute in OBJ. +; By definition, objects that support the default (base) mach support +; all machs. + +(define (mach-supports? mach obj) + (let ((machs (bitset-attr->list (obj-attr-value obj 'MACH))) + (name (obj:name mach))) + (or (memq name machs) + (memq 'base machs))) + ;(let ((deflt (attr-lookup-default 'MACH obj))) + ; (any-true? (map (lambda (m) (memq m deflt)) machs))))) +) + +; Create the ISA attribute. +; ISAS is the canonicalized isas spec to define-arch: (name . sanitize-key). +; ISAS is a list of isa names. + +(define (def-isa-attr! isas) + (let ((isa-enums (append + (map (lambda (isa) + (cons (car isa) + (cons '- + (if (cdr isa) + (list (cons 'sanitize (cdr isa))) + nil)))) + isas) + '((max))))) + ; Using a bitset attribute here implies something could be used by two + ; separate isas. This seems highly unlikely but we don't [as yet] + ; preclude it. The other thing to consider is whether the cpu table + ; would ever want to be opened for multiple isas. + (define-attr '(type bitset) '(name ISA) + '(comment "instruction set selection") + ; If there's only one isa, don't (yet) pollute the tables with a value + ; for it. + (if (= (length isas) 1) + '(for) + '(for ifield operand insn)) + (cons 'values isa-enums)) + ) + + *UNSPECIFIED* +) + +; Return #t if <isa> ISA is supported by OBJ. +; This is done by looking for the ISA attribute in OBJ. + +(define (isa-supports? isa obj) + (let ((isas (bitset-attr->list (obj-attr-value obj 'ISA))) + (name (obj:name isa))) + (->bool (memq name isas))) +) + +; The fetch/decode/execute process. +; "extract" is a fancy word for fetch/decode. +; FIXME: wip, not currently used. +; FIXME: move to inside define-isa, and maybe elsewhere. +; +;(defmacro +; define-extract (code) +; ;(arch-set-insn-extract! CURRENT-ARCH code) +; *UNSPECIFIED* +;) +; +;(defmacro +; define-execute (code) +; ;(arch-set-insn-execute! CURRENT-ARCH code) +; *UNSPECIFIED* +;) + +; ISA specification. +; Each architecture is generally one isa, but in the case of ARM (and a few +; others) there is more than one. +; +; ??? "ISA" has a very well defined meaning, and our usage of it one might +; want to quibble over. A better name would be welcome. + +; Associated with an instruction set is its framing. +; This refers to how instructions are laid out at the liw level (where several +; insns are framed together and executed sequentially or in parallel). +; ??? If one defines the term "format" as being how an individual instruction +; is laid out then formatting can be thought of as being different from +; framing. However, it's possible for a particular ISA to intertwine the two. +; Thus this will need to evolve. +; ??? Not used yet, wip. + +(define <iframe> ; pronounced I-frame + (class-make '<iframe> '(<ident>) + '( + ; list of <itype> objects that make up the frame + insns + + ; assembler syntax + syntax + + ; list of (length value) elements that make up the format + ; Length is in bits. Value is either a number or a $number + ; symbol refering to the insn specified in `insns'. + value + + ; Initial bitnumbers to decode insns by. + ; ??? At present the rest of the decoding is determined + ; algorithmically. May wish to give the user more control + ; [like psim]. + decode-assist + + ; rtl that executes instructions in `value' + ; Fields specified in `value' can be used here. + action + ) + nil) +) + +; Accessors. + +(define-getters <iframe> iframe (insns syntax value decode-assist action)) + +; Instruction types, recorded in <iframe>. +; ??? Not used yet, wip. + +(define <itype> + (class-make '<itype> '(<ident>) + '( + ; length in bits, or initial part if variable length (wip) + length + + ; constraint specifying which insns are included + constraint + + ; Initial bitnumbers to decode insns by. + ; ??? At present the rest of the decoding is determined + ; algorithmically. May wish to give the user more control + ; [like psim]. + decode-assist + ) + nil) +) + +; Accessors. + +(define-getters <itype> itype (length constraint decode-assist)) + +; Simulator instruction decode splitting. +; FIXME: Should live in simulator specific code. Requires class handling +; cleanup first. +; +; Instructions can be split by particular values for an ifield. +; The ARM port uses this to split insns into those that set the pc and +; those that don't. + +(define <decode-split> + (class-make '<decode-split> '() + '( + ; Name of ifield to split on. + name + + ; Constraint. Only insns satifying this constraint are + ; split. #f if no constraint. + constraint + + ; List of ifield splits. + ; Each element is one of (name value) or (name (values)). + values + ) + nil + ) +) + +; Accessors. + +(define-getters <decode-split> decode-split (name constraint values)) + +; Parse a decode-split spec. +; SPEC is (ifield-name constraint value-list). +; CONSTRAINT is an rtl expression. Only insns satifying the constraint +; are split. +; Each element of VALUE-LIST is one of (name value) or (name (values)). +; FIXME: All possible values must be specified. Need an `else' clause. +; Ranges would also be useful. + +(define (-isa-parse-decode-split context spec) + (if (!= (length spec) 3) + (parse-error context "decode-split spec is (ifield-name constraint value-list)" spec)) + + (let ((name (parse-name (car spec) context)) + (constraint (cadr spec)) + (value-list (caddr spec))) + + ; FIXME: more error checking. + + (make <decode-split> + name + (if (null? constraint) #f constraint) + value-list)) +) + +; Parse a list of decode-split specs. + +(define (-isa-parse-decode-splits context spec-list) + (map (lambda (spec) + (-isa-parse-decode-split context spec)) + spec-list) +) + +; Top level class to describe an isa. + +(define <isa> + (class-make '<isa> '(<ident>) + '( + ; Default length to record in ifields. + ; This is used in calculations involving bit numbers. + default-insn-word-bitsize + + ; Length of an unknown instruction. Used by disassembly + ; and by the simulator's invalid insn handler. + default-insn-bitsize + + ; Number of bytes of insn that can be initially fetched. + ; In non-LIW isas this would be the length of the smallest + ; insn. For LIW isas it depends - only one LIW isa is + ; currently supported (m32r). + base-insn-bitsize + + ; Initial bitnumbers to decode insns by. + ; ??? At present the rest of the decoding is determined + ; algorithmically. May wish to give the user more control + ; [like psim]. + decode-assist + + ; Number of instructions that can be fetched at a time + ; [e.g. 2 on m32r]. + liw-insns + + ; Maximum number of instructions the cpu can execute in + ; parallel. + ; FIXME: Rename to max-parallel-insns. + parallel-insns + + ; List of <iframe> objects. + ;frames + + ; Condition tested before execution of any instruction or + ; #f if there is none. For architectures like ARM, ARC. + ; If specified it is a pair of + ; (condition-field-name . rtl-for-condition) + (condition . #f) + + ; Code to execute after CONDITION and prior to SEMANTICS. + ; This is rtl in source form or #f if there is none. + ; This is generally unused. It is used on the ARM to set + ; R15 to the correct value. + ; The reason it's not specified with SEMANTICS is that it is + ; believed some applications won't need/want this. + ; ??? It is a bit of a hack though, as it is used to aid + ; implementation of apps (e.g. simulator). Arguably something + ; that doesn't belong here. Maybe as more architectures are + ; ported that have the PC as a general register, a better way + ; to do this will arise. + (setup-semantics . #f) + + ; list of simulator instruction splits + ; FIXME: should live in simulator file (needs class cleanup). + (decode-splits . ()) + + ; ??? More may need to migrate here. + ) + nil) +) + +; Accessors. + +(define-getters <isa> isa + (base-insn-bitsize default-insn-bitsize default-insn-word-bitsize + decode-assist liw-insns parallel-insns condition + setup-semantics decode-splits) +) + +(define-setters <isa> isa + (decode-splits) +) + +(define (isa-enum isa) (string-append "ISA_" (string-upcase (gen-sym isa)))) + +; Return minimum/maximum size in bits of all insns in the isa. + +(define (isa-min-insn-bitsize isa) + ; add `65535' in case list is nil (avoids crash) + ; [a language with infinite precision can't have min-reduce-iota-0 :-)] + (apply min (cons 65535 + (map insn-length (find (lambda (insn) + (and (not (has-attr? insn 'ALIAS)) + (eq? (obj-attr-value insn 'ISA) + (obj:name isa)))) + (non-multi-insns (current-insn-list)))))) +) + +(define (isa-max-insn-bitsize isa) + ; add `0' in case list is nil (avoids crash) + ; [a language with infinite precision can't have max-reduce-iota-0 :-)] + (apply max (cons 0 + (map insn-length (find (lambda (insn) + (and (not (has-attr? insn 'ALIAS)) + (eq? (obj-attr-value insn 'ISA) + (obj:name isa)))) + (non-multi-insns (current-insn-list)))))) +) + +; Return a boolean indicating if instructions in ISA can be kept in a +; portable int. + +(define (isa-integral-insn? isa) + (<= (isa-max-insn-bitsize isa) 32) +) + +; Parse an isa condition spec. +; `condition' here refers to the condition performed by architectures like +; ARM and ARC before each insn. + +(define (-isa-parse-condition context spec) + (if (null? spec) + #f + (begin + (if (or (!= (length spec) 2) + (not (symbol? (car spec))) + (not (form? (cadr spec)))) + (parse-error context + "condition spec not `(ifield-name rtl-code)'" spec)) + spec)) +) + +; Parse a setup-semantics spec. + +(define (-isa-parse-setup-semantics context spec) + (if (not (null? spec)) + spec + #f) +) + +; Parse an isa spec. +; The result is the <isa> object. +; All arguments are in raw (non-evaluated) form. + +(define (-isa-parse context name comment attrs + base-insn-bitsize default-insn-bitsize default-insn-word-bitsize + decode-assist liw-insns parallel-insns condition + setup-semantics decode-splits) + (logit 2 "Processing isa " name " ...\n") + + (let ((name (parse-name name context))) + (if (not (memq name (current-arch-isa-name-list))) + (parse-error context "isa name is not present in `define-arch'" name)) + + ; Isa's are always kept - we need them to validate later uses, even if + ; the then resulting object won't be kept. All isas are also needed to + ; compute a proper value for the isas-cache member of <hardware-base> + ; for builtin objects. + (make <isa> + name + (parse-comment comment context) + (atlist-parse attrs "isa" context) + (parse-number (string-append context + ": default-insn-word-bitsize") + default-insn-word-bitsize '(8 . 128)) + (parse-number (string-append context + ": default-insn-bitsize") + default-insn-bitsize '(8 . 128)) + (parse-number (string-append context + ": base-insn-bitsize") + base-insn-bitsize '(8 . 128)) + decode-assist + liw-insns + parallel-insns + (-isa-parse-condition context condition) + (-isa-parse-setup-semantics context setup-semantics) + (-isa-parse-decode-splits context decode-splits) + )) +) + +; Read an isa entry. +; ARG-LIST is an associative list of field name and field value. + +(define -isa-read + (lambda arg-list + (let ((context "isa-read") + ; <isa> object members and default values + (name #f) + (attrs nil) + (comment "") + (base-insn-bitsize #f) + (default-insn-bitsize #f) + (default-insn-word-bitsize #f) + (decode-assist nil) + (liw-insns 1) + ; FIXME: Hobbit computes the wrong symbol for `parallel-insns' + ; in the `case' expression below because there is a local var + ; of the same name ("__1" gets appended to the symbol name). + (parallel-insns- 1) + (condition nil) + (setup-semantics nil) + (decode-splits nil) + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((default-insn-word-bitsize) + (set! default-insn-word-bitsize (cadr arg))) + ((default-insn-bitsize) (set! default-insn-bitsize (cadr arg))) + ((base-insn-bitsize) (set! base-insn-bitsize (cadr arg))) + ((decode-assist) (set! decode-assist (cadr arg))) + ((liw-insns) (set! liw-insns (cadr arg))) + ((parallel-insns) (set! parallel-insns- (cadr arg))) + ((condition) (set! condition (cdr arg))) + ((setup-semantics) (set! setup-semantics (cadr arg))) + ((decode-splits) (set! decode-splits (cdr arg))) + ((insn-types) #t) ; ignore for now + ((frame) #t) ; ignore for now + (else (parse-error context "invalid isa arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-isa-parse context name comment attrs + base-insn-bitsize + (if default-insn-word-bitsize + default-insn-word-bitsize + base-insn-bitsize) + (if default-insn-bitsize + default-insn-bitsize + base-insn-bitsize) + decode-assist liw-insns parallel-insns- condition + setup-semantics decode-splits) + ) + ) +) + +; Define a <isa> object, name/value pair list version. + +(define define-isa + (lambda arg-list + (let ((i (apply -isa-read arg-list))) + (if i + (current-isa-add! i)) + i)) +) + +; Subroutine of modify-isa to process one add-decode-split spec. + +(define (-isa-add-decode-split! context isa spec) + (let ((decode-split (-isa-parse-decode-split context spec))) + (isa-set-decode-splits! (cons decode-split (isa-decode-splits isa))) + *UNSPECIFIED*) +) + +; Main routine for modifying existing isa definitions + +(define modify-isa + (lambda arg-list + (let ((errtxt "modify-isa") + (isa-spec (assq 'name arg-list))) + (if (not isa-spec) + (parse-error errtxt "isa name not specified")) + + (let ((isa (current-isa-lookup (arg-list-symbol-arg errtxt isa-spec)))) + (if (not isa) + (parse-error errtxt "undefined isa" isa-spec)) + + (let loop ((args arg-list)) + (if (null? args) + #f ; done + (let ((arg-spec (car args))) + (case (car arg-spec) + ((name) #f) ; ignore, already processed + ((add-decode-split) + (-isa-add-decode-split! errtxt isa (cdr arg-spec))) + (else + (parse-error errtxt "invalid/unsupported option" (car arg-spec)))) + (loop (cdr args))))))) + + *UNSPECIFIED*) +) + +; Return boolean indicating if ISA supports parallel execution. + +(define (isa-parallel-exec? isa) (> (isa-parallel-insns isa) 1)) + +; Return a boolean indicating if ISA supports conditional execution +; of all instructions. + +(define (isa-conditional-exec? isa) (->bool (isa-condition isa))) + +; The `<cpu>' object collects together various details about a particular +; subset of the architecture (e.g. perhaps all 32 bit variants of the sparc +; architecture). +; This is called a "cpu-family". +; ??? May be renamed to <family> (both internally and in the .cpu file). +; ??? Another way to do this would be to discard the family notion and allow +; machs to inherit from other machs, as well as use isas to distinguish +; sufficiently dissimilar machs. This would remove a fuzzy illspecified +; notion with a concrete one. +; ??? Maybe a better way to organize sparc32 vs sparc64 is via an isa. + +(define <cpu> + (class-make '<cpu> + '(<ident>) + '( + ; one of big/little/either/#f. + ; If #f, then {insn,data,float}-endian are used. + ; Otherwise they're ignored. + endian + + ; one of big/little/either. + insn-endian + + ; one of big/little/either/big-words/little-words. + ; If big-words then each word is little-endian. + ; If little-words then each word is big-endian. + data-endian + + ; one of big/little/either/big-words/little-words. + float-endian + + ; number of bits in a word. + word-bitsize + + ; Transformation to use in generated files should one be + ; needed. At present the only supported value is a string + ; which is the file suffix. + ; ??? A dubious element of the description language, but given + ; the quantity of generated files, some machine generated + ; headers may need to #include other machine generated headers + ; (e.g. cpuall.h). + file-transform + + ; Allow a cpu family to override the isa parallel-insns spec. + ; ??? Concession to the m32r port which can go away, in time. + parallel-insns + ) + nil) +) + +; Accessors. + +(define-getters <cpu> cpu (word-bitsize file-transform parallel-insns)) + +; Return endianness of instructions. + +(define (cpu-insn-endian cpu) + (let ((endian (elm-xget cpu 'endian))) + (if endian + endian + (elm-xget cpu 'insn-endian))) +) + +; Return endianness of data. + +(define (cpu-data-endian cpu) + (let ((endian (elm-xget cpu 'endian))) + (if endian + endian + (elm-xget cpu 'data-endian))) +) + +; Return endianness of floats. + +(define (cpu-float-endian cpu) + (let ((endian (elm-xget cpu 'endian))) + (if endian + endian + (elm-xget cpu 'float-endian))) +) + +; Parse a cpu family description +; This is the main routine for building a <cpu> object from a cpu +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. + +(define (-cpu-parse name comment attrs + endian insn-endian data-endian float-endian + word-bitsize file-transform parallel-insns) + (logit 2 "Processing cpu family " name " ...\n") + ; Pick out name first 'cus we need it as a string(/symbol). + (let* ((name (parse-name name "cpu")) + (errtxt (string-append "cpu " name))) + (if (keep-cpu? name) + (make <cpu> + name + (parse-comment comment errtxt) + (atlist-parse attrs "cpu" errtxt) + endian insn-endian data-endian float-endian + word-bitsize + file-transform + parallel-insns) + (begin + (logit 2 "Ignoring " name ".\n") + #f))) ; cpu is not to be kept +) + +; Read a cpu family description +; This is the main routine for analyzing a cpu description in the .cpu file. +; ARG-LIST is an associative list of field name and field value. +; -cpu-parse is invoked to create the <cpu> object. + +(define -cpu-read + (lambda arg-list + (let ((errtxt "cpu-read") + ; <cpu> object members and default values + (name nil) + (comment nil) + (attrs nil) + (endian #f) + (insn-endian #f) + (data-endian #f) + (float-endian #f) + (word-bitsize nil) + (file-transform "") + ; FIXME: Hobbit computes the wrong symbol for `parallel-insns' + ; in the `case' expression below because there is a local var + ; of the same name ("__1" gets appended to the symbol name). + (parallel-insns- #f) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((endian) (set! endian (cadr arg))) + ((insn-endian) (set! insn-endian (cadr arg))) + ((data-endian) (set! data-endian (cadr arg))) + ((float-endian) (set! float-endian (cadr arg))) + ((word-bitsize) (set! word-bitsize (cadr arg))) + ((file-transform) (set! file-transform (cadr arg))) + ((parallel-insns) (set! parallel-insns- (cadr arg))) + (else (parse-error errtxt "invalid cpu arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-cpu-parse name comment attrs + endian insn-endian data-endian float-endian + word-bitsize file-transform parallel-insns-) + ) + ) +) + +; Define a cpu family object, name/value pair list version. + +(define define-cpu + (lambda arg-list + (let ((c (apply -cpu-read arg-list))) + (if c + (current-cpu-add! c)) + c)) +) + +; The `<mach>' object describes one member of a `cpu' family. + +(define <mach> + (class-make '<mach> '(<ident>) + '( + ; cpu family this mach is a member of + cpu + ; bfd name of mach + bfd-name + ; list of <isa> objects + isas + ) + nil) +) + +; Accessors. + +(define-getters <mach> mach (cpu bfd-name isas)) + +(define (mach-enum obj) + (string-append "MACH_" (string-upcase (gen-sym obj))) +) + +(define (mach-number obj) (mach-enum obj)) + +; Parse a machine entry. +; The result is a <mach> object or #f if the mach isn't to be kept. +; All arguments are in raw (non-evaluated) form. + +(define (-mach-parse context name comment attrs cpu bfd-name isas) + (logit 2 "Processing mach " name " ...\n") + + (let ((name (parse-name name context))) + (if (not (list? isas)) + (parse-error context "isa spec not a list" isas)) + (let ((cpu-obj (current-cpu-lookup cpu)) + (isa-list (map current-isa-lookup isas))) + (if (not (memq name (current-arch-mach-name-list))) + (parse-error context "mach name is not present in `define-arch'" name)) + (if (null? cpu) + (parse-error context "missing cpu spec" cpu)) + (if (not cpu-obj) + (parse-error context "unknown cpu" cpu)) + (if (null? isas) + (parse-error context "missing isas spec" isas)) + (if (not (all-true? isa-list)) + (parse-error context "unknown isa in" isas)) + (if (not (string? bfd-name)) + (parse-error context "bfd-name not a string" bfd-name)) + (if (keep-mach? (list name)) + (make <mach> + name + (parse-comment comment context) + (atlist-parse attrs "mach" context) + cpu-obj + bfd-name + isa-list) + (begin + (logit 2 "Ignoring " name ".\n") + #f)))) ; mach is not to be kept +) + +; Read a mach entry. +; ARG-LIST is an associative list of field name and field value. + +(define -mach-read + (lambda arg-list + (let ((context "mach-read") + (name nil) + (attrs nil) + (comment nil) + (cpu nil) + (bfd-name #f) + (isas #f) + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((cpu) (set! cpu (cadr arg))) + ((bfd-name) (set! bfd-name (cadr arg))) + ((isas) (set! isas (cdr arg))) + (else (parse-error context "invalid mach arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-mach-parse context name comment attrs cpu + ; Default bfd-name is same as object's name. + (if bfd-name bfd-name (symbol->string name)) + ; Default isa is the first one. + (if isas isas (list (obj:name (car (current-isa-list)))))) + ) + ) +) + +; Define a <mach> object, name/value pair list version. + +(define define-mach + (lambda arg-list + (let ((m (apply -mach-read arg-list))) + (if m + (current-mach-add! m)) + m)) +) + +; Miscellaneous state derived from the input data. +; FIXME: being redone + +; Size of a word in bits. +; All selected cpu families must have same value or error. +; FIXME: Only user is opcodes.scm and we don't want this restriction there. + +(define (state-word-bitsize) + (let ((wb (map cpu-word-bitsize (current-cpu-list)))) + ; FIXME: ensure all have same value. + (car wb)) +) + +; Return maximum word bitsize. + +(define (state-max-word-bitsize) + (apply max (map cpu-word-bitsize (current-cpu-list))) +) + +; Size of normal instruction. +; All selected isas must have same value or error. + +(define (state-default-insn-bitsize) + (let ((dib (map isa-default-insn-bitsize (current-isa-list)))) + ; FIXME: ensure all have same value. + (car dib)) +) + +; Number of bytes of insn we can initially fetch. +; All selected isas must have same value or error. + +(define (state-base-insn-bitsize) + (let ((bib (map isa-base-insn-bitsize (current-isa-list)))) + ; FIXME: ensure all have same value. + (car bib)) +) + +; Return parallel-insns spec. + +(define (state-parallel-insns) + ; Assert only one cpu family has been selected. + (assert-keep-one) + + (let ((par-insns (map isa-parallel-insns (current-isa-list))) + (cpu-par-insns (cpu-parallel-insns (current-cpu)))) + ; ??? The m32r does have parallel execution, but to keep support for the + ; base mach simpler, a cpu family is allowed to override the isa spec. + (or cpu-par-insns + ; FIXME: ensure all have same value. + (car par-insns))) +) + +; Return boolean indicating if parallel execution support is required. + +(define (state-parallel-exec?) + (> (state-parallel-insns) 1) +) + +; Return liw-insns spec. + +(define (state-liw-insns) + (let ((liw-insns (map isa-liw-insns (current-isa-list)))) + ; FIXME: ensure all have same value. + (car liw-insns)) +) + +; Return decode-assist spec. + +(define (state-decode-assist) + (isa-decode-assist (current-isa)) +) + +; Return boolean indicating if current isa conditionally executes all insn. + +(define (state-conditional-exec?) + (isa-conditional-exec? (current-isa)) +) + +; Architecture or cpu wide values derived from other data. + +(define <derived-arch-data> + (class-make '<derived-arch-data> + nil + '( + ; whether all insns can be recorded in a host int + integral-insn? + ) + nil) +) + +; Called after the .cpu file has been read in to prime derived value +; computation. +; Often this data isn't needed so we only computed it if we have to. + +(define (-adata-set-derived! arch) + ; Don't compute this data unless we need to. + (arch-set-derived! + arch + (make <derived-arch-data> + ; integral-insn? + (delay (isa-integral-insn? (current-isa))) + )) +) + +; Accessors. + +(define (adata-integral-insn? arch) + (force (elm-xget (arch-derived arch) 'integral-insn?)) +) + +; Instruction analysis control. + +; Analyze the instruction set. +; The name is explicitly vague because it's intended that all insn analysis +; would be controlled here. +; If the instruction set has already been sufficiently analyzed, do nothing. +; INCLUDE-ALIASES? is #t if alias insns are to be included. +; ANALYZE-SEMANTICS? is #t if insn semantics are to be analyzed. +; +; This is a very expensive operation, so we only do it as necessary. +; There are (currently) two different kinds of users: assemblers and +; simulators. Assembler style apps don't always need to analyze the semantics. +; Simulator style apps don't want to include the alias insns. + +(define (arch-analyze-insns! arch include-aliases? analyze-semantics?) + (if (or (not (arch-insns-analyzed? arch)) + (not (eq? analyze-semantics? (arch-semantics-analyzed? arch))) + (not (eq? include-aliases? (arch-aliases-analyzed? arch)))) + + (begin + (if (any-true? (map multi-insn? (current-insn-list))) + (begin + ; Instantiate sub-insns of all multi-insns. + (logit 1 "Instantiating multi-insns ...\n") + (for-each (lambda (insn) + (multi-insn-instantiate! insn)) + (multi-insns (current-insn-list))) + )) + + ; This is expensive so indicate start/finish. + (logit 1 "Analyzing instruction set ...\n") + + (let ((fmt-lists + (ifmt-compute! (non-multi-insns + (if include-aliases? + (map cdr (arch-insn-list arch)) + (non-alias-insns (map cdr (arch-insn-list arch))))) + analyze-semantics?))) + + (arch-set-ifmt-list! arch (car fmt-lists)) + (arch-set-sfmt-list! arch (cadr fmt-lists)) + (arch-set-insns-analyzed?! arch #t) + (arch-set-semantics-analyzed?! arch analyze-semantics?) + (arch-set-aliases-analyzed?! arch include-aliases?) + + (logit 1 "Done analysis.\n") + )) + ) + + *UNSPECIFIED* +) + +; Called before a .cpu file is read in. + +(define (arch-init!) + + (reader-add-command! 'define-arch + "\ +Define an architecture, name/value pair list version. +" + nil 'arg-list define-arch) + + (reader-add-command! 'define-isa + "\ +Define an instruction set architecture, name/value pair list version. +" + nil 'arg-list define-isa) + (reader-add-command! 'modify-isa + "\ +Modify an isa, name/value pair list version. +" + nil 'arg-list modify-isa) + + (reader-add-command! 'define-cpu + "\ +Define a cpu family, name/value pair list version. +" + nil 'arg-list define-cpu) + + *UNSPECIFIED* +) + +; Called before a .cpu file is read in. + +(define (mach-init!) + + (reader-add-command! 'define-mach + "\ +Define a machine, name/value pair list version. +" + nil 'arg-list define-mach) + + *UNSPECIFIED* +) + +; Called after .cpu file is read in. + +(define (arch-finish!) + (let ((arch CURRENT-ARCH)) + + ; Lists are constructed in the reverse order they appear in the file + ; [for simplicity and efficiency]. Restore them to file order for the + ; human reader/debugger. + (arch-set-enum-list! arch (reverse (arch-enum-list arch))) + (arch-set-kw-list! arch (reverse (arch-kw-list arch))) + (arch-set-isa-list! arch (reverse (arch-isa-list arch))) + (arch-set-cpu-list! arch (reverse (arch-cpu-list arch))) + (arch-set-mach-list! arch (reverse (arch-mach-list arch))) + (arch-set-model-list! arch (reverse (arch-model-list arch))) + (arch-set-ifld-list! arch (reverse (arch-ifld-list arch))) + (arch-set-hw-list! arch (reverse (arch-hw-list arch))) + (arch-set-op-list! arch (reverse (arch-op-list arch))) + (arch-set-insn-list! arch (reverse (arch-insn-list arch))) + (arch-set-minsn-list! arch (reverse (arch-minsn-list arch))) + (arch-set-subr-list! arch (reverse (arch-subr-list arch))) + ) + + *UNSPECIFIED* +) + +; Called after .cpu file is read in. + +(define (mach-finish!) + (-adata-set-derived! CURRENT-ARCH) + + *UNSPECIFIED* +) diff --git a/cgen/minsn.scm b/cgen/minsn.scm new file mode 100644 index 00000000000..671c3a1849d --- /dev/null +++ b/cgen/minsn.scm @@ -0,0 +1,259 @@ +; Macro instruction definitions. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Expansion: +; If the macro expands to a string, arguments in the input string +; are refered to with %N. Multiple insns are separated with '\n'. +; String expansion is a special case of the normal form which is a Scheme +; expression that controls the expansion. The Scheme expression will be able +; to refer to the current assembly state to decide how to perform the +; expansion. Special expression `emit' is used to call the assembler emitter +; for a particular insn. Special expression `expand' is used to return a +; string to be reparsed (which is special cased). + +; Parse a list of macro-instruction expansion descriptions. +; This is the main routine for building an minsn-expansion object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. + +; ??? At present we only support macros that are aliases of one real insn. + +; Object to describe a macro-insn. + +(define <macro-insn> + (class-make '<macro-insn> + '(<ident>) + '( + ; syntax of the macro + syntax + ; list of expansion expressions + expansions + ) + nil) +) + +; Accessor fns + +(define minsn-syntax (elm-make-getter <macro-insn> 'syntax)) +(define minsn-expansions (elm-make-getter <macro-insn> 'expansions)) + +; Return a list of the machs that support MINSN. + +(define (minsn-machs minsn) + nil +) + +; Return macro-instruction mnemonic. +; This is computed from the syntax string. + +(define minsn-mnemonic insn-mnemonic) + +; Return enum cgen_minsn_types value for MINSN. + +(define (minsn-enum minsn) + (string-upcase (string-append "@ARCH@_MINSN_" (gen-sym minsn))) +) + +; Parse a macro-insn expansion description. +; ??? At present we only support unconditional simple expansion. + +(define (-minsn-parse-expansion errtxt expn) + (if (not (form? expn)) + (parse-error errtxt "invalid macro expansion" expn)) + (if (not (eq? 'emit (car expn))) + (parse-error errtxt "invalid macro expansion, must be `(emit ...)'" expn)) + expn +) + +; Parse a macro-instruction description. +; This is the main routine for building a macro-insn object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). + +(define (-minsn-parse errtxt name comment attrs syntax expansions) + (logit 2 "Processing macro-insn " name " ...\n") + + (if (not (list? expansions)) + (parse-error errtxt "invalid macro expansion list" expansions)) + + (let ((name (parse-name name errtxt)) + (atlist-obj (atlist-parse attrs "cgen_minsn" errtxt))) + + (if (keep-atlist? atlist-obj #f) + + (let ((result (make <macro-insn> + name + (parse-comment comment errtxt) + atlist-obj + (parse-syntax syntax errtxt) + (map (lambda (e) (-minsn-parse-expansion errtxt e)) + expansions)))) + result) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read a macro-insn description +; This is the main routine for analyzing macro-insns in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -minsn-parse is invoked to create the `macro-insn' object. + +(define (-minsn-read errtxt . arg-list) + (let (; Current macro-insn elements: + (name nil) + (comment "") + (attrs nil) + (syntax "") + (expansions nil) + ) + ; Loop over each element in ARG-LIST, recording what's found. + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((syntax) (set! syntax (cadr arg))) + ((expansions) (set! expansions (cdr arg))) + (else (parse-error errtxt "invalid macro-insn arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-minsn-parse errtxt name comment attrs syntax expansions) + ) +) + +; Define a macro-insn object, name/value pair list version. + +(define define-minsn + (lambda arg-list + (if (eq? APPLICATION 'SIMULATOR) + #f ; don't waste time if simulator + (let ((m (apply -minsn-read (cons "define-minsn" arg-list)))) + (if m + (current-minsn-add! m)) + m))) +) + +; Define a macro-insn object, all arguments specified. +; This only supports one expansion. +; Use define-minsn for the general case (??? which is of course not implemented +; yet :-). + +(define (define-full-minsn name comment attrs syntax expansion) + (if (eq? APPLICATION 'SIMULATOR) + #f ; don't waste time if simulator + (let ((m (-minsn-parse "define-full-minsn" name comment + (cons 'ALIAS attrs) + syntax (list expansion)))) + (if m + (current-minsn-add! m)) + m)) +) + +; Compute the ifield list for an alias macro-insn. +; This involves making a copy of REAL-INSN's ifield list and assigning +; known quantities to operands that have fixed values in the macro-insn. + +(define (minsn-compute-iflds errtxt minsn-iflds real-insn) + (let* ((iflds (list-copy (insn-iflds real-insn))) + ; List of "free variables", i.e. operands. + (ifld-ops (find ifld-operand? iflds)) + ; Names of fields in `ifld-ops'. As elements of minsn-iflds are + ; parsed the associated element in ifld-names is deleted. At the + ; end ifld-names must be empty. delq! can't delete the first + ; element in a list, so we insert a fencepost. + (ifld-names (cons #f (map obj:name ifld-ops)))) + ;(logit 3 "Computing ifld list, operand field names: " ifld-names "\n") + ; For each macro-insn ifield expression, look it up in the real insn's + ; ifield list. If an operand without a prespecified value, leave + ; unchanged. If an operand or ifield with a value, assign the value to + ; the ifield entry. + (for-each (lambda (f) + (let* ((op-name (if (pair? f) (car f) f)) + (op-obj (current-op-lookup op-name)) + ; If `op-name' is an operand, use its ifield. + ; Otherwise `op-name' must be an ifield name. + (f-name (if op-obj + (obj:name (hw-index:value (op:index op-obj))) + op-name)) + (ifld-pair (object-memq f-name iflds))) + ;(logit 3 "Processing ifield " f-name " ...\n") + (if (not ifld-pair) + (parse-error errtxt "unknown operand" f)) + ; Ensure `f' is an operand. + (if (not (memq f-name ifld-names)) + (parse-error errtxt "not an operand" f)) + (if (pair? f) + (set-car! ifld-pair (ifld-new-value (car ifld-pair) (cadr f)))) + (delq! f-name ifld-names))) + minsn-iflds) + (if (not (equal? ifld-names '(#f))) + (parse-error errtxt "incomplete operand list, missing: " (cdr ifld-names))) + iflds) +) + +; Create an aliased real insn from an alias macro-insn. + +(define (minsn-make-alias errtxt minsn) + (if (or (not (has-attr? minsn 'ALIAS)) + ; Must emit exactly one real insn. + (not (eq? 'emit (caar (minsn-expansions minsn))))) + (parse-error errtxt "not an alias macro-insn" minsn)) + + (let* ((expn (car (minsn-expansions minsn))) + (alias-of (current-insn-lookup (cadr expn)))) + + (if (not alias-of) + (parse-error errtxt "unknown real insn in expansion" minsn)) + + (let ((i (make <insn> + (obj:name minsn) + (obj:comment minsn) + (obj-atlist minsn) + (minsn-syntax minsn) + (minsn-compute-iflds (string-append errtxt + ": " (obj:name minsn)) + (cddr expn) alias-of) + #f ; ifield-assertion + #f ; semantics + #f ; timing + ))) + ; FIXME: use same format entry as real insn, + ; build mask and test value at run time. + (insn-set-ifmt! i (ifmt-build i -1 #f (insn-iflds i))) ; (car (ifmt-analyze i #f)))) + ;(insn-set-ifmt! i (insn-ifmt alias-of)) + i)) +) + +; Called before a .cpu file is read in. + +(define (minsn-init!) + (reader-add-command! 'define-minsn + "\ +Define a macro instruction, name/value pair list version. +" + nil 'arg-list define-minsn) + (reader-add-command! 'define-full-minsn + "\ +Define a macro instruction, all arguments specified. +" + nil '(name comment attrs syntax expansion) + define-full-minsn) + + *UNSPECIFIED* +) + +; Called after the .cpu file has been read in. + +(define (minsn-finish!) + *UNSPECIFIED* +) diff --git a/cgen/mode.scm b/cgen/mode.scm new file mode 100644 index 00000000000..5e0c69effb9 --- /dev/null +++ b/cgen/mode.scm @@ -0,0 +1,471 @@ +; Mode objects. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; FIXME: Later allow target to add new modes. + +(define <mode> + (class-make '<mode> + '(<ident>) + '( + ; One of RANDOM, INT, UINT, FLOAT. + class + + ; size in bits + bits + + ; size in bytes + bytes + + ; NON-MODE-C-TYPE is the C type to use in situations where + ; modes aren't available. A somewhat dubious feature, but at + ; the moment the opcodes tables use it. It is either the C + ; type as a string (e.g. "int") or #f for non-portable modes + ; (??? could use other typedefs for #f, e.g. int64 for DI). + ; Use of GCC can't be assumed though. + non-mode-c-type + + ; PRINTF-TYPE is the %<letter> arg to printf-like functions, + ; however we define our own extensions for non-portable modes. + ; Values not understood by printf aren't intended to be used + ; with printf. + ; + ; Possible values: + ; %x - as always + ; %D - DI mode + ; %f - SF,DF modes + ; %F - XF,TF modes + printf-type + + ; SEM-MODE is the mode to use for semantic operations. + ; Unsigned modes are not part of the semantic language proper, + ; but they can be used in hardware descriptions. This maps + ; unusable -> usable modes. It is #f if the mode is usable by + ; itself. This prevents circular data structures and makes it + ; easy to define since the object doesn't exist before it's + ; defined. + ; ??? May wish to later remove SEM-MODE (e.g. mips signed add + ; is different than mips unsigned add) however for now it keeps + ; things simpler (and prevents being wildly dissimilar from + ; GCC-RTL. And the mips case needn't be handled with different + ; adds anyway. + sem-mode + + ; PTR-TO, if non-#f, is the mode being pointed to. + ptr-to + + ; HOST? is non-#f if the mode is a portable int for hosts, + ; or other host-related value. + ; This is used for things like register numbers and small + ; odd-sized immediates and registers. + ; ??? Not my favorite word choice here, but it's close. + host? + ) + nil) +) + +; Accessor fns + +(define mode:class (elm-make-getter <mode> 'class)) +(define mode:bits (elm-make-getter <mode> 'bits)) +(define mode:bytes (elm-make-getter <mode> 'bytes)) +(define mode:non-mode-c-type (elm-make-getter <mode> 'non-mode-c-type)) +(define mode:printf-type (elm-make-getter <mode> 'printf-type)) +(define mode:sem-mode (elm-make-getter <mode> 'sem-mode)) +; ptr-to is currently private so there is no accessor. +(define mode:host? (elm-make-getter <mode> 'host?)) + +; Return C type to use for values of mode M. + +(define (mode:c-type m) + (let ((ptr-to (elm-xget m 'ptr-to))) + (if ptr-to + (string-append (mode:c-type ptr-to) " *") + (obj:name m))) +) + +; CM is short for "concat mode". It is a list of modes of the elements +; of a `concat'. +; ??? Experiment. Not currently used. + +(define <concat-mode> + (class-make '<concat-mode> '(<mode>) + '( + ; List of element modes + elm-modes + ) + nil) +) + +; Accessors. + +(define cmode-elm-modes (elm-make-getter <concat-mode> 'elm-modes)) + +; List of all modes. + +(define mode-list nil) + +; Return list of mode objects. +; Hides the fact that its stored as an alist from caller. + +(define (mode-list-values) (map cdr mode-list)) + +; Return list of real mode objects (no aliases). + +(define (mode-list-non-alias-values) + (map cdr + (find (lambda (m) (eq? (car m) (obj:name (cdr m)))) + mode-list)) +) + +; Return a boolean indicating if X is a <mode> object. + +(define (mode? x) (class-instance? <mode> x)) + +; Return enum cgen_mode_types value for M. + +(define (mode:enum m) + (gen-c-symbol (string-append "MODE_" (string-upcase (obj:name m)))) +) + +; Return a boolean indicating if MODE1 is equal to MODE2 +; Either may be the name of a mode or a <mode> object. +; Aliases are handled by refering to their real name. + +(define (mode:eq? mode1 mode2) + (let ((mode1-name (mode-real-name mode1)) + (mode2-name (mode-real-name mode2))) + (eq? mode1-name mode2-name)) +) + +; Return a boolean indicating if CLASS is one of INT/UINT. + +(define (mode-class-integral? class) (memq class '(INT UINT))) +(define (mode-class-signed? class) (eq? class 'INT)) +(define (mode-class-unsigned? class) (eq? class 'UINT)) + +; Return a boolean indicating if CLASS is floating point. + +(define (mode-class-float? class) (memq class '(FLOAT))) + +; Return a boolean indicating if CLASS is numeric. + +(define (mode-class-numeric? class) (memq class '(INT UINT FLOAT))) + +; Return a boolean indicating if MODE has an integral mode class. +; Similarily for signed/unsigned. + +(define (mode-integral? mode) (mode-class-integral? (mode:class mode))) +(define (mode-signed? mode) (mode-class-signed? (mode:class mode))) +(define (mode-unsigned? mode) (mode-class-unsigned? (mode:class mode))) + +; Return a boolean indicating if MODE has a floating point mode class. + +(define (mode-float? mode) (mode-class-float? (mode:class mode))) + +; Return a boolean indicating if MODE has a numeric mode class. + +(define (mode-numeric? mode) (mode-class-numeric? (mode:class mode))) + +; Return a boolean indicating if MODE1 is compatible with MODE2. +; MODE[12] are either names or <mode> objects. +; HOW is a symbol indicating how the test is performed: +; strict: modes must have same name +; samesize: modes must be both float or both integer (int or uint) and have +; same size +; sameclass: modes must be both float or both integer (int or uint) +; numeric: modes must be both numeric + +(define (mode-compatible? how mode1 mode2) + (let ((m1 (mode:lookup mode1)) + (m2 (mode:lookup mode2))) + (case how + ((strict) + (eq? (obj:name m1) (obj:name m2))) + ((samesize) + (cond ((mode-integral? m1) + (and (mode-integral? m2) + (= (mode:bits m1) (mode:bits m2)))) + ((mode-float? m1) + (and (mode-float? m2) + (= (mode:bits m1) (mode:bits m2)))) + (else #f))) + ((sameclass) + (cond ((mode-integral? m1) (mode-integral? m2)) + ((mode-float? m1) (mode-float? m2)) + (else #f))) + ((numeric) + (and (mode-numeric? m1) (mode-numeric? m2))) + (else (error "bad `how' arg to mode-compatible?" how)))) +) + +; Add MODE named NAME to the list of recognized modes. +; If NAME is already present, replace it with MODE. +; MODE is a mode object. +; NAME exists to allow aliases of modes [e.g. WI, UWI, AI]. +; +; No attempt to preserve any particular order of entries is done here. +; That is up to the caller. + +(define (mode:add! name mode) + (let ((entry (assq name mode-list))) + (if entry + (set-cdr! entry mode) + (set! mode-list (acons name mode mode-list))) + mode) +) + +; Parse a mode. +; This is the main routine for building a mode object. +; All arguments are in raw (non-evaluated) form. + +(define (-mode-parse errtxt name comment attrs class bits bytes + non-mode-c-type printf-type sem-mode ptr-to host?) + (logit 2 "Processing mode " name " ...\n") + (let* ((name (parse-name name errtxt)) + (errtxt (string-append errtxt " " name)) + (result (make <mode> + name + (parse-comment comment errtxt) + (atlist-parse attrs "mode" errtxt) + class bits bytes non-mode-c-type printf-type + sem-mode ptr-to host?))) + result) +) + +; ??? At present there is no define-mode that takes an associative list +; of arguments. + +; Define a mode object, all arguments specified. + +(define (define-full-mode name comment attrs class bits bytes + non-mode-c-type printf-type sem-mode ptr-to host?) + (let ((m (-mode-parse "define-full-mode" name comment attrs + class bits bytes + non-mode-c-type printf-type sem-mode ptr-to host?))) + ; Add it to the list of insn modes. + (mode:add! name m) + m) +) + +; Lookup the mode named X. +; Return the found object or #f. +; If X is already a mode object, return that. + +(define (mode:lookup x) + (if (mode? x) + x + (let ((result (assq x mode-list))) + (if result + (cdr result) + #f))) +) + +; Return a boolean indicating if X is a valid mode name. + +(define (mode-name? x) + (and (symbol? x) + ; FIXME: Time to make `mode-list' a hash table. + (->bool (assq x mode-list))) +) + +; Return the name of the real mode of M. +; This is a no-op unless M is an alias in which case we return the +; real mode of the alias. + +(define (mode-real-name m) + (obj:name (mode:lookup m)) +) + +; Return the real mode of M. +; This is a no-op unless M is an alias in which case we return the +; real mode of the alias. + +(define (mode-real-mode m) + (mode:lookup (mode-real-name m)) +) + +; Return #t if mode M1-NAME is bigger than mode M2-NAME. + +(define (mode-bigger? m1-name m2-name) + (> (mode:bits (mode:lookup m1-name)) + (mode:bits (mode:lookup m2-name))) +) + +; Return a mode in mode class CLASS wide enough to hold BITS. + +(define (mode-find bits class) + (let ((modes (find (lambda (mode) (eq? (mode:class (cdr mode)) class)) + mode-list))) + (if (null? modes) + (error "invalid mode class" class)) + (let loop ((modes modes)) + (cond ((null? modes) (error "no modes for bits" bits)) + ((<= bits (mode:bits (cdar modes))) (cdar modes)) + (else (loop (cdr modes)))))) +) + +; Parse MODE-NAME and return the mode object. +; An error is signalled if MODE isn't valid. + +(define (parse-mode-name mode-name errtxt) + (let ((m (mode:lookup mode-name))) + (if (not m) (parse-error errtxt "not a valid mode" mode-name)) + m) +) + +; Make a new INT/UINT mode. +; These have a variable number of bits (1-32). + +(define (mode-make-int bits) + (if (or (<= bits 0) (> bits 64)) + (error "unsupported number of bits" bits)) + (let ((result (object-copy-top INT))) + (elm-xset! result 'bits bits) + (elm-xset! result 'bytes (bits->bytes bits)) + result) +) + +(define (mode-make-uint bits) + (if (or (<= bits 0) (> bits 64)) + (error "unsupported number of bits" bits)) + (let ((result (object-copy-top UINT))) + (elm-xset! result 'bits bits) + (elm-xset! result 'bytes (bits->bytes bits)) + result) +) + +; Initialization. + +; Some modes are refered to by the Scheme code. +; These have global bindings, but we try not to make this the general rule. +; [Actually I don't think this is all that bad, but it seems reasonable to +; not create global bindings that we don't have to.] + +(define VOID #f) +(define DFLT #f) + +; This is defined by the target. We provide a default def'n. +(define WI #f) +(define UWI #f) + +; An "address int". This is recorded in addition to a "word int" because it +; is believed that some target will need it. It also stays consistent with +; what BFD does. +; This can also be defined by the target. We provide a default. +(define AI #f) +(define IAI #f) + +; Variable sized portable ints. +(define INT #f) +(define UINT #f) + +(define (mode-init!) + (set! mode-list nil) + + (reader-add-command! 'define-full-mode + "\ +Define a mode, all arguments specified. +" + nil '(name commment attrs class bits bytes + non-c-mode-type printf-type sem-mode ptr-to host?) + define-full-mode) + + *UNSPECIFIED* +) + +; Called before a . cpu file is read in to install any builtins. + +(define (mode-builtin!) + ; FN-SUPPORT: In sem-ops.h file, include prototypes as well as macros. + ; Elsewhere, functions are defined to perform the operation. + (define-attr '(for mode) '(type boolean) '(name FN-SUPPORT)) + + (let ((dfm define-full-mode)) + ; This list must be defined in order of increasing size among each type. + + (dfm 'VOID "void" '() 'RANDOM 0 0 "void" "" #f #f #f) ; VOIDmode + + ; Special marker to indicate "use the default mode". + ; ??? Not yet used everywhere it should be. + (dfm 'DFLT "default mode" '() 'RANDOM 0 0 "" "" #f #f #f) + + ; Not UINT on purpose. + (dfm 'BI "one bit (0,1 not 0,-1)" '() 'INT 1 1 "int" "'x'" #f #f #f) + + (dfm 'QI "8 bit byte" '() 'INT 8 1 "int" "'x'" #f #f #f) + (dfm 'HI "16 bit int" '() 'INT 16 2 "int" "'x'" #f #f #f) + (dfm 'SI "32 bit int" '() 'INT 32 4 "int" "'x'" #f #f #f) + (dfm 'DI "64 bit int" '(FN-SUPPORT) 'INT 64 8 "" "'D'" #f #f #f) + + (dfm 'UQI "8 bit unsigned byte" '() 'UINT + 8 1 "unsigned int" "'x'" (mode:lookup 'QI) #f #f) + (dfm 'UHI "16 bit unsigned int" '() 'UINT + 16 2 "unsigned int" "'x'" (mode:lookup 'HI) #f #f) + (dfm 'USI "32 bit unsigned int" '() 'UINT + 32 4 "unsigned int" "'x'" (mode:lookup 'SI) #f #f) + (dfm 'UDI "64 bit unsigned int" '(FN-SUPPORT) 'UINT + 64 8 "" "'D'" (mode:lookup 'DI) #f #f) + + ; Floating point values. + (dfm 'SF "32 bit float" '(FN-SUPPORT) 'FLOAT + 32 4 "" "'f'" #f #f #f) + (dfm 'DF "64 bit float" '(FN-SUPPORT) 'FLOAT + 64 8 "" "'f'" #f #f #f) + (dfm 'XF "80/96 bit float" '(FN-SUPPORT) 'FLOAT + 96 12 "" "'F'" #f #f #f) + (dfm 'TF "128 bit float" '(FN-SUPPORT) 'FLOAT + 128 16 "" "'F'" #f #f #f) + + ; These are useful modes that represent host values. + ; For INT/UINT the sizes indicate maximum portable values. + ; These are also used for random width hardware elements (e.g. immediates + ; and registers). + ; FIXME: Can't be used to represent both host and target values. + ; Either remove the distinction or add new modes with the distinction. + (dfm 'INT "portable int" '() 'INT 32 4 "int" "'x'" + (mode:lookup 'SI) #f #t) + (dfm 'UINT "portable unsigned int" '() 'UINT 32 4 "unsigned int" "'x'" + (mode:lookup 'SI) #f #t) + + ; ??? Experimental. + (dfm 'PTR "host pointer" '() 'RANDOM 0 0 "PTR" "'x'" + #f (mode:lookup 'VOID) #t) + ) + + (set! VOID (mode:lookup 'VOID)) + (set! DFLT (mode:lookup 'DFLT)) + + (set! INT (mode:lookup 'INT)) + (set! UINT (mode:lookup 'UINT)) + + ; To redefine these, use mode:add! again. + (set! WI (mode:add! 'WI (mode:lookup 'SI))) + (set! UWI (mode:add! 'UWI (mode:lookup 'USI))) + (set! AI (mode:add! 'AI (mode:lookup 'USI))) + (set! IAI (mode:add! 'IAI (mode:lookup 'USI))) + + *UNSPECIFIED* +) + +(define (mode-finish!) + ; Keep the fields sorted for mode-find. + (set! mode-list (reverse mode-list)) + + (if #f + ; ???: Something like this would be nice if it was timed appropriately + ; redefine WI/UWI/AI/IAI for this target + (case (cpu-word-bitsize (current-cpu)) + ((32) (begin + (display "Recognized 32-bit cpu.\n"))) + ((64) (begin + (display "Recognized 64-bit cpu.\n") + (set! WI (mode:add! 'WI (mode:lookup 'DI))) + (set! UWI (mode:add! 'UWI (mode:lookup 'UDI))) + (set! AI (mode:add! 'AI (mode:lookup 'UDI))) + (set! IAI (mode:add! 'IAI (mode:lookup 'UDI))))) + (else (error "Unknown word-bitsize for WI/UWI/AI/IAI mode!")))) + + *UNSPECIFIED* +) diff --git a/cgen/model.scm b/cgen/model.scm new file mode 100644 index 00000000000..f57ca557d92 --- /dev/null +++ b/cgen/model.scm @@ -0,0 +1,304 @@ +; CPU implementation description. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; A model is an implementation of a mach. +; NOTE: wip [with all the caveats that implies]. +; The intent here is to define the aspects of a CPU that affect performance, +; usable by any tool (but for the immediate future a simulator). + +; Pipeline specification. + +(define <pipeline> + (class-make '<pipeline> nil '(name comment atlist elms) nil)) + +(define (pipeline:length p) (length (elm-xget p 'elms))) + +; Function unit specification. + +; FIXME: Might wish to record which pipeline element(s) the unit is associated +; with. At the moment pipeline data isn't used, but later. + +(define <unit> + (class-make '<unit> + '(<ident>) + '( + ; wip + issue done + ; Lists of (name mode) pairs that record unit state. + state + ; Lists of (name mode [default-value]). + inputs outputs + ; RTL of code to invoke to do profiling. + ; `nil' means use the default + ; ??? Not currently used since all profiling handlers + ; are user-written. + profile + ; Model this unit is associated with. + model-name + ) + nil)) + +; ??? Rather than create a circularity, we record the model's symbol in +; the `model' element. +; FIXME: Shouldn't use current-model-lookup. Guile is better at printing +; things with circularities now, so should probably put back the circularity +; and delete the current-model-lookup reference. +(define (unit:model u) (current-model-lookup (elm-xget u 'model-name))) +(define unit:issue (elm-make-getter <unit> 'issue)) +(define unit:done (elm-make-getter <unit> 'done)) +(define unit:state (elm-make-getter <unit> 'state)) +(define unit:inputs (elm-make-getter <unit> 'inputs)) +(define unit:outputs (elm-make-getter <unit> 'outputs)) +(define unit:profile (elm-make-getter <unit> 'profile)) + +; Create a copy of unit U with new values for ISSUE and DONE. +; This is used when recording an instruction's timing information. +; ??? This might be better recorded in a different class from UNIT +; since we're not creating a new unit, we're just special casing it for +; one instruction. +; FIXME: No longer used. + +(define (unit:make-insn-timing u issue done) + (let ((result (object-copy-top u))) + (elm-xset! result 'issue issue) + (elm-xset! result 'done done) + result) +) + +(define (unit:enum u) + (gen-c-symbol (string-append "UNIT_" + (string-upcase (obj:name (unit:model u))) + "_" + (string-upcase (obj:name u)))) +) + +; The `<model>' class. +; +; FETCH is the instruction fetch process as it relates to the implementation. +; e.g. +; - how many instructions are fetched at once +; - how those instructions are initially processed for delivery to the +; appropriate pipeline +; RETIRE is used to specify any final processing needed to complete an insn. +; PIPELINES is a list of pipeline objects. +; UNITS is a list of function units. +; STATE is a list of (var mode) pairs. +; +; For the more complicated cpus this can get really complicated really fast. +; No intent is made to get there in one day. + +(define <model> + (class-make '<model> + '(<ident>) + '(mach prefetch retire pipelines state units) + nil)) + +(define model:mach (elm-make-getter <model> 'mach)) +(define model:prefetch (elm-make-getter <model> 'prefetch)) +(define model:retire (elm-make-getter <model> 'retire)) +(define model:pipelines (elm-make-getter <model> 'pipelines)) +(define model:state (elm-make-getter <model> 'state)) +(define model:units (elm-make-getter <model> 'units)) + +(define (model:enum m) + (gen-c-symbol (string-append "MODEL_" (string-upcase (obj:name m)))) +) + +; Parse a `prefetch' spec. + +(define (-prefetch-parse errtxt expr) + nil +) + +; Parse a `retire' spec. + +(define (-retire-parse errtxt expr) + nil +) + +; Parse a `pipeline' spec. +; ??? Perhaps we should also use name/value pairs here, but that's an +; unnecessary complication at this point in time. + +(define (-pipeline-parse errtxt model-name spec) ; name comments attrs elements) + (if (not (= (length spec) 4)) + (parse-error errtxt "pipeline spec not `name comment attrs elements'" spec)) + (apply make (cons <pipeline> spec)) +) + +; Parse a function `unit' spec. +; ??? Perhaps we should also use name/value pairs here, but that's an +; unnecessary complication at this point in time. + +(define (-unit-parse errtxt model-name spec) ; name comments attrs elements) + (if (not (= (length spec) 9)) + (parse-error errtxt "unit spec not `name comment attrs issue done state inputs outputs profile'" spec)) + (apply make (append (cons <unit> spec) (list model-name))) +) + +; Parse a model definition. +; This is the main routine for building a model object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. + +(define (-model-parse errtxt name comment attrs mach-name prefetch retire pipelines state units) + (logit 2 "Processing model " name " ...\n") + (let ((name (parse-name name errtxt)) + ; FIXME: switch to `context' like in cver. + (errtxt (string-append errtxt " " name)) + (mach (current-mach-lookup mach-name))) + (if (null? units) + (parse-error errtxt "there must be at least one function unit" name)) + (if mach ; is `mach' being "kept"? + (let ((model-obj + (make <model> + name + (parse-comment comment errtxt) + (atlist-parse attrs "cpu" errtxt) + mach + (-prefetch-parse errtxt prefetch) + (-retire-parse errtxt retire) + (map (lambda (p) (-pipeline-parse errtxt name p)) pipelines) + state + (map (lambda (u) (-unit-parse errtxt name u)) units)))) + model-obj) + (begin + ; MACH wasn't found, ignore this model. + (logit 2 "Nonexistant mach " mach-name ", ignoring " name ".\n") + #f))) +) + +; Read a model description. +; This is the main routine for analyzing models in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -model-parse is invoked to create the `model' object. + +(define (-model-read errtxt . arg-list) + (let (; Current mach elements: + (name nil) ; name of model + (comment nil) ; description of model + (attrs nil) ; attributes + (mach nil) ; mach this model implements + (prefetch nil) ; instruction prefetch handling + (retire nil) ; instruction completion handling + (pipelines nil) ; list of pipelines + (state nil) ; list of (name mode) pairs to record state + (units nil) ; list of function units + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mach) (set! mach (cadr arg))) + ((prefetch) (set! prefetch (cadr arg))) + ((retire) (set! retire (cadr arg))) + ((pipeline) (set! pipelines (cons (cdr arg) pipelines))) + ((state) (set! state (cdr arg))) + ((unit) (set! units (cons (cdr arg) units))) + (else (parse-error errtxt "invalid model arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-model-parse errtxt name comment attrs mach prefetch retire pipelines state units) + ) +) + +; Define a cpu model object, name/value pair list version. + +(define define-model + (lambda arg-list + (let ((m (apply -model-read (cons "define-model" arg-list)))) + (if m + (current-model-add! m)) + m)) +) + +; Instruction timing. + +; There is one of these for each model timing description per instruction. + +(define <timing> (class-make '<timing> nil '(model units) nil)) + +(define timing:model (elm-make-getter <timing> 'model)) +(define timing:units (elm-make-getter <timing> 'units)) + +; timing:units is a list of these. +; ARGS is a list of (name value) pairs. + +(define <iunit> (class-make '<iunit> nil '(unit args) nil)) + +(define iunit:unit (elm-make-getter <iunit> 'unit)) +(define iunit:args (elm-make-getter <iunit> 'args)) + +; Return the default unit used by MODEL. +; ??? For now this is always u-exec. + +(define (model-default-unit model) + (object-assq 'u-exec (model:units model)) +) + +; Subroutine of parse-insn-timing to parse the timing spec for MODEL. +; The result is a <timing> object. + +(define (-insn-timing-parse-model context model spec) + (make <timing> model + (map (lambda (unit-timing-desc) + (let ((type (car unit-timing-desc)) + (args (cdr unit-timing-desc))) + (case type + ((unit) ; syntax is `unit name (arg1 val1) ...' + (let ((unit (object-assq (car args) + (model:units model)))) + (if (not unit) + (parse-error context "unknown function unit" args)) + (make <iunit> unit (cdr args)))) + (else (parse-error context "bad unit timing spec" + unit-timing-desc))))) + spec)) +) + +; Given the timing information for an instruction return an associative +; list of timing objects (one for each specified model). +; INSN-TIMING-DESC is a list of +; (model1 (unit unit1-name ...) ...) (model2 (unit unit1-name ...) ...) ... +; Entries for models not included (because the machine wasn't selected) +; are returned as (model1), i.e. an empty unit list. + +(define (parse-insn-timing context insn-timing-desc) + (map (lambda (model-timing-desc) + (let* ((model-name (car model-timing-desc)) + (model (current-model-lookup model-name))) + (cons model-name + (if model + (-insn-timing-parse-model context model + (cdr model-timing-desc)) + ())))) + insn-timing-desc) +) + +; Called before a .cpu file is read in. + +(define (model-init!) + + (reader-add-command! 'define-model + "\ +Define a cpu model, name/value pair list version. +" + nil 'arg-list define-model + ) + + *UNSPECIFIED* +) + +; Called after a .cpu file has been read in. + +(define (model-finish!) + *UNSPECIFIED* +) diff --git a/cgen/opc-asmdis.scm b/cgen/opc-asmdis.scm new file mode 100644 index 00000000000..d3a441ce0d8 --- /dev/null +++ b/cgen/opc-asmdis.scm @@ -0,0 +1,182 @@ +; Assembler/disassembler support generator. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Assembler support. + +(define (-gen-parse-switch) + (logit 2 "Generating parse switch ...\n") + (string-list + "\ +/* Main entry point for operand parsing. + + This function is basically just a big switch statement. Earlier versions + used tables to look up the function to use, but + - if the table contains both assembler and disassembler functions then + the disassembler contains much of the assembler and vice-versa, + - there's a lot of inlining possibilities as things grow, + - using a switch statement avoids the function call overhead. + + This function could be moved into `parse_insn_normal', but keeping it + separate makes clear the interface between `parse_insn_normal' and each of + the handlers. +*/ + +const char * +@arch@_cgen_parse_operand (cd, opindex, strp, fields) + CGEN_CPU_DESC cd; + int opindex; + const char ** strp; + CGEN_FIELDS * fields; +{ + const char * errmsg = NULL; + /* Used by scalar operands that still need to be parsed. */ + " (gen-ifield-default-type) " junk; + + switch (opindex) + { +" + (gen-switch 'parse) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while parsing.\\n\"), opindex); + abort (); + } + + return errmsg; +}\n\n") +) + +; Assembler initialization C code +; Code is appended during processing. + +(define -asm-init-code "") +(define (add-asm-init code) + (set! -asm-init-code (string-append -asm-init-code code)) +) + +; Return C code to define the assembler init function. +; This is called after opcode_open. + +(define (-gen-init-asm-fn) + (string-append + "\ +void +@arch@_cgen_init_asm (cd) + CGEN_CPU_DESC cd; +{ + @arch@_cgen_init_opcode_table (cd); + @arch@_cgen_init_ibld_table (cd); + cd->parse_handlers = & @arch@_cgen_parse_handlers[0]; + cd->parse_operand = @arch@_cgen_parse_operand; +" + -asm-init-code +"}\n\n" + ) +) + +; Generate C code that is inserted into the assembler source. + +(define (cgen-asm.in) + (logit 1 "Generating " (current-arch-name) "-asm.in ...\n") + (string-write + ; No need for copyright, appended to file with one. + "\n" + (lambda () (gen-extra-asm.c srcdir (current-arch-name))) ; from <arch>.opc + "\n" + -gen-parse-switch + (lambda () (gen-handler-table "parse" opc-parse-handlers)) + -gen-init-asm-fn + ) +) + +; Disassembler support. + +(define (-gen-print-switch) + (logit 2 "Generating print switch ...\n") + (string-list + "\ +/* Main entry point for printing operands. + XINFO is a `void *' and not a `disassemble_info *' to not put a requirement + of dis-asm.h on cgen.h. + + This function is basically just a big switch statement. Earlier versions + used tables to look up the function to use, but + - if the table contains both assembler and disassembler functions then + the disassembler contains much of the assembler and vice-versa, + - there's a lot of inlining possibilities as things grow, + - using a switch statement avoids the function call overhead. + + This function could be moved into `print_insn_normal', but keeping it + separate makes clear the interface between `print_insn_normal' and each of + the handlers. +*/ + +void +@arch@_cgen_print_operand (cd, opindex, xinfo, fields, attrs, pc, length) + CGEN_CPU_DESC cd; + int opindex; + PTR xinfo; + CGEN_FIELDS *fields; + void const *attrs; + bfd_vma pc; + int length; +{ + disassemble_info *info = (disassemble_info *) xinfo; + + switch (opindex) + { +" + (gen-switch 'print) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while printing insn.\\n\"), + opindex); + abort (); + } +}\n\n") +) + +; Disassembler initialization C code. +; Code is appended during processing. + +(define -dis-init-code "") +(define (add-dis-init code) + (set! -dis-init-code (string-append -dis-init-code code)) +) + +; Return C code to define the disassembler init function. + +(define (-gen-init-dis-fn) + (string-append + " +void +@arch@_cgen_init_dis (cd) + CGEN_CPU_DESC cd; +{ + @arch@_cgen_init_opcode_table (cd); + @arch@_cgen_init_ibld_table (cd); + cd->print_handlers = & @arch@_cgen_print_handlers[0]; + cd->print_operand = @arch@_cgen_print_operand; +" + -dis-init-code +"}\n\n" + ) +) + +; Generate C code that is inserted into the disassembler source. + +(define (cgen-dis.in) + (logit 1 "Generating " (current-arch-name) "-dis.in ...\n") + (string-write + ; No need for copyright, appended to file with one. + "\n" + (lambda () (gen-extra-dis.c srcdir (current-arch-name))) ; from <arch>.opc + "\n" + -gen-print-switch + (lambda () (gen-handler-table "print" opc-print-handlers)) + -gen-init-dis-fn + ) +) diff --git a/cgen/opc-ibld.scm b/cgen/opc-ibld.scm new file mode 100644 index 00000000000..0795187e90a --- /dev/null +++ b/cgen/opc-ibld.scm @@ -0,0 +1,319 @@ +; Instruction builder support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Instruction field support. + +(define (-gen-fget-switch) + (logit 2 "Generating field get switch ...\n") + (string-list + "\ +/* Getting values from cgen_fields is handled by a collection of functions. + They are distinguished by the type of the VALUE argument they return. + TODO: floating point, inlining support, remove cases where result type + not appropriate. */ + +int +@arch@_cgen_get_int_operand (cd, opindex, fields) + CGEN_CPU_DESC cd; + int opindex; + const CGEN_FIELDS * fields; +{ + int value; + + switch (opindex) + { +" + (gen-switch 'fget) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while getting int operand.\\n\"), + opindex); + abort (); + } + + return value; +} + +bfd_vma +@arch@_cgen_get_vma_operand (cd, opindex, fields) + CGEN_CPU_DESC cd; + int opindex; + const CGEN_FIELDS * fields; +{ + bfd_vma value; + + switch (opindex) + { +" + (gen-switch 'fget) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while getting vma operand.\\n\"), + opindex); + abort (); + } + + return value; +} +\n") +) + +(define (-gen-fset-switch) + (logit 2 "Generating field set switch ...\n") + (string-list + "\ +/* Stuffing values in cgen_fields is handled by a collection of functions. + They are distinguished by the type of the VALUE argument they accept. + TODO: floating point, inlining support, remove cases where argument type + not appropriate. */ + +void +@arch@_cgen_set_int_operand (cd, opindex, fields, value) + CGEN_CPU_DESC cd; + int opindex; + CGEN_FIELDS * fields; + int value; +{ + switch (opindex) + { +" + (gen-switch 'fset) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while setting int operand.\\n\"), + opindex); + abort (); + } +} + +void +@arch@_cgen_set_vma_operand (cd, opindex, fields, value) + CGEN_CPU_DESC cd; + int opindex; + CGEN_FIELDS * fields; + bfd_vma value; +{ + switch (opindex) + { +" + (gen-switch 'fset) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while setting vma operand.\\n\"), + opindex); + abort (); + } +} +\n") +) + +; Utilities of cgen-ibld.h. + +; Return a list of operands the assembler syntax uses. +; This is a subset of the fields of the insn. + +(define (ifmt-opcode-operands ifmt) + (map ifld-get-value + (find (lambda (elm) (not (number? (ifld-get-value elm)))) + (ifmt-ifields ifmt))) +) + +; Subroutine of gen-insn-builders to generate the builder for one insn. +; FIXME: wip. + +(define (gen-insn-builder insn) + (let* ((ifmt (insn-ifmt insn)) + (operands (ifmt-opcode-operands ifmt)) + (length (ifmt-length ifmt))) + (gen-obj-sanitize + insn + (string-append + "#define @ARCH@_IBLD_" + (string-upcase (gen-sym insn)) + "(endian, buf, lenp" + (gen-c-args (map obj:name operands)) + ")\n" + "\n"))) +) + +(define (gen-insn-builders) + (string-write + "\ +/* For each insn there is an @ARCH@_IBLD_<NAME> macro that builds the + instruction in the supplied buffer. For architectures where it's + possible to represent all machine codes as host integer values it + would be nicer to have these return the instruction rather than store + it in BUF. For consistency with variable length ISA's this does not. */ + +" + (lambda () (string-write-map gen-insn-builder (current-insn-list))) + ) +) + +; Generate the C code for dealing with operands. + +(define (-gen-insert-switch) + (logit 2 "Generating insert switch ...\n") + (string-list + "\ +/* Main entry point for operand insertion. + + This function is basically just a big switch statement. Earlier versions + used tables to look up the function to use, but + - if the table contains both assembler and disassembler functions then + the disassembler contains much of the assembler and vice-versa, + - there's a lot of inlining possibilities as things grow, + - using a switch statement avoids the function call overhead. + + This function could be moved into `parse_insn_normal', but keeping it + separate makes clear the interface between `parse_insn_normal' and each of + the handlers. It's also needed by GAS to insert operands that couldn't be + resolved during parsing. +*/ + +const char * +@arch@_cgen_insert_operand (cd, opindex, fields, buffer, pc) + CGEN_CPU_DESC cd; + int opindex; + CGEN_FIELDS * fields; + CGEN_INSN_BYTES_PTR buffer; + bfd_vma pc; +{ + const char * errmsg = NULL; + unsigned int total_length = CGEN_FIELDS_BITSIZE (fields); + + switch (opindex) + { +" + (gen-switch 'insert) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while building insn.\\n\"), + opindex); + abort (); + } + + return errmsg; +}\n\n") +) + +(define (-gen-extract-switch) + (logit 2 "Generating extract switch ...\n") + (string-list + "\ +/* Main entry point for operand extraction. + The result is <= 0 for error, >0 for success. + ??? Actual values aren't well defined right now. + + This function is basically just a big switch statement. Earlier versions + used tables to look up the function to use, but + - if the table contains both assembler and disassembler functions then + the disassembler contains much of the assembler and vice-versa, + - there's a lot of inlining possibilities as things grow, + - using a switch statement avoids the function call overhead. + + This function could be moved into `print_insn_normal', but keeping it + separate makes clear the interface between `print_insn_normal' and each of + the handlers. +*/ + +int +@arch@_cgen_extract_operand (cd, opindex, ex_info, insn_value, fields, pc) + CGEN_CPU_DESC cd; + int opindex; + CGEN_EXTRACT_INFO *ex_info; + CGEN_INSN_INT insn_value; + CGEN_FIELDS * fields; + bfd_vma pc; +{ + /* Assume success (for those operands that are nops). */ + int length = 1; + unsigned int total_length = CGEN_FIELDS_BITSIZE (fields); + + switch (opindex) + { +" + (gen-switch 'extract) +" + default : + /* xgettext:c-format */ + fprintf (stderr, _(\"Unrecognized field %d while decoding insn.\\n\"), + opindex); + abort (); + } + + return length; +}\n\n") +) + +; Utilities of cgen-ibld.in. + +; Emit a function to call to initialize the ibld tables. + +(define (-gen-ibld-init-fn) + (string-write + "\ +/* Function to call before using the instruction builder tables. */ + +void +@arch@_cgen_init_ibld_table (cd) + CGEN_CPU_DESC cd; +{ + cd->insert_handlers = & @arch@_cgen_insert_handlers[0]; + cd->extract_handlers = & @arch@_cgen_extract_handlers[0]; + + cd->insert_operand = @arch@_cgen_insert_operand; + cd->extract_operand = @arch@_cgen_extract_operand; + + cd->get_int_operand = @arch@_cgen_get_int_operand; + cd->set_int_operand = @arch@_cgen_set_int_operand; + cd->get_vma_operand = @arch@_cgen_get_vma_operand; + cd->set_vma_operand = @arch@_cgen_set_vma_operand; +} +" + ) +) + +; Generate the C header for building instructions. + +(define (cgen-ibld.h) + (logit 1 "Generating " (current-arch-name) "-ibld.h ...\n") + (string-write + (gen-copyright "Instruction builder for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifndef @ARCH@_IBLD_H +#define @ARCH@_IBLD_H + +" + (lambda () (gen-extra-ibld.h srcdir (current-arch-name))) ; from <arch>.opc + "\n" + gen-insn-builders + " +#endif /* @ARCH@_IBLD_H */ +" + ) +) + +; Generate the C support for building instructions. + +(define (cgen-ibld.in) + (logit 1 "Generating " (current-arch-name) "-ibld.in ...\n") + (string-write + ; No need for copyright, appended to file with one. + "\n" + -gen-insert-switch + -gen-extract-switch + (lambda () (gen-handler-table "insert" opc-insert-handlers)) + (lambda () (gen-handler-table "extract" opc-extract-handlers)) + -gen-fget-switch + -gen-fset-switch + -gen-ibld-init-fn + ) +) diff --git a/cgen/opc-itab.scm b/cgen/opc-itab.scm new file mode 100644 index 00000000000..830b7e0083e --- /dev/null +++ b/cgen/opc-itab.scm @@ -0,0 +1,724 @@ +; Opcode table support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Append code here to be run before insn parsing/etc. +; These are for internal use and aren't intended to appear in .cpu files. +; ??? Nothing currently uses them but that might change. + +(define parse-init-code "") +(define insert-init-code "") +(define extract-init-code "") +(define print-init-code "") + +; Define CGEN_INIT_{PARSE,INSERT,EXTRACT,PRINT} macros. +; ??? These were early escape hatches. Not currently used. + +(define (-gen-init-macros) + (logit 2 "Generating init macros ...\n") + (string-append + "#define CGEN_INIT_PARSE(od) \\ +{\\\n" + parse-init-code + "}\n" + "#define CGEN_INIT_INSERT(od) \\ +{\\\n" + insert-init-code + "}\n" + "#define CGEN_INIT_EXTRACT(od) \\ +{\\\n" + extract-init-code + "}\n" + "#define CGEN_INIT_PRINT(od) \\ +{\\\n" + print-init-code + "}\n" + ) +) + +; Instruction field support. + +; Return C code to declare various ifield types,decls. + +(define (-gen-ifield-decls) + (logit 2 "Generating instruction field decls ...\n") + (string-append + "/* This struct records data prior to insertion or after extraction. */\n" + "struct cgen_fields\n{\n" + ; A special member `length' is used to record the length. + " int length;\n" + (string-map gen-ifield-value-decl (non-derived-ifields (current-ifld-list))) + "};\n\n" + ) +) + +; Instruction syntax support. + +; Extract the operand fields in SYNTAX-STRING. +; The result is a list of operand names. +; ??? Not currently used, but keep awhile. + +(define (extract-syntax-operands syntax) + (let loop ((syn syntax) (result nil)) + + (cond ((= (string-length syn) 0) + (reverse! result)) + + ((char=? #\\ (string-ref syn 0)) + (if (= (string-length syn) 1) + (error "missing char after '\\'" syntax)) + (loop (string-drop 2 syn) result)) + + ((char=? #\$ (string-ref syn 0)) + ; Extract the symbol from the string, which will be the name of + ; an operand. Append it to the result. + (if (= (string-length syn) 1) + (error "missing operand name" syntax)) + (if (char=? (string-ref syn 1) #\{) + (let ((n (chars-until-delimiter syn #\}))) + ; Note that 'n' includes the leading ${. + (case n + ((0) (error "empty operand name" syntax)) + ((#f) (error "missing '}'" syntax)) + (else (loop (string-drop (+ n 1) syn) + (cons (string->symbol (substring syn 2 n)) + result))))) + (let ((n (id-len (string-drop1 syn)))) + (if (= n 0) + (error "empty or invalid operand name" syntax)) + (loop (string-drop (1+ n) syn) + (cons (string->symbol (substring syn 1 (1+ n))) + result))))) + + (else (loop (string-drop1 syn) result)))) +) + +; Strip the mnemonic part from SYNTAX. +; (ie: everything up to but not including the first space or '$') +; If STRIP-MNEM-OPERANDS?, strip them too. + +(define (strip-mnemonic strip-mnem-operands? syntax) + (let ((space (string-index syntax #\space))) + (if strip-mnem-operands? + (if space + (string-drop space syntax) + "") + (let loop ((syn syntax)) + (if (= (string-length syn) 0) + "" + (case (string-ref syn 0) + ((#\space) syn) + ((#\\) (loop (string-drop 2 syn))) + ((#\$) syn) + (else (loop (string-drop1 syn)))))))) +) + +; Compute the sequence of syntax bytes for SYNTAX. +; STRIP-MNEMONIC? is #t if the mnemonic part is to be stripped off. +; STRIP-MNEM-OPERANDS? is #t if any mnemonic operands are to be stripped off. +; SYNTAX is a string of text and operands. +; OP-MACRO is the macro to call that computes an operand's value. +; The resulting syntax is expressed as a sequence of bytes. +; Values < 128 are characters that must be matched. +; Values >= 128 are 128 + the index into the operand table. + +(define (compute-syntax strip-mnemonic? strip-mnem-operands? syntax op-macro) + (let ((context "syntax computation") + (syntax (if strip-mnemonic? + (strip-mnemonic strip-mnem-operands? syntax) + syntax))) + + (let loop ((syn syntax) (result "")) + + (cond ((= (string-length syn) 0) + (string-append result "0")) + + ((char=? #\\ (string-ref syn 0)) + (if (= (string-length syn) 1) + (parse-error context "missing char after '\\'" syntax)) + (let ((escaped-char (string-ref syn 1)) + (remainder (string-drop 2 syn))) + (if (char=? #\\ escaped-char) + (loop remainder (string-append result "'\\\\', ")) + (loop remainder (string-append result "'" (string escaped-char) "', "))))) + + ((char=? #\$ (string-ref syn 0)) + ; Extract the symbol from the string, which will be the name of + ; an operand. Append it to the result. + (if (= (string-length syn) 1) + (parse-error context "missing operand name" syntax)) + ; Is it $foo or ${foo}? + (if (char=? (string-ref syn 1) #\{) + (let ((n (chars-until-delimiter syn #\}))) + ; Note that 'n' includes the leading ${. + ; FIXME: \} not implemented yet. + (case n + ((0) (parse-error context "empty operand name" syntax)) + ((#f) (parse-error context "missing '}'" syntax)) + (else (loop (string-drop (+ n 1) syn) + (string-append result op-macro " (" + (string-upcase + (gen-c-symbol + (substring syn 2 n))) + "), "))))) + (let ((n (id-len (string-drop1 syn)))) + (loop (string-drop (1+ n) syn) + (string-append result op-macro " (" + (string-upcase + (gen-c-symbol + (substring syn 1 (1+ n)))) + "), "))))) + + ; Append the character to the result. + (else (loop (string-drop1 syn) + (string-append result + "'" (string-take1 syn) "', ")))))) +) + +; Return C code to define the syntax string for SYNTAX +; MNEM is the C value to use to represent the instruction's mnemonic. +; OP is the C macro to use to compute an operand's syntax value. + +(define (gen-syntax-entry mnem op syntax) + (string-append + "{ { " + mnem ", " + ; `mnem' is used to represent the mnemonic, so we always want to strip it + ; from the syntax string, regardless of the setting of `strip-mnemonic?'. + (compute-syntax #t #f syntax op) + " } }") +) + +; Instruction format table support. + +; Return the table for IFMT, an <iformat> object. + +(define (-gen-ifmt-table-1 ifmt) + (gen-obj-sanitize + (ifmt-eg-insn ifmt) ; sanitize based on the example insn + (string-list + "static const CGEN_IFMT " (gen-sym ifmt) " = {\n" + " " + (number->string (ifmt-mask-length ifmt)) ", " + (number->string (ifmt-length ifmt)) ", " + "0x" (number->string (ifmt-mask ifmt) 16) ", " + "{ " + (string-list-map (lambda (ifld) + (string-list "{ F (" (ifld-enum ifld #f) ") }, ")) + (ifmt-ifields ifmt)) + "{ 0 } }\n};\n\n")) +) + +; Generate the insn format table. + +(define (-gen-ifmt-table) + (string-write + "/* Instruction formats. */\n\n" + "#define F(f) & @arch@_cgen_ifld_table[CONCAT2 (@ARCH@_,f)]\n\n" + (string-list-map -gen-ifmt-table-1 (current-ifmt-list)) + "#undef F\n\n" + ) +) + +; Parse/insert/extract/print handlers. +; Each handler type is recorded in the assembler/disassembler as an array of +; pointers to functions. The value recorded in the operand table is the index +; into this array. The first element in the array is reserved as index 0 is +; special (the "default"). +; +; The handlers are recorded here as associative lists in case we ever want +; to record more than just the name. +; +; Adding a new handler involves +; - specifying its name in the .cpu file +; - getting its name appended to these tables +; - writing the C code +; +; ??? It might be useful to define the handler in Scheme. Later. + +(define opc-parse-handlers '((insn-normal))) +(define opc-insert-handlers '((insn-normal))) +(define opc-extract-handlers '((insn-normal))) +(define opc-print-handlers '((insn-normal))) + +; FIXME: There currently isn't a spot for specifying special handlers for +; each instruction. For now assume we always use the same ones. + +(define (insn-handlers insn) + (string-append + (number->string (lookup-index 'insn-normal opc-parse-handlers 0)) + ", " + (number->string (lookup-index 'insn-normal opc-insert-handlers 0)) + ", " + (number->string (lookup-index 'insn-normal opc-extract-handlers 0)) + ", " + (number->string (lookup-index 'insn-normal opc-print-handlers 0)) + ) +) + +; Return C code to define the cgen_opcode_handler struct for INSN. +; This is intended to be the ultimate escape hatch for the parse/insert/ +; extract/print handlers. Each entry is an index into a table of handlers. +; The escape hatch isn't used yet. + +(define (gen-insn-handlers insn) + (string-append + "{ " + (insn-handlers insn) + " }" + ) +) + +; Handler table support. +; There are tables for each of parse/insert/extract/print. + +; Return C code to define the handler table for NAME with values VALUES. + +(define (gen-handler-table name values) + (string-append + "cgen_" name "_fn * const @arch@_cgen_" name "_handlers[] = \n{\n" + (string-map (lambda (elm) + (string-append " " name "_" + (gen-c-symbol (car elm)) + ",\n")) + values) + "};\n\n" + ) +) + +; Instruction table support. + +; Return a declaration of an enum for all insns. + +(define (-gen-insn-enum) + (logit 2 "Generating instruction enum ...\n") + (string-list + (gen-enum-decl 'cgen_insn_type "@arch@ instruction types" + "@ARCH@_INSN_" + (cons '(invalid) + (append (gen-obj-list-enums (non-multi-insns (current-insn-list))) + '((max))))) + "/* Index of `invalid' insn place holder. */\n" + "#define CGEN_INSN_INVALID @ARCH@_INSN_INVALID\n\n" + "/* Total number of insns in table. */\n" + "#define MAX_INSNS ((int) @ARCH@_INSN_MAX)\n\n" + ) +) + +; Return a reference to the format table entry of INSN. + +(define (gen-ifmt-entry insn) + (string-append "& " (gen-sym (insn-ifmt insn))) +) + +; Return the definition of an instruction value entry. + +(define (gen-ivalue-entry insn) + (string-list "{ " + "0x" (number->string (insn-value insn) 16) + (if #f ; (ifmt-opcodes-beyond-base? (insn-ifmt insn)) + (string-list ", { " + ; ??? wip: opcode values beyond the base insn + "0 }") + "") + " }") +) + +; Generate an insn opcode entry for INSN. +; ALL-ATTRS is a list of all instruction attributes. +; NUM-NON-BOOLS is the number of non-boolean insn attributes. + +(define (-gen-insn-opcode-entry insn all-attrs num-non-bools) + (gen-obj-sanitize + insn + (string-list + "/* " (insn-syntax insn) " */\n" + " {\n" + " " (gen-insn-handlers insn) ",\n" + " " (gen-syntax-entry "MNEM" "OP" (insn-syntax insn)) ",\n" + ; ??? 'twould save space to put a pointer here and record format separately + " " (gen-ifmt-entry insn) ", " + ;"0x" (number->string (insn-value insn) 16) ",\n" + (gen-ivalue-entry insn) "\n" + " },\n")) +) + +; Generate insn table. + +(define (-gen-insn-opcode-table) + (logit 2 "Generating instruction opcode table ...\n") + (let* ((all-attrs (current-insn-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-write + "\ +#define A(a) (1 << CONCAT2 (CGEN_INSN_,a)) +#define MNEM CGEN_SYNTAX_MNEMONIC /* syntax value for mnemonic */ +#define OPERAND(op) CONCAT2 (@ARCH@_OPERAND_,op) +#define OP(field) CGEN_SYNTAX_MAKE_FIELD (OPERAND (field)) + +/* The instruction table. */ + +static const CGEN_OPCODE @arch@_cgen_insn_opcode_table[MAX_INSNS] = +{ + /* Special null first entry. + A `num' value of zero is thus invalid. + Also, the special `invalid' insn resides here. */ + { { 0, 0, 0, 0 }, {{0}}, 0, {0}},\n" + + (lambda () + (string-write-map (lambda (insn) + (logit 3 "Generating insn opcode entry for " (obj:name insn) " ...\n") + (-gen-insn-opcode-entry insn all-attrs + num-non-bools)) + (non-multi-insns (current-insn-list)))) + + "\ +}; + +#undef A +#undef MNEM +#undef OPERAND +#undef OP + +" + ) + ) +) + +; Return assembly/disassembly hashing support. + +(define (-gen-hash-fns) + (string-list + "\ +#ifndef CGEN_ASM_HASH_P +#define CGEN_ASM_HASH_P(insn) 1 +#endif + +#ifndef CGEN_DIS_HASH_P +#define CGEN_DIS_HASH_P(insn) 1 +#endif + +/* Return non-zero if INSN is to be added to the hash table. + Targets are free to override CGEN_{ASM,DIS}_HASH_P in the .opc file. */ + +static int +asm_hash_insn_p (insn) + const CGEN_INSN *insn; +{ + return CGEN_ASM_HASH_P (insn); +} + +static int +dis_hash_insn_p (insn) + const CGEN_INSN *insn; +{ + /* If building the hash table and the NO-DIS attribute is present, + ignore. */ + if (CGEN_INSN_ATTR_VALUE (insn, CGEN_INSN_NO_DIS)) + return 0; + return CGEN_DIS_HASH_P (insn); +} + +#ifndef CGEN_ASM_HASH +#define CGEN_ASM_HASH_SIZE 127 +#ifdef CGEN_MNEMONIC_OPERANDS +#define CGEN_ASM_HASH(mnem) (*(unsigned char *) (mnem) % CGEN_ASM_HASH_SIZE) +#else +#define CGEN_ASM_HASH(mnem) (*(unsigned char *) (mnem) % CGEN_ASM_HASH_SIZE) /*FIXME*/ +#endif +#endif + +/* It doesn't make much sense to provide a default here, + but while this is under development we do. + BUFFER is a pointer to the bytes of the insn, target order. + VALUE is the first base_insn_bitsize bits as an int in host order. */ + +#ifndef CGEN_DIS_HASH +#define CGEN_DIS_HASH_SIZE 256 +#define CGEN_DIS_HASH(buf, value) (*(unsigned char *) (buf)) +#endif + +/* The result is the hash value of the insn. + Targets are free to override CGEN_{ASM,DIS}_HASH in the .opc file. */ + +static unsigned int +asm_hash_insn (mnem) + const char * mnem; +{ + return CGEN_ASM_HASH (mnem); +} + +/* BUF is a pointer to the bytes of the insn, target order. + VALUE is the first base_insn_bitsize bits as an int in host order. */ + +static unsigned int +dis_hash_insn (buf, value) + const char * buf; + CGEN_INSN_INT value; +{ + return CGEN_DIS_HASH (buf, value); +} +\n" + ) +) + +; Hash support decls. + +(define (-gen-hash-decls) + (string-list + "\ +/* The hash functions are recorded here to help keep assembler code out of + the disassembler and vice versa. */ + +static int asm_hash_insn_p PARAMS ((const CGEN_INSN *)); +static unsigned int asm_hash_insn PARAMS ((const char *)); +static int dis_hash_insn_p PARAMS ((const CGEN_INSN *)); +static unsigned int dis_hash_insn PARAMS ((const char *, CGEN_INSN_INT)); +\n" + ) +) + +; Macro insn support. + +; Return a macro-insn expansion entry. + +(define (-gen-miexpn-entry entry) + ; FIXME: wip + "0, " +) + +; Return a macro-insn table entry. +; ??? wip, not currently used. + +(define (-gen-minsn-table-entry minsn all-attrs num-non-bools) + (gen-obj-sanitize + minsn + (string-list + " /* " (minsn-syntax minsn) " */\n" + " {\n" + " " + "-1, " ; macro-insns are not currently enumerated, no current need to + "\"" (obj:name minsn) "\", " + "\"" (minsn-mnemonic minsn) "\",\n" + " " (gen-syntax-entry "MNEM" "OP" (minsn-syntax minsn)) ",\n" + " (PTR) & macro_" (gen-sym minsn) "_expansions[0],\n" + " " + (gen-obj-attr-defn 'minsn minsn all-attrs num-non-bools gen-insn-attr-mask) + "\n" + " },\n")) +) + +; Return a macro-insn opcode table entry. +; ??? wip, not currently used. + +(define (-gen-minsn-opcode-entry minsn all-attrs num-non-bools) + (gen-obj-sanitize + minsn + (string-list + " /* " (minsn-syntax minsn) " */\n" + " {\n" + " " + "-1, " ; macro-insns are not currently enumerated, no current need to + "\"" (obj:name minsn) "\", " + "\"" (minsn-mnemonic minsn) "\",\n" + " " (gen-syntax-entry "MNEM" "OP" (minsn-syntax minsn)) ",\n" + " (PTR) & macro_" (gen-sym minsn) "_expansions[0],\n" + " " + (gen-obj-attr-defn 'minsn minsn all-attrs num-non-bools gen-insn-attr-mask) + "\n" + " },\n")) +) + +; Macro insn expansion has one basic form, but we optimize the common case +; of unconditionally expanding the input text to one instruction. +; The general form is a Scheme expression that is interpreted at runtime to +; decide how to perform the expansion. Yes, that means having a (perhaps +; minimal) Scheme interpreter in the assembler. +; Another thing to do is have a builder for each real insn so instead of +; expanding to text, the macro-expansion could invoke the builder for each +; expanded-to insn. + +(define (-gen-macro-insn-table) + (logit 2 "Generating macro-instruction table ...\n") + (let* ((minsn-list (map (lambda (minsn) + (if (has-attr? minsn 'ALIAS) + (minsn-make-alias "gen-macro-insn-table" minsn) + minsn)) + (current-minsn-list))) + (all-attrs (current-insn-attr-list)) + (num-non-bools (attr-count-non-bools all-attrs))) + (string-write + "/* Formats for ALIAS macro-insns. */\n\n" + "#define F(f) & @arch@_cgen_ifld_table[CONCAT2 (@ARCH@_,f)]\n\n" + (lambda () + (string-write-map -gen-ifmt-table-1 + (map insn-ifmt (find (lambda (minsn) + (has-attr? minsn 'ALIAS)) + minsn-list)))) + "#undef F\n\n" + "/* Each non-simple macro entry points to an array of expansion possibilities. */\n\n" + (lambda () + (string-write-map (lambda (minsn) + (if (has-attr? minsn 'ALIAS) + "" + (string-append + "static const CGEN_MINSN_EXPANSION macro_" (gen-sym minsn) "_expansions[] =\n" + "{\n" + (string-map -gen-miexpn-entry + (minsn-expansions minsn)) + " { 0, 0 }\n};\n\n"))) + minsn-list)) + "\ +#define A(a) (1 << CONCAT2 (CGEN_INSN_,a)) +#define MNEM CGEN_SYNTAX_MNEMONIC /* syntax value for mnemonic */ +#define OPERAND(op) CONCAT2 (@ARCH@_OPERAND_,op) +#define OP(field) CGEN_SYNTAX_MAKE_FIELD (OPERAND (field)) + +/* The macro instruction table. */ + +static const CGEN_IBASE @arch@_cgen_macro_insn_table[] = +{ +" + (lambda () + (string-write-map (lambda (minsn) + (logit 3 "Generating macro-insn table entry for " (obj:name minsn) " ...\n") + ; Simple macro-insns are emitted as aliases of real insns. + (if (has-attr? minsn 'ALIAS) + (gen-insn-table-entry minsn all-attrs num-non-bools) + (-gen-minsn-table-entry minsn all-attrs num-non-bools))) + minsn-list)) + "\ +}; + +/* The macro instruction opcode table. */ + +static const CGEN_OPCODE @arch@_cgen_macro_insn_opcode_table[] = +{\n" + (lambda () + (string-write-map (lambda (minsn) + (logit 3 "Generating macro-insn table entry for " (obj:name minsn) " ...\n") + ; Simple macro-insns are emitted as aliases of real insns. + (if (has-attr? minsn 'ALIAS) + (-gen-insn-opcode-entry minsn all-attrs num-non-bools) + (-gen-minsn-opcode-entry minsn all-attrs num-non-bools))) + minsn-list)) + "\ +}; + +#undef A +#undef MNEM +#undef OPERAND +#undef OP +\n" + )) +) + +; Emit a function to call to initialize the opcode table. + +(define (-gen-opcode-init-fn) + (string-write + "\ +/* Set the recorded length of the insn in the CGEN_FIELDS struct. */ + +static void +set_fields_bitsize (fields, size) + CGEN_FIELDS *fields; + int size; +{ + CGEN_FIELDS_BITSIZE (fields) = size; +} + +/* Function to call before using the operand instance table. + This plugs the opcode entries and macro instructions into the cpu table. */ + +void +@arch@_cgen_init_opcode_table (cd) + CGEN_CPU_DESC cd; +{ + int i; + int num_macros = (sizeof (@arch@_cgen_macro_insn_table) / + sizeof (@arch@_cgen_macro_insn_table[0])); + const CGEN_IBASE *ib = & @arch@_cgen_macro_insn_table[0]; + const CGEN_OPCODE *oc = & @arch@_cgen_macro_insn_opcode_table[0]; + CGEN_INSN *insns = (CGEN_INSN *) xmalloc (num_macros * sizeof (CGEN_INSN)); + memset (insns, 0, num_macros * sizeof (CGEN_INSN)); + for (i = 0; i < num_macros; ++i) + { + insns[i].base = &ib[i]; + insns[i].opcode = &oc[i]; + } + cd->macro_insn_table.init_entries = insns; + cd->macro_insn_table.entry_size = sizeof (CGEN_IBASE); + cd->macro_insn_table.num_init_entries = num_macros; + + oc = & @arch@_cgen_insn_opcode_table[0]; + insns = (CGEN_INSN *) cd->insn_table.init_entries; + for (i = 0; i < MAX_INSNS; ++i) + insns[i].opcode = &oc[i]; + + cd->sizeof_fields = sizeof (CGEN_FIELDS); + cd->set_fields_bitsize = set_fields_bitsize; + + cd->asm_hash_p = asm_hash_insn_p; + cd->asm_hash = asm_hash_insn; + cd->asm_hash_size = CGEN_ASM_HASH_SIZE; + + cd->dis_hash_p = dis_hash_insn_p; + cd->dis_hash = dis_hash_insn; + cd->dis_hash_size = CGEN_DIS_HASH_SIZE; +} +" + ) +) + +; Top level C code generators + +; FIXME: Create enum objects for all the enums we explicitly declare here. +; Then they'd be usable and we wouldn't have to special case them here. + +(define (cgen-opc.h) + (logit 1 "Generating " (current-arch-name) "-opc.h ...\n") + (string-write + (gen-copyright "Instruction opcode header for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifndef @ARCH@_OPC_H +#define @ARCH@_OPC_H + +" + (lambda () (gen-extra-opc.h srcdir (current-arch-name))) ; from <arch>.opc + -gen-insn-enum + -gen-ifield-decls + -gen-init-macros + " + +#endif /* @ARCH@_OPC_H */ +" + ) +) + +; This file contains the instruction opcode table. + +(define (cgen-opc.c) + (logit 1 "Generating " (current-arch-name) "-opc.c ...\n") + (string-write + (gen-copyright "Instruction opcode table for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#include \"sysdep.h\" +#include \"ansidecl.h\" +#include \"bfd.h\" +#include \"symcat.h\" +#include \"@prefix@-desc.h\" +#include \"@prefix@-opc.h\" +#include \"libiberty.h\" +\n" + (lambda () (gen-extra-opc.c srcdir (current-arch-name))) ; from <arch>.opc + -gen-hash-decls + -gen-ifmt-table + -gen-insn-opcode-table + -gen-macro-insn-table + -gen-hash-fns + -gen-opcode-init-fn + ) +) diff --git a/cgen/opc-opinst.scm b/cgen/opc-opinst.scm new file mode 100644 index 00000000000..b76392825c8 --- /dev/null +++ b/cgen/opc-opinst.scm @@ -0,0 +1,168 @@ +; Operand instance support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Return C code to define one instance of operand object OP. +; TYPE is one of "INPUT" or "OUTPUT". + +(define (-gen-operand-instance op type) + (let ((index (op:index op))) + (string-append " { " + type ", " + "\"" (gen-sym op) "\", " + (hw-enum (op:type op)) ", " + ; FIXME: Revisit CGEN_ prefix, use MODE (FOO) instead. + "CGEN_" (mode:enum (op:mode op)) ", " + ; FIXME: We don't handle memory properly yet. Later. + (cond ((memory? (op:type op)) + "0, 0") + ((has-attr? op 'SEM-ONLY) + "0, 0") + ((eq? (hw-index:type index) 'ifield) + (if (= (ifld-length (hw-index:value index)) 0) + "0, 0" + (string-append "OP_ENT (" + (string-upcase (gen-sym op)) + "), 0"))) + ((eq? (hw-index:type index) 'constant) + (string-append "0, " + (number->string (hw-index:value index)))) + (else "0, 0")) + ", " (if (op:cond? op) "COND_REF" "0") + " },\n")) +) + +; Return C code to define arrays of operand instances read from and written +; to by <sformat> SFMT. +; This is based on the semantics of the instruction. +; ??? All runtime chosen values (e.g. a particular register in a register bank) +; is assumed to be selected statically by the instruction. When some cpu +; violates this assumption (say because a previous instruction determines +; which register(s) the next instruction operates on), this will need +; additional support. + +(define (-gen-operand-instance-table sfmt) + (let ((ins (sfmt-in-ops sfmt)) + (outs (sfmt-out-ops sfmt))) + ; This used to exclude outputing anything if there were no ins or outs. + (gen-obj-sanitize + (sfmt-eg-insn sfmt) ; sanitize based on the example insn + (string-append + "static const CGEN_OPINST " + (gen-sym sfmt) "_ops[] = {\n" + (string-map (lambda (op) (-gen-operand-instance op "INPUT")) + ins) + (string-map (lambda (op) (-gen-operand-instance op "OUTPUT")) + outs) + " { END }\n};\n\n"))) +) + +(define (-gen-operand-instance-tables) + (string-write + "\ +/* Operand references. */ + +#define INPUT CGEN_OPINST_INPUT +#define OUTPUT CGEN_OPINST_OUTPUT +#define END CGEN_OPINST_END +#define COND_REF CGEN_OPINST_COND_REF +#define OP_ENT(op) CONCAT2 (@ARCH@_OPERAND_,op) + +" + (lambda () (string-write-map -gen-operand-instance-table (current-sfmt-list))) + "\ +#undef INPUT +#undef OUTPUT +#undef END +#undef COND_REF +#undef OP_ENT + +" + ) +) + +; Return C code for INSN's operand instance table. + +(define (gen-operand-instance-ref insn) + (let* ((sfmt (insn-sfmt insn)) + (ins (sfmt-in-ops sfmt)) + (outs (sfmt-out-ops sfmt))) + (if (and (null? ins) (null? outs)) + "0" + (string-append "& " (gen-sym sfmt) "_ops[0]"))) +) + +; Return C code to define a table to lookup an insn's operand instance table. + +(define (-gen-insn-opinst-lookup-table) + (string-list + "/* Operand instance lookup table. */\n\n" + "static const CGEN_OPINST *@arch@_cgen_opinst_table[MAX_INSNS] = {\n" + " 0,\n" ; null first entry + (string-list-map + (lambda (insn) + (gen-obj-sanitize + insn + (string-append " & " (gen-sym (insn-sfmt insn)) "_ops[0],\n"))) + (current-insn-list)) + "};\n\n" + "\ +/* Function to call before using the operand instance table. */ + +void +@arch@_cgen_init_opinst_table (cd) + CGEN_CPU_DESC cd; +{ + int i; + const CGEN_OPINST **oi = & @arch@_cgen_opinst_table[0]; + CGEN_INSN *insns = (CGEN_INSN *) cd->insn_table.init_entries; + for (i = 0; i < MAX_INSNS; ++i) + insns[i].opinst = oi[i]; +} +" + ) +) + +; Return the maximum number of operand instances used by any insn. +; If not generating the operand instance table, use a heuristic. + +(define (max-operand-instances) + (if -opcodes-build-operand-instance-table? + (apply max + (map (lambda (insn) + (+ (length (sfmt-in-ops (insn-sfmt insn))) + (length (sfmt-out-ops (insn-sfmt insn))))) + (current-insn-list))) + 8) ; FIXME: for now +) + +; Generate $arch-opinst.c. + +(define (cgen-opinst.c) + (logit 1 "Generating " (current-arch-name) "-opinst.c ...\n") + + ; If instruction semantics haven't been analyzed, do that now. + (if (not (arch-semantics-analyzed? CURRENT-ARCH)) + (begin + (logit 1 "Instruction semantics weren't analyzed when .cpu file was loaded.\n") + (logit 1 "Doing so now ...\n") + (arch-analyze-insns! CURRENT-ARCH + #t ; include aliases + #t) ; -opcodes-build-operand-instance-table? + )) + + (string-write + (gen-copyright "Semantic operand instances for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#include \"sysdep.h\" +#include \"ansidecl.h\" +#include \"bfd.h\" +#include \"symcat.h\" +#include \"@prefix@-desc.h\" +#include \"@prefix@-opc.h\" +\n" + -gen-operand-instance-tables + -gen-insn-opinst-lookup-table + ) +) diff --git a/cgen/opcodes.scm b/cgen/opcodes.scm new file mode 100644 index 00000000000..f5ed26f801d --- /dev/null +++ b/cgen/opcodes.scm @@ -0,0 +1,804 @@ +; General cpu info generator support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Global state variables. + +; Specify which application. +(set! APPLICATION 'OPCODES) + +; Boolean indicating if we're to build the operand instance table. +; The default is no, since only the m32r uses it at present. +; ??? Simulator tracing support could use it. +; ??? Might be lazily built at runtime by parsing the semantic code +; (which would be recorded in the insn table). +(define -opcodes-build-operand-instance-table? #f) + +; String containing copyright text. +(define CURRENT-COPYRIGHT #f) + +; String containing text defining the package we're generating code for. +(define CURRENT-PACKAGE #f) + +; Initialize the options. + +(define (option-init!) + (set! -opcodes-build-operand-instance-table? #f) + (set! CURRENT-COPYRIGHT copyright-fsf) + (set! CURRENT-PACKAGE package-gnu-binutils-gdb) + *UNSPECIFIED* +) + +; Handle an option passed in from the command line. + +(define (option-set! name value) + (case name + ((opinst) (set! -opcodes-build-operand-instance-table? #t)) + ((copyright) (cond ((equal? value '("fsf")) + (set! CURRENT-COPYRIGHT copyright-fsf)) + ((equal? value '("cygnus")) + (set! CURRENT-COPYRIGHT copyright-cygnus)) + (else (error "invalid copyright value" value)))) + ((package) (cond ((equal? value '("binutils")) + (set! CURRENT-PACKAGE package-gnu-binutils-gdb)) + ((equal? value '("gnusim")) + (set! CURRENT-PACKAGE package-gnu-simulators)) + ((equal? value '("cygsim")) + (set! CURRENT-PACKAGE package-cygnus-simulators)) + (else (error "invalid package value" value)))) + (else (error "unknown option" name)) + ) + *UNSPECIFIED* +) + +; Instruction fields support code. + +; Default type of variable to use to hold ifield value. + +(define (gen-ifield-default-type) + ; FIXME: Use long for now. + "long" +) + +; Given field F, return a C definition of a variable big enough to hold +; its value. + +(define (gen-ifield-value-decl f) + (gen-obj-sanitize f (string-append " " + (gen-ifield-default-type) + " " (gen-sym f) ";\n")) +) + +; Return name of function to call to insert the value of <ifield> F +; into an insn. + +(define (ifld-insert-fn-name f) + "insert_normal" +) + +; Return name of function to call to extract the value of <ifield> F +; into an insn. + +(define (ifld-extract-fn-name f) + "extract_normal" +) + +; Default routine to emit C code to insert a field in an insn. + +(method-make! + <ifield> 'gen-insert + (lambda (self operand) + (let* ((encode (elm-get self 'encode)) + (need-extra? encode) ; use to also handle operand's `insert' field + (varname (gen-operand-result-var self))) + (string-append + (if need-extra? + (string-append " {\n" + " " + (gen-ifield-default-type) + " value = " varname ";\n") + "") + (if encode + (string-append " value = " + (let ((expr (cadr encode)) + (value (caar encode)) + (pc (cadar encode))) + (rtl-c DFLT expr + (list (list value (obj:name (ifld-encode-mode self)) "value") + (list pc 'IAI "pc")))) + ";\n") + "") + (if need-extra? + " " + "") + " errmsg = " + (ifld-insert-fn-name self) + " (cd, " + (if need-extra? + "value" + varname) + ", " + ; We explicitly pass the attributes here rather than look them up + ; to give the code more optimization opportunities. + ; ??? Maybe when fields are recorded in opc.c, stop doing this, and + ; pass a pointer to the recorded attributes instead. + (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT) + (atlist-cons (bool-attr-make 'SIGNED #t) + (obj-atlist self)) + (obj-atlist self)) + gen-attr-mask) + ", " (number->string (ifld-word-offset self)) + ", " (number->string (ifld-start self #f)) + ", " (number->string (ifld-length self)) + ", " (number->string (ifld-word-length self)) + ", total_length" + ", buffer" + ");\n" + (if need-extra? + " }\n" + "") + ))) +) + +; Default routine to emit C code to extract a field from an insn. + +(method-make! + <ifield> 'gen-extract + (lambda (self operand) + (let* ((decode (elm-get self 'decode)) + (need-extra? decode) ; use to also handle operand's `extract' field + (varname (gen-operand-result-var self))) + (string-append + (if need-extra? + (string-append " {\n " + (gen-ifield-default-type) + " value;\n ") + "") + " length = " + (ifld-extract-fn-name self) + " (cd, ex_info, insn_value, " + ; We explicitly pass the attributes here rather than look them up + ; to give the code more optimization opportunities. + ; ??? Maybe when fields are recorded in opc.c, stop doing this, and + ; pass a pointer to the recorded attributes instead. + (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT) + (atlist-cons (bool-attr-make 'SIGNED #t) + (obj-atlist self)) + (obj-atlist self)) + gen-attr-mask) + ", " (number->string (ifld-word-offset self)) + ", " (number->string (ifld-start self #f)) + ", " (number->string (ifld-length self)) + ", " (number->string (ifld-word-length self)) + ", total_length" + ", pc" + ", & " + (if need-extra? + "value" + varname) + ");\n" + (if decode + (string-append " value = " + (let ((expr (cadr decode)) + (value (caar decode)) + (pc (cadar decode))) + (rtl-c DFLT expr + (list (list value (obj:name (ifld-decode-mode self)) "value") + (list pc 'IAI "pc")))) + ";\n") + "") + (if need-extra? + (string-append " " varname " = value;\n" + " }\n") + "") + ))) +) + +; gen-insert of multi-ifields + +(method-make! + <multi-ifield> 'gen-insert + (lambda (self operand) + (let* ((varname (gen-operand-result-var self)) + (encode (elm-get self 'encode)) + (need-extra? encode)) + (string-list + " {\n" + (if need-extra? + (string-append " " varname " = " + (let ((expr (cadr encode)) + (value (caar encode)) + (pc (cadar encode))) + (rtl-c DFLT expr + (list (list value (obj:name (ifld-encode-mode self)) varname) + (list pc 'IAI "pc")))) + ";\n") + "") + (let ((expr (elm-get self 'insert))) + (rtl-c VOID expr nil)) + (string-list-map (lambda (subfld) + (string-list + " " + (send subfld 'gen-insert operand) + " if (errmsg)\n" + " break;\n")) + (elm-get self 'subfields)) + " }\n" + ))) +) + +; gen-insert of derived-operands + +(method-make! + <derived-operand> 'gen-insert + (lambda (self operand) + " abort();\n") +) + +; gen-extract of multi-ifields + +(method-make! + <multi-ifield> 'gen-extract + (lambda (self operand) + (let* ((varname (gen-operand-result-var self)) + (decode (elm-get self 'decode)) + (need-extra? decode)) + (string-list + " {\n" + (string-list-map (lambda (subfld) + (string-list + " " + (send subfld 'gen-extract operand) + " if (length <= 0) break;\n" + )) + (elm-get self 'subfields)) + (let ((expr (elm-get self 'extract))) + (rtl-c VOID expr nil)) + (if need-extra? + (string-append " " varname " = " + (let ((expr (cadr decode)) + (value (caar decode)) + (pc (cadar decode))) + (rtl-c DFLT expr + (list (list value (obj:name (ifld-decode-mode self)) varname) + (list pc 'IAI "pc")))) + ";\n") + "") + " }\n" + ))) +) + + +(method-make! + <derived-operand> 'gen-extract + (lambda (self operand) + " abort();\n") +) + +;(method-make! +; <derived-operand> 'gen-extract +; (lambda (self operand) +; (string-list +; " {\n" +; (string-list-map (lambda (subop) +; (string-list +; " " (send subop 'gen-extract operand) +; " if (length <= 0)\n" +; " break;\n")) +; (elm-get self 'args)) +; " }\n" +; )) +;) + + +; Hardware index support code. + +(method-make! + <hw-index> 'gen-insert + (lambda (self operand) + (case (hw-index:type self) + ((ifield) + (send (hw-index:value self) 'gen-insert operand)) + (else + ""))) +) + +(method-make! + <hw-index> 'gen-extract + (lambda (self operand) + (case (hw-index:type self) + ((ifield) + (send (hw-index:value self) 'gen-extract operand)) + (else + "")))) + +; HW-ASM is the base class for supporting hardware elements in the opcode table +; (aka assembler/disassembler). + +; Utility to return C code to parse a number of <mode> MODE for an operand. +; RESULT-VAR-NAME is a string containing the variable to store the +; parsed number in. +; PARSE-FN is the name of the function to call or #f to use the default. +; OP-ENUM is the enum of the operand. + +(define (-gen-parse-number mode parse-fn op-enum result-var-name) + (string-append + " errmsg = " + ; Use operand's special parse function if there is one, otherwise compute + ; the function's name from the mode. + (or parse-fn + (case (obj:name mode) + ((QI HI SI INT) "cgen_parse_signed_integer") + ((BI UQI UHI USI UINT) "cgen_parse_unsigned_integer") + (else (error "unsupported (as yet) mode for parsing" + (obj:name mode))))) + " (cd, strp, " + op-enum + ", &" result-var-name + ");\n" + ) +) + +; Utility to return C code to parse an address. +; RESULT-VAR-NAME is a string containing the variable to store the +; parsed number in. +; PARSE-FN is the name of the function to call or #f to use the default. +; OP-ENUM is the enum of the operand. + +(define (-gen-parse-address parse-fn op-enum result-var-name) + (string-append + " {\n" + " bfd_vma value;\n" + " errmsg = " + ; Use operand's special parse function if there is one. + (or parse-fn + "cgen_parse_address") + " (cd, strp, " + op-enum + ", 0, " ; opinfo arg + "NULL, " ; result_type arg (FIXME) + " & value);\n" + " " result-var-name " = value;\n" + " }\n" + ) +) + +; Return C code to parse an expression. + +(method-make! + <hw-asm> 'gen-parse + (lambda (self operand) + (let ((mode (elm-get self 'mode)) + (result-var + (case (hw-index:type (op:index operand)) + ((ifield) (gen-operand-result-var (op-ifield operand))) + (else "junk")))) + (if (address? (op:type operand)) + (-gen-parse-address (send operand 'gen-function-name 'parse) + (op-enum operand) + result-var) + (-gen-parse-number mode (send operand 'gen-function-name 'parse) + (op-enum operand) + result-var)))) +) + +; Default method to emit C code to print a hardware element. + +(method-make! + <hw-asm> 'gen-print + (lambda (self operand) + (let ((value + (case (hw-index:type (op:index operand)) + ((ifield) (gen-operand-result-var (op-ifield operand))) + (else "0")))) + (string-append + " " + (or (send operand 'gen-function-name 'print) + (and (address? (op:type operand)) + "print_address") + "print_normal") +; (or (send operand 'gen-function-name 'print) +; (case (obj:name (elm-get self 'mode)) +; ((QI HI SI INT) "print_signed") +; ((BI UQI UHI USI UINT) "print_unsigned") +; (else (error "unsupported (as yet) mode for printing" +; (obj:name (elm-get self 'mode)))))) + " (cd, info, " + value + ", " + ; We explicitly pass the attributes here rather than look them up + ; to give the code more optimization opportunities. + (gen-bool-attrs (if (eq? (mode:class (elm-get self 'mode)) 'INT) + (atlist-cons (bool-attr-make 'SIGNED #t) + (obj-atlist operand)) + (obj-atlist operand)) + gen-attr-mask) + ;(gen-bool-attrs (obj-atlist operand) gen-attr-mask) + ", pc, length" + ");\n" + ))) +) + +; Keyword support. + +; Return C code to parse a keyword. + +(method-make! + <keyword> 'gen-parse + (lambda (self operand) + (let ((result-var + (case (hw-index:type (op:index operand)) + ((ifield) (gen-operand-result-var (op-ifield operand))) + (else "junk")))) + (string-append + " errmsg = " + (or (send operand 'gen-function-name 'parse) + "cgen_parse_keyword") + " (cd, strp, " + (send self 'gen-ref) ", " + ;(op-enum operand) ", " + "& " result-var + ");\n" + ))) +) + +; Return C code to print a keyword. + +(method-make! + <keyword> 'gen-print + (lambda (self operand) + (let ((value + (case (hw-index:type (op:index operand)) + ((ifield) (gen-operand-result-var (op-ifield operand))) + (else "0")))) + (string-append + " " + (or (send operand 'gen-function-name 'print) + "print_keyword") + " (cd, " + "info" ; The disassemble_info argument to print_insn. + ", " + (send self 'gen-ref) + ", " value + ", " + ; We explicitly pass the attributes here rather than look them up + ; to give the code more optimization opportunities. + (gen-bool-attrs (obj-atlist operand) gen-attr-mask) + ");\n" + ))) +) + +; Hardware support. + +; For registers, use the indices field. Ignore values. +; ??? Not that that will always be the case. + +(method-make-forward! <hw-register> 'indices '(gen-parse gen-print)) + +; No such support for memory yet. + +(method-make! + <hw-memory> 'gen-parse + (lambda (self operand) + (error "gen-parse of memory not supported yet")) +) + +(method-make! + <hw-memory> 'gen-print + (lambda (self operand) + (error "gen-print of memory not supported yet")) +) + +; For immediates, use the values field. Ignore indices. +; ??? Not that that will always be the case. + +(method-make-forward! <hw-immediate> 'values '(gen-parse gen-print)) + +; For addresses, use the values field. Ignore indices. + +(method-make-forward! <hw-address> 'values '(gen-parse gen-print)) + +; Generate the C code for dealing with operands. +; This code is inserted into cgen-{ibld,asm,dis}.in above the insn routines +; so that it can be inlined if desired. ??? Actually this isn't always the +; case but this is minutiae to be dealt with much later. + +; Generate the guts of a C switch to handle an operation for all operands. +; WHAT is one of fget/fset/parse/insert/extract/print. +; +; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the +; operations from similar ones in other contexts. ??? I'd prefer to come +; up with better names for fget/fset but I haven't come up with anything +; satisfactory yet. + +(define (gen-switch what) + (string-list-map + (lambda (ops) + ; OPS is a list of operands with the same name that for whatever reason + ; were defined separately. + (logit 3 (string-append "Processing " (obj:name (car ops)) " " what " ...\n")) + (if (= (length ops) 1) + (gen-obj-sanitize + (car ops) + (string-list + " case @ARCH@_OPERAND_" + (string-upcase (gen-sym (car ops))) + " :\n" + (send (car ops) (symbol-append 'gen- what) (car ops)) + " break;\n")) + (string-list + ; FIXME: operand name doesn't get sanitized. + " case @ARCH@_OPERAND_" + (string-upcase (gen-sym (car ops))) + " :\n" + ; There's more than one operand defined with this name, so we + ; have to distinguish them. + ; FIXME: Unfinished. + (string-list-map (lambda (op) + (gen-obj-sanitize + op + (string-list + (send op (symbol-append 'gen- what) op) + ))) + ops) + " break;\n" + ))) + (op-sort (find (lambda (op) (and (not (has-attr? op 'SEM-ONLY)) + (not (anyof-operand? op)) + (not (derived-operand? op)))) + (current-op-list)))) +) + +; Operand support. + +; Return the function name to use for WHAT or #f if there isn't a special one. +; WHAT is one of fget/fset/parse/insert/extract/print. + +(method-make! + <operand> 'gen-function-name + (lambda (self what) + (let ((handlers (elm-get self 'handlers))) + (let ((fn (assq-ref handlers what))) + (and fn (string-append what "_" (car fn)))))) +) + +; Interface fns. +; The default is to forward the request onto TYPE. +; OP is a copy of SELF so the method we forward to sees it. +; There is one case in the fget/fset/parse/insert/extract/print +; switches for each operand. +; These are invoked via gen-switch. + +; Emit C code to get an operand value from the fields struct. +; Operand values are stored in a struct "indexed" by field name. +; +; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the +; operations from similar ones in other contexts. ??? I'd prefer to come +; up with better names for fget/fset but I haven't come up with anything +; satisfactory yet. + +(method-make! + <operand> 'gen-fget + (lambda (self operand) + (case (hw-index:type (op:index self)) + ((ifield) + (string-append " value = " + (gen-operand-result-var (op-ifield self)) + ";\n")) + (else + " value = 0;\n"))) +) + +(method-make! + <derived-operand> 'gen-fget + (lambda (self operand) + " abort();\n") ; should never be called +) + +; Emit C code to save an operand value in the fields struct. + +(method-make! + <operand> 'gen-fset + (lambda (self operand) + (case (hw-index:type (op:index self)) + ((ifield) + (string-append " " + (gen-operand-result-var (op-ifield self)) + " = value;\n")) + (else + ""))) ; ignore +) + +(method-make! + <derived-operand> 'gen-fset + (lambda (self operand) + " abort();\n") ; should never be called +) + + +; Need to call op:type to resolve the hardware reference. +;(method-make-forward! <operand> 'type '(gen-parse gen-print)) + +(method-make! + <operand> 'gen-parse + (lambda (self operand) + (send (op:type self) 'gen-parse operand)) +) + +(method-make! + <derived-operand> 'gen-parse + (lambda (self operand) + " abort();\n") ; should never be called +) + +(method-make! + <operand> 'gen-print + (lambda (self operand) + (send (op:type self) 'gen-print operand)) +) + +(method-make! + <derived-operand> 'gen-print + (lambda (self operand) + " abort();\n") ; should never be called +) + +(method-make-forward! <operand> 'index '(gen-insert gen-extract)) +; But: <derived-operand> has its own gen-insert / gen-extract. + + +; Return the value of PC. +; Used by insert/extract fields. + +(method-make! + <pc> 'cxmake-get + (lambda (self estate mode index selector) + (cx:make IAI "pc")) +) + +; Opcodes init,finish,analyzer support. + +; Initialize any opcodes specific things before loading the .cpu file. + +(define (opcodes-init!) + (desc-init!) + *UNSPECIFIED* +) + +; Finish any opcodes specific things after loading the .cpu file. +; This is separate from analyze-data! as cpu-load performs some +; consistency checks in between. + +(define (opcodes-finish!) + (desc-finish!) + *UNSPECIFIED* +) + +; Compute various needed globals and assign any computed fields of +; the various objects. This is the standard routine that is called after +; a .cpu file is loaded. + +(define (opcodes-analyze!) + (desc-analyze!) + + ; Initialize the rtl->c translator. + (rtl-c-config!) + + ; Only include semantic operands when computing the format tables if we're + ; generating operand instance tables. + ; ??? Actually, may always be able to exclude the semantic operands. + ; Still need to traverse the semantics to derive machine computed attributes. + (arch-analyze-insns! CURRENT-ARCH + #t ; include aliases + -opcodes-build-operand-instance-table?) + + *UNSPECIFIED* +) + +; Extra target specific code generation. +; For now, such code lives in <arch>.opc. + +; Pick out a section from the .opc file. +; The section is delimited with: +; /* -- name ... */ +; ... +; /* -- ... */ +; +; FIXME: This is a pretty involved bit of code. 'twould be nice to split +; it up into manageable chunks. + +(define (read-cpu.opc srcdir cpu delim) + (let ((file (string-append srcdir "/" (current-arch-name) ".opc")) + (start-delim (string-append "/* -- " delim)) + (end-delim "/* -- ")) + (if (file-exists? file) + (let ((port (open-file file "r")) + ; Extra amount is added to SIZE so substring's to fetch possible + ; delim won't fail, even at end of file + (size (+ (file-size file) (string-length start-delim)))) + (if port + (let ((result (make-string size #\space))) + (let loop ((start -1) (line 0) (index 0)) + (let ((char (read-char port))) + (if (not (eof-object? char)) + (string-set! result index char)) + (cond ((eof-object? char) + (begin + (close-port port) + ; End of file, did we find the text? + (if (=? start -1) + "" + (substring result start index)))) + ((char=? char #\newline) + ; Check for start delim or end delim? + (if (=? start -1) + (if (string=? (substring result line + (+ (string-length start-delim) + line)) + start-delim) + (loop line (+ index 1) (+ index 1)) + (loop -1 (+ index 1) (+ index 1))) + (if (string=? (substring result line + (+ (string-length end-delim) + line)) + end-delim) + (begin + (close-port port) + (substring result start (+ index 1))) + (loop start (+ index 1) (+ index 1))))) + (else + (loop start line (+ index 1))))))) + (error "Unable to open:" file))) + "" ; file doesn't exist + )) +) + +; FIXME: collapse into one? +(define (gen-extra-cpu.h srcdir arch) + (logit 2 "Generating extra cpu.h stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "cpu.h") +) +(define (gen-extra-cpu.c srcdir arch) + (logit 2 "Generating extra cpu.c stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "cpu.c") +) +(define (gen-extra-opc.h srcdir arch) + (logit 2 "Generating extra opc.h stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "opc.h") +) +(define (gen-extra-opc.c srcdir arch) + (logit 2 "Generating extra opc.c stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "opc.c") +) +(define (gen-extra-asm.c srcdir arch) + (logit 2 "Generating extra asm.c stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "asm.c") +) +(define (gen-extra-dis.c srcdir arch) + (logit 2 "Generating extra dis.c stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "dis.c") +) +(define (gen-extra-ibld.h srcdir arch) + (logit 2 "Generating extra ibld.h stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "ibld.h") +) +(define (gen-extra-ibld.c srcdir arch) + (logit 2 "Generating extra ibld.c stuff from " arch ".opc ...\n") + (read-cpu.opc srcdir arch "ibld.c") +) + +; For debugging. + +(define (cgen-all) + (string-write + cgen-desc.h + cgen-desc.c + cgen-opinst.c + cgen-opc.h + cgen-opc.c + cgen-ibld.h + cgen-ibld.in + cgen-asm.in + cgen-dis.in + ) +) diff --git a/cgen/operand.scm b/cgen/operand.scm new file mode 100644 index 00000000000..03a52172985 --- /dev/null +++ b/cgen/operand.scm @@ -0,0 +1,1559 @@ +; Operands +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Operands map a set of values (registers, whatever) to an instruction field +; or other indexing mechanism. Operands are also how the semantic code refers +; to hardware elements. + +; The `<operand>' class. +; +; ??? Need a new lighterweight version for instances in semantics. +; This should only contain the static elements from the description file. +; +; ??? Derived operands don't use all the current class members. Perhaps +; split <operand> into two. + +(define <operand> + (class-make '<operand> + '(<ident>) + '( + ; Name as used in semantic code. + ; Generally this is the same as NAME. It is changed by the + ; `operand:' rtx function. One reason is to set a "pretty" + ; name in tracing output (most useful in memory operands). + ; A more important reason is to help match semantic operands + ; with function unit input/output arguments. + sem-name + + ; Semantic name of hardware element refered to by this operand. + hw-name + + ; Hardware type of operand, a subclass of <hardware-base>. + ; This is computed lazily from HW-NAME as many hardware + ; elements can have the same semantic name. Applications + ; that require a unique hardware element to be refered to are + ; required to ensure duplicates are discarded (usually done + ; by keeping the appropriate machs). + ; FIXME: Rename to hw. + (type . #f) + + ; Name of mode, as specified in description file. + ; This needn't be the actual mode, as WI will get coerced + ; to the actual word int mode. + mode-name + + ; The mode TYPE is being referenced in. + ; This is also looked up lazily for the same reasons as TYPE. + (mode . #f) + + ; Selector. + ; A number or #f used to select a variant of the hardware + ; element. An example is ASI's on sparc. + ; ??? I really need to be better at picking names. + (selector . #f) + + ; Index into type, class <hw-index>. + ; For example in the case of an array of registers + ; it can be an instruction field or in the case of a memory + ; reference it can be a register operand (or general rtx). + ; ??? At present <hw-index> is a facade over the real index + ; type. Not sure what the best way to do this is. + (index . #f) + + ; Code to run when the operand is read or #f meaning pass + ; the request on to the hardware object. + (getter . #f) + + ; Code to run when the operand is written or #f meaning pass + ; the request on to the hardware object. + (setter . #f) + + ; Associative list of (symbol . "handler") entries. + ; Each entry maps an operation to its handler (which is up to + ; the application but is generally a function name). + (handlers . ()) + + ; Ordinal number of the operand in an insn's semantic + ; description. There is no relation between the number and + ; where in the semantics the operand appears. An operand that + ; is both read and written are given separate ordinal numbers + ; (inputs are treated separately from outputs). + (num . -1) + + ; Boolean indicating if the operand is conditionally + ; referenced. #f means the operand is always referenced by + ; the instruction. + (cond? . #f) + ) + nil) +) + +; The default make! assigns the default h/w selector. + +(method-make! + <operand> 'make! + (lambda (self name comment attrs hw-name mode-name index handlers getter setter) + (elm-set! self 'name name) + (elm-set! self 'sem-name name) + (elm-set! self 'comment comment) + (elm-set! self 'attrs attrs) + (elm-set! self 'hw-name hw-name) + (elm-set! self 'mode-name mode-name) + (elm-set! self 'selector hw-selector-default) + (elm-set! self 'index index) + (elm-set! self 'handlers handlers) + (elm-set! self 'getter getter) + (elm-set! self 'setter setter) + self) +) + +; FIXME: The prefix field- doesn't seem right. Indices needn't be +; ifields, though for operands defined in .cpu files they usually are. +(method-make-forward! <operand> 'index '(field-start field-length)) + +; Accessor fns + +(define op:sem-name (elm-make-getter <operand> 'sem-name)) +(define op:set-sem-name! (elm-make-setter <operand> 'sem-name)) +(define op:hw-name (elm-make-getter <operand> 'hw-name)) +(define op:mode-name (elm-make-getter <operand> 'mode-name)) +(define op:selector (elm-make-getter <operand> 'selector)) +; FIXME: op:index should be named op:hwindex. +(define op:index (elm-make-getter <operand> 'index)) +(define op:handlers (elm-make-getter <operand> 'handlers)) +(define op:getter (elm-make-getter <operand> 'getter)) +(define op:setter (elm-make-getter <operand> 'setter)) +(define op:num (elm-make-getter <operand> 'num)) +(define op:set-num! (elm-make-setter <operand> 'num)) +(define op:cond? (elm-make-getter <operand> 'cond?)) +(define op:set-cond?! (elm-make-setter <operand> 'cond?)) + +; Compute the hardware type lazily. +; FIXME: op:type should be named op:hwtype or some such. + +(define op:type + (let ((getter (elm-make-getter <operand> 'type))) + (lambda (op) + (let ((type (getter op))) + (if type + type + (let* ((hw-name (op:hw-name op)) + (hw-objs (current-hw-sem-lookup hw-name))) + (if (!= (length hw-objs) 1) + (error "can't resolve h/w reference" hw-name)) + ((elm-make-setter <operand> 'type) op (car hw-objs)) + (car hw-objs)))))) +) + +; Compute the operand's mode lazily (depends on hardware type which is +; computed lazily). + +(define op:mode + (let ((getter (elm-make-getter <operand> 'mode))) + (lambda (op) + (let ((mode (getter op))) + (if mode + mode + (let ((mode-name (op:mode-name op)) + (type (op:type op))) + (let ((mode (if (eq? mode-name 'DFLT) + (hw-default-mode type) + (mode:lookup mode-name)))) + ((elm-make-setter <operand> 'mode) op mode) + mode)))))) +) + +(method-make! <operand> 'get-mode (lambda (self) (op:mode self))) + +; FIXME: wip +; Result is the <ifield> object or #f if there is none. + +(define (op-ifield op) + (logit 4 "op-ifield op=" (obj:name op) " indx=" (obj:name (op:index op)) "\n") + (let ((indx (op:index op))) + (if indx + (let ((maybe-ifld (hw-index:value (op:index op)))) + (logit 4 " ifld=" (obj:name maybe-ifld) "\n") + (cond ((ifield? maybe-ifld) maybe-ifld) + ((derived-ifield? maybe-ifld) maybe-ifld) + ((ifield? indx) indx) + ((derived-ifield? indx) indx) + (else #f))) + #f)) +) + +; Return mode to use for index or #f if scalar. +; This can't use method-make-forward! as we need to call op:type to +; resolve the hardware reference. + +(method-make! + <operand> 'get-index-mode + (lambda (self) (send (op:type self) 'get-index-mode)) +) + +; Return the operand's enum. + +(define (op-enum op) + (string-upcase (string-append "@ARCH@_OPERAND_" (gen-sym op))) +) + +; Return a boolean indicating if X is an operand. + +(define (operand? x) (class-instance? <operand> x)) + +; Default gen-pretty-name method. +; Return a C string of the name intended for users. +; +; FIXME: The current implementation is a quick hack. Parallel execution +; support can create operands with long names. e.g. h-memory-add-WI-src2-slo16 +; The eventual way this will be handled is to record with each operand the +; entry number (or some such) in the operand instance table so that for +; registers we can compute the register's name. + +(method-make! + <operand> 'gen-pretty-name + (lambda (self mode) + (let* ((name (op:sem-name self)) + (pname (cond ((string=? "h-memory" (string-take 8 name)) "memory") + ((string=? "h-" (string-take 2 name)) (string-drop 2 name)) + (else name)))) + (string-append "\"" pname "\""))) +) + +; PC support. +; This is a subclass of <operand>, used to give the simulator a place to +; hang a couple of methods. +; At the moment we only support one pc, a reasonable place to stop for now. + +(define <pc> (class-make '<pc> '(<operand>) nil nil)) + +(method-make! + <pc> 'make! + (lambda (self) + (send-next self 'make! 'pc "program counter" + (atlist-parse '(SEM-ONLY) "cgen_operand" "make! of pc") + 'h-pc + 'DFLT + (make <hw-index> 'anonymous + 'ifield 'UINT (current-ifld-lookup 'f-nil)) + nil ; handlers + #f #f) ; getter setter + self) +) + +; Return a boolean indicating if operand op is the pc. +; This must not call op:type. op:type will try to resolve a hardware +; element that may be multiply specified, and this is used in contexts +; where that's not possible. + +(define (pc? op) (class-instance? <pc> op)) + +; Mode support. + +; Create a copy of operand OP in mode NEW-MODE-NAME. +; If OP has been subclassed the result must contain the complete class +; (e.g. the behaviour of `object-copy-top'). + +(define (op:new-mode op new-mode-name) + (let ((result (object-copy-top op))) + ; (logit 1 "op:new-mode op=" (op:sem-name op) + ; " class=" (object-class-name op) + ; " hw-name=" (op:hw-name op) + ; " mode=" (op:mode op) + ; " newmode=" new-mode-name) + (if (or (eq? new-mode-name 'DFLT) + (eq? new-mode-name 'VOID) ; temporary: for upward compatibility + (mode:eq? new-mode-name (op:mode op))) + ; Mode isn't changing. + result + ; See if new mode is supported by the hardware. + (if (hw-mode-ok? (op:type op) new-mode-name (op:index op)) + (let ((new-mode (mode:lookup new-mode-name))) + (if (not new-mode) + (error "op:new-mode: internal error, bad mode" + new-mode-name)) + (elm-xset! result 'mode new-mode) + result) + (parse-error "op:new-mode" + (string-append "invalid mode for operand `" + (obj:name op) + "'") + new-mode-name)))) +) + +; Ifield support. + +; Return list of ifields used by OP. + +(define (op-iflds-used op) + (if (derived-operand? op) + (collect op-iflds-used (derived-args op)) + ; else + (let ((indx (op:index op))) + (if (and (eq? (hw-index:type indx) 'ifield) + (not (= (ifld-length (hw-index:value indx)) 0))) + (ifld-needed-iflds (hw-index:value indx)) + nil))) +) + +; The `hw-index' class. +; [Was named `index' but that conflicts with the C library function and caused +; problems when using Hobbit. And `index' is too generic a name anyway.] +; +; An operand combines a hardware object with its index. +; e.g. in an array of registers an operand serves to combine the register bank +; with the instruction field that chooses which one. +; Hardware elements are accessed via other means as well besides instruction +; fields so we need a way to designate something as being an index. +; The `hw-index' class does that. It serves as a facade to the underlying +; details. +; ??? Not sure whether this is the best way to handle this or not. +; +; NAME is the name of the index or 'anonymous. +; This is used, for example, to give a name to the simulator extraction +; structure member. +; TYPE is a symbol that indicates what VALUE is. +; scalar: the hardware object is a scalar, no index is required +; [MODE and VALUE are #f to denote "undefined" in this case] +; constant: a (non-negative) integer +; str-expr: a C expression as a string +; rtx: an rtx to be expanded +; ifield: an ifield object +; operand: an operand object +; ??? A useful simplification may be to always record the value as an rtx +; [which may require extensions to rtl so is deferred]. +; ??? We could use runtime type identification, but doing things this way +; adds more structure. +; +; MODE is the mode of VALUE. If DFLT, mode must be obtained from VALUE. +; DFLT is only allowable for rtx and operand types. + +(define <hw-index> (class-make '<hw-index> nil '(name type mode value) nil)) + +; Accessors. +; Use obj:name for `name'. +(define hw-index:type (elm-make-getter <hw-index> 'type)) +(define hw-index:mode (elm-make-getter <hw-index> 'mode)) +(define hw-index:value (elm-make-getter <hw-index> 'value)) + +; Allow the mode to be specified by its name. +(method-make! + <hw-index> 'make! + (lambda (self name type mode value) + (elm-set! self 'name name) + (elm-set! self 'type type) + (elm-set! self 'mode (mode:lookup mode)) + (elm-set! self 'value value) + self) +) + +; get-name handler +(method-make! + <hw-index> 'get-name + (lambda (self) + (elm-get self 'name)) +) + +; get-atlist handler +(method-make! + <hw-index> 'get-atlist + (lambda (self) + (case (hw-index:type self) + ((ifield) (obj-atlist (hw-index:value self))) + (else atlist-empty))) +) + +; ??? Until other things settle. +(method-make! + <hw-index> 'field-start + (lambda (self word-len) + (if (eq? (hw-index:type self) 'ifield) + (send (hw-index:value self) 'field-start #f) + 0)) +) +(method-make! + <hw-index> 'field-length + (lambda (self) + (if (eq? (hw-index:type self) 'ifield) + (send (hw-index:value self) 'field-length) + 0)) +) + +; There only ever needs to be one of these objects, so create one. + +(define hw-index-scalar + ; We can't use `make' here as the make! method calls mode:lookup which + ; (a) doesn't exist if we're compiled with Hobbit and mode.scm isn't + ; and (b) will fail anyway since #f isn't a valid mode. + (let ((scalar-index (new <hw-index>))) + (elm-xset! scalar-index 'type 'scalar) + (elm-xset! scalar-index 'mode #f) + (elm-xset! scalar-index 'value #f) + (lambda () scalar-index)) +) + + +; Placeholder for indices of "anyof" operands. +; There only needs to be one of these, so we create one and always use that. + +(define hw-index-anyof + ; We can't use `make' here as the make! method calls mode:lookup which + ; (a) doesn't exist if we're compiled with Hobbit and mode.scm isn't + ; and (b) will fail anyway since #f isn't a valid mode. + (let ((anyof-index (new <hw-index>))) + (elm-xset! anyof-index 'type 'scalar) + (elm-xset! anyof-index 'mode #f) + (elm-xset! anyof-index 'value #f) + (lambda () anyof-index)) +) + +(define hw-index-derived + ; We can't use `make' here as the make! method calls mode:lookup which + ; (a) doesn't exist if we're compiled with Hobbit and mode.scm isn't + ; and (b) will fail anyway since #f isn't a valid mode. + (let ((derived-index (new <hw-index>))) + (elm-xset! derived-index 'type 'scalar) + (elm-xset! derived-index 'mode #f) + (elm-xset! derived-index 'value #f) + (lambda () derived-index)) +) + + + +; Hardware selector support. +; +; A hardware "selector" is like an index except is along an atypical axis +; and thus is rarely used. It exists to support things like ASI's on Sparc. + +; What to pass to indicate "default selector". +; (??? value is temporary choice to be revisited). +(define hw-selector-default '(symbol NONE)) + +(define (hw-selector-default? sel) (equal? sel hw-selector-default)) + +; Hardware support. + +; Return list of hardware elements refered to in OP-LIST +; with no duplicates. + +(define (op-nub-hw op-list) + ; Build a list of hw elements. + (let ((hw-list (map (lambda (op) + (if (hw-ref? op) ; FIXME: hw-ref? is undefined + op + (op:type op))) + op-list))) + ; Now build an alist of (name . obj) elements, take the nub, then the cdr. + ; ??? These lists tend to be small so sorting first is probably overkill. + (map cdr + (alist-nub (alist-sort (map (lambda (hw) (cons (obj:name hw) hw)) + hw-list))))) +) + +; Parsing support. + +; Utility of -operand-parse-[gs]etter to build the expected syntax, +; for use in error messages. + +(define (-operand-g/setter-syntax rank setter?) + (string-append "(" + (string-drop1 + (numbers->string (iota rank) " index")) + (if setter? + (if (>= rank 1) + " newval" + "newval") + "") + ") (expression)") +) + +; Parse a getter spec. +; The syntax is (([index-names]) (... code ...)). +; Omit `index-names' for scalar objects. +; {rank} is the required number of elements in {index-names}. + +(define (-operand-parse-getter context getter rank) + (if (null? getter) + #f ; use default + (let () + (if (or (not (list? getter)) + (!= (length getter) 2) + (not (and (list? (car getter)) + (= (length (car getter)) rank)))) + (context-error context + (string-append "invalid getter, should be " + (-operand-g/setter-syntax rank #f)) + getter)) + (if (not (rtx? (cadr getter))) + (context-error context "invalid rtx expression" getter)) + getter)) +) + +; Parse a setter spec. +; The syntax is (([index-names] newval) (... code ...)). +; Omit `index-names' for scalar objects. +; {rank} is the required number of elements in {index-names}. + +(define (-operand-parse-setter context setter rank) + (if (null? setter) + #f ; use default + (let () + (if (or (not (list? setter)) + (!= (length setter) 2) + (not (and (list? (car setter)) + (= (+ 1 (length (car setter)) rank))))) + (context-error context + (string-append "invalid setter, should be " + (-operand-g/setter-syntax rank #t)) + setter)) + (if (not (rtx? (cadr setter))) + (context-error context "invalid rtx expression" setter)) + setter)) +) + +; Parse an operand definition. +; This is the main routine for building an operand object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). +; ??? This only takes insn fields as the index. May need another proc (or an +; enhancement of this one) that takes other kinds of indices. + +(define (-operand-parse errtxt name comment attrs hw mode ifld handlers getter setter) + (logit 2 "Processing operand " name " ...\n") + + (let ((name (parse-name name errtxt)) + (atlist-obj (atlist-parse attrs "cgen_operand" errtxt))) + + (if (keep-atlist? atlist-obj #f) + + (let ((hw-objs (current-hw-sem-lookup hw)) + (mode-obj (parse-mode-name mode errtxt)) + (ifld-val (if (integer? ifld) + ifld + (current-ifld-lookup ifld))) + ; FIXME: quick hack + (context (context-make-reader errtxt))) + + (if (not mode-obj) + (parse-error errtxt "unknown mode" mode)) + (if (not ifld-val) + (parse-error errtxt "unknown insn field" ifld)) + ; Disallow some obviously invalid numeric indices. + (if (and (integer? ifld-val) + (< ifld-val 0)) + (parse-error errtxt "invalid integer index" ifld-val)) + ; Don't validate HW until we know whether this operand will be kept + ; or not. If not, HW may have been discarded too. + (if (null? hw-objs) + (parse-error errtxt "unknown hardware element" hw)) + + ; At this point IFLD-VAL is either an integer or an <ifield> object. + ; Since we can't look up the hardware element at this time + ; [well, actually we should be able to with a bit of work], + ; we determine scalarness from the index. + (let* ((scalar? (or (integer? ifld-val) (ifld-nil? ifld-val))) + (hw-index + (if (integer? ifld-val) + (make <hw-index> (symbol-append 'i- name) + ; FIXME: constant -> const + 'constant 'UINT ifld-val) + (if scalar? + (hw-index-scalar) + (make <hw-index> (symbol-append 'i- name) + 'ifield 'UINT ifld-val))))) + (make <operand> + name + (parse-comment comment errtxt) + ; Copy FLD's attributes so one needn't duplicate attrs like + ; PCREL-ADDR, etc. An operand inherits the attributes of + ; its field. They are overridable of course, which is why we use + ; `atlist-append' here. + (if (integer? ifld-val) + atlist-obj + (atlist-append atlist-obj (obj-atlist ifld-val))) + hw ; note that this is the hw's name, not an object + mode ; ditto, this is a name, not an object + hw-index + (parse-handlers errtxt '(parse print) handlers) + (-operand-parse-getter context getter (if scalar? 0 1)) + (-operand-parse-setter context setter (if scalar? 0 1)) + ))) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read an operand description. +; This is the main routine for analyzing operands in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -operand-parse is invoked to create the <operand> object. + +(define (-operand-read errtxt . arg-list) + (let (; Current operand elements: + (name nil) + (comment nil) + (attrs nil) + (type nil) + (mode 'DFLT) ; use default mode of TYPE + (index nil) + (handlers nil) + (getter nil) + (setter nil) + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((type) (set! type (cadr arg))) + ((mode) (set! mode (cadr arg))) + ((index) (set! index (cadr arg))) + ((handlers) (set! handlers (cdr arg))) + ((getter) (set! getter (cdr arg))) + ((setter) (set! setter (cdr arg))) + (else (parse-error errtxt "invalid operand arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-operand-parse errtxt name comment attrs type mode index handlers + getter setter) + ) +) + +; Define an operand object, name/value pair list version. + +(define define-operand + (lambda arg-list + (let ((op (apply -operand-read (cons "define-operand" arg-list)))) + (if op + (current-op-add! op)) + op)) +) + +; Define an operand object, all arguments specified. + +(define (define-full-operand name comment attrs type mode index handlers getter setter) + (let ((op (-operand-parse "define-full-operand" name comment attrs + type mode index handlers getter setter))) + (if op + (current-op-add! op)) + op) +) + +; Derived operands. +; +; Derived operands are used to implement operands more complex than just +; the mapping of an instruction field to a register bank. Their present +; raison d'etre is to create a new axis on which to implement the complex +; addressing modes of the i386 and m68k. The brute force way of describing +; these instruction sets would be to have one `dni' per addressing mode +; per instruction. What's needed is to abstract away the various addressing +; modes within something like operands. +; +; ??? While internally we end up with the "brute force" approach, in and of +; itself that's ok because it's an internal implementation issue. +; See <multi-insn>. +; +; ??? Another way to go is to have one dni per addressing mode. That seems +; less clean though as one dni would be any of add, sub, and, or, xor, etc. +; +; ??? Some addressing modes have side-effects (e.g. pre-dec, etc. like insns). +; This can be represented, but if two operands have side-effects special +; trickery may be required to get the order of side-effects right. Need to +; avoid any "trickery" at all. +; +; ??? Not yet handled are modelling parameters. +; ??? Not yet handled are the handlers,getter,setter spec of normal operands. +; +; ??? Division of class members b/w <operand> and <derived-operand> is wip. +; ??? As is potential introduction of other classes to properly organize +; things. + +(define <derived-operand> + (class-make '<derived-operand> + '(<operand>) + '( + ; Args (list of <operands> objects). + args + + ; Syntax string. + syntax + + ; Base ifield, common to all choices. + ; ??? experiment + base-ifield + + ; <derived-ifield> object. + encoding + + ; Assertions of any ifield values or #f if none. + (ifield-assertion . #f) + ) + ()) +) + +(method-make-make! <derived-operand> + '(name comment attrs mode + args syntax base-ifield encoding ifield-assertion + getter setter) +) + +(define (derived-operand? x) (class-instance? <derived-operand> x)) + +(define-getters <derived-operand> derived + (args syntax base-ifield encoding ifield-assertion) +) + +; "anyof" operands are subclassed from derived operands. +; They typically handle multiple addressing modes of CISC architectures. + +(define <anyof-operand> + (class-make '<anyof-operand> + '(<operand>) + '( + ; Base ifield, common to all choices. + ; FIXME: wip + base-ifield + + ; List of <derived-operand> objects. + ; ??? Maybe allow <operand>'s too? + choices + ) + ()) +) + +(define (anyof-operand? x) (class-instance? <anyof-operand> x)) + +(method-make! + <anyof-operand> 'make! + (lambda (self name comment attrs mode base-ifield choices) + (elm-set! self 'name name) + (elm-set! self 'comment comment) + (elm-set! self 'attrs attrs) + (elm-set! self 'mode-name mode) + (elm-set! self 'base-ifield base-ifield) + (elm-set! self 'choices choices) + ; Set index to a special marker value. + (elm-set! self 'index (hw-index-anyof)) + self) +) + +(define-getters <anyof-operand> anyof (choices)) + +; Derived/Anyof parsing support. + +; Subroutine of -derived-operand-parse to parse the encoding. +; The result is a <derived-ifield> object. +; The {owner} member still needs to be set! + +(define (-derived-parse-encoding context operand-name encoding) + (if (or (null? encoding) + (not (list? encoding))) + (context-error context "encoding not a list" encoding)) + (if (not (eq? (car encoding) '+)) + (context-error context "encoding must begin with `+'" encoding)) + + ; ??? Calling -parse-insn-format is a quick hack. + ; It's an internal routine of some other file. + (let ((iflds (-parse-insn-format "anyof encoding" encoding))) + (make <derived-ifield> + operand-name + (string-append "<derived-ifield> for " operand-name) + atlist-empty + #f ; owner + iflds ; subfields + )) +) + +; Subroutine of -derived-operand-parse to parse the ifield assertion. +; The ifield assertion is either () or an RTL expression asserting something +; about the ifield values of the containing insn. +; Operands are specified by name, but what is used is their indices (there's +; an implicit `index-of' going on). + +(define (-derived-parse-ifield-assertion context args ifield-assertion) + ; FIXME: for now + (if (null? ifield-assertion) + #f + ifield-assertion) +) + +; Parse a derived operand definition. +; This is the main routine for building a derived operand object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). +; +; ??? Currently no support for handlers(,???) found in normal operands. +; Later, when necessary. + +(define (-derived-operand-parse errtxt name comment attrs mode + args syntax + base-ifield encoding ifield-assertion + getter setter) + (logit 2 "Processing derived operand " name " ...\n") + + (let ((name (parse-name name errtxt)) + (atlist-obj (atlist-parse attrs "cgen_operand" errtxt))) + + (if (keep-atlist? atlist-obj #f) + + (let* ((mode-obj (parse-mode-name mode errtxt)) + ; FIXME: quick hack + (context (context-make-reader errtxt)) + (parsed-encoding (-derived-parse-encoding context name encoding)) + ) + (if (not mode-obj) + (parse-error errtxt "unknown mode" mode)) + + (let ((result + (make <derived-operand> + name + (parse-comment comment errtxt) + atlist-obj + mode-obj + (map (lambda (a) + (if (not (symbol? a)) + (parse-error errtxt "arg not a symbol" a)) + (let ((op (current-op-lookup a))) + (if (not op) + (parse-error errtxt "not an operand" a)) + op)) + args) + syntax + base-ifield ; FIXME: validate + parsed-encoding + (-derived-parse-ifield-assertion context args ifield-assertion) + (if (null? getter) + #f + (-operand-parse-getter context + (list args + (rtx-canonicalize context getter)) + (length args))) + (if (null? setter) + #f + (-operand-parse-setter context + (list (append args '(newval)) + (rtx-canonicalize context setter)) + (length args))) + ))) + (elm-set! result 'hw-name (obj:name (hardware-for-mode mode-obj))) + (elm-set! result 'index parsed-encoding) + ; (elm-set! result 'index (hw-index-derived)) ; A temporary dummy + (logit 1 "new derived-operand; name=" name " hw-name= " (op:hw-name result) + " index=" (obj:name parsed-encoding) "\n") + (derived-ifield-set-owner! parsed-encoding result) + result)) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read a derived operand description. +; This is the main routine for analyzing derived operands in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -derived-operand-parse is invoked to create the <derived-operand> object. + +(define (-derived-operand-read errtxt . arg-list) + (let (; Current derived-operand elements: + (name nil) + (comment nil) + (attrs nil) + (mode 'DFLT) ; use default mode of TYPE + (args nil) + (syntax nil) + (base-ifield nil) + (encoding nil) + (ifield-assertion nil) + (getter nil) + (setter nil) + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mode) (set! mode (cadr arg))) + ((args) (set! args (cadr arg))) + ((syntax) (set! syntax (cadr arg))) + ((base-ifield) (set! base-ifield (cadr arg))) + ((encoding) (set! encoding (cadr arg))) + ((ifield-assertion) (set! ifield-assertion (cadr arg))) + ((getter) (set! getter (cadr arg))) + ((setter) (set! setter (cadr arg))) + (else (parse-error errtxt "invalid derived-operand arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-derived-operand-parse errtxt name comment attrs mode args + syntax base-ifield encoding ifield-assertion + getter setter) + ) +) + +; Define a derived operand object, name/value pair list version. + +(define define-derived-operand + (lambda arg-list + (let ((op (apply -derived-operand-read + (cons "define-derived-operand" arg-list)))) + (if op + (current-op-add! op)) + op)) +) + +; Define a derived operand object, all arguments specified. +; ??? Not supported (yet). +; +;(define (define-full-derived-operand name comment attrs mode ...) +; (let ((op (-derived-operand-parse "define-full-derived-operand" +; name comment attrs +; mode ...))) +; (if op +; (current-op-add! op)) +; op) +;) + +; Parse an "anyof" choice, which is a derived-operand name. +; The result is {choice} unchanged. + +(define (-anyof-parse-choice context choice) + (if (not (symbol? choice)) + (context-error context "anyof choice not a symbol" choice)) + (let ((op (current-op-lookup choice))) + (if (not (derived-operand? op)) + (context-error context "anyof choice not a derived-operand" choice)) + op) +) + +; Parse an "anyof" derived operand. +; This is the main routine for building a derived operand object from a +; description in the .cpu file. +; All arguments are in raw (non-evaluated) form. +; The result is the parsed object or #f if object isn't for selected mach(s). +; +; ??? Currently no support for handlers(,???) found in normal operands. +; Later, when necessary. + +(define (-anyof-operand-parse errtxt name comment attrs mode + base-ifield choices) + (logit 2 "Processing anyof operand " name " ...\n") + + (let ((name (parse-name name errtxt)) + (atlist-obj (atlist-parse attrs "cgen_operand" errtxt))) + + (if (keep-atlist? atlist-obj #f) + + (let ((mode-obj (parse-mode-name mode errtxt)) + ; FIXME: quick hack + (context (context-make-reader errtxt))) + (if (not mode-obj) + (parse-error errtxt "unknown mode" mode)) + + (make <anyof-operand> + name + (parse-comment comment errtxt) + atlist-obj + mode + base-ifield + (map (lambda (c) + (-anyof-parse-choice context c)) + choices))) + + (begin + (logit 2 "Ignoring " name ".\n") + #f))) +) + +; Read an anyof operand description. +; This is the main routine for analyzing anyof operands in the .cpu file. +; ERRTXT is prepended to error messages to provide context. +; ARG-LIST is an associative list of field name and field value. +; -anyof-operand-parse is invoked to create the <anyof-operand> object. + +(define (-anyof-operand-read errtxt . arg-list) + (let (; Current operand elements: + (name nil) + (comment nil) + (attrs nil) + (mode 'DFLT) ; use default mode of TYPE + (base-ifield nil) + (choices nil) + ) + (let loop ((arg-list arg-list)) + (if (null? arg-list) + nil + (let ((arg (car arg-list)) + (elm-name (caar arg-list))) + (case elm-name + ((name) (set! name (cadr arg))) + ((comment) (set! comment (cadr arg))) + ((attrs) (set! attrs (cdr arg))) + ((mode) (set! mode (cadr arg))) + ((base-ifield) (set! base-ifield (cadr arg))) + ((choices) (set! choices (cdr arg))) + (else (parse-error errtxt "invalid anyof-operand arg" arg))) + (loop (cdr arg-list))))) + ; Now that we've identified the elements, build the object. + (-anyof-operand-parse errtxt name comment attrs mode base-ifield choices) + ) +) + +; Define an anyof operand object, name/value pair list version. + +(define define-anyof-operand + (lambda arg-list + (let ((op (apply -anyof-operand-read + (cons "define-anyof-operand" arg-list)))) + (if op + (current-op-add! op)) + op)) +) + +; Utilities to flatten out the <anyof-operand> derivation heirarchy. + +; Utility class used when instantiating insns with derived operands. +; This collects together in one place all the appropriate data of an +; instantiated "anyof" operand. + +(define <anyof-instance> + (class-make '<anyof-instance> + '(<derived-operand>) + '( + ; <anyof-operand> object we were instantiated from. + parent + ) + nil) +) + +(method-make-make! <anyof-instance> + '(name comment attrs mode + args syntax base-ifield encoding ifield-assertion + getter setter parent) +) + +(define-getters <anyof-instance> anyof-instance (parent)) + +(define (anyof-instance? x) (class-instance? <anyof-instance> x)) + +; Return initial list of known ifield values in {anyof-instance}. + +(define (-anyof-initial-known anyof-instance) + (assert (derived-operand? anyof-instance)) + (let ((encoding (derived-encoding anyof-instance))) + (assert (derived-ifield? encoding)) + (ifld-known-values (derived-ifield-subfields encoding))) +) + +; Return true if {anyof-instance} satisfies its ifield assertions. +; {known-values} is the {known} argument to rtx-solve. + +(define (anyof-satisfies-assertions? anyof-instance known-values) + (assert (derived-operand? anyof-instance)) + (let ((assertion (derived-ifield-assertion anyof-instance))) + (if assertion + (rtx-solve #f ; FIXME: context + anyof-instance ; owner + assertion + known-values) + #t)) +) + +; Subroutine of -anyof-merge-subchoices. +; Merge syntaxes of VALUE-NAMES/VALUES into SYNTAX. +; +; Example: +; If SYNTAX is "$a+$b", and VALUE-NAMES is (b), and VALUES is +; ("$c+$d"-object), then return "$a+$c+$d". + +(define (-anyof-syntax anyof-instance) + (elm-get anyof-instance 'syntax) +) + +(define (-anyof-name anyof-instance) + (elm-get anyof-instance 'name) +) + + +(define (-anyof-merge-syntax syntax value-names values) + (let ((syntax-elements (syntax-break-out syntax))) + (syntax-make (map (lambda (e) + (if (anyof-operand? e) + (let* ((name (obj:name e)) + (indx (element-lookup-index name value-names 0))) + (assert indx) + (-anyof-syntax (list-ref values indx))) + e)) + syntax-elements))) +) + +; Subroutine of -anyof-merge-subchoices. +; Merge syntaxes of {value-names}/{values} into <derived-ifield> {encoding}. +; The result is a new <derived-ifield> object with subfields matching +; {value-names} replaced with {values}. +; {container} is the containing <anyof-operand>. +; +; Example: +; If {encoding} is (a-ifield-object b-anyof-ifield-object), and {value-names} +; is (b), and {values} is (c-choice-of-b-object), then return +; (a-ifield-object c-choice-of-b-ifield-object). + +(define (-anyof-merge-encoding container encoding value-names values) + (assert (derived-ifield? encoding)) + (let ((subfields (derived-ifield-subfields encoding)) + (result (object-copy-top encoding))) + ; Delete all the elements that are being replaced with ifields from + ; {values} and add the new ifields. + (derived-ifield-set-subfields! result + (append + (find (lambda (f) + (not (memq (obj:name f) value-names))) + subfields) + (map derived-encoding values))) + result) +) + +; Subroutine of -anyof-merge-subchoices. +; Merge semantics of VALUE-NAMES/VALUES into GETTER. +; +; Example: +; If GETTER is (mem QI foo), and VALUE-NAMES is (foo), and VALUES is +; ((add a b)-object), then return (mem QI (add a b)). + +(define (-anyof-merge-getter getter value-names values) + ;(debug-repl-env getter value-names values) + ; ??? This implementation is a quick hack, intended to evolve or be replaced. + (cond ((not getter) + #f) + (else + (map (lambda (e) + (cond ((symbol? e) + (let ((indx (element-lookup-index e value-names 0))) + (if indx + (op:getter (list-ref values indx)) + e))) + ((pair? e) ; pair? -> cheap non-null-list? + (-anyof-merge-getter e value-names values)) + (else + e))) + getter))) +) + +; Subroutine of -anyof-merge-subchoices. +; Merge semantics of VALUE-NAMES/VALUES into SETTER. +; +; Example: +; If SETTER is (set (mem QI foo) newval), and VALUE-NAMES is (foo), +; and VALUES is ((add a b)-object), then return +; (set (mem QI (add a b)) newval). +; +; ??? `newval' in this context is a reserved word. + +(define (-anyof-merge-setter setter value-names values) + ;(debug-repl-env setter value-names values) + ; ??? This implementation is a quick hack, intended to evolve or be replaced. + (cond ((not setter) + #f) + ((rtx-single-set? setter) + (let ((src (rtx-set-src setter)) + (dest (rtx-set-dest setter)) + (mode (rtx-mode setter)) + (options (rtx-options setter))) + (if (rtx-kind 'mem dest) + (set! dest + (rtx-change-address dest + (-anyof-merge-getter + (rtx-mem-addr dest) + value-names values)))) + (set! src (-anyof-merge-getter src value-names values)) + (rtx-make 'set options mode dest src))) + (else + (error "-anyof-merge-setter: unsupported form" (car setter)))) +) + +; Subroutine of -sub-insn-make!. +; Merge semantics of VALUE-NAMES/VALUES into SEMANTICS. +; Defined here and not in insn.scm to keep it with the getter/setter mergers. +; +; Example: +; If SEMANTICS is (mem QI foo), and VALUE-NAMES is (foo), and VALUES is +; ((add a b)-object), then return (mem QI (add a b)). + +(define (anyof-merge-semantics semantics value-names values) + ;(debug-repl-env semantics value-names values) + ; ??? This implementation is a quick hack, intended to evolve or be replaced. + (let ((result + (cond ((not semantics) + #f) + (else + (map (lambda (e) + (cond ((symbol? e) + (let ((indx (element-lookup-index e value-names 0))) + (if indx + (-anyof-name (list-ref values indx)) + ; (op:sem-name (list-ref values indx)) + e))) + ((pair? e) ; pair? -> cheap non-null-list? + (anyof-merge-semantics e value-names values)) + (else + e))) + semantics))))) + (logit 4 "Merged semantics [" semantics "] -> [" result "]\n") + result) +) + +; Subroutine of -anyof-merge-subchoices. +; Merge assertion of VALUE-NAMES/VALUES into ASSERTION. +; +; Example: +; If ASSERTION is (ne f-base-reg 5), and VALUE-NAMES is +; (foo), and VALUES is ((ne f-mod 0)), then return +; (andif (ne f-base-reg 5) (ne f-mod 0)). +; +; FIXME: Perform simplification pass, based on combined set of known +; ifield values. + +(define (-anyof-merge-ifield-assertion assertion value-names values) + (let ((assertions (find identity + (cons assertion + (map derived-ifield-assertion values))))) + (if (null? assertions) + #f + (rtx-combine 'andif assertions))) +) + +; Subroutine of -anyof-all-subchoices. +; Return a copy of <derived-operand> CHOICE with NEW-ARGS from ANYOF-ARGS +; merged in. This is for when a derived operand is itself composed of +; anyof operands. +; ANYOF-ARGS is a list of <anyof-operand>'s to be replaced in CHOICE. +; NEW-ARGS is a corresponding list of values (<derived-operands>'s) of each +; element in ANYOF-ARGS. +; CONTAINER is the <anyof-operand> containing CHOICE. + +(define (-anyof-merge-subchoices container choice anyof-args new-args) + (assert (all-true? (map anyof-operand? anyof-args))) + (assert (all-true? (map derived-operand? new-args))) + + (let* ((arg-names (map obj:name anyof-args)) + (encoding (-anyof-merge-encoding container (derived-encoding choice) + arg-names new-args)) + (result + (make <anyof-instance> + (apply symbol-append + (cons (obj:name choice) + (map (lambda (anyof) + (symbol-append '- (obj:name anyof))) + new-args))) + (obj:comment choice) + (obj-atlist choice) + (op:mode choice) + (derived-args choice) + (-anyof-merge-syntax (derived-syntax choice) + arg-names new-args) + (derived-base-ifield choice) + encoding + (-anyof-merge-ifield-assertion (derived-ifield-assertion choice) + anyof-args new-args) + (-anyof-merge-getter (op:getter choice) + arg-names new-args) + (-anyof-merge-setter (op:setter choice) + arg-names new-args) + container))) + ; + (elm-set! result 'index encoding) + ; Creating the link from {encoding} to {result}. + (derived-ifield-set-owner! encoding result) + result) +) + +; Subroutine of -anyof-all-choices-1. +; Return a list of all possible subchoices of <derived-operand> ANYOF-CHOICE, +; known to use <anyof-operand>'s itself. +; CONTAINER is the containing <anyof-operand>. + +(define (-anyof-all-subchoices container anyof-choice) + ; Split args into anyof and non-anyof elements. + (let* ((args (derived-args anyof-choice)) + (anyof-args (find anyof-operand? args))) + + (assert (not (null? anyof-args))) + + ; Iterate over all combinations. + ; {todo} is a list with one element for each anyof argument. + ; Each element is in turn a list of all <derived-operand> choices for the + ; <anyof-operand>. The result we want is every possible combination. + ; Example: + ; If {todo} is ((1 2 3) (a) (B C)) the result we want is + ; ((1 a B) (1 a C) (2 a B) (2 a C) (3 a B) (3 a C)). + ; + ; Note that some of these values may be derived from nested + ; <anyof-operand>'s which is why we recursively call -anyof-all-choices-1. + ; ??? -anyof-all-choices-1 should cache the results. + + (let* ((todo (map -anyof-all-choices-1 anyof-args)) + (lengths (map length todo)) + (total (apply * lengths)) + (result nil)) + + ; ??? One might prefer a `do' loop here, but every time I see one I + ; have to spend too long remembering its syntax. + (let loop ((i 0)) + (if (< i total) + (let* ((indices (split-value lengths i)) + (new-args (map list-ref todo indices))) + ;(display "new-args: " (current-error-port)) + ;(display (map obj:name new-args) (current-error-port)) + ;(newline (current-error-port)) + (set! result + (cons (-anyof-merge-subchoices container + anyof-choice + anyof-args + new-args) + result)) + (loop (+ i 1))))) + + result)) +) + +; Return an <anyof-instance> object from <derived-operand> {derop}, which is a +; choice of {anyof-operand}. + +(define (-anyof-instance-from-derived anyof-operand derop) + (let* ((encoding (object-copy-top (derived-encoding derop))) + (result + (make <anyof-instance> + (obj:name derop) + (obj:comment derop) + (obj-atlist derop) + (op:mode derop) + (derived-args derop) + (derived-syntax derop) + (derived-base-ifield derop) + encoding + (derived-ifield-assertion derop) + (op:getter derop) + (op:setter derop) + anyof-operand))) + ; Creating the link from {encoding} to {result}. + (derived-ifield-set-owner! encoding result) + result) +) + +; Return list of <anyof-instance> objects, one for each possible variant of +; ANYOF-OPERAND. +; +; One could move this up into the cpu description file using pmacros. +; However, that's not the right way to go. How we currently implement +; the notion of derived operands is separate from the notion of having them +; in the description language. pmacros are not "in" the language (to the +; extent that the cpu description file reader "sees" them), they live +; above it. And the right way to do this is with something "in" the language. +; Derived operands are the first cut at it. They'll evolve or be replaced +; (and it's the implementation of them that will evolve first). + +(define (-anyof-all-choices-1 anyof-operand) + (assert (anyof-operand? anyof-operand)) + + (let ((result nil)) + + ; For each choice, scan the operands for further derived operands. + ; If found, replace the choice with the list of its subchoices. + ; If not found, create an <anyof-instance> object for it. This is basically + ; just a copy of the object, but {anyof-operand} is recorded with it so + ; that we can later resolve `follows' specs. + + (let loop ((choices (anyof-choices anyof-operand))) + (if (not (null? choices)) + (let* ((this (car choices)) + (args (derived-args this))) + + (if (any-true? (map anyof-operand? args)) + + ; This operand has "anyof" operands so we need to turn this + ; choice into a list of all possible subchoices. + (let ((subchoices (-anyof-all-subchoices anyof-operand this))) + (set! result + (append subchoices result))) + + ; No <anyof-operand> arguments. + (set! result + (cons (-anyof-instance-from-derived anyof-operand this) + result))) + + (loop (cdr choices))))) + + (assert (all-true? (map anyof-instance? result))) + result) +) + +; Cover fn of -anyof-all-choices-1. +; Return list of <anyof-instance> objects, one for each possible variant of +; ANYOF-OPERAND. +; We want to delete choices that fail their ifield assertions, but since +; -anyof-all-choices-1 can recursively call itself, assertion checking is +; defered until it returns. + +(define (anyof-all-choices anyof-operand) + (let ((all-choices (-anyof-all-choices-1 anyof-operand))) + + ; Delete ones that fail their ifield assertions. + ; Sometimes there isn't enough information yet to completely do this. + ; When that happens it is the caller's responsibility to deal with it. + ; However, it is our responsibility to assert as much as we can. + (find (lambda (op) + (anyof-satisfies-assertions? op + (-anyof-initial-known op))) + all-choices)) +) + +; Operand utilities. + +; Look up operand NAME in the operand table. +; This proc isolates the strategy we use to record operand objects. + +; Look up an operand via SEM-NAME. + +(define (op:lookup-sem-name op-list sem-name) + (let loop ((op-list op-list)) + (cond ((null? op-list) #f) + ((eq? sem-name (op:sem-name (car op-list))) (car op-list)) + (else (loop (cdr op-list))))) +) + +; Given an operand, return the starting bit number. +; Note that the field isn't necessarily contiguous. + +(define (op:start operand) (send operand 'field-start #f)) + +; Given an operand, return the total length in bits. +; Note that the field isn't necessarily contiguous. + +(define (op:length operand) (send operand 'field-length)) + +; Return the nub of a list of operands, base on their names. + +(define (op-nub op-list) + (nub op-list obj:name) +) + +; Return a sorted list of operand lists. +; Each element in the inner list is an operand with the same name, but for +; whatever reason were defined separately. +; The outer list is sorted by name. + +(define (op-sort op-list) + ; We assume there is at least one operand. + (if (null? op-list) + (error "op-sort: no operands!")) + ; First sort by name. + (let ((sorted-ops (sort op-list + (lambda (a b) + (string<? (obj:name a) (obj:name b))))) + ) + (let loop ((result nil) + ; Current set of operands with same name. + (this-elm (list (car sorted-ops))) + (ops (cdr sorted-ops)) + ) + (if (null? ops) + ; Reverse things to keep them in file order (minimizes random + ; changes in generated files). + (reverse! (cons (reverse! this-elm) result)) + ; Not done. Check for new set. + (if (eq? (obj:name (car ops)) (obj:name (car this-elm))) + (loop result (cons (car ops) this-elm) (cdr ops)) + (loop (cons (reverse! this-elm) result) (list (car ops)) + (cdr ops)))))) +) + +; FIXME: Not used anymore but leave in for now. +; Objects used in assembler syntax ($0, $1, ...). +; +;(define <syntax-operand> +; (class-make '<syntax-operand> nil '(number value) nil)) +;(method-make-make! <syntax-operand> '(number)) +; +;(define $0 (make <syntax-operand> 0)) +;(define $1 (make <syntax-operand> 1)) +;(define $2 (make <syntax-operand> 2)) +;(define $3 (make <syntax-operand> 3)) + +; Called before/after loading the .cpu file to initialize/finalize. + +; Builtins. +; The pc operand used in rtl expressions. +(define pc nil) + +; Called before reading a .cpu file in. + +(define (operand-init!) + (reader-add-command! 'define-operand + "\ +Define an operand, name/value pair list version. +" + nil 'arg-list define-operand) + (reader-add-command! 'define-full-operand + "\ +Define an operand, all arguments specified. +" + nil '(name comment attrs hw-type mode hw-index handlers getter setter) + define-full-operand) + + (reader-add-command! 'define-derived-operand + "\ +Define a derived operand, name/value pair list version. +" + nil 'arg-list define-derived-operand) + + (reader-add-command! 'define-anyof-operand + "\ +Define an anyof operand, name/value pair list version. +" + nil 'arg-list define-anyof-operand) + + *UNSPECIFIED* +) + +; Install builtin operands. + +(define (operand-builtin!) + ; Standard operand attributes. + ; ??? Some of these can be combined into one. + + (define-attr '(for operand) '(type boolean) '(name NEGATIVE) + '(comment "value is negative")) + (define-attr '(for operand) '(type boolean) '(name RELAX) + '(comment "operand is relaxable")) + + ; ??? Might be able to make SEM-ONLY go away (or machine compute it) + ; by scanning which operands are refered to by the insn syntax strings. + (define-attr '(for operand) '(type boolean) '(name SEM-ONLY) + '(comment "operand is for semantic use only")) + + ; Also (defined elsewhere): PCREL-ADDR ABS-ADDR. + + (set! pc (make <pc>)) + (current-op-add! pc) + + *UNSPECIFIED* +) + +; Called after a .cpu file has been read in. + +(define (operand-finish!) + *UNSPECIFIED* +) diff --git a/cgen/pgmr-tools.scm b/cgen/pgmr-tools.scm new file mode 100644 index 00000000000..c945aea7577 --- /dev/null +++ b/cgen/pgmr-tools.scm @@ -0,0 +1,183 @@ +; Programmer development tools. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; This file contains a collection of programmer debugging tools. +; They're mainly intended for using cgen to debug other things, +; but any kind of debugging tool can go here. +; All routines require the application independent part of cgen to be loaded +; and the .cpu file to be loaded. They do not require any particular +; application though (opcodes, simulator, etc.). If they do, that's a bug. +; It may be that the appication has a generally useful routine that should +; live elsewhere, but that's it. +; +; These tools don't have to be particularily efficient (within reason). +; It's more important that they be simple and clear. +; +; Some tools require ifmt-compute! to be run. +; They will run it if necessary. +; +; Table of contents: +; +; pgmr-pretty-print-insn-format +; cgen debugging tool, pretty prints the iformat of an <insn> object +; +; pgmr-pretty-print-insn-value +; break out an instruction's value into its component fields +; +; pgmr-lookup-insn +; given a random bit pattern for an instruction, lookup the insn and return +; its <insn> object + +; Pretty print the instruction's opcode value, for debugging. +; INSN is an <insn> object. + +(define (pgmr-pretty-print-insn-format insn) + + (define (to-width width n-str) + (string-take-with-filler (- width) + n-str + #\0)) + + (define (dump-insn-mask mask insn-length) + (string-append "0x" (to-width (quotient insn-length 4) + (number->string mask 16)) + ", " + (string-map + (lambda (n) + (string-append " " (to-width 4 (number->string n 2)))) + (reverse + (split-bits (make-list (quotient insn-length 4) 4) + mask))))) + + ; Print VALUE with digits not in MASK printed as "X". + (define (dump-insn-value value mask insn-length) + (string-append "0x" (to-width (quotient insn-length 4) + (number->string value 16)) + ", " + (string-map + (lambda (n mask) + (string-append + " " + (list->string + (map (lambda (char in-mask?) + (if in-mask? char #\X)) + (string->list (to-width 4 (number->string n 2))) + (bits->bools mask 4))))) + (reverse + (split-bits (make-list (quotient insn-length 4) 4) + value)) + (reverse + (split-bits (make-list (quotient insn-length 4) 4) + mask))))) + + (define (dump-ifield f) + (string-append " Name: " + (obj:name f) + ", " + "Start: " + (number->string + (+ (bitrange-word-offset (-ifld-bitrange f)) + (bitrange-start (-ifld-bitrange f)))) + ", " + "Length: " + (number->string (ifld-length f)) + "\n")) + + (let* ((iflds (sort-ifield-list (insn-iflds insn) + (not (current-arch-insn-lsb0?)))) + (mask (compute-insn-base-mask iflds)) + (mask-length (compute-insn-base-mask-length iflds))) + + (display + (string-append + "Instruction: " (obj:name insn) + "\n" + "Syntax: " + (insn-syntax insn) + "\n" + "Fields:\n" + (string-map dump-ifield iflds) + "Instruction length (computed from ifield list): " + (number->string (apply + (map ifld-length iflds))) + "\n" + "Mask: " + (dump-insn-mask mask mask-length) + "\n" + "Value: " + (let ((value (apply + + (map (lambda (fld) + (ifld-value fld mask-length + (ifld-get-value fld))) + (find ifld-constant? (collect ifld-base-ifields (insn-iflds insn))))))) + (dump-insn-value value mask mask-length)) + ; TODO: Print value spaced according to fields. + "\n" + ))) +) + +; Pretty print an instruction's value. + +(define (pgmr-pretty-print-insn-value insn value) + (define (dump-ifield ifld value name-width) + (string-append + (string-take name-width (obj:name ifld)) + ": " + (number->string value) + ", 0x" + (number->hex value) + "\n")) + + (let ((ifld-values (map (lambda (ifld) + (ifld-extract ifld insn value)) + (insn-iflds insn))) + (max-name-length (apply max + (map string-length + (map obj:name + (insn-iflds insn))))) + ) + + (display + (string-append + "Instruction: " (obj:name insn) + "\n" + "Fields:\n" + (string-map (lambda (ifld value) + (dump-ifield ifld value max-name-length)) + (insn-iflds insn) + ifld-values) + ))) +) + +; Return the <insn> object matching VALUE. +; VALUE is either a single number of size base-insn-bitsize, +; or a list of numbers for variable length ISAs. +; LENGTH is the total length of VALUE in bits. + +(define (pgmr-lookup-insn length value) + (arch-analyze-insns! CURRENT-ARCH + #t ; include aliases + #f) ; don't need to analyze semantics + + ; Return a boolean indicating if BASE matches the base part of <insn> INSN. + (define (match-base base insn) + (let ((mask (compute-insn-base-mask (insn-iflds insn))) + (ivalue (insn-value insn))) + ; return (value & mask) == ivalue + (= (logand base mask) ivalue))) + + (define (match-rest value insn) + #t) + + (let ((base (if (list? value) (car value) value))) + (let loop ((insns (current-insn-list))) + (if (null? insns) + #f + (let ((insn (car insns))) + (if (and (= length (insn-length insn)) + (match-base base insn) + (match-rest value insn)) + insn + (loop (cdr insns))))))) +) diff --git a/cgen/play.cpu b/cgen/play.cpu new file mode 100644 index 00000000000..3ef3775f22a --- /dev/null +++ b/cgen/play.cpu @@ -0,0 +1,265 @@ +; cpu description for debugging and experimental purposes. -*- Scheme -*- +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; Copyright (C) 2000 Red Hat, Inc. +; +; This file is for experimental purposes. Don't expect it to be correct +; or up to date. + +(include "simplify.inc") + +(define-arch + (name play) ; name of cpu + (comment "experimental .cpu file") + (insn-lsb0? #f) + (machs playb) + (isas play) +) + +(define-isa + (name play) + (base-insn-bitsize 16) + (decode-assist (0 1 2 3)) +) + +(define-cpu + (name cpuf) + (comment "experimental cpu family") + (endian little) + (word-bitsize 32) +) + +(define-mach + (name playb) + (comment "experimental mach") + (cpu cpuf) +) + +(define-model + (name test) (comment "test") (attrs) + (mach playb) + ;(pipeline all "" () ((fetch) (decode) (execute) (writeback))) + (unit u-exec "Execution Unit" () 1 1 + () () () ()) +) + +; Instruction fields. + +(dnf f-op1 "op1" () 0 4) +(dnf f-op2 "op2" () 4 4) +(dnf f-op3 "op3" () 8 4) +(dnf f-op4 "op4" () 12 4) +(dnf f-r1 "r1" () 8 4) +(dnf f-r2 "r2" () 12 4) +(df f-simm16 "simm16" () 16 16 INT #f #f) + +(define-normal-insn-enum insn-op1 "insn format enums" () OP1_ f-op1 + (.map .str (.iota 16)) +) + +(define-normal-insn-enum insn-op2 "insn format enums (2)" () OP2_ f-op2 + (.map .str (.iota 16)) +) + +(define-normal-insn-enum insn-op3 "insn format enums (3)" () OP3_ f-op3 + (.map .str (.iota 16)) +) + +(define-normal-insn-enum insn-op4 "insn format enums (4)" () OP4_ f-op4 + (.map .str (.iota 16)) +) + +; Hardware. + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-hardware + (name h-gr) + (comment "general registers") + (attrs PROFILE );CACHE-ADDR) + (type register WI (16)) + (indices keyword "" + ( (fp 13) (lr 14) (sp 15) + (r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7) + (r8 8) (r9 9) (r10 10) (r11 11) (r12 12) (r13 13) (r14 14) (r15 15) + )) +) + +(define-hardware + (name h-status) + (comment "status reg") + (type register SI) + (get () (const 0)) + (set (newval) (nop)) +) + +; These bits are actualy part of the PS register +(dsh h-nbit "negative bit" () (register BI)) +(dsh h-zbit "zero bit" () (register BI)) +(dsh h-vbit "overflow bit" () (register BI)) +(dsh h-cbit "carry bit" () (register BI)) + +(dsh h-df "df test" () (register DF)) +(dsh h-tf "tf test" () (register TF)) + +; Operand attributes. + +(define-attr + (for operand) + (type boolean) + (name HASH-PREFIX) + (comment "immediates have a '#' prefix") +) + +; Operands. + +(dnop nbit "negative bit" (SEM-ONLY) h-nbit f-nil) +(dnop vbit "overflow bit" (SEM-ONLY) h-vbit f-nil) +(dnop zbit "zero bit" (SEM-ONLY) h-zbit f-nil) +(dnop cbit "carry bit" (SEM-ONLY) h-cbit f-nil) + +(dnop dr "destination register" () h-gr f-r1) +(dnop sr "source register" () h-gr f-r2) +(dnop simm-16 "16 bit signed immediate" (HASH-PREFIX) h-sint f-simm16) + +; Note that `df' doesn't work as that is a pmacro. +(dnop df-reg "df reg" () h-df f-nil) +(dnop tf-reg "tf reg" () h-tf f-nil) + +; Instructions. + +(dni add "add" + () + "add $dr,$sr" + (+ OP1_4 OP2_0 dr sr) + (sequence () + (set vbit (add-oflag dr sr (const 0))) + (set cbit (add-cflag dr sr (const 0))) + (set dr (add dr sr)) + (set zbit (zflag dr)) + (set nbit (nflag dr))) + () +) + +(dni addv2 "add version 2" + () + "add $dr,$sr" + (+ OP1_4 OP2_1 dr sr) + (sequence ((WI tmp1)) + (parallel () + (set tmp1 (add dr sr)) + (set vbit (add-oflag dr sr (const 0))) + (set cbit (add-cflag dr sr (const 0)))) + (set zbit (zflag tmp1)) + (set nbit (nflag tmp1)) + (set dr tmp1) + ) + () +) + +(dni addi "addi" + () + "addi $dr,$sr,$simm-16" + (+ OP1_4 OP2_2 dr sr simm-16) + (set dr (add sr simm-16)) + () +) + +(define-pmacro (reg+ oprnd n) + (reg h-gr (add (index-of oprnd) (const n))) +) + +(dni ldm "ldm" + () + "ldm $dr,$sr" + (+ OP1_5 OP2_2 dr sr) + (sequence () + (set dr sr) + (set (reg+ dr 1) (reg+ sr 1)) + ) + () +) + +(dni use-ifield "use-ifield" + () + "foo $dr,$sr" + (+ OP1_5 OP2_3 dr sr) + (sequence () + (set dr (ifield f-r2)) + ) + () +) + +(dni use-index-of "index-of" + () + "index-of $dr,$sr" + (+ OP1_5 OP2_4 dr sr) + (set dr (reg h-gr (add (index-of sr) (const 1)))) + () +) + +(dni load-df "use df" + () + "load-df df,[$sr]" + (+ OP1_6 OP2_0 OP3_0 sr) + (set df-reg (mem DF sr)) + () +) + +(dni make-df "use df" + () + "make-df df,[$sr]" + (+ OP1_6 OP2_1 OP3_0 sr) + (set df-reg (join DF SI (mem SI sr) (mem SI (add sr (const 4))))) + () +) + +(dni split-df "use df" + () + "split-df df,[$sr]" + (+ OP1_6 OP2_2 OP3_0 sr) + (sequence ((DF temp)) + (set temp df-reg) + (set (concat (SI SI) + sr + (reg h-gr (add (regno sr) (const 1)))) + (split DF SI temp)) + ) + () +) + +(dni load-tf "use tf" + () + "load-tf tf,[$sr]" + (+ OP1_6 OP2_3 OP3_0 sr) + (set tf-reg (mem TF sr)) + () +) + +(dni make-tf "use tf" + () + "make-tf tf,[$sr]" + (+ OP1_6 OP2_4 OP3_0 sr) + (set tf-reg (join TF SI + sr + (reg h-gr (add (regno sr) (const 1))) + (reg h-gr (add (regno sr) (const 2))) + (reg h-gr (add (regno sr) (const 3))))) + () +) + +(dni split-tf "use tf" + () + "split-tf tf,[$sr]" + (+ OP1_6 OP2_5 OP3_0 sr) + (sequence ((TF temp)) + (set temp tf-reg) + (set (concat (SI SI SI SI) + sr + (reg h-gr (add (regno sr) (const 1))) + (reg h-gr (add (regno sr) (const 2))) + (reg h-gr (add (regno sr) (const 3)))) + (split TF SI temp)) + ) + () +) diff --git a/cgen/pmacros.scm b/cgen/pmacros.scm new file mode 100644 index 00000000000..67e84806d2f --- /dev/null +++ b/cgen/pmacros.scm @@ -0,0 +1,562 @@ +; Preprocessor-like macro support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; TODO: +; - Like C preprocessor macros, there is no scoping [one can argue +; there should be]. Maybe in time (??? Hmmm... done?) +; On the other hand these macros aren't intended for use outside +; the cpu description file. +; - Support for multiple macro tables. +; - Comments for .pmacros. + +; Required routines: +; make-hash-table, hashq-ref, hashq-set! +; string-append, symbol-append, map, apply, number?, number->string, +; eval, num-args-ok?, *UNSPECIFIED*. +; `num-args-ok?' and `*UNSPECIFIED*' are defined in cgen's utils.scm. + +; The convention we use says `-' begins "local" objects. +; At some point this might also use the Guile module system. + +; Exported routines: +; +; pmacro-init! - initialize the pmacro system +; +; define-pmacro - define a symbolic or procedural macro +; +; (define-pmacro symbol "comment" expansion) +; (define-pmacro (symbol [args]) "comment" (expansion)) +; +; ARGS is a list of `symbol' or `(symbol default-value)' elements. +; +; pmacro-expand - expand all macros in an expression +; +; (pmacro-expand expression) +; +; pmacro-trace - same as pmacro-expand, but print debugging messages +; +; (pmacro-trace expression) + +; Builtin macros: +; +; (.sym symbol1 symbol2 ...) - symbol-append +; (.str string1 string2 ...) - string-append +; (.hex number) - convert to hex string +; (.upcase string) - convert to uppercase +; (.downcase string) - convert to lowercase +; (.substring string start end) - get part of a string +; (.splice a b (.unsplice c) d e ...) - quasi-quote/unquote-splicing +; (.iota count [start [increment]]) - number generator +; (.map macro-name arg1 ...) - map +; (.apply macro-name arg) - apply +; (.pmacro (arg-list) expansion) - lambda (??? call it .lambda?) +; (.eval (expr)) - eval (experimental) +; +; .sym and .str convert numbers to symbols/strings as necessary (base 10). +; +; .pmacro is for constructing pmacros on-the-fly, like lambda, and is currently +; only valid as arguments to other macros. +; ??? Nested pmacros don't bind their arguments the way nested lambda's do. +; Should they? +; +; .eval is an experiment. Ports that consider themselves to be of beta +; quality or better don't use it. +; +; ??? Methinks .foo isn't a valid R5RS symbol. May need to change +; to something else. Where's Quad when you need it?! :-) + +(define -pmacro-trace? #f) + +(define -pmacro-table #f) +(define (-pmacro-lookup name) (hashq-ref -pmacro-table name)) +(define (-pmacro-set! name val) (hashq-set! -pmacro-table name val)) + +; Marker to indicate a value is a pmacro. +(define -pmacro-marker '<pmacro>) + +; Utilities to create and access pmacros. +(define (-pmacro-make name arg-spec default-values transformer comment) + (vector -pmacro-marker name arg-spec default-values transformer comment) +) +(define (-pmacro? x) (and (vector? x) (eq? (vector-ref x 0) -pmacro-marker))) +(define (-pmacro-name pmac) (vector-ref pmac 1)) +(define (-pmacro-arg-spec pmac) (vector-ref pmac 2)) +(define (-pmacro-default-values pmac) (vector-ref pmac 3)) +(define (-pmacro-transformer pmac) (vector-ref pmac 4)) +(define (-pmacro-comment pmac) (vector-ref pmac 5)) + +; Cover functions to manage an "environment" in case a need or desire for +; another method arises. + +(define (-pmacro-env-make names values) (map cons names values)) +(define (-pmacro-env-ref env name) (assq name env)) + +; Error message generator. + +(define (-pmacro-error msg expr) + (error (string-append + (or (port-filename (current-input-port)) "<input>") + ":" + (number->string (port-line (current-input-port))) + ":" + msg + ":") + expr) +) + +; Process list of keyword/value specified arguments. + +(define (-pmacro-process-keyworded-args arg-spec default-values args) + ; Build a list of default values, then override ones specified in ARGS, + (let ((result-alist (alist-copy default-values))) + (let loop ((args args)) + (cond ((null? args) + #f) ; done + ((and (pair? args) (keyword? (car args))) + (let ((elm (assq (car args) result-alist))) + (if (not elm) + (-pmacro-error "not an argument name" (car args))) + (if (null? (cdr args)) + (-pmacro-error "missing argument to #:keyword" (car args))) + (set-cdr! elm (cadr args)) + (loop (cddr args)))) + (else + (-pmacro-error "bad keyword/value argument list" args)))) + + ; Ensure each element has a value. + (let loop ((to-scan result-alist)) + (if (null? to-scan) + #f ; done + (begin + (if (not (cdar to-scan)) + (-pmacro-error "argument value not specified" (caar to-scan))) + (loop (cdr to-scan))))) + + ; If varargs pmacro, adjust result. + (if (list? arg-spec) + (map cdr result-alist) ; not varargs + (let ((nr-args (length (result-alist)))) + (append! (map cdr (list-head result-alist (- nr-args 1))) + (cdr (list-tail result-alist (- nr-args 1))))))) +) + +; Process a pmacro argument list. +; ARGS is either a fully specified position dependent argument list, +; or is a list of keyword/value pairs with missing values coming from +; DEFAULT-VALUES. + +(define (-pmacro-process-args arg-spec default-values args) + (if (and (pair? args) (keyword? (car args))) + (-pmacro-process-keyworded-args arg-spec default-values args) + args) +) + +; Invoke a procedural macro. +; ??? A better name might be -pmacro-apply but that is taken by the +; .apply handler. + +(define (-pmacro-invoke macro args) + (let ((arg-spec (-pmacro-arg-spec macro)) + (default-values (-pmacro-default-values macro))) + (let ((processed-args (-pmacro-process-args arg-spec default-values args))) + (if (not (num-args-ok? (length processed-args) arg-spec)) + (-pmacro-error (string-append + "wrong number of arguments to pmacro " + (with-output-to-string + (lambda () + (write (cons (-pmacro-name macro) + (-pmacro-arg-spec macro)))))) + args)) + (apply (-pmacro-transformer macro) processed-args))) +) + +; Expand expression EXP using ENV, an alist of variable assignments. + +(define (-pmacro-expand exp env) + + (define cep (current-error-port)) + + ; If the symbol is in `env', return its value. + ; Otherwise see if symbol is a globally defined pmacro. + ; Otherwise return the symbol unchanged. + (define (scan-symbol sym) + (let ((val (-pmacro-env-ref env sym))) + (if val + (cdr val) ; cdr is value of (name . value) pair + (let ((val (-pmacro-lookup sym))) + (if val + ; Symbol is a macro. + ; If this is a procedural macro, let caller perform expansion. + ; Otherwise, return the macro's value. + (if (procedure? (-pmacro-transformer val)) + val + (-pmacro-transformer val)) + ; Return symbol unchanged. + sym))))) + + ; See if (car exp) is a macro. + ; Return macro or #f. + (define (check-macro exp) + (if -pmacro-trace? + (begin + (display "macro? " cep) + (write exp cep) + (newline cep))) + (and (-pmacro? (car exp)) (car exp))) + + ; Scan each element in EXP and see if the result is a macro invocation. + (define (scan-list exp) + ; Check for syntactic forms. + (case (car exp) + ((.pmacro) + (if (not (= (length exp) 3)) + (-pmacro-error "wrong number of arguments to .pmacro" exp)) + (-pmacro-pmacro (cadr exp) (caddr exp))) + (else + (let ((scanned-exp (map scan exp))) + (let ((macro (check-macro scanned-exp))) + (if macro + (if (procedure? (-pmacro-transformer macro)) + (-pmacro-invoke macro (cdr scanned-exp)) + (cons (-pmacro-transformer macro) (cdr scanned-exp))) + scanned-exp)))))) + + ; Scan EXP, an arbitrary value. + (define (scan exp) + (let ((result (cond ((symbol? exp) (scan-symbol exp)) + ((and (list? exp) (not (null? exp))) (scan-list exp)) + ; Not a symbol or expression, return unchanged. + (else exp)))) + ; ??? We use to re-examine `result' to see if it was another pmacro + ; invocation. This allowed doing things like ((.sym a b c) arg1 arg2) + ; where `abc' is a pmacro. Scheme doesn't work this way, so it was + ; removed. It can be put back should it ever be warranted. + result)) + + (if -pmacro-trace? + (begin + ; We use `write' to display `exp' to see strings quoted. + (display "expand: " cep) (write exp cep) (newline cep) + (display " env: " cep) (display env cep) (newline cep))) + + (let ((result (scan exp))) + (if -pmacro-trace? + (begin + (display "result: " cep) (write result cep) (newline cep))) + result) +) + +; Return the argument spec from ARGS. +; ARGS is a [possibly improper] list of `symbol' or `(symbol default-value)' +; elements. For varargs pmacros, ARGS must be an improper list +; (e.g. (a b . c)) with the last element being a symbol. + +(define (-pmacro-get-arg-spec args) + (let ((parse-arg + (lambda (arg) + (cond ((symbol? arg) + arg) + ((and (pair? arg) (symbol? (car arg))) + (car arg)) + (else + (-pmacro-error "argument not `symbol' or `(symbol . default-value)'" + arg)))))) + (if (list? args) + (map parse-arg args) + (letrec ((parse-improper-list + (lambda (args) + (cond ((symbol? args) + args) + ((pair? args) + (cons (parse-arg (car args)) + (parse-improper-list (cdr args)))) + (else + (-pmacro-error "argument not `symbol' or `(symbol . default-value)'" + args)))))) + (parse-improper-list args)))) +) + +; Return the default values specified in ARGS. +; The result is an alist of (#:arg-name . default-value) elements. +; ARGS is a [possibly improper] list of `symbol' or `(symbol . default-value)' +; elements. For varargs pmacros, ARGS must be an improper list +; (e.g. (a b . c)) with the last element being a symbol. +; Unspecified default values are recorded as #f. + +(define (-pmacro-get-default-values args) + (let ((parse-arg + (lambda (arg) + (cond ((symbol? arg) + (cons (symbol->keyword arg) #f)) + ((and (pair? arg) (symbol? (car arg))) + (cons (symbol->keyword (car arg)) (cdr arg))) + (else + (-pmacro-error "argument not `symbol' or `(symbol . default-value)'" + arg)))))) + (if (list? args) + (map parse-arg args) + (letrec ((parse-improper-list + (lambda (args) + (cond ((symbol? args) + (cons (parse-arg args) nil)) + ((pair? args) + (cons (parse-arg (car args)) + (parse-improper-list (cdr args)))) + (else + (-pmacro-error "argument not `symbol' or `(symbol . default-value)'" + args)))))) + (parse-improper-list args)))) +) + +; Build a procedure that performs a pmacro expansion. + +(define (-pmacro-build-lambda params expansion) + (eval `(lambda ,params + (-pmacro-expand ',expansion (-pmacro-env-make ',params (list ,@params))))) +) + +; ??? I'd prefer to use `define-macro', but boot-9.scm uses it and +; I'd rather not risk a collision. I could of course make the association +; during parsing, maybe later. +; ??? On the other hand, calling them pmacros removes all ambiguity. +; +; The syntax is one of: +; (define (name args ...) expansion) +; (define (name args ...) "documentation" expansion) +; +; If `expansion' is the name of a pmacro, its value is used (rather than its +; name). +; ??? The goal here is to follow Scheme's define/lambda, but not all variants +; are supported yet. There's also the difference that we treat undefined +; symbols as being themselves. + +(define (define-pmacro header arg1 . arg-rest) + (let ((name (if (symbol? header) header (car header))) + (arg-spec (if (symbol? header) #f (-pmacro-get-arg-spec (cdr header)))) + (default-values (if (symbol? header) #f (-pmacro-get-default-values (cdr header)))) + (comment (if (null? arg-rest) "" arg1)) + (expansion (if (null? arg-rest) arg1 (car arg-rest)))) + (if (symbol? header) + (if (symbol? expansion) + (let ((maybe-pmacro (-pmacro-lookup expansion))) + (if maybe-pmacro + (-pmacro-set! name + (-pmacro-make name + (-pmacro-arg-spec maybe-pmacro) + (-pmacro-default-values maybe-pmacro) + (-pmacro-transformer maybe-pmacro) + comment)) + (-pmacro-set! name (-pmacro-make name #f #f expansion comment)))) + (-pmacro-set! name (-pmacro-make name #f #f expansion comment))) + (-pmacro-set! name + (-pmacro-make name arg-spec default-values + (-pmacro-build-lambda arg-spec expansion) + comment)))) + *UNSPECIFIED* +) + +; Expand any pmacros in EXPR. + +(define (pmacro-expand expr) + (-pmacro-expand expr '()) +) + +; Debugging routine to trace macro expansion. + +(define (pmacro-trace expr) + ; ??? Need unwind protection. + (let ((old -pmacro-trace?)) + (set! -pmacro-trace? #t) + (let ((result (-pmacro-expand expr '()))) + (set! -pmacro-trace? old) + result)) +) + +; Builtin macros. + +; .sym - symbol-append, auto-convert numbers + +(define -pmacro-sym + (lambda args + (apply symbol-append + (map (lambda (elm) + (if (number? elm) + (number->string elm) + elm)) + args))) +) + +; .str - string-append, auto-convert numbers + +(define -pmacro-str + (lambda args + (apply string-append + (map (lambda (elm) + (if (number? elm) + (number->string elm) + elm)) + args))) +) + +; .hex - convert number to hex string +; WIDTH, if present, is the number of characters in the result, beginning +; from the least significant digit. + +(define (-pmacro-hex num . width) + (if (> (length width) 1) + (-pmacro-error "wrong number of arguments to .hex" + (cons '.hex (cons num width)))) + (let ((str (number->string num 16))) + (if (null? width) + str + (let ((len (string-length str))) + (substring (string-append (make-string (car width) #\0) str) + len (+ len (car width)))))) +) + +; .upcase - convert a string to uppercase + +(define (-pmacro-upcase str) + (string-upcase str) +) + +; .downcase - convert a string to lowercase + +(define (-pmacro-downcase str) + (string-downcase str) +) + +; .substring - get part of a string + +(define (-pmacro-substring str start end) + (substring str start end) +) + +; .splice - splicing support +; Splice lists into the outer list. +; +; E.g. (define-pmacro '(splice-test a b c) '(.splice a (.unsplice b) c)) +; (pmacro-expand '(splice-test (1 (2) 3))) --> (1 2 3) +; +; Similar to `(1 ,@'(2) 3) in Scheme, though the terminology is slightly +; different (??? may need to revisit). In Scheme we have quasi-quote, +; unquote, unquote-splicing. Here we have splice, unsplice. + +(define -pmacro-splice + (lambda arg-list + ; ??? Not the most efficient implementation, but will the difference + ; ever be measureable? + (let loop ((arg-list arg-list) (result '())) + (cond ((null? arg-list) result) + ((and (pair? (car arg-list)) (eq? '.unsplice (caar arg-list))) + (if (= (length (car arg-list)) 2) + (if (list? (cadar arg-list)) + (loop (cdr arg-list) (append result (cadar arg-list))) + (-pmacro-error "argument to .unsplice must be a list" + (car arg-list))) + (-pmacro-error "wrong number of arguments to .unsplice" + (car arg-list)))) + (else + (loop (cdr arg-list) (append result (list (car arg-list)))))))) +) + +; .iota +; Usage: +; (.iota count) ; start=0, incr=1 +; (.iota count start) ; incr=1 +; (.iota count start incr) + +(define (-pmacro-iota count . start-incr) + (if (> (length start-incr) 2) + (-pmacro-error "wrong number of arguments to .iota" + (cons '.iota (cons count start-incr)))) + (if (< count 0) + (-pmacro-error "count must be non-negative" + (cons '.iota (cons count start-incr)))) + (let ((start (if (pair? start-incr) (car start-incr) 0)) + (incr (if (= (length start-incr) 2) (cadr start-incr) 1))) + (let loop ((i start) (count count) (result '())) + (if (= count 0) + (reverse! result) + (loop (+ i incr) (- count 1) (cons i result))))) +) + +; .map + +(define (-pmacro-map pmacro arg1 . arg-rest) + (if (not (-pmacro? pmacro)) + (-pmacro-error "not a pmacro" pmacro)) + (let ((transformer (-pmacro-transformer pmacro))) + (if (not (procedure? transformer)) + (-pmacro-error "not a procedural macro" pmacro)) + (apply map (cons transformer (cons arg1 arg-rest)))) +) + +; .apply + +(define (-pmacro-apply pmacro arg-list) + (if (not (-pmacro? pmacro)) + (-pmacro-error "not a pmacro" pmacro)) + (let ((transformer (-pmacro-transformer pmacro))) + (if (not (procedure? transformer)) + (-pmacro-error "not a procedural macro" pmacro)) + (apply transformer arg-list)) +) + +; .pmacro + +(define (-pmacro-pmacro params expansion) + (if (not (list? params)) + (-pmacro-error "bad parameter list" params)) + (-pmacro-make '.anonymous params #f (-pmacro-build-lambda params expansion) "") +) + +; Initialization. + +(define (pmacros-init!) + (set! -pmacro-table (make-hash-table 127)) + + ; Some "predefined" macros. + + (-pmacro-set! '.sym + (-pmacro-make '.sym 'symbols #f -pmacro-sym "symbol-append")) + (-pmacro-set! '.str + (-pmacro-make '.str 'strings #f -pmacro-str "string-append")) + (-pmacro-set! '.hex + (-pmacro-make '.hex '(number . width) #f -pmacro-hex + "convert to hex, with optional width")) + (-pmacro-set! '.upcase + (-pmacro-make '.upcase '(string) #f + -pmacro-upcase "string-upcase")) + (-pmacro-set! '.downcase + (-pmacro-make '.downcase '(string) #f + -pmacro-downcase "string-downcase")) + (-pmacro-set! '.substring + (-pmacro-make '.substring '(string start end) #f + -pmacro-substring "get part of a string")) + (-pmacro-set! '.splice + (-pmacro-make '.splice 'arg-list #f -pmacro-splice + "splice lists into the outer list")) + (-pmacro-set! '.iota + (-pmacro-make '.iota '(count . start-incr) #f -pmacro-iota + "iota number generator")) + (-pmacro-set! '.map + (-pmacro-make '.map '(macro-name arg1 . arg-rest) #f + -pmacro-map + "map a macro over a list of arguments")) + (-pmacro-set! '.apply + (-pmacro-make '.apply '(macro-name arg-list) #f -pmacro-apply + "apply a macro, taking arguments from a list")) + (-pmacro-set! '.pmacro + (-pmacro-make '.pmacro '(params expansion) #f -pmacro-pmacro + "create a pmacro on-the-fly")) + + ; doesn't work, Hobbit creates "eval" variable + ;(-pmacro-set! '.eval (-pmacro-make '.eval '(expr) #f eval "eval")) + (-pmacro-set! '.eval (-pmacro-make '.eval '(expr) #f (eval 'eval) "eval")) +) + +; Initialize so we're ready to use after loading. +(pmacros-init!) diff --git a/cgen/profile.scm b/cgen/profile.scm new file mode 100644 index 00000000000..02fdee8cc57 --- /dev/null +++ b/cgen/profile.scm @@ -0,0 +1,180 @@ +;;; {Profile} +;;; +;;; This code is just an experimental prototype (e. g., it is not +;;; thread safe), but since it's at the same time useful, it's +;;; included anyway. +;;; +;;; This is copied from the tracing support in debug.scm. +;;; If merged into the main distribution it will need an efficiency +;;; and layout cleanup pass. + +; FIXME: Prefix "proc-" added to not collide with cgen stuff. + +; Put this stuff in the debug module since we need the trace facilities. +(define-module (ice-9 profile) :use-module (ice-9 debug)) + +(define profiled-procedures '()) + +(define-public (profile-enable . args) + (if (null? args) + (nameify profiled-procedures) + (begin + (for-each (lambda (proc) + (if (not (procedure? proc)) + (error "profile: Wrong type argument:" proc)) + ; `trace' is a magic property understood by guile + (set-procedure-property! proc 'trace #t) + (if (not (memq proc profiled-procedures)) + (set! profiled-procedures + (cons proc profiled-procedures)))) + args) + (set! apply-frame-handler profile-entry) + (set! exit-frame-handler profile-exit) + (debug-enable 'trace) + (nameify args)))) + +(define-public (profile-disable . args) + (if (and (null? args) + (not (null? profiled-procedures))) + (apply profile-disable profiled-procedures) + (begin + (for-each (lambda (proc) + (set-procedure-property! proc 'trace #f) + (set! profiled-procedures (delq! proc profiled-procedures))) + args) + (if (null? profiled-procedures) + (debug-disable 'trace)) + (nameify args)))) + +(define (nameify ls) + (map (lambda (proc) + (let ((name (procedure-name proc))) + (or name proc))) + ls)) + +; Subroutine of profile-entry to find the calling procedure. +; Result is name of calling procedure or #f. + +(define (find-caller frame) + (let ((prev (frame-previous frame))) + (if prev + ; ??? Not sure this is right. The goal is to find the real "caller". + (if (and (frame-procedure? prev) + ;(or (frame-real? prev) (not (frame-evaluating-args? prev))) + (not (frame-evaluating-args? prev)) + ) + (let ((name (procedure-name (frame-procedure prev)))) + (if name name 'lambda)) + (find-caller prev)) + 'top-level)) +) + +; Return the current time. +; The result is a black box understood only by elapsed-time. + +(define (current-time) (gettimeofday)) + +; Return the elapsed time in milliseconds since START. + +(define (elapsed-time start) + (let ((now (gettimeofday))) + (+ (* (- (car now) (car start)) 1000) + (quotient (- (cdr now) (cdr start)) 1000))) +) + +; Handle invocation of profiled procedures. + +(define (profile-entry key cont tail) + (if (eq? (stack-id cont) 'repl-stack) + (let* ((stack (make-stack cont)) + (frame (stack-ref stack 0)) + (proc (frame-procedure frame))) + (if proc + ; procedure-property returns #f if property not present + (let ((counts (procedure-property proc 'profile-count))) + (set-procedure-property! proc 'entry-time (current-time)) + (if counts + (let* ((caller (find-caller frame)) + (count-elm (assq caller counts))) + (if count-elm + (set-cdr! count-elm (1+ (cdr count-elm))) + (set-procedure-property! proc 'profile-count + (acons caller 1 counts))))))))) + + ; SCM_TRACE_P is reset each time by the interpreter + ;(display "entry\n" (current-error-port)) + (debug-enable 'trace) + ;; It's not necessary to call the continuation since + ;; execution will continue if the handler returns + ;(cont #f) +) + +; Handle exiting of profiled procedures. + +(define (profile-exit key cont retval) + ;(display "exit\n" (current-error-port)) + (display (list key cont retval)) (newline) + (display (stack-id cont)) (newline) + (if (eq? (stack-id cont) 'repl-stack) + (let* ((stack (make-stack cont)) + (frame (stack-ref stack 0)) + (proc (frame-procedure frame))) + (display stack) (newline) + (display frame) (newline) + (if proc + (set-procedure-property! + proc 'total-time + (+ (procedure-property proc 'total-time) + (elapsed-time (procedure-property proc 'entry-time))))))) + + ; ??? Need to research if we have to do this or not. + ; SCM_TRACE_P is reset each time by the interpreter + (debug-enable 'trace) +) + +; Called before something is to be profiled. +; All desired procedures to be profiled must have been previously selected. +; Property `profile-count' is an association list of caller name and call +; count. +; ??? Will eventually want to use a hash table or some such. + +(define-public (profile-init) + (for-each (lambda (proc) + (set-procedure-property! proc 'profile-count '()) + (set-procedure-property! proc 'total-time 0)) + profiled-procedures) +) + +; Called after execution to print profile counts. +; If ARGS contains 'all, stats on all profiled procs are printed, not just +; those that were actually called. + +(define-public (profile-stats . args) + (let ((stats (map (lambda (proc) + (cons (procedure-name proc) + (procedure-property proc 'profile-count))) + profiled-procedures)) + (all? (memq 'all args)) + (sort (if (defined? 'sort) (local-ref '(sort)) (lambda args args)))) + + (display "Profiling results:\n\n") + + ; Print the procs in sorted order. + (let ((stats (sort stats (lambda (a b) (string<? (car a) (car b)))))) + (for-each (lambda (proc-stats) + (if (or all? (not (null? (cdr proc-stats)))) + ; Print by decreasing frequency. + (let ((calls (sort (cdr proc-stats) (lambda (a b) (> (cdr a) (cdr b)))))) + (display (string-append (car proc-stats) "\n")) + (for-each (lambda (call) + (display (string-append " " + (number->string (cdr call)) + " " + (car call) + "\n"))) + calls) + (display " ") + (display (apply + (map cdr calls))) + (display " -- total\n\n")))) + stats))) +) diff --git a/cgen/read.scm b/cgen/read.scm new file mode 100644 index 00000000000..2b2ef008b05 --- /dev/null +++ b/cgen/read.scm @@ -0,0 +1,1198 @@ +; Top level file for reading and recording .cpu file contents. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; This file [and its subordinates] contain no C code (well, as little as +; possible). That lives at a layer above us. + +; A .cpu file consists of several sections: +; +; - basic definitions (e.g. cpu variants, word size, endianness, etc.) +; - enums (enums are used throughout so by convention there is a special +; section in which they're defined) +; - attributes +; - instruction fields and formats +; - hardware descriptions (e.g. registers, allowable immediate values) +; - model descriptions (e.g. pipelines, latencies, etc.) +; - instruction operands (mapping of insn fields to associated hardware) +; - instruction definitions +; - macro instruction definitions + +; TODO: +; - memory access, layout, etc. +; - floating point quirks +; - ability to describe an ABI +; - anything else that comes along + +; Notes: +; - by convention most objects are subclasses of <ident> (having name, comment, +; and attrs elements and they are the first three elements of any .cpu file +; entry + +; Guidelines: +; - Try to conform to R5RS, try to limit guile-ness. +; The current code is undoubtedly off in many places. + +; Conventions: +; [I want there to be a plethora of conventions and I want them strictly +; adhered to. ??? There's probably a few violations here and there. +; No big deal - fix them!] +; These conventions are subject to revision. +; +; - procs/vars local to a file are named "-foo" +; - only routines that emit application code begin with "gen-" +; - symbols beginning with "c-" are either variables containing C code +; or procedures that generate C code, similarily for C++ and "c++-" +; - variables containing C code begin with "c-" +; - only routines that emit an entire file begin with "cgen-" +; - all .cpu file elements shall have -foo-parse and -foo-read procedures +; - global vars containing class definitions shall be named "<class-name>" +; - procs related to a particular class shall be named "class-name-proc-name", +; class-name may be abbreviated +; - procs that test whether something is an object of a particular class +; shall be named "class-name?" +; - in keeping with Scheme conventions, predicates shall have a "?" suffix +; - in keeping with Scheme conventions, methods and procedures that modify an +; argument or have other side effects shall have a "!" suffix, +; usually these procs return "*UNSPECIFIED*" +; - all -foo-parse,parse-foo procs shall have `context' as the first arg +; [FIXME: not all such procs have been converted] +; - stay away from non-portable C symbols, it makes using hobbit more difficult +; e.g. don't have anything named `index', sigh. + +; Variables representing misc. global constants. + +; A list of three numbers designating the cgen version: major minor fixlevel. +(define -CGEN-VERSION '(0 7 2)) +(define (cgen-major) (car -CGEN-VERSION)) +(define (cgen-minor) (cadr -CGEN-VERSION)) +(define (cgen-fixlevel) (caddr -CGEN-VERSION)) + +; A list of three numbers designating the description language version. +; Note that this is different from -CGEN-VERSION. +(define -CGEN-LANG-VERSION '(0 7 2)) +(define (cgen-lang-major) (car -CGEN-LANG-VERSION)) +(define (cgen-lang-minor) (cadr -CGEN-LANG-VERSION)) +(define (cgen-lang-fixlevel) (caddr -CGEN-LANG-VERSION)) + +; Which application is in use (UNKNOWN, DESC, OPCODES, SIMULATOR, ???). +; This is mostly for descriptive purposes. +(define APPLICATION 'UNKNOWN) + +; Things are organized so that files can be compiled with Hobbit for +; experimentation. Thus we need one file that loads all the other files. +; This is that file, though it would make sense to move the code in this +; file to another. + +; If a routine to initialize compiled-in code is defined, run it. +(if (defined? 'cgen-init-c) (cgen-init-c)) + +; Don't use the debugging evaluator unless asked for. +(if (not (defined? 'DEBUG-EVAL)) + (define DEBUG-EVAL #f)) + +(if (and (not DEBUG-EVAL) + (memq 'debug-extensions *features*)) + (begin + (debug-disable 'debug) + (read-disable 'positions) + )) + +; If this is set to #f, the file is always loaded. +; Don't override any current setting, e.g. from dev.scm. +(if (not (defined? 'CHECK-LOADED?)) + (define CHECK-LOADED? #t)) + +; Unlink file if we're reloaded (say in an interactive session). +; Dynamic loading is enabled by setting LIBCPU.SO to the pathname of the .so. +(if (and (defined? 'libcpu.so) (dynamic-object? libcpu.so)) + (dynamic-unlink libcpu.so)) +(define libcpu.so #f) +(if (and (defined? 'LIBCPU.SO) + (file-exists? LIBCPU.SO)) + (set! libcpu.so (dynamic-link LIBCPU.SO)) +) + +; List of loaded files. + +(if (not (defined? '-loaded-file-list)) + (define -loaded-file-list '())) + +; Return non-zero if FILE was loaded last time through. + +(define (-loaded-file? file) + (->bool (memq (string->symbol file) -loaded-file-list)) +) + +; Record FILE as compiled in. + +(define (-loaded-file-record! file) + (let ((file (string->symbol file))) + (if (not (memq file -loaded-file-list)) + (set! -loaded-file-list (cons file -loaded-file-list)))) +) + +; Load FILE if SYM is not compiled in. + +(define (maybe-load file init-func sym) + ; Return non-#f if FUNC is present in DYNOBJ. + (define (dynamic-func? func dynobj) + (catch #t + (lambda () (dynamic-func func dynobj)) + (lambda args #f)) + ) + + (let ((init-func (string-append "init_" (if init-func init-func file)))) + (cond ((and libcpu.so + (dynamic-func? init-func libcpu.so)) + (dynamic-call init-func libcpu.so) + (display (string-append "Skipping " file ", dynamically loaded.\n"))) + ((or (not CHECK-LOADED?) + (not (defined? sym)) + (-loaded-file? file)) + (-loaded-file-record! file) + (load file)) + (else + (display (string-append "Skipping " file ", already loaded.\n"))))) +) + +(maybe-load "pmacros" #f 'define-pmacro) +(maybe-load "cos" #f 'make) +(maybe-load "slib/sort" #f 'sort) +; Used to pretty-print debugging messages. +(maybe-load "slib/pp" #f 'pretty-print) +; Used by pretty-print. +(maybe-load "slib/genwrite" #f 'generic-write) +(maybe-load "utils" #f 'logit) +(maybe-load "utils-cgen" "utils_cgen" 'obj:name) +(maybe-load "attr" #f '<attribute>) +(maybe-load "enum" #f '<enum>) +(maybe-load "mach" #f '<mach>) +(maybe-load "model" #f '<model>) +(maybe-load "types" #f '<scalar>) +(maybe-load "mode" #f '<mode>) +(maybe-load "ifield" #f '<ifield>) +(maybe-load "iformat" #f '<iformat>) +(maybe-load "hardware" #f '<hardware-base>) +(maybe-load "operand" #f '<operand>) +(maybe-load "insn" #f '<insn>) +(maybe-load "minsn" #f '<macro-insn>) +(maybe-load "decode" #f 'decode-build-table) +(maybe-load "rtl" "rtl" '<rtx-func>) +(maybe-load "rtx-funcs" "rtx_funcs" 'def-rtx-funcs) +(maybe-load "rtl-c" "rtl_c" '<c-expr>) +(maybe-load "semantics" #f 'semantic-compile) +(maybe-load "sem-frags" "sem_frags" 'gen-threaded-engine) +(maybe-load "utils-gen" "utils_gen" 'attr-gen-decl) +(maybe-load "pgmr-tools" "pgmr_tools" 'pgmr-pretty-print-insn-format) + +; Reader state data. +; All state regarding the reading of a .cpu file is kept in an object of +; class <reader>. + +; Class to record info for each top-level `command' (for lack of a better +; word) in the description file. +; Top level commands are things like define-*. + +(define <command> + (class-make '<command> + '(<ident>) + '( + ; argument spec to `lambda' + arg-spec + ; lambda that processes the entry + handler + ) + nil) +) + +(define command-arg-spec (elm-make-getter <command> 'arg-spec)) +(define command-handler (elm-make-getter <command> 'handler)) + +; Return help text for COMMAND. + +(define (command-help cmd) + (string-append + (obj:comment cmd) + "Arguments: " + (with-output-to-string (lambda () (write (command-arg-spec cmd)))) + "\n") +) + +; A pair of two lists: machs to keep, machs to drop. +; Keep all machs, drop none. + +(define -keep-all-machs '((all))) + +; Main reader state class. + +(define <reader> + (class-make '<reader> + nil + (list + ; Selected machs to keep. + ; A pair of two lists: the car lists the machs to keep, the cdr + ; lists the machs to drop. Two special entries are `all' and + ; `base'. Both are only valid in the keep list. `base' is a + ; place holder for objects that are common to all machine + ; variants in the architecture, it is the default value of the + ; MACH attribute. If `all' is present the drop list is still + ; processed. + (cons 'keep-mach -keep-all-machs) + + ; Selected isas to keep or `all'. + '(keep-isa . (all)) + + ; Currently select cpu family, computed from `keep-mach'. + ; Some applications don't care, and this is moderately + ; expensive to compute so we use delay/force. + 'current-cpu + + ; Associative list of file entry commands + ; (e.g. define-insn, etc.). + ; Each entry is (name . command-object). + (cons 'commands nil) + ) + nil) +) + +; Accessors. + +(define-getters <reader> reader (keep-mach keep-isa current-cpu commands)) +(define-setters <reader> reader (keep-mach keep-isa current-cpu commands)) + +(define (reader-add-command! name comment attrs arg-spec handler) + (reader-set-commands! CURRENT-READER + (acons name + (make <command> name comment attrs + arg-spec handler) + (reader-commands CURRENT-READER))) +) + +(define (reader-lookup-command name) + (assq-ref (reader-commands CURRENT-READER) name) +) + +; Reader state for current .cpu file. + +(define CURRENT-READER #f) + +; Signal an error while reading a .cpu file. + +(define (reader-error msg expr help-text) + (let ((errmsg + (string-append (or (port-filename (current-input-port)) + "<input>") + ":" + (number->string (port-line (current-input-port))) + ": " + msg + ":"))) + (error (string-append errmsg "\n" help-text) + expr)) +) + +; Signal a parse error while reading a .cpu file. + +(define (parse-error errtxt message . args) + (reader-error (string-append errtxt ": " message ":") args "") +) + +; Process a macro-expanded entry. + +(define (-reader-process-expanded-1 entry) + (logit 4 (with-output-to-string (lambda () (pretty-print entry)))) + (let ((command (reader-lookup-command (car entry)))) + (if command + (let* ((handler (command-handler command)) + (arg-spec (command-arg-spec command)) + (num-args (num-args arg-spec))) + (if (cdr num-args) + ; Variable number of trailing arguments. + (if (< (length (cdr entry)) (car num-args)) + (reader-error (string-append "Incorrect number of arguments to " + (car entry) + ", expecting at least " + (number->string (car num-args))) + entry + (command-help command)) + (apply handler (cdr entry))) + ; Fixed number of arguments. + (if (!= (length (cdr entry)) (car num-args)) + (reader-error (string-append "Incorrect number of arguments to " + (car entry) + ", expecting " + (number->string (car num-args))) + entry + (command-help command)) + (apply handler (cdr entry))))) + (reader-error "unknown entry type" entry ""))) + *UNSPECIFIED* +) + +; Process 1 or more macro-expanded entries. + +(define (-reader-process-expanded entry) + ; `begin' is used to group a collection of entries into one, since pmacro + ; can only return one expression (borrowed from Scheme of course). + ; ??? Maybe someday (begin ...) will be equivalent to (sequence () ...) + ; but not yet. + ; Recurse in case there are nested begins. + (if (eq? (car entry) 'begin) + (for-each -reader-process-expanded + (cdr entry)) + (-reader-process-expanded-1 entry)) +) + +; Process file entry ENTRY. + +(define (reader-process entry) + (if (not (form? entry)) + (reader-error "improperly formed entry" entry "")) + + ; First do macro expansion, but not if define-pmacro of course. + (let ((expansion (if (eq? (car entry) 'define-pmacro) + entry + (pmacro-expand entry)))) + (-reader-process-expanded expansion)) +) + +; Read in and process FILE. +; +; It would be nice to get the line number of the beginning of the object, +; but that's extra work, so for now we do the simple thing and use +; port-line after we've read an entry. + +(define (reader-read-file! file) + (let ((readit (lambda () + (let loop ((entry (read))) + (if (eof-object? entry) + #t ; done + (begin + (reader-process entry) + (loop (read))))))) + ) + + (with-input-from-file file readit) + *UNSPECIFIED*) +) + +; Cpu data is recorded in an object of class <arch>. +; This is necessary as we need to allow recording of multiple cpu descriptions +; simultaneously. +; Class <arch> is defined in mach.scm. + +; Global containing all data of the currently selected architecture. + +(define CURRENT-ARCH #f) + +; `keep-mach' processing. + +; Return the currently selected cpu family. +; If a specific cpu family has been selected, each machine that is kept must +; be in that cpu family [so there's no ambiguity in the result]. +; This is a moderately expensive computation so use delay/force. + +(define (current-cpu) (force (reader-current-cpu CURRENT-READER))) + +; Return a boolean indicating if CPU-NAME is to be kept. +; ??? Currently this is always true. Note that this doesn't necessarily apply +; to machs in CPU-NAME. + +(define (keep-cpu? cpu-name) #t) + +; Cover proc to set `keep-mach'. +; MACH-NAME-LIST is a comma separated string of machines to keep and drop +; (if prefixed with !). + +(define (-keep-mach-set! mach-name-list) + (let* ((mach-name-list (string-cut mach-name-list #\,)) + (keep (find (lambda (name) (not (char=? (string-ref name 0) #\!))) + mach-name-list)) + (drop (map (lambda (name) (string->symbol (string-drop 1 name))) + (find (lambda (name) (char=? (string-ref name 0) #\!)) + mach-name-list)))) + (reader-set-keep-mach! CURRENT-READER + (cons (map string->symbol keep) + (map string->symbol drop))) + ; Reset current-cpu. + (reader-set-current-cpu! + CURRENT-READER + (delay (let ((selected-machs (find (lambda (mach) + (keep-mach? (list (obj:name mach)))) + (current-mach-list)))) + (if (= (length selected-machs) 0) + (error "no machs selected")) + (if (not (all-true? (map (lambda (mach) + (eq? (obj:name (mach-cpu mach)) + (obj:name (mach-cpu (car selected-machs))))) + selected-machs))) + (error "machs from different cpu families selected")) + (mach-cpu (car selected-machs))))) + + *UNSPECIFIED*) +) + +; Validate the user-provided keep-mach list against the list of machs +; specified in the .cpu file (in define-arch). + +(define (keep-mach-validate!) + (let ((mach-names (cons 'all (current-arch-mach-name-list))) + (keep-mach (reader-keep-mach CURRENT-READER))) + (for-each (lambda (mach) + (if (not (memq mach mach-names)) + (error "unknown mach to keep:" mach))) + (car keep-mach)) + (for-each (lambda (mach) + (if (not (memq mach mach-names)) + (error "unknown mach to drop:" mach))) + (cdr keep-mach)) + ) + *UNSPECIFIED* +) + +; Return #t if a machine in MACH-LIST, a list of symbols, is to be kept. +; If any machine in MACH-LIST is to be kept, the result is #t. +; If MACH-LIST is the empty list (no particular mach specified, thus the base +; mach), the result is #t. + +(define (keep-mach? mach-list) + (if (null? mach-list) + #t + (let* ((keep-mach (reader-keep-mach CURRENT-READER)) + (keep (cons 'base (car keep-mach))) + (drop (cdr keep-mach)) + (keep? (map (lambda (m) (memq m keep)) mach-list)) + (all? (memq 'all keep)) + (drop? (map (lambda (m) (memq m drop)) mach-list))) + (any-true? (map (lambda (k d) + ; keep if K(ept) or ALL? and not D(ropped) + (->bool (and (or k all?) (not d)))) + keep? drop?)))) +) + +; Return non-#f if the object containing ATLIST is to be kept. +; OBJ is the container object or #f if there is none. +; The object is kept if its attribute list specifies a `MACH' that is +; kept (and not dropped) or does not have the `MACH' attribute (which means +; it has the default value which means it's for use with all machines). + +(define (keep-mach-atlist? atlist obj) + ; The MACH attribute is not created until the .cpu file is read in which + ; is too late for us [we will get called for builtin objects]. + ; Thus we peek inside the attribute list directly. + ; ??? Maybe postpone creation of builtins until after define-arch? + (let ((machs (atlist-attr-value-no-default atlist 'MACH obj))) + (if (null? machs) + #t + (keep-mach? (map string->symbol (string-cut machs #\,))))) +) + +; Return a boolean indicating if the object containing ATLIST is to be kept. +; OBJ is the container object or #f if there is none. +; The object is kept if both its isa and its mach are kept. + +(define (keep-atlist? atlist obj) + (and (keep-mach-atlist? atlist obj) + (keep-isa-atlist? atlist obj)) +) + +; Return a boolean indicating if multiple cpu families are being kept. + +(define (keep-multiple?) + (let ((selected-machs (find (lambda (mach) + (keep-mach? (list (obj:name mach)))) + (current-mach-list)))) + (not (all-true? (map (lambda (mach) + (eq? (obj:name (mach-cpu mach)) + (obj:name (mach-cpu (car selected-machs))))) + selected-machs)))) +) + +; Return a boolean indicating if everything is kept. + +(define (keep-all?) + (equal? (reader-keep-mach CURRENT-READER) -keep-all-machs) +) + +; Ensure all cpu families were kept, necessary for generating files that +; encompass the entire architecture. + +(define (assert-keep-all) + (if (not (keep-all?)) + (error "no can do, all cpu families not selected")) + *UNSPECIFIED* +) + +; Ensure exactly one cpu family was kept, necessary for generating files that +; are specific to one cpu family. + +(define (assert-keep-one) + (if (keep-multiple?) + (error "no can do, multiple cpu families selected")) + *UNSPECIFIED* +) + +; `keep-isa' processing. + +; Cover proc to set `keep-isa'. +; ISA-NAME-LIST is a comma separated string of isas to keep. +; ??? We don't support the !drop notation of keep-mach processing. +; Perhaps we should as otherwise there are two different styles the user +; has to remember. On the other hand, !drop support is moderately complicated, +; and it can be added in an upward compatible manner later. + +(define (-keep-isa-set! isa-name-list) + (let ((isa-name-list (map string->symbol (string-cut isa-name-list #\,)))) + (reader-set-keep-isa! CURRENT-READER isa-name-list) + ) + *UNSPECIFIED* +) + +; Validate the user-provided keep-isa list against the list of isas +; specified in the .cpu file (in define-arch). + +(define (keep-isa-validate!) + (let ((isa-names (cons 'all (current-arch-isa-name-list))) + (keep-isa (reader-keep-isa CURRENT-READER))) + (for-each (lambda (isa) + (if (not (memq isa isa-names)) + (error "unknown isa to keep:" isa))) + keep-isa) + ) + *UNSPECIFIED* +) + +; Return currently selected isa (there must be exactly one). + +(define (current-isa) + (let ((keep-isa (reader-keep-isa CURRENT-READER))) + (if (equal? keep-isa '(all)) + (let ((isas (current-isa-list))) + (if (= (length isas) 1) + (car isas) + (error "multiple isas selected" keep-isa))) + (if (= (length keep-isa) 1) + (current-isa-lookup (car keep-isa)) + (error "multiple isas selected" keep-isa)))) +) + +; Return #t if an isa in ISA-LIST, a list of symbols, is to be kept. +; If any isa in ISA-LIST is to be kept, the result is #t. +; If ISA-LIST is the empty list (no particular isa specified) use the default +; isa. + +(define (keep-isa? isa-list) + (if (null? isa-list) + (set! isa-list (list (car (current-arch-isa-name-list))))) + (let* ((keep (reader-keep-isa CURRENT-READER)) + (keep? (map (lambda (i) + (or (memq i keep) + (memq 'all keep))) + isa-list))) + (any-true? keep?)) +) + +; Return #t if the object containing ATLIST is to be kept. +; OBJ is the container object or #f if there is none. +; The object is kept if its attribute list specifies an `ISA' that is +; kept or does not have the `ISA' attribute (which means it has the default +; value) and the default isa is being kept. + +(define (keep-isa-atlist? atlist obj) + (let ((isas (atlist-attr-value atlist 'ISA obj))) + (keep-isa? (map string->symbol (string-cut isas #\,)))) +) + +; Return non-#f if object OBJ is to be kept, according to its ISA attribute. + +(define (keep-isa-obj? obj) + (keep-isa-atlist? (obj-atlist obj) obj) +) + +; Return a boolean indicating if multiple isas are being kept. + +(define (keep-isa-multiple?) + (let ((keep (reader-keep-isa CURRENT-READER))) + (or (> (length keep) 1) + (and (memq 'all keep) + (> (length (current-arch-isa-name-list)) 1)))) +) + +; Return list of isa names currently being kept. + +(define (current-keep-isa-name-list) + (reader-keep-isa CURRENT-READER) +) + +; If #f, treat reserved fields as operands and extract them with the insn. +; Code can then be emitted in the extraction routines to validate them. +; If #t, treat reserved fields as part of the opcode. +; This complicates the decoding process as these fields have to be +; checked too. +; ??? Unimplemented. + +(define option:reserved-as-opcode? #f) + +; Process options passed in on the command line. +; OPTIONS is a space separated string of name=value values. +; Each application is required to provide: option-init!, option-set!. + +(define (set-cgen-options! options) + (option-init!) + (for-each (lambda (opt) + (if (null? opt) + #t ; ignore extraneous spaces + (let ((name (string->symbol (car opt))) + (value (cdr opt))) + (logit 1 "Setting option `" name "' to \"" + (apply string-append value) "\".\n") + (option-set! name value)))) + (map (lambda (opt) (string-cut opt #\=)) + (string-cut options #\space))) +) + +; Application specific object creation support. +; +; Each entry in the .cpu file has a basic container class. +; Each application adds functionality by subclassing the container +; and registering with set-for-new! the proper class to create. +; ??? Not sure this is the best way to handle this, but it does keep the +; complexity down while not requiring as dynamic a language as I had before. +; ??? Class local variables would provide a more efficient way to do this. +; Assuming one wants to continue on this route. + +(define -cpu-new-class-list nil) + +(define (set-for-new! parent child) + (set! -cpu-new-class-list (acons parent child -cpu-new-class-list)) +) + +; Lookup the class registered with set-for-new! +; If none registered, return PARENT. + +(define (lookup-for-new parent) + (let ((child (assq-ref -cpu-new-class-list parent))) + (if child + child + parent)) +) + +; .cpu file loader support + +; Prepare to parse a .cpu file. +; This initializes the application independent tables. +; KEEP-MACH specifies what machs to keep. +; KEEP-ISA specifies what isas to keep. +; OPTIONS is a list of options to control code generation. +; The values are application dependent. + +(define (-init-parse-cpu! keep-mach keep-isa options) + (set! -cpu-new-class-list nil) + + (set! CURRENT-READER (new <reader>)) + (set! CURRENT-ARCH (new <arch>)) + (-keep-mach-set! keep-mach) + (-keep-isa-set! keep-isa) + (set-cgen-options! options) + + (reader-add-command! 'include + "Include a file.\n" + nil '(file) include + ) + (reader-add-command! 'if + "(if test then . else)\n" + nil '(test then . else) cmd-if + + ) + + ; Rather than add cgen specific stuff to pmacros.scm, we create + ; a define-pmacro command here. + (pmacros-init!) + (reader-add-command! 'define-pmacro + "\ +Define a preprocessor-style macro. +" + nil '(name arg1 . arg-rest) define-pmacro) + + ; The order here is important. + (arch-init!) ; Must be done first. + (enum-init!) + (attr-init!) + (types-init!) + (mach-init!) + (model-init!) + (mode-init!) + (ifield-init!) + (hardware-init!) + (operand-init!) + (insn-init!) + (minsn-init!) + (rtl-init!) + (rtl-c-init!) + (utils-init!) + + *UNSPECIFIED* +) + +; Install any builtin objects. +; This is defered until define-arch is read. +; One reason is that attributes MACH and ISA don't exist until then. + +(define (reader-install-builtin!) + ; The order here is important. + (attr-builtin!) + (mode-builtin!) + (ifield-builtin!) + (hardware-builtin!) + (operand-builtin!) + ; This is mainly for the insn attributes. + (insn-builtin!) + (rtl-builtin!) + *UNSPECIFIED* +) + +; Do anything necessary for the application independent parts after parsing +; a .cpu file. +; The lists get cons'd in reverse order. One thing this does is change them +; back to file order, it makes things easier for the human viewer. + +(define (-finish-parse-cpu!) + ; The order here is generally the reverse of init-parse-cpu!. + (rtl-finish!) + (minsn-finish!) + (insn-finish!) + (operand-finish!) + (hardware-finish!) + (ifield-finish!) + (mode-finish!) + (model-finish!) + (mach-finish!) + (types-finish!) + (attr-finish!) + (enum-finish!) + (arch-finish!) ; Must be done last. + + *UNSPECIFIED* +) + +; Perform a global error checking pass after the .cpu file has been read in. + +(define (-global-error-checks) + ; ??? None yet. + ; TODO: + ; - all hardware elements with same name must have same rank and + ; compatible modes (which for now means same float mode or all int modes) + #f +) + +; .cpu file include mechanism + +(define (include file) + (display (string-append "Including file " file " ...\n")) + (reader-read-file! (string-append srcdir "/" file)) + (logit 2 "Resuming previous file ...\n") +) + +; Version of `if' invokable at the top level of a description file. +; This is a work-in-progress. Its presence in the description file is ok, +; but the implementation will need to evolve. + +(define (cmd-if test then . else) + (if (> (length else) 1) + (reader-error "wrong number of arguments to `if'" + (cons 'if (cons test (cons then else))) + "")) + ; ??? rtx-eval test + (if (not (memq (car test) '(keep-isa? keep-mach?))) + (reader-error "only (if (keep-mach?|keep-isa? ...) ...) is currently supported")) + (case (car test) + ((keep-isa?) + (if (keep-isa? (cadr test)) + (eval then) + (if (null? else) + #f + (eval (car else))))) + ((keep-mach?) + (if (keep-mach? (cadr test)) + (eval then) + (if (null? else) + #f + (eval (car else)))))) +) + +; Top level routine for loading .cpu files. +; FILE is the name of the .cpu file to load. +; KEEP-MACH is a string of comma separated machines to keep +; (or not keep if prefixed with !). +; KEEP-ISA is a string of comma separated isas to keep. +; OPTIONS is the OPTIONS argument to -init-parse-cpu!. +; APP-INITER! is an application specific zero argument proc (thunk) +; to call after -init-parse-cpu! +; APP-FINISHER! is an application specific zero argument proc to call after +; -finish-parse-cpu! +; ANALYZER! is a zero argument proc to call after loading the .cpu file. +; It is expected to set up various tables and things useful for the application +; in question. + +(define (cpu-load file keep-mach keep-isa options + app-initer! app-finisher! analyzer!) + (-init-parse-cpu! keep-mach keep-isa options) + + (app-initer!) + + ; This used to be done here, but is now defered until define-arch. + ;(reader-install-builtin!) + + (display (string-append "Loading cpu file " file " ...\n")) + + (reader-read-file! file) + + (display (string-append "Processing cpu file " file " ...\n")) + (-finish-parse-cpu!) + (app-finisher!) + (-global-error-checks) + (analyzer!) + *UNSPECIFIED* +) + +; Argument parsing utilities. + +; Generate a usage message. +; ERRTYPE is one of 'help, 'unknown, 'missing. +; OPTION is the option that had the error or "" if ERRTYPE is 'help. + +(define (cgen-usage errtype option arguments) + (let ((cep (current-error-port))) + (case errtype + ((help) #f) + ((unknown) (display (string-append "Unknown option: " option "\n") cep)) + ((missing) (display (string-append "Missing argument: " option "\n") cep)) + (else (display "Unknown error!\n" cep))) + (display "Usage: cgen arguments ...\n" cep) + (for-each (lambda (arg) + (display (string-append (car arg) + " " (if (cadr arg) (cadr arg) "") + " - " (caddr arg) + "\n") + cep)) + arguments) + (display "...\n" cep) + (case errtype + ((help) (quit 0)) + ((unknown missing) (quit 1)) + (else (quit 2)))) +) + +; Poor man's getopt. +; [We don't know where to find the real one until we've parsed the args, +; and this isn't something we need to get too fancy about anyways.] +; The result is always ((a . b) . c). +; If the argument is valid, the result is ((opt-spec . arg) . remaining-argv), +; or (('unknown . option) . remaining-argv) if `option' isn't recognized, +; or (('missing . option) . remaining argv) if `option' is missing a required +; argument, +; or ((#f . #f) . #f) if there are no more arguments. +; OPT-SPEC is a list of option specs. +; Each element is an alist of at least 3 elements: option argument help-text. +; `option' is a string or symbol naming the option. e.g. -a, --help, "-i". +; symbols are supported for backward compatibility, -i is a complex number. +; `argument' is a string naming the argument or #f if the option takes no +; arguments. +; `help-text' is a string that is printed with the usage information. +; Elements beyond `help-text' are ignored. + +(define (-getopt argv opt-spec) + (if (null? argv) + (cons (cons #f #f) #f) + (let ((opt (assoc (car argv) opt-spec))) + (cond ((not opt) (cons (cons 'unknown (car argv)) (cdr argv))) + ((and (cadr opt) (null? (cdr argv))) + (cons (cons 'missing (car argv)) (cdr argv))) + ((cadr opt) (cons (cons opt (cadr argv)) (cddr argv))) + (else ; must be option that doesn't take an argument + (cons (cons opt #f) (cdr argv)))))) +) + +; Convert old style option spec to new style. +; This involves converting a symbol option name to a string. + +(define (-opt-spec-update spec-list) + (map (lambda (spec) + (if (symbol? (car spec)) + (cons (symbol->string (car spec)) (cdr spec)) + spec)) + spec-list) +) + +; Used to ensure backtraces are printed if an error occurs. + +(define (catch-with-backtrace thunk) + (lazy-catch #t thunk + (lambda args + ;(display args (current-error-port)) + ;(newline (current-error-port)) + ; display-error takes 6 arguments. + ; If `quit' is called from elsewhere, it may not have 6 + ; arguments. Not sure how best to handle this. + (if (= (length args) 5) + (begin + (apply display-error #f (current-error-port) (cdr args)) + (save-stack) + (backtrace))) + (quit 1))) +) + +; Return (cadr args) or print a pretty error message if not possible. + +(define (option-arg args) + (if (and (pair? args) (pair? (cdr args))) + (cadr args) + (parse-error "option processing" "missing argument to" (car args))) +) + +; Record of arguments passed to debug-repl, so they can be accessed in +; the repl loop. + +(define debug-env #f) + +; Return list of recorded variables for debugging. + +(define (debug-var-names) (map car debug-env)) + +; Return value of recorded var NAME. + +(define (debug-var name) (assq-ref debug-env name)) + +; Enter a repl loop for debugging purposes. +; Use (quit) to exit cgen completely. +; Use (debug-quit) or (quit 0) to exit the debugging session and +; resume argument processing. +; +; ENV-ALIST can be anything, but it is intended to be an alist of values +; the caller will want to be able to access in the repl loop. +; It is stored in global `debug-env'. +; +; FIXME: Move to utils.scm. + +(define (debug-repl env-alist) + (set! debug-env env-alist) + (let loop () + (let ((rc (top-repl))) + (if (null? rc) + (quit 1)) ; indicate error to `make' + (if (not (equal? rc '(0))) + (loop)))) +) + +; Utility for debug-repl. + +(define (debug-quit) + ; Keep around for later debugging. + ;(set! debug-env #f) + + (quit 0) +) + +; Macro to simplify calling debug-repl. +; Usage: (debug-repl-env var-name1 var-name2 ...) + +(defmacro debug-repl-env var-names + (let ((env (map (lambda (var-name) + (list 'cons (list 'quote var-name) var-name)) + var-names))) + (list 'debug-repl (cons 'list env))) +) + +; List of common arguments. +; +; ??? Another useful arg would be one that says "do file generation with +; arguments specified up til now, then continue with next batch of args". + +(define common-arguments + '(("-a" "arch" "set arch, specifies name of .cpu file to load") + ("-b" #f "use debugging evaluator, for backtraces") + ("-d" #f "start interactive debugging session") + ("-f" "flags" "specify a set of flags to control code generation") + ("-h" #f "print usage information") + ("--help" #f "print usage information") + ("-i" "isa-list" "specify isa-list entries to keep") + ("-m" "mach-list" "specify mach-list entries to keep") + ("-s" "srcdir" "set srcdir") + ("-v" #f "increment verbosity level") + ("--version" #f "print version info") + ) +) + +; Parse options and call generators. +; ARGS is a #:keyword delimited list of arguments. +; #:app-name name +; #:arg-spec optspec ; FIXME: rename to #:opt-spec +; #:init init-routine +; #:finish finish-routine +; #:analyze analysis-routine +; #:argv command-line-arguments +; +; ARGSPEC is a list of (option option-arg comment option-handler) elements. +; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and +; processes the option. + +(define -cgen + (lambda args + (let ((app-name "unknown") + (opt-spec nil) + (app-init! (lambda () #f)) + (app-finish! (lambda () #f)) + (app-analyze! (lambda () #f)) + (argv (list "cgen")) + ) + (let loop ((args args)) + (if (not (null? args)) + (case (car args) + ((#:app-name) (begin + (set! app-name (option-arg args)) + (loop (cddr args)))) + ((#:arg-spec) (begin + (set! opt-spec (option-arg args)) + (loop (cddr args)))) + ((#:init) (begin + (set! app-init! (option-arg args)) + (loop (cddr args)))) + ((#:finish) (begin + (set! app-finish! (option-arg args)) + (loop (cddr args)))) + ((#:analyze) (begin + (set! app-analyze! (option-arg args)) + (loop (cddr args)))) + ((#:argv) (begin + (set! argv (option-arg args)) + (loop (cddr args)))) + (else (error "cgen: unknown argument" (car args)))))) + + ; ARGS has been processed, now we can process ARGV. + + (let ( + (opt-spec (append common-arguments (-opt-spec-update opt-spec))) + (app-args nil) ; application's args are queued here + (repl? #f) + (arch #f) + (keep-mach "all") ; default is all machs + (keep-isa "all") ; default is all isas + (flags "") + (moreopts? #t) + (cep (current-error-port)) + (str=? string=?) + ) + + (let loop ((argv (cdr argv))) + (let* ((new-argv (-getopt argv opt-spec)) + (opt (caar new-argv)) + (arg (cdar new-argv))) + (case opt + ((#f) (set! moreopts? #f)) + ((unknown) (cgen-usage 'unknown arg opt-spec)) + ((missing) (cgen-usage 'missing arg opt-spec)) + (else + (cond ((str=? "-a" (car opt)) + (set! arch arg) + ) + ((str=? "-b" (car opt)) + (if (memq 'debug-extensions *features*) + (begin + (debug-enable 'backtrace) + (debug-enable 'debug) + (debug-enable 'backwards) + (debug-set! depth 200) + (debug-set! frames 10) + (read-enable 'positions))) + ) + ((str=? "-d" (car opt)) + (let ((prompt (string-append "cgen-" app-name "> "))) + (set! repl? #t) + (set-repl-prompt! prompt) + (if (feature? 'readline) + (set-readline-prompt! prompt)) + )) + ((str=? "-f" (car opt)) + (set! flags arg) + ) + ((str=? "-h" (car opt)) + (cgen-usage 'help "" opt-spec) + ) + ((str=? "--help" (car opt)) + (cgen-usage 'help "" opt-spec) + ) + ((str=? "-i" (car opt)) + (set! keep-isa arg) + ) + ((str=? "-m" (car opt)) + (set! keep-mach arg) + ) + ((str=? "-s" (car opt)) + #f ; ignore, already processed by caller + ) + ((str=? "-v" (car opt)) + (verbose-inc!) + ) + ((str=? "--version" (car opt)) + (begin + (display "Cpu tools GENerator version ") + (display (cgen-major)) + (display ".") + (display (cgen-minor)) + (display ".") + (display (cgen-fixlevel)) + (newline) + (quit 0) + )) + ; Else this is an application specific option. + (else + ; Record it for later processing. Note that they're + ; recorded in reverse order (easier). This is undone + ; later. + (set! app-args (acons opt arg app-args))) + ))) + (if moreopts? (loop (cdr new-argv))) + ) + ) ; end of loop + + ; All arguments have been parsed. + + (if (not arch) + (error "-a option missing, no architecture specified")) + + (if repl? + (debug-repl nil)) + (cpu-load (string-append srcdir "/" arch ".cpu") + keep-mach keep-isa flags + app-init! app-finish! app-analyze!) + ; Start another repl loop if -d. + ; Awkward. Both places are useful, though this is more useful. + (if repl? + (debug-repl nil)) + + ; Done with processing the arguments. Call the application's + ; file generators. + + (for-each (lambda (opt-arg) + (let ((opt (car opt-arg)) + (arg (cdr opt-arg))) + (if (cadr opt) + ((cadddr opt) arg) + ((cadddr opt))))) + (reverse app-args)) + ) + ) + #f) ; end of lambda +) + +; Main entry point called by application file generators. +; Cover fn to -cgen that uses catch-with-backtrace. +; ??? (debug-enable 'backtrace) might also work except I seem to remember +; having problems with it. They may be fixed now. + +(define cgen + (lambda args + (catch-with-backtrace (lambda () (apply -cgen args)))) +) diff --git a/cgen/rtl-c.scm b/cgen/rtl-c.scm new file mode 100644 index 00000000000..0469c9be6d6 --- /dev/null +++ b/cgen/rtl-c.scm @@ -0,0 +1,1662 @@ +; RTL->C translation support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Generating C from RTL +; --------------------- +; The main way to generate C code from an RTL expression is: +; +; (rtl-c mode '(func mode ...) nil) +; +; E.g. +; (rtl-c DFLT '(add SI (const SI 1) (const SI 2)) nil) +; --> +; "ADDSI (1, 2)" +; Mode `DFLT' (DEFAULTmode) means "use the default/natural mode". +; +; The expression is in source form or may be already compiled (with +; rtx-compile). +; +; The `set' rtx needs to be handled a little carefully. +; Both the dest and src are processed first, and then code to perform the +; assignment is computed. However, the dest may require more than a simple +; C assignment. Therefore set dests are converted to the specified object +; (e.g. a hardware operand) and then a message is sent to this object to +; perform the actual code generation. +; +; All interesting operands (e.g. regs, mem) are `operand' objects. +; The following messages must be supported by operand objects. +; - get-mode - return mode of operand +; - cxmake-get - return <c-expr> object containing operand's value +; - gen-set-quiet - return string of C code to set operand's value (no tracing) +; - gen-set-trace - return string of C code to set operand's value +; +; Instruction fields are refered to by name. +; (estate-owner estate) must be an instruction that has the field. +; Instruction ifields must have these methods: +; - get-mode +; - cxmake-get +; +; Conventions used in this file: +; - see rtl.scm + +; The <c-expr> object. +; This is a fully translated expression (i.e. C code). + +(define <c-expr> + (class-make '<c-expr> nil + '( + ; The mode of C-CODE. + mode + ; The translated C code. + c-code + ; The source expression, for debugging. + expr + ; Attributes of the expression. + atlist + ; List of temporaries required to compute the expression. + ; ??? wip. These would be combined as the expression is + ; built up. Then in sets and other statements, the temporaries + ; would be declared. + ;(tmps . nil) + ) + nil) +) + +(method-make! + <c-expr> 'make! + (lambda (self mode c-code atlist) + ; FIXME: Extend COS to allow specifying member predicates. + (assert (mode? mode)) + (assert (string? c-code)) + ;(assert (atlist? atlist)) ; FIXME: What should this be? + (elm-set! self 'mode mode) + (elm-set! self 'c-code c-code) + (elm-set! self 'atlist atlist) + self) +) + +; Accessor fns + +(define cx:mode (elm-make-getter <c-expr> 'mode)) +(define cx:c-code (elm-make-getter <c-expr> 'c-code)) +(define cx:expr (elm-make-getter <c-expr> 'expr)) +(define cx:atlist (elm-make-getter <c-expr> 'atlist)) +;(define cx:tmps (elm-make-getter <c-expr> 'tmps)) + +; Any object with attributes requires the get-atlist method. + +(method-make! <c-expr> 'get-atlist (lambda (self) (elm-get self 'atlist))) + +; Respond to 'get-mode messages. + +(method-make! <c-expr> 'get-mode (lambda (self) (elm-get self 'mode))) + +; Respond to 'get-name messages for rtx-dump. + +(method-make! + <c-expr> 'get-name + (lambda (self) + (string-append "(" (obj:name (elm-get self 'mode)) ") " + (cx:c self))) +) + +; Return C code to perform an assignment. +; NEWVAL is a <c-expr> object of the value to be assigned to SELF. + +(method-make! <c-expr> 'gen-set-quiet + (lambda (self estate mode indx selector newval) + (string-append " " (cx:c self) " = " (cx:c newval) ";\n")) +) + +(method-make! <c-expr> 'gen-set-trace + (lambda (self estate mode indx selector newval) + (string-append " " (cx:c self) " = " (cx:c newval) ";\n")) +) + +; Return the C code of CX. +; ??? This used to handle lazy evaluation of the expression. +; Maybe it will again, so it's left in, as a cover fn to cx:c-code. + +(define (cx:c cx) + (cx:c-code cx) +) + +; Main routine to create a <c-expr> node object. +; MODE is either the mode's symbol (e.g. 'QI) or a mode object. +; CODE is a string of C code. + +(define (cx:make mode code) + (make <c-expr> (mode:lookup mode) code nil) +) + +; Make copy of CX in new mode MODE. +; MODE must be a <mode> object. + +(define (cx-new-mode mode cx) + (make <c-expr> mode (cx:c cx) (cx:atlist cx)) +) + +; Same as cx:make except with attributes. + +(define (cx:make-with-atlist mode code atlist) + (make <c-expr> (mode:lookup mode) code atlist) +) + +; Return a boolean indicated if X is a <c-expr> object. + +(define (c-expr? x) (class-instance? <c-expr> x)) + +; RTX environment support. + +(method-make! + <rtx-temp> 'cxmake-get + (lambda (self estate mode indx selector) + (cx:make mode (rtx-temp-value self))) +) + +(method-make! + <rtx-temp> 'gen-set-quiet + (lambda (self estate mode indx selector src) + (string-append " " (rtx-temp-value self) " = " (cx:c src) ";\n")) +) + +(method-make! + <rtx-temp> 'gen-set-trace + (lambda (self estate mode indx selector src) + (string-append " " (rtx-temp-value self) " = " (cx:c src) ";\n")) +) + +(define (gen-temp-defs estate env) + (string-map (lambda (temp) + (let ((temp-obj (cdr temp))) + (string-append " " (mode:c-type (rtx-temp-mode temp-obj)) + " " (rtx-temp-value temp-obj) ";\n"))) + env) +) + +; Top level routines to handle rtl->c translation. + +; rtl->c configuration parameters + +; #t -> emit calls to rtl cover fns, otherwise emit plain C where possible. +(define -rtl-c-rtl-cover-fns? #f) + +; Called before emitting code to configure the generator. +; ??? I think this can go away now (since cover-fn specification is also +; done at each call to rtl-c). + +(define (rtl-c-config! . args) + (set! -rtl-c-rtl-cover-fns? #f) + (let loop ((args args)) + (if (null? args) + #f ; done + (begin + (case (car args) + ((#:rtl-cover-fns?) + (set! -rtl-c-rtl-cover-fns? (cadr args))) + (else (error "rtl-c-config: unknown option:" (car args)))) + (loop (cddr args))))) + *UNSPECIFIED* +) + +; Subclass of <eval-state> to record additional things needed for rtl->c. + +(define <rtl-c-eval-state> + (class-make '<rtl-c-eval-state> '(<eval-state>) + '( + ; #t -> emit calls to rtl cover fns. + (rtl-cover-fns? . #f) + + ; name of output language, "c" or "c++" + (output-language . "c") + + ; #t if generating code for a macro. + ; Each newline is then preceeded with '\\'. + (macro? . #f) + + ; #f -> reference ifield values using FLD macro. + ; #t -> use C variables. + ; ??? This is only needed to get correct ifield references + ; in opcodes, decoder, and semantics. Maybe a better way to + ; go would be to specify the caller's name so there'd be just + ; one of these, rather than an increasing number. However, + ; for now either way is the same. + ; An alternative is to specify a callback to try first. + (ifield-var? . #f) + ) + nil) +) + +; FIXME: involves upcasting. +(define-getters <rtl-c-eval-state> estate + (rtl-cover-fns? output-language macro? ifield-var?) +) + +; Return booleans indicating if output language is C/C++. + +(define (estate-output-language-c? estate) + (string=? (estate-output-language estate) "c") +) +(define (estate-output-language-c++? estate) + (string=? (estate-output-language estate) "c++") +) + +(method-make! + <rtl-c-eval-state> 'vmake! + (lambda (self args) + ; Initialize parent class first. + (let loop ((args (send-next self 'vmake! args)) (unrecognized nil)) + (if (null? args) + (reverse! unrecognized) ; ??? Could invoke method to initialize here. + (begin + (case (car args) + ((#:rtl-cover-fns?) + (elm-set! self 'rtl-cover-fns? (cadr args))) + ((#:output-language) + (elm-set! self 'output-language (cadr args))) + ((#:macro?) + (elm-set! self 'macro? (cadr args))) + ((#:ifield-var?) + (elm-set! self 'ifield-var? (cadr args))) + (else + ; Build in reverse order, as we reverse it back when we're done. + (set! unrecognized + (cons (cadr args) (cons (car args) unrecognized))))) + (loop (cddr args) unrecognized))))) +) + +; Build an estate for use in generating C. +; CONTEXT is a <context> object or #f if there is none. +; OWNER is the owner of the expression or #f if there is none. +; EXTRA-VARS-ALIST is an association list of (symbol <mode> value) +; elements to be used during value lookup. +; OVERRIDES is a #:keyword/value list of parameters to apply last. + +(define (estate-make-for-rtl-c context owner extra-vars-alist + rtl-cover-fns? macro? overrides) + (apply vmake + (append! + (list + <rtl-c-eval-state> + #:context context + #:owner owner + #:expr-fn (lambda (rtx-obj expr mode estate) + (rtl-c-generator rtx-obj)) + #:env (rtx-env-init-stack1 extra-vars-alist) + #:rtl-cover-fns? rtl-cover-fns? + #:macro? macro?) + overrides)) +) + +(define (estate-make-for-normal-rtl-c extra-vars-alist overrides) + (estate-make-for-rtl-c + #f ; FIXME: context + #f ; FIXME: owner + extra-vars-alist + -rtl-c-rtl-cover-fns? + #f ; macro? + overrides) +) + +; Translate RTL expression EXPR to C. +; ESTATE is the current rtx evaluation state. + +(define (rtl-c-with-estate estate mode expr) + (cx:c (rtl-c-get estate mode (rtx-eval-with-estate expr mode estate))) +) + +; Translate parsed RTL expression X to a string of C code. +; X must have already been fed through rtx-parse/rtx-compile. +; MODE is the desired mode of the value or DFLT for "natural mode". +; EXTRA-VARS-ALIST is an association list of extra (symbol <mode> value) +; elements to be used during value lookup. +; OVERRIDES is a #:keyword/value list of arguments to build the eval state +; with. +; ??? Maybe EXTRA-VARS-ALIST should be handled this way. + +(define (rtl-c-parsed mode x extra-vars-alist . overrides) + (let ((estate (estate-make-for-normal-rtl-c extra-vars-alist overrides))) + (rtl-c-with-estate estate mode x)) +) + +; Same as rtl-c-parsed but X is unparsed. + +(define (rtl-c mode x extra-vars-alist . overrides) + ; ??? rtx-compile could return a closure, then we wouldn't have to + ; pass EXTRA-VARS-ALIST to two routines here. + (let ((estate (estate-make-for-normal-rtl-c extra-vars-alist overrides))) + (rtl-c-with-estate estate mode (rtx-compile #f x extra-vars-alist))) +) + +; C++ versions of rtl-c routines. + +; Build an estate for use in generating C++. +; EXTRA-VARS-ALIST is an association list of (symbol <mode> value) +; elements to be used during value lookup. +; OVERRIDES is a #:keyword/value list of parameters to apply last. + +(define (estate-make-for-normal-rtl-c++ extra-vars-alist overrides) + (estate-make-for-rtl-c + #f ; FIXME: context + #f ; FIXME: owner + extra-vars-alist + -rtl-c-rtl-cover-fns? + #f ; macro? + (cons #:output-language (cons "c++" overrides))) +) + +; Translate parsed RTL expression X to a string of C++ code. +; X must have already been fed through rtx-parse/rtx-compile. +; MODE is the desired mode of the value or DFLT for "natural mode". +; EXTRA-VARS-ALIST is an association list of extra (symbol <mode> value) +; elements to be used during value lookup. +; OVERRIDES is a #:keyword/value list of arguments to build the eval state +; with. +; ??? Maybe EXTRA-VARS-ALIST should be handled this way. + +(define (rtl-c++-parsed mode x extra-vars-alist . overrides) + (let ((estate (estate-make-for-normal-rtl-c++ extra-vars-alist overrides))) + (rtl-c-with-estate estate mode x)) +) + +; Same as rtl-c-parsed but X is unparsed. + +(define (rtl-c++ mode x extra-vars-alist . overrides) + ; ??? rtx-compile could return a closure, then we wouldn't have to + ; pass EXTRA-VARS-ALIST to two routines here. + (let ((estate (estate-make-for-normal-rtl-c++ extra-vars-alist overrides))) + (rtl-c-with-estate estate mode (rtx-compile #f x extra-vars-alist))) +) + +; Top level routines for getting/setting values. + +; Return a <c-expr> node to get the value of SRC in mode MODE. +; ESTATE is the current rtl evaluation state. +; SRC is one of: +; - <c-expr> node +; - rtl expression (e.g. '(add WI dr sr)) +; - sequence's local variable name +; - sequence's local variable object +; - operand name +; - operand object +; - a string of C code +; FIXME: Reduce acceptable values of SRC. +; The result has mode MODE, unless MODE is the "default mode indicator" +; (DFLT) in which case the mode of the result is derived from SRC. +; If SRC is a string, MODE can't be VOID or DFLT. +; +; ??? mode compatibility checks are wip + +(define (rtl-c-get estate mode src) + (logit 4 "(rtl-c-get " (mode-real-name mode) " " (rtx-strdump src) ")\n") + + (let ((mode (mode:lookup mode))) + + (cond ((c-expr? src) + (cond ((or (mode:eq? 'VOID mode) + (mode:eq? 'DFLT mode) + (mode:eq? (cx:mode src) mode)) + src) + ((-rtx-mode-compatible? mode (cx:mode src)) + (cx-new-mode mode src)) + (else + (error (string-append "incompatible mode for " + "(" (obj:name (cx:mode src)) ") " + "\"" (cx:c src) "\"" + ": ") + (obj:name mode))))) + + ; The recursive call to rtl-c-get is in case the result of rtx-eval + ; is a hardware object, rtx-func object, or another rtl expression. + ((rtx? src) + (let ((evald-src (rtx-eval-with-estate src mode estate))) + ; There must have been some change, otherwise we'll loop forever. + (assert (not (eq? src evald-src))) + (rtl-c-get estate mode evald-src))) + + ((or (and (symbol? src) (current-op-lookup src)) + (operand? src)) + (begin + (if (symbol? src) + (set! src (current-op-lookup src))) + (cond ((mode:eq? 'DFLT mode) + ; FIXME: If we fetch the mode here, operands can assume + ; they never get called with "default mode". + (send src 'cxmake-get estate mode #f #f)) + ((-rtx-mode-compatible? mode (op:mode src)) + (let ((mode (-rtx-lazy-sem-mode mode))) + (send src 'cxmake-get estate mode #f #f))) + (else + (error (string-append "operand " (obj:name src) + " referenced in incompatible mode: ") + (obj:name mode)))))) + + ((or (and (symbol? src) (rtx-temp-lookup (estate-env estate) src)) + (rtx-temp? src)) + (begin + (if (symbol? src) + (set! src (rtx-temp-lookup (estate-env estate) src))) + (cond ((mode:eq? 'DFLT mode) + (send src 'cxmake-get estate (rtx-temp-mode src) #f #f)) + ((-rtx-mode-compatible? mode (rtx-temp-mode src)) + (let ((mode (-rtx-lazy-sem-mode mode))) + (send src 'cxmake-get estate mode #f #f))) + (else (error (string-append "sequence temp " (rtx-temp-name src) + " referenced in incompatible mode: ") + (obj:name mode)))))) + + ((integer? src) + ; Default mode of string argument is INT. + (if (or (mode:eq? 'DFLT mode) (mode:eq? 'VOID mode)) + (cx:make INT (number->string src)) + (cx:make mode (number->string src)))) + + ((string? src) + ; Default mode of string argument is INT. + (if (or (mode:eq? 'DFLT mode) (mode:eq? 'VOID mode)) + (cx:make INT src) + (cx:make mode src))) + + (else (error "rtl-c-get: invalid argument:" src)))) +) + +; Return a <c-expr> object to set the value of DEST to SRC. +; ESTATE is the current rtl evaluation state. +; DEST is one of: +; - <c-expr> node +; - rtl expression (e.g. '(mem QI dr)) +; SRC is a <c-expr> object. +; The mode of the result is always VOID (void). + +(define (rtl-c-set-quiet estate mode dest src) + ;(display (list 'rtl-c-set-quiet mode dest src)) (newline) + (let ((xdest (cond ((c-expr? dest) + dest) + ((rtx? dest) + (rtx-eval-with-estate dest mode estate)) + (else + (error "rtl-c-set-quiet: invalid dest:" dest))))) + (if (not (object? xdest)) + (error "rtl-c-set-quiet: invalid dest:" dest)) + (let ((mode (if (mode:eq? 'DFLT mode) + (-rtx-obj-mode xdest) + (-rtx-lazy-sem-mode mode)))) + (assert (mode? mode)) + (cx:make VOID (send xdest 'gen-set-quiet + estate mode #f #f + (rtl-c-get estate mode src))))) +) + +; Same as rtl-c-set-quiet except also print TRACE_RESULT message. +; ??? One possible change is to defer the (rtl-c-get src) call to dest's +; set handler. Such sources would be marked accordingly and rtl-c-get +; would recognize them. This would allow, for example, passing the address +; of the result to the computation. + +(define (rtl-c-set-trace estate mode dest src) + ;(display (list 'rtl-c-set-trace mode dest src)) (newline) + (let ((xdest (cond ((c-expr? dest) + dest) + ((rtx? dest) + (rtx-eval-with-estate dest mode estate)) + (else + (error "rtl-c-set-trace: invalid dest:" dest))))) + (if (not (object? xdest)) + (error "rtl-c-set-trace: invalid dest:" dest)) + (let ((mode (if (mode:eq? 'DFLT mode) + (-rtx-obj-mode xdest) ; FIXME: internal routines + (-rtx-lazy-sem-mode mode)))) + (assert (mode? mode)) + (cx:make VOID (send xdest 'gen-set-trace + estate mode #f #f + (rtl-c-get estate mode src))))) +) + +; Emit C code for each rtx function. + +; Table mapping rtx function to C generator. + +(define -rtl-c-gen-table #f) + +; Return the C generator for <rtx-func> F. + +(define (rtl-c-generator f) + (vector-ref -rtl-c-gen-table (rtx-num f)) +) + +; Support for explicit C/C++ code. +; ??? Actually, "support for explicit foreign language code". +; s-c-call needs a better name but "unspec" seems like obfuscation. +; ??? Need to distinguish owner of call (cpu, ???). + +(define (s-c-call estate mode name . args) + (cx:make mode + (string-append + (if (estate-output-language-c++? estate) + (string-append "current_cpu->" name " (") + ; FIXME: Prepend @cpu@_ to name here, and delete @cpu@_ from + ; description file. + (string-append name " (current_cpu")) + (let ((c-args + (string-map (lambda (arg) + (string-append + ", " + (cx:c (rtl-c-get estate DFLT arg)))) + args))) + (if (estate-output-language-c++? estate) + (string-drop 2 c-args) + c-args)) + ; If the mode is VOID, this is a statement. + ; Otherwise it's an expression. + (if (or (mode:eq? 'DFLT mode) + (mode:eq? 'VOID mode)) + ");\n" + ")") + )) +) + +; Same as c-call except there is no particular owner of the call. +; In general this means making a call to a non-member function, +; whereas c-call makes calls to member functions (in C++ parlance). + +(define (s-c-raw-call estate mode name . args) + (cx:make mode + (string-append + name " (" + (string-drop 2 + (string-map (lambda (elm) + (string-append + ", " (cx:c (rtl-c-get estate DFLT elm)))) + args)) + ; If the mode is VOID, this is a statement. + ; Otherwise it's an expression. + (if (or (mode:eq? 'DFLT mode) + (mode:eq? 'VOID mode)) + ");\n" + ")") + )) +) + +; Standard arithmetic operations. + +; Return a boolean indicating if a cover function/macro should be emitted +; to perform an operation. +; C-OP is a string containing the C operation or #f if there is none. +; MODE is the mode of the operation. + +(define (-rtx-use-sem-fn? estate c-op mode) + ; If no C operation has been provided, use a macro, or + ; if this is the simulator and MODE is not a host mode, use a macro. +; (or (not c-op) +; (and (estate-rtl-cover-fns? estate) +; (not (mode:host? mode)))) + ; FIXME: The current definition is a temporary hack while host/target-ness + ; of INT/UINT is unresolved. + (and (not (obj-has-attr? mode 'FORCE-C)) + (or (not c-op) + (and (estate-rtl-cover-fns? estate) + (or (insn? (estate-owner estate)) + (not (mode:host? mode)))))) +) + +; One operand referenced, result is in same mode. + +(define (s-unop estate name c-op mode src) + (let* ((val (rtl-c-get estate mode src)) + ; Refetch mode in case it was DFLT and ensure unsigned->signed. + (mode (cx:mode val)) + (sem-mode (-rtx-sem-mode mode))) + ; FIXME: Argument checking. + + (if (-rtx-use-sem-fn? estate c-op mode) + (if (mode-float? mode) + (cx:make sem-mode + (string-append "(* CGEN_CPU_FPU (current_cpu)->ops->" + (string-downcase name) + (string-downcase (obj:name sem-mode)) + ") (CGEN_CPU_FPU (current_cpu), " + (cx:c val) ")")) + (cx:make sem-mode + (string-append name (obj:name sem-mode) + " (" (cx:c val) ")"))) + (cx:make mode ; not sem-mode on purpose + (string-append "(" c-op " (" + (cx:c val) "))")))) +) + +; Two operands referenced in the same mode producing a result in the same mode. +; If MODE is DFLT, use the mode of SRC1. +; +; ??? Will eventually want to handle floating point modes specially. Since +; bigger modes may get clumsily passed (there is no pass by reference in C) and +; since we want to eventually handle lazy transformation, FP values could be +; passed by reference. This is easy in C++. C requires more work and is +; defered until it's warranted. +; Implementing this should probably be via a new cxmake-get-ref method, +; rather then complicating cxmake-get. Ditto for rtl-c-get-ref/rtl-c-get. + +(define (s-binop estate name c-op mode src1 src2) + (let* ((val1 (rtl-c-get estate mode src1)) + ; Refetch mode in case it was DFLT and ensure unsigned->signed. + (mode (cx:mode val1)) + (sem-mode (-rtx-sem-mode mode)) + (val2 (rtl-c-get estate mode src2))) + ; FIXME: Argument checking. + + (if (-rtx-use-sem-fn? estate c-op mode) + (if (mode-float? mode) + (cx:make sem-mode + (string-append "(* CGEN_CPU_FPU (current_cpu)->ops->" + (string-downcase name) + (string-downcase (obj:name sem-mode)) + ") (CGEN_CPU_FPU (current_cpu), " + (cx:c val1) ", " + (cx:c val2) ")")) + (cx:make sem-mode + (string-append name (obj:name sem-mode) + " (" (cx:c val1) ", " + (cx:c val2) ")"))) + (cx:make mode ; not sem-mode on purpose + (string-append "((" + (cx:c val1) + ") " c-op " (" + (cx:c val2) + "))")))) +) + +; Same as s-binop except there's a third argument which is always one bit. + +(define (s-binop-with-bit estate name mode src1 src2 src3) + (let* ((val1 (rtl-c-get estate mode src1)) + ; Refetch mode in case it was DFLT and ensure unsigned->signed. + (mode (-rtx-sem-mode (cx:mode val1))) + (val2 (rtl-c-get estate mode src2)) + (val3 (rtl-c-get estate 'BI src3))) + ; FIXME: Argument checking. + (cx:make mode + (string-append name (obj:name mode) + " (" + (cx:c val1) ", " + (cx:c val2) ", " + (cx:c val3) + ")"))) +) + +; Shift operations are slightly different than binary operations: +; the mode of src2 is any integral mode. +; ??? Note that some cpus have a signed shift left that is semantically +; different from a logical one. May need to create `sla' some day. Later. + +(define (s-shop estate name c-op mode src1 src2) + (let* ((val1 (rtl-c-get estate mode src1)) + ; Refetch mode in case it was DFLT and ensure unsigned->signed + ; [sign of operation is determined from operation name, not mode]. + (mode (cx:mode val1)) + (sem-mode (-rtx-sem-mode mode)) + (val2 (rtl-c-get estate mode src2))) + ; FIXME: Argument checking. + + (if (-rtx-use-sem-fn? estate c-op mode) + (cx:make sem-mode + (string-append name (obj:name sem-mode) + " (" (cx:c val1) ", " + (cx:c val2) ")")) + (cx:make mode ; not sem-mode on purpose + (string-append "(" + ; Ensure correct sign of shift. + (cond ((equal? name "SRL") + (string-append "(" + (if (eq? (mode:class mode) 'UINT) + "" + "unsigned ") + (mode:non-mode-c-type mode) + ") ")) + ((equal? name "SRA") + (string-append "(" + (mode:non-mode-c-type mode) + ") ")) + (else "")) + "(" (cx:c val1) ") " + c-op + " (" (cx:c val2) "))")))) +) + +; Process andif, orif. +; SRC1 and SRC2 have any arithmetic mode. +; The result has mode BI. +; ??? May want to use INT as BI may introduce some slowness +; in the generated code. + +(define (s-boolifop estate name c-op src1 src2) + (let* ((val1 (rtl-c-get estate DFLT src1)) + (val2 (rtl-c-get estate DFLT src2))) + ; FIXME: Argument checking. + ; If this is the simulator and MODE is not a host mode, use a macro. + ; ??? MODE here being the mode of SRC1. Maybe later. + (if (estate-rtl-cover-fns? estate) + (cx:make (mode:lookup 'BI) + (string-append name ; "BI", leave off mode, no need for it + " (" (cx:c val1) ", " + (cx:c val2) ")")) + (cx:make (mode:lookup 'BI) + (string-append "((" + (cx:c val1) + ") " c-op " (" + (cx:c val2) + "))")))) +) + +; Mode conversions. + +(define (s-convop estate name mode s1) + ; Get S1 in its normal mode, then convert. + (let ((s (rtl-c-get estate DFLT s1)) + (mode (mode:lookup mode))) + (if (and (not (estate-rtl-cover-fns? estate)) + (mode:host? (cx:mode s))) + (cx:make mode + (string-append "((" (obj:name mode) ")" + " (" (obj:name (cx:mode s)) ")" + " (" (cx:c s) "))")) + (if (or (mode-float? mode) + (mode-float? (cx:mode s))) + (cx:make mode + (string-append "(* CGEN_CPU_FPU (current_cpu)->ops->" + (string-downcase name) + (string-downcase (obj:name (-rtx-sem-mode (cx:mode s)))) + (string-downcase (obj:name (-rtx-sem-mode mode))) + ") (CGEN_CPU_FPU (current_cpu), " + (cx:c s) ")")) + (cx:make mode + (string-append name + (obj:name (-rtx-sem-mode (cx:mode s))) + (obj:name (-rtx-sem-mode mode)) + " (" (cx:c s) ")"))))) +) + +; Compare SRC1 and SRC2 in mode MODE. The result has mode BI. +; NAME is one of eq,ne,lt,le,gt,ge,ltu,leu,gtu,geu. +; ??? May want a host int mode result as BI may introduce some slowness +; in the generated code. + +(define (s-cmpop estate name c-op mode src1 src2) + (let* ((val1 (rtl-c-get estate mode src1)) + ; Refetch mode in case it was DFLT. + (mode (cx:mode val1)) + (val2 (rtl-c-get estate mode src2))) + ; FIXME: Argument checking. + + ; If no C operation has been provided, use a macro, or + ; if this is the simulator and MODE is not a host mode, use a macro. + (if (-rtx-use-sem-fn? estate c-op mode) + (if (mode-float? mode) + (cx:make (mode:lookup 'BI) + (string-append "(* CGEN_CPU_FPU (current_cpu)->ops->" + (string-downcase name) + (string-downcase (obj:name (-rtx-sem-mode mode))) + ") (CGEN_CPU_FPU (current_cpu), " + (cx:c val1) ", " + (cx:c val2) ")")) + (cx:make (mode:lookup 'BI) + (string-append (string-upcase name) + (if (memq name '(eq ne)) + (obj:name (-rtx-sem-mode mode)) + (obj:name mode)) + " (" (cx:c val1) ", " + (cx:c val2) ")"))) + (cx:make (mode:lookup 'BI) + (string-append "((" + (cx:c val1) + ") " c-op " (" + (cx:c val2) + "))")))) +) + +; Conditional execution. + +; `if' in RTL has a result, like ?: in C. +; We support both: one with a result (non VOID mode), and one without (VOID mode). +; The non-VOID case must have an else part. +; MODE is the mode of the result, not the comparison. +; The comparison is expected to return a zero/non-zero value. +; ??? Perhaps this should be a syntax-expr. Later. + +(define (s-if estate mode cond then . else) + (if (> (length else) 1) + (error "if: too many elements in `else' part" else)) + (let () + (if (or (mode:eq? 'DFLT mode) + (mode:eq? 'VOID mode)) + (cx:make mode + (string-append "if (" (cx:c (rtl-c-get estate DFLT cond)) ")" + " {\n" (cx:c (rtl-c-get estate mode then)) "}" + (if (not (null? else)) + (string-append " else {\n" + (cx:c (rtl-c-get estate mode (car else))) + "}\n") + "\n") + )) + (if (= (length else) 1) + (cx:make mode + (string-append "((" + (cx:c (rtl-c-get estate DFLT cond)) + ") ? (" + (cx:c (rtl-c-get estate mode then)) + ") : (" + (cx:c (rtl-c-get estate mode (car else))) + "))")) + (error "non-VoidMode `if' must have `else' part")))) +) + +; A multiway `if'. +; If MODE is VOID emit a series of if/else's. +; If MODE is not VOID, emit a series of ?:'s. +; COND-CODE-LIST is a list of lists, each sublist is a list of two elements: +; condition, code. The condition part must return a zero/non-zero value, and +; the code part is treated as a `sequence'. +; This defer argument evaluation, the syntax +; ((... condition ...) ... action ...) +; needs special parsing. +; FIXME: Need more error checking of arguments. + +(define (s-cond estate mode . cond-code-list) + (let ((vm? (or (mode:eq? 'DFLT mode) (mode:eq? 'VOID mode)))) + (if (null? cond-code-list) + (error "empty `cond'")) + (let ((if-part (if vm? "if (" "(")) + (then-part (if vm? ") " ") ? ")) + (elseif-part (if vm? " else if (" " : (")) + (else-part (if vm? " else " " : ")) + (fi-part (if vm? "" ")"))) + (let loop ((result + (string-append + if-part + (cx:c (rtl-c-get estate DFLT (caar cond-code-list))) + then-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar cond-code-list)))))))) + (ccl (cdr cond-code-list))) + (cond ((null? ccl) (cx:make mode result)) + ((eq? (caar ccl) 'else) + (cx:make mode + (string-append + result + else-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar ccl))))))))) + (else (loop (string-append + result + elseif-part + (cx:c (rtl-c-get estate DFLT (caar ccl))) + then-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar ccl))))))) + (cdr ccl))))))) +) + +; Utility of s-case to print a case prefix (for lack of a better term). + +(define (-gen-case-prefix val) + (string-append " case " + (cond ((number? val) + (number->string val)) + ((symbol? val) + (string-upcase (gen-c-symbol val))) ; yes, upcase + ((string? val) val) + (else + (parse-error "case:" "bad case" val))) + " : ") +) + +; Utility of s-case to handle a void result. + +(define (s-case-vm estate test case-list) + (cx:make + VOID + (string-append + " switch (" + (cx:c (rtl-c-get estate DFLT test)) + ")\n" + " {\n" + (string-map (lambda (case-entry) + (let ((caseval (car case-entry)) + (code (cdr case-entry))) + (string-append + (cond ((list? caseval) + (string-map -gen-case-prefix caseval)) + ((eq? 'else caseval) + (string-append " default : ")) + (else + (-gen-case-prefix caseval))) + (cx:c (apply s-sequence + (cons estate (cons VOID (cons nil code))))) + " break;\n"))) + case-list) + " }\n")) +) + +; Utility of s-case-non-vm to generate code to perform the test. + +(define (-gen-non-vm-case-test estate mode test cases) + (assert (not (null? cases))) + (let loop ((result "") (cases cases)) + (if (null? cases) + result + (let ((case (cond ((number? (car cases)) + (car cases)) + ((symbol? (car cases)) + (if (enum-lookup-val (car cases)) + (rtx-make 'enum mode (car cases)) + (context-error (estate-context estate) + "symbol not an enum" + (car cases)))) + (else (error "invalid case" (car cases)))))) + (loop (string-append + result + (if (= (string-length result) 0) + "" + " || ") + (cx:c (rtl-c-get estate mode test)) + " == " + (cx:c (rtl-c-get estate mode case))) + (cdr cases))))) +) + +; Utility of s-case to handle a non-void result. +; This is expanded as a series of ?:'s. + +(define (s-case-non-vm estate mode test case-list) + (let ((if-part "(") + (then-part ") ? ") + (elseif-part " : (") + (else-part " : ") + (fi-part ")")) + (let loop ((result + (string-append + if-part + (-gen-non-vm-case-test estate mode test (caar case-list)) + then-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar case-list)))))))) + (cl (cdr case-list))) + (cond ((null? cl) (cx:make mode result)) + ((eq? (caar cl) 'else) + (cx:make mode + (string-append + result + else-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar cl))))))))) + (else (loop (string-append + result + elseif-part + (-gen-non-vm-case-test estate mode test (caar cl)) + then-part + (cx:c (apply s-sequence + (cons estate + (cons mode + (cons nil + (cdar cl))))))) + (cdr cl)))))) +) + +; C switch statement +; To follow convention, MODE is the first arg. +; FIXME: What to allow for case choices is wip. + +(define (s-case estate mode test . case-list) + (if (or (mode:eq? 'DFLT mode) (mode:eq? 'VOID mode)) + (s-case-vm estate test case-list) + (s-case-non-vm estate mode test case-list)) +) + +; Parallels and Sequences + +; Temps for `parallel' are recorded differently than for `sequence'. +; ??? I believe this is because there was an interaction between the two. + +(define -par-temp-list nil) + +; Record a temporary needed for a parallel in mode MODE. +; We just need to record the mode with a unique name so we use a <c-expr> +; object where the "expression" is the variable's name. + +(define (-par-new-temp! mode) + (set! -par-temp-list + (cons (cx:make mode (string-append "temp" + (number->string + (length -par-temp-list)))) + -par-temp-list)) + (car -par-temp-list) +) + +; Return the next temp from the list, and leave the list pointing to the +; next one. + +(define (-par-next-temp!) + (let ((result (car -par-temp-list))) + (set! -par-temp-list (cdr -par-temp-list)) + result) +) + +(define (-gen-par-temp-defns temp-list) + ;(display temp-list) (newline) + (string-append + " " + ; ??? mode:c-type + (string-map (lambda (temp) (string-append (obj:name (cx:mode temp)) " " (cx:c temp) ";")) + temp-list) + "\n") +) + +; Parallels are handled by converting them into two sequences. The first has +; all set destinations replaced with temps, and the second has all set sources +; replaced with those temps. +; ??? Revisit later to see if (if ...) and (set pc ...) is ok. +; How about disallowing if's and jump's inside parallels? +; One can still put a parallel inside an `if' however. + +(define (-par-replace-set-dests estate exprs) + (let ((sets (list 'set 'set-quiet + (rtx-lookup 'set) (rtx-lookup 'set-quiet)))) + (letrec ((replace + (lambda (expr) + (let ((name (car expr)) + (options (rtx-options expr)) + (mode (rtx-mode expr))) + (if (memq name sets) + (list name + options + mode + (-par-new-temp! ; replace dest with temp + (if (mode:eq? 'DFLT mode) + (rtx-lvalue-mode-name estate (rtx-set-dest expr)) + mode)) + (rtx-set-src expr)) + (cons name + (cons options + (cons mode (replace (rtx-args expr))))))))) + ) + (map replace exprs))) +) + +; This must process expressions in the same order as -par-replace-set-dests! + +(define (-par-replace-set-srcs estate exprs) + (let ((sets (list 'set 'set-quiet + (rtx-lookup 'set) (rtx-lookup 'set-quiet)))) + (letrec ((replace + (lambda (expr) + (let ((name (car expr)) + (options (rtx-options expr)) + (mode (rtx-mode expr))) + (if (memq name sets) + (list name + options + mode + (rtx-set-dest expr) + (-par-next-temp!)) ; the source's temp + (cons name + (cons options + (cons mode (replace (cddr expr))))))))) + ) + (map replace exprs))) +) + +; Return a <c-expr> node for a `parallel'. + +(define (s-parallel estate . exprs) + (begin + ; Initialize -par-temp-list for -par-replace-set-dests. + (set! -par-temp-list nil) + (let* ((set-dests (string-map (lambda (e) + (rtl-c-with-estate estate VOID e)) + (-par-replace-set-dests estate exprs))) + (temps (reverse! -par-temp-list))) + ; Initialize -par-temp-list for -par-replace-set-srcs. + (set! -par-temp-list temps) + (cx:make VOID + (string-append + ; FIXME: do {} while (0); doesn't get "optimized out" + ; internally by gcc, meaning two labels and a loop are + ; created for it to have to process. We can generate pretty + ; big files and can cause gcc to require *lots* of memory. + ; So let's try just {} ... + "{\n" + (-gen-par-temp-defns temps) + set-dests + (string-map (lambda (e) + (rtl-c-with-estate estate VOID e)) + (-par-replace-set-srcs estate exprs)) + "}\n") + ))) +) + +; Return a <c-expr> node for a `sequence'. + +(define (s-sequence estate mode env . exprs) + (let* ((env (rtx-env-make-locals env)) ; compile env + (estate (estate-push-env estate env))) + (if (or (mode:eq? 'DFLT mode) + (mode:eq? 'VOID mode)) + (cx:make mode + (string-append + ; FIXME: do {} while (0); doesn't get "optimized out" + ; internally by gcc, meaning two labels and a loop are + ; created for it to have to process. We can generate pretty + ; big files and can cause gcc to require *lots* of memory. + ; So let's try just {} ... + "{\n" + (gen-temp-defs estate env) + (string-map (lambda (e) + (rtl-c-with-estate estate DFLT e)) + exprs) + "}\n")) + (cx:make mode + (string-append + ; Don't use GCC extension unless necessary. + (if (rtx-env-empty? env) "(" "({ ") + (gen-temp-defs estate env) + (string-drop 2 + (string-map + (lambda (e) + (string-append + ", " + (rtl-c-with-estate estate DFLT e))) + exprs)) + (if (rtx-env-empty? env) ")" "; })"))))) +) + +; ***************************************************************************** +; +; RTL->C generators for each rtx function. + +; Return code to set FN as the generator for RTX. + +(defmacro define-fn (rtx args expr . rest) + `(begin + (assert (rtx-lookup (quote ,rtx))) + (vector-set! table (rtx-num (rtx-lookup (quote ,rtx))) + (lambda ,args ,@(cons expr rest)))) +) + +(define (rtl-c-init!) + (set! -rtl-c-gen-table (rtl-c-build-table)) + *UNSPECIFIED* +) + +; The rest of this file is one big function to return the rtl->c lookup table. + +(define (rtl-c-build-table) + (let ((table (make-vector (rtx-max-num) #f))) + +; Error generation + +(define-fn error (estate options mode message) + (let ((c-call (s-c-call estate mode "cgen_rtx_error" + (string-append "\"" + (backslash "\"" message) + "\"")))) + (if (or (mode:eq? 'DFLT mode) (mode:eq? 'VOID mode)) + c-call + (cx:make mode (string-append "(" (cx:c c-call) ", 0)")))) +) + +; Enum support + +(define-fn enum (estate options mode name) + (cx:make mode (string-upcase (gen-c-symbol name))) +) + +; Instruction field support. +; ??? This should build an operand object like -build-ifield-operand! does +; in semantics.scm. +; ??? Mode support is wip. + +(define-fn ifield (estate options mode ifld-name) + (if (estate-ifield-var? estate) + (cx:make 'UINT (gen-c-symbol ifld-name)) + (cx:make 'UINT (string-append "FLD (" (gen-c-symbol ifld-name) ")"))) +; (let ((f (current-ifld-lookup ifld-name))) +; (make <operand> ifld-name ifld-name +; (atlist-cons (bool-attr-make 'SEM-ONLY #t) +; (obj-atlist f)) +; (obj:name (ifld-hw-type f)) +; (obj:name (ifld-mode f)) +; (make <hw-index> 'anonymous +; 'ifield (ifld-mode f) f) +; nil #f #f)) +) + +; Operand support + +(define-fn operand (estate options mode object-or-name) + (cond ((operand? object-or-name) + object-or-name) + ((symbol? object-or-name) + (let ((object (current-op-lookup object-or-name))) + (if (not object) + (context-error (estate-context estate) + "undefined operand" object-or-name)) + object)) + (else + (context-error (estate-context estate) + "bad arg to `operand'" object-or-name))) +) + +(define-fn xop (estate options mode object) object) + +(define-fn local (estate options mode object-or-name) + (cond ((rtx-temp? object-or-name) + object-or-name) + ((symbol? object-or-name) + (let ((object (rtx-temp-lookup (estate-env estate) object-or-name))) + (if (not object) + (context-error (estate-context estate) + "undefined local" object-or-name)) + object)) + (else + (context-error (estate-context estate) + "bad arg to `local'" object-or-name))) +) + +(define-fn reg (estate options mode hw-elm . indx-sel) + (let ((indx (or (list-maybe-ref indx-sel 0) 0)) + (sel (or (list-maybe-ref indx-sel 1) hw-selector-default))) + (s-hw estate mode hw-elm indx sel)) +) + +(define-fn raw-reg (estate options mode hw-elm . indx-sel) + (let ((indx (or (list-maybe-ref indx-sel 0) 0)) + (sel (or (list-maybe-ref indx-sel 1) hw-selector-default))) + (let ((result (s-hw estate mode hw-elm indx sel))) + (obj-cons-attr! result (bool-attr-make 'RAW #t)) + result)) +) + +(define-fn mem (estate options mode addr . sel) + (s-hw estate mode 'h-memory addr + (if (pair? sel) (car sel) hw-selector-default)) +) + +(define-fn pc (estate options mode) + s-pc +) + +(define-fn ref (estate options mode name) + (if (not (insn? (estate-owner estate))) + (error "ref: not processing an insn")) + (cx:make 'UINT + (string-append + "(referenced & (1 << " + (number->string + (op:num (insn-lookup-op (estate-owner estate) name))) + "))")) +) + +; ??? Maybe this should return an operand object. +(define-fn index-of (estate options mode op) + (send (op:index (rtx-eval-with-estate op 'DFLT estate)) 'cxmake-get estate 'DFLT) +) + +(define-fn clobber (estate options mode object) + (cx:make VOID "; /*clobber*/\n") +) + +(define-fn delay (estate options mode n rtx) + (s-sequence (estate-with-modifiers estate '((#:delay))) VOID '() rtx) ; wip! +) + +; Gets expanded as a macro. +;(define-fn annul (estate yes?) +; (s-c-call estate 'VOID "SEM_ANNUL_INSN" "pc" yes?) +;) + +(define-fn skip (estate options mode yes?) + (send pc 'cxmake-skip estate yes?) + ;(s-c-call estate 'VOID "SEM_SKIP_INSN" "pc" yes?) +) + +(define-fn eq-attr (estate options mode obj attr-name value) + (cx:make 'INT + (string-append "(GET_ATTR (" + (gen-c-symbol attr-name) + ") == " + (gen-c-symbol value) + ")")) +) + +(define-fn attr (estate options mode owner attr-name) + (cond ((equal? owner '(current-insn () DFLT)) + (s-c-raw-call estate 'INT "GET_ATTR" + (string-upcase (gen-c-symbol attr-name)))) + (else (error "attr: unsupported object type:" owner))) +) + +(define-fn const (estate options mode c) + (assert (not (mode:eq? 'VOID mode))) + (if (mode:eq? 'DFLT mode) + (set! mode 'INT)) + (let ((mode (mode:lookup mode))) + (cx:make mode + (cond ((or (mode:eq? 'DI mode) + (mode:eq? 'UDI mode)) + (string-append "MAKEDI (" + (gen-integer (high-part c)) ", " + (gen-integer (low-part c)) + ")")) + ((and (<= #x-80000000 c) (> #x80000000 c)) + (number->string c)) + ((and (<= #x80000000 c) (>= #xffffffff c)) + ; ??? GCC complains if not affixed with "U" but that's not k&r. + ;(string-append (number->string val) "U")) + (string-append "0x" (number->string c 16))) + ; Else punt. + (else (number->string c))))) +) + +(define-fn join (estate options out-mode in-mode arg1 . arg-rest) + ; FIXME: Endianness issues undecided. + ; FIXME: Ensure correct number of args for in/out modes. + ; Ensure compatible modes. + (apply s-c-raw-call (cons estate + (cons out-mode + (cons (string-append "JOIN" + in-mode + out-mode) + (cons arg1 arg-rest))))) +) + +(define-fn subword (estate options mode value word-num) + (let* ((mode (mode:lookup mode)) + (val (rtl-c-get estate DFLT value)) + ; Refetch mode in case it was DFLT. + (val-mode (cx:mode val))) + (cx:make mode + (string-append "SUBWORD" (obj:name val-mode) (obj:name mode) + " (" (cx:c val) + (if (mode-bigger? val-mode mode) + (string-append + ", " + (if (number? word-num) + (number->string word-num) + (cx:c (rtl-c-get estate DFLT word-num)))) + "") + ")"))) +) + +(define-fn c-code (estate options mode text) + (cx:make mode text) +) + +(define-fn c-call (estate options mode name . args) + (apply s-c-call (cons estate (cons mode (cons name args)))) +) + +(define-fn c-raw-call (estate options mode name . args) + (apply s-c-raw-call (cons estate (cons mode (cons name args)))) +) + +(define-fn nop (estate options mode) + (cx:make VOID "((void) 0); /*nop*/\n") +) + +(define-fn set (estate options mode dst src) + (if (insn? (estate-owner estate)) + (rtl-c-set-trace estate mode dst (rtl-c-get estate mode src)) + (rtl-c-set-quiet estate mode dst (rtl-c-get estate mode src))) +) + +(define-fn set-quiet (estate options mode dst src) + (rtl-c-set-quiet estate mode dst (rtl-c-get estate mode src)) +) + +(define-fn neg (estate options mode s1) + (s-unop estate "NEG" "-" mode s1) +) + +(define-fn abs (estate options mode s1) + (s-unop estate "ABS" #f mode s1) +) + +(define-fn inv (estate options mode s1) + (s-unop estate "INV" "~" mode s1) +) + +(define-fn not (estate options mode s1) + (s-unop estate "NOT" "!" mode s1) +) + +(define-fn add (estate options mode s1 s2) + (s-binop estate "ADD" "+" mode s1 s2) +) +(define-fn sub (estate options mode s1 s2) + (s-binop estate "SUB" "-" mode s1 s2) +) + +(define-fn addc (estate options mode s1 s2 s3) + (s-binop-with-bit estate "ADDC" mode s1 s2 s3) +) +(define-fn add-cflag (estate options mode s1 s2 s3) + (s-binop-with-bit estate "ADDCF" mode s1 s2 s3) +) +(define-fn add-oflag (estate options mode s1 s2 s3) + (s-binop-with-bit estate "ADDOF" mode s1 s2 s3) +) +(define-fn subc (estate options mode s1 s2 s3) + (s-binop-with-bit estate "SUBC" mode s1 s2 s3) +) +(define-fn sub-cflag (estate options mode s1 s2 s3) + (s-binop-with-bit estate "SUBCF" mode s1 s2 s3) +) +(define-fn sub-oflag (estate options mode s1 s2 s3) + (s-binop-with-bit estate "SUBOF" mode s1 s2 s3) +) + +;(define-fn zflag (estate options mode value) +; (list 'eq mode value (list 'const mode 0)) +;) + +;(define-fn nflag (estate options mode value) +; (list 'lt mode value (list 'const mode 0)) +;) + +(define-fn mul (estate options mode s1 s2) + (s-binop estate "MUL" "*" mode s1 s2) +) +(define-fn div (estate options mode s1 s2) + (s-binop estate "DIV" "/" mode s1 s2) +) +(define-fn udiv (estate options mode s1 s2) + (s-binop estate "UDIV" "/" mode s1 s2) +) +(define-fn mod (estate options mode s1 s2) + (s-binop estate "MOD" "%" mode s1 s2) +) +(define-fn umod (estate options mode s1 s2) + (s-binop estate "UMOD" "%" mode s1 s2) +) + +(define-fn sqrt (estate options mode s1) + (s-unop estate "SQRT" #f mode s1) +) +(define-fn cos (estate options mode s1) + (s-unop estate "COS" #f mode s1) +) +(define-fn sin (estate options mode s1) + (s-unop estate "SIN" #f mode s1) +) + +(define-fn min (estate options mode s1 s2) + (s-binop estate "MIN" #f mode s1 s2) +) +(define-fn max (estate options mode s1 s2) + (s-binop estate "MAX" #f mode s1 s2) +) +(define-fn umin (estate options mode s1 s2) + (s-binop estate "UMIN" #f mode s1 s2) +) +(define-fn umax (estate options mode s1 s2) + (s-binop estate "UMAX" #f mode s1 s2) +) + +(define-fn and (estate options mode s1 s2) + (s-binop estate "AND" "&" mode s1 s2) +) +(define-fn or (estate options mode s1 s2) + (s-binop estate "OR" "|" mode s1 s2) +) +(define-fn xor (estate options mode s1 s2) + (s-binop estate "XOR" "^" mode s1 s2) +) + +(define-fn sll (estate options mode s1 s2) + (s-shop estate "SLL" "<<" mode s1 s2) +) +(define-fn srl (estate options mode s1 s2) + (s-shop estate "SRL" ">>" mode s1 s2) +) +(define-fn sra (estate options mode s1 s2) + (s-shop estate "SRA" ">>" mode s1 s2) +) +(define-fn ror (estate options mode s1 s2) + (s-shop estate "ROR" #f mode s1 s2) +) +(define-fn rol (estate options mode s1 s2) + (s-shop estate "ROL" #f mode s1 s2) +) + +(define-fn andif (estate options mode s1 s2) + (s-boolifop estate "ANDIF" "&&" s1 s2) +) +(define-fn orif (estate options mode s1 s2) + (s-boolifop estate "ORIF" "||" s1 s2) +) + +(define-fn ext (estate options mode s1) + (s-convop estate "EXT" mode s1) +) +(define-fn zext (estate options mode s1) + (s-convop estate "ZEXT" mode s1) +) +(define-fn trunc (estate options mode s1) + (s-convop estate "TRUNC" mode s1) +) +(define-fn fext (estate options mode s1) + (s-convop estate "FEXT" mode s1) +) +(define-fn ftrunc (estate options mode s1) + (s-convop estate "FTRUNC" mode s1) +) +(define-fn float (estate options mode s1) + (s-convop estate "FLOAT" mode s1) +) +(define-fn ufloat (estate options mode s1) + (s-convop estate "UFLOAT" mode s1) +) +(define-fn fix (estate options mode s1) + (s-convop estate "FIX" mode s1) +) +(define-fn ufix (estate options mode s1) + (s-convop estate "UFIX" mode s1) +) + +(define-fn eq (estate options mode s1 s2) + (s-cmpop estate 'eq "==" mode s1 s2) +) +(define-fn ne (estate options mode s1 s2) + (s-cmpop estate 'ne "!=" mode s1 s2) +) + +(define-fn lt (estate options mode s1 s2) + (s-cmpop estate 'lt "<" mode s1 s2) +) +(define-fn le (estate options mode s1 s2) + (s-cmpop estate 'le "<=" mode s1 s2) +) +(define-fn gt (estate options mode s1 s2) + (s-cmpop estate 'gt ">" mode s1 s2) +) +(define-fn ge (estate options mode s1 s2) + (s-cmpop estate 'ge ">=" mode s1 s2) +) + +(define-fn ltu (estate options mode s1 s2) + (s-cmpop estate 'ltu "<" mode s1 s2) +) +(define-fn leu (estate options mode s1 s2) + (s-cmpop estate 'leu "<=" mode s1 s2) +) +(define-fn gtu (estate options mode s1 s2) + (s-cmpop estate 'gtu ">" mode s1 s2) +) +(define-fn geu (estate options mode s1 s2) + (s-cmpop estate 'geu ">=" mode s1 s2) +) + +(define-fn member (estate options mode value set) + ; FIXME: Multiple evalutions of VALUE. + (let ((c-value (rtl-c-get estate 'DFLT value)) + (set (rtx-number-list-values set))) + (let loop ((set (cdr set)) + (code (string-append "(" (cx:c c-value) + " == " + (gen-integer (car set)) + ")"))) + (if (null? set) + (cx:make (mode:lookup 'BI) (string-append "(" code ")")) + (loop (cdr set) + (string-append code + " || (" + (cx:c c-value) + " == " + (gen-integer (car set)) + ")"))))) +) + +(define-fn if (estate options mode cond then . else) + (apply s-if (append! (list estate mode cond then) else)) +) + +(define-fn cond (estate options mode . cond-code-list) + (apply s-cond (cons estate (cons mode cond-code-list))) +) + +(define-fn case (estate options mode test . case-list) + (apply s-case (cons estate (cons mode (cons test case-list)))) +) + +(define-fn parallel (estate options mode ignore expr . exprs) + (apply s-parallel (cons estate (cons expr exprs))) +) + +(define-fn sequence (estate options mode locals expr . exprs) + (apply s-sequence + (cons estate (cons mode (cons locals (cons expr exprs))))) +) + +(define-fn closure (estate options mode expr env) + ; ??? estate-push-env? + (rtl-c-with-estate (estate-new-env estate env) DFLT expr) +) + +; The result is the rtl->c generator table. +table +)) ; End of rtl-c-build-table diff --git a/cgen/rtl.scm b/cgen/rtl.scm new file mode 100644 index 00000000000..c6c55b40bd3 --- /dev/null +++ b/cgen/rtl.scm @@ -0,0 +1,2205 @@ +; Basic RTL support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; The name for the description language has been changed a couple of times. +; RTL isn't my favorite because of perceived confusion with GCC +; (and perceived misinterpretation of intentions!). +; On the other hand my other choices were taken (and believed to be +; more confusing). +; +; RTL functions are described by class <rtx-func>. +; The complete list of rtl functions is defined in doc/rtl.texi. + +; Conventions used in this file: +; - procs that perform the basic rtl or semantic expression manipulation that +; is for public use shall be prefixed with "s-" or "rtl-" or "rtx-" +; - no other procs shall be so prefixed +; - rtl globals and other rtx-func object support shall be prefixed with +; "-rtx[-:]" +; - no other procs shall be so prefixed + +; Class for defining rtx nodes. + +; FIXME: Add new members that are lambda's to perform the argument checking +; specified by `arg-types' and `arg-modes'. This will save a lookup during +; traversing. It will also allow custom versions for oddballs (e.g. for +; `member' we want to verify the 2nd arg is a `number-list' rtx). +; ??? Still useful? + +(define <rtx-func> + (class-make '<rtx-func> nil + '( + ; name as it appears in RTL + name + + ; argument list + args + + ; types of each argument, as symbols + ; This is #f for macros. + ; Possible values: + ; OPTIONS - optional list of :-prefixed options. + ; ANYMODE - any mode + ; INTMODE - any integer mode + ; FLOATMODE - any floating point mode + ; NUMMODE - any numeric mode + ; EXPLNUMMODE - explicit numeric mode, can't be DFLT or VOID + ; NONVOIDMODE - can't be `VOID' + ; VOIDMODE - must be `VOID' + ; DFLTMODE - must be `DFLT', used when any mode is inappropriate + ; RTX - any rtx + ; SETRTX - any rtx allowed to be `set' + ; TESTRTX - the test of an `if' + ; CONDRTX - a cond expression ((test) rtx ... rtx) + ; CASERTX - a case expression ((symbol .. symbol) rtx ... rtx) + ; LOCALS - the locals list of a sequence + ; ENV - environment stack + ; ATTRS - attribute list + ; SYMBOL - operand must be a symbol + ; STRING - operand must be a string + ; NUMBER - operand must be a number + ; SYMORNUM - operand must be a symbol or number + ; OBJECT - operand is an object + arg-types + + ; required mode of each argument + ; This is #f for macros. + ; Possible values include any mode name and: + ; ANY - any mode + ; NA - not applicable + ; OP0 - mode is specified in operand 0 + ; unless it is DFLT in which case use the default mode + ; of the operand + ; MATCH1 - must match mode of operand 1 + ; which will have OP0 for its mode spec + ; MATCH2 - must match mode of operand 2 + ; which will have OP0 for its mode spec + ; <MODE-NAME> - must match specified mode + arg-modes + + ; The class of rtx. + ; This is #f for macros. + ; ARG - operand, local, const + ; SET - set + ; UNARY - not, inv, etc. + ; BINARY - add, sub, etc. + ; TRINARY - addc, subc, etc. + ; IF - if + ; COND - cond, case + ; SEQUENCE - sequence, parallel + ; UNSPEC - c-call + ; MISC - everything else + class + + ; A symbol indicating the flavour of rtx node this is. + ; function - normal function + ; syntax - don't pre-eval arguments + ; operand - result is an operand + ; macro - converts one rtx expression to another + ; The word "style" was chosen to be sufficiently different + ; from "type", "kind", and "class". + style + + ; A function to perform the rtx. + evaluator + + ; Ordinal number of rtx. Used to index into tables. + num + ) + nil) +) + +; Predicate. + +(define (rtx-func? x) (class-instance? <rtx-func> x)) + +; Accessor fns + +(define-getters <rtx-func> rtx + (name args arg-types arg-modes class style evaluator num) +) + +(define (rtx-class-arg? rtx) (eq? (rtx-class rtx) 'ARG)) +(define (rtx-class-set? rtx) (eq? (rtx-class rtx) 'SET)) +(define (rtx-class-unary? rtx) (eq? (rtx-class rtx) 'UNARY)) +(define (rtx-class-binary? rtx) (eq? (rtx-class rtx) 'BINARY)) +(define (rtx-class-trinary? rtx) (eq? (rtx-class rtx) 'TRINARY)) +(define (rtx-class-if? rtx) (eq? (rtx-class rtx) 'IF)) +(define (rtx-class-cond? rtx) (eq? (rtx-class rtx) 'COND)) +(define (rtx-class-sequence? rtx) (eq? (rtx-class rtx) 'SEQUENCE)) +(define (rtx-class-unspec? rtx) (eq? (rtx-class rtx) 'UNSPEC)) +(define (rtx-class-misc? rtx) (eq? (rtx-class rtx) 'MISC)) + +(define (rtx-style-function? rtx) (eq? (rtx-style rtx) 'function)) +(define (rtx-style-syntax? rtx) (eq? (rtx-style rtx) 'syntax)) +(define (rtx-style-operand? rtx) (eq? (rtx-style rtx) 'operand)) +(define (rtx-style-macro? rtx) (eq? (rtx-style rtx) 'macro)) + +; Add standard `get-name' method since this isn't a subclass of <ident>. + +(method-make! <rtx-func> 'get-name (lambda (self) (elm-get self 'name))) + +; List of valid values for arg-types, not including mode names. + +(define -rtx-valid-types + '(OPTIONS + ANYMODE INTMODE FLOATMODE NUMMODE EXPLNUMMODE NONVOIDMODE VOIDMODE DFLTMODE + RTX TESTRTX CONDRTX CASERTX + LOCALS ENV ATTRS SYMBOL STRING NUMBER SYMORNUM OBJECT) +) + +; List of valid mode matchers, excluding mode names. + +(define -rtx-valid-matches + '(ANY NA OP0 MATCH1 MATCH2) +) + +; List of all defined rtx names. This can be map'd over without having +; to know the innards of -rtx-func-table (which is a hash table). + +(define -rtx-name-list nil) +(define (rtx-name-list) -rtx-name-list) + +; Table of rtx function objects. +; This is set in rtl-init!. + +(define -rtx-func-table nil) + +; Look up the <rtx-func> object for RTX-KIND. +; Returns the object or #f if not found. +; RTX-KIND may already be an <rtx-func> object. FIXME: delete? + +(define (rtx-lookup rtx-kind) + (cond ((symbol? rtx-kind) + (hashq-ref -rtx-func-table rtx-kind)) + ((rtx-func? rtx-kind) + rtx-kind) + (else #f)) +) + +; Table of rtx macro objects. +; This is set in rtl-init!. + +(define -rtx-macro-table nil) + +; Table of operands, modes, and other non-functional aspects of RTL. +; This is defined in rtl-finish!, after all operands have been read in. + +(define -rtx-operand-table nil) + +; Number of next rtx to be defined. + +(define -rtx-num-next #f) + +; Return the number of rtx's. + +(define (rtx-max-num) + -rtx-num-next +) + +; Define Rtx Node +; +; Add an entry to the rtx function table. +; NAME-ARGS is a list of the operation name and arguments. +; The mode of the result must be the first element in `args' (if there are +; any arguments). +; ARG-TYPES is a list of argument types (-rtx-valid-types). +; ARG-MODES is a list of mode matchers (-rtx-valid-matches). +; ACTION is a list of Scheme expressions to perform the operation. +; +; ??? Note that we can support variables. Not sure it should be done. + +(define (def-rtx-node name-args arg-types arg-modes class action) + (let ((name (car name-args)) + (args (cdr name-args))) + (let ((rtx (make <rtx-func> name args + arg-types arg-modes + class + 'function + (if action + (eval (list 'lambda (cons '*estate* args) action)) + #f) + -rtx-num-next))) + ; Add it to the table of rtx handlers. + (hashq-set! -rtx-func-table name rtx) + (set! -rtx-num-next (+ -rtx-num-next 1)) + (set! -rtx-name-list (cons name -rtx-name-list)) + *UNSPECIFIED*)) +) + +(define define-rtx-node + ; Written this way so Hobbit can handle it. + (defmacro:syntax-transformer (lambda arg-list + (apply def-rtx-node arg-list) + nil)) +) + +; Same as define-rtx-node but don't pre-evaluate the arguments. +; Remember that `mode' must be the first argument. + +(define (def-rtx-syntax-node name-args arg-types arg-modes class action) + (let ((name (car name-args)) + (args (cdr name-args))) + (let ((rtx (make <rtx-func> name args + arg-types arg-modes + class + 'syntax + (if action + (eval (list 'lambda (cons '*estate* args) action)) + #f) + -rtx-num-next))) + ; Add it to the table of rtx handlers. + (hashq-set! -rtx-func-table name rtx) + (set! -rtx-num-next (+ -rtx-num-next 1)) + (set! -rtx-name-list (cons name -rtx-name-list)) + *UNSPECIFIED*)) +) + +(define define-rtx-syntax-node + ; Written this way so Hobbit can handle it. + (defmacro:syntax-transformer (lambda arg-list + (apply def-rtx-syntax-node arg-list) + nil)) +) + +; Same as define-rtx-node but return an operand (usually an <operand> object). +; ??? `mode' must be the first argument? + +(define (def-rtx-operand-node name-args arg-types arg-modes class action) + ; Operand nodes must specify an action. + (assert action) + (let ((name (car name-args)) + (args (cdr name-args))) + (let ((rtx (make <rtx-func> name args + arg-types arg-modes + class + 'operand + (eval (list 'lambda (cons '*estate* args) action)) + -rtx-num-next))) + ; Add it to the table of rtx handlers. + (hashq-set! -rtx-func-table name rtx) + (set! -rtx-num-next (+ -rtx-num-next 1)) + (set! -rtx-name-list (cons name -rtx-name-list)) + *UNSPECIFIED*)) +) + +(define define-rtx-operand-node + ; Written this way so Hobbit can handle it. + (defmacro:syntax-transformer (lambda arg-list + (apply def-rtx-operand-node arg-list) + nil)) +) + +; Convert one rtx expression into another. +; NAME-ARGS is a list of the operation name and arguments. +; ACTION is a list of Scheme expressions to perform the operation. +; The result of ACTION must be another rtx expression (a list). + +(define (def-rtx-macro-node name-args action) + ; macro nodes must specify an action + (assert action) + (let ((name (car name-args)) + (args (cdr name-args))) + (let ((rtx (make <rtx-func> name args #f #f + #f ; class + 'macro + (eval (list 'lambda args action)) + -rtx-num-next))) + ; Add it to the table of rtx macros. + (hashq-set! -rtx-macro-table name rtx) + (set! -rtx-num-next (+ -rtx-num-next 1)) + (set! -rtx-name-list (cons name -rtx-name-list)) + *UNSPECIFIED*)) +) + +(define define-rtx-macro-node + ; Written this way so Hobbit can handle it. + (defmacro:syntax-transformer (lambda arg-list + (apply def-rtx-macro-node arg-list) + nil)) +) + +; RTL macro expansion. +; RTL macros are different than pmacros. The difference is that the expansion +; happens internally, RTL macros are part of the language. + +; Lookup MACRO-NAME and return its <rtx-func> object or #f if not found. + +(define (-rtx-macro-lookup macro-name) + (hashq-ref -rtx-macro-table macro-name) +) + +; Lookup (car exp) and return the macro's lambda if it is one or #f. + +(define (-rtx-macro-check exp fn-getter) + (let ((macro (hashq-ref -rtx-macro-table (car exp)))) + (if macro + (fn-getter macro) + #f)) +) + +; Expand a list. + +(define (-rtx-macro-expand-list exp fn-getter) + (let ((macro (-rtx-macro-check exp fn-getter))) + (if macro + (apply macro (map (lambda (x) (-rtx-macro-expand x fn-getter)) + (cdr exp))) + (map (lambda (x) (-rtx-macro-expand x fn-getter)) + exp))) +) + +; Main entry point to expand a macro invocation. + +(define (-rtx-macro-expand exp fn-getter) + (if (pair? exp) ; pair? -> cheap (and (not (null? exp)) (list? exp)) + (let ((result (-rtx-macro-expand-list exp fn-getter))) + ; If the result is a new macro invocation, recurse. + (if (pair? result) + (let ((macro (-rtx-macro-check result fn-getter))) + (if macro + (-rtx-macro-expand (apply macro (cdr result)) fn-getter) + result)) + result)) + exp) +) + +; Publically accessible version. + +(define rtx-macro-expand -rtx-macro-expand) + +; RTX canonicalization. +; ??? wip + +; Subroutine of rtx-canonicalize. +; Return canonical form of rtx expression EXPR. +; CONTEXT is a <context> object or #f if there is none. +; It is used for error message. +; RTX-OBJ is the <rtx-func> object of (car expr). + +(define (-rtx-canonicalize-expr context rtx-obj expr) + #f +) + +; Return canonical form of EXPR. +; CONTEXT is a <context> object or #f if there is none. +; It is used for error message. +; +; Does: +; - operand shortcuts expanded +; - numbers -> (const number) +; - operand-name -> (operand operand-name) +; - ifield-name -> (ifield ifield-name) +; - no options -> null option list +; - absent result mode of those that require a mode -> DFLT +; - rtx macros are expanded +; +; EXPR is returned in source form. We could speed up future processing by +; transforming it into a more compiled form, but that makes debugging more +; difficult, so for now we don't. + +(define (rtx-canonicalize context expr) + ; FIXME: wip + (cond ((integer? expr) + (rtx-make-const 'INT expr)) + ((symbol? expr) + (let ((op (current-op-lookup expr))) + (if op + (rtx-make-operand expr) + (context-error context "can't canonicalize" expr)))) + ((pair? expr) + expr) + (else + (context-error context "can't canonicalize" expr))) +) + +; RTX mode support. + +; Get implied mode of X, either an operand expression, sequence temp, or +; a hardware reference expression. +; The result is the name of the mode. + +(define (rtx-lvalue-mode-name estate x) + (assert (rtx? x)) + (case (car x) +; ((operand) (obj:name (op:mode (current-op-lookup (cadr x))))) + ((xop) (obj:name (send (rtx-xop-obj x) 'get-mode))) +; ((opspec) +; (if (eq? (rtx-opspec-mode x) 'VOID) +; (rtx-lvalue-mode-name estate (rtx-opspec-hw-ref x)) +; (rtx-opspec-mode x))) +; ((reg mem) (cadr x)) +; ((local) (obj:name (rtx-temp-mode (rtx-temp-lookup (estate-env estate) +; (cadr x))))) + (else + (error "rtx-lvalue-mode-name: not an operand or hardware reference:" x))) +) + +; Lookup the mode to use for semantic operations (unsigned modes aren't +; allowed since we don't have ANDUSI, etc.). +; ??? I have actually implemented both ways (full use of unsigned modes +; and mostly hidden use of unsigned modes). Neither makes me real +; comfortable, though I liked bringing unsigned modes out into the open +; even if it doubled the number of semantic operations. + +(define (-rtx-sem-mode m) (or (mode:sem-mode m) m)) + +; MODE is a mode name or <mode> object. +(define (-rtx-lazy-sem-mode mode) (-rtx-sem-mode (mode:lookup mode))) + +; Return the mode of object OBJ. + +(define (-rtx-obj-mode obj) (send obj 'get-mode)) + +; Return a boolean indicating of modes M1,M2 are compatible. + +(define (-rtx-mode-compatible? m1 m2) + (let ((mode1 (-rtx-lazy-sem-mode m1)) + (mode2 (-rtx-lazy-sem-mode m2))) + ;(eq? (obj:name mode1) (obj:name mode2))) + ; ??? This is more permissive than is perhaps proper. + (mode-compatible? 'sameclass mode1 mode2)) +) + +; Environments (sequences with local variables). + +; Temporaries are created within a sequence. +; e.g. (sequence ((WI tmp)) (set tmp reg0) ...) +; ??? Perhaps what we want here is `let' but for now I prefer `sequence'. +; This isn't exactly `let' either as no initial value is specified. +; Environments are also used to specify incoming values from the top level. + +(define <rtx-temp> (class-make '<rtx-temp> nil '(name mode value) nil)) + +;(define cx-temp:name (elm-make-getter <c-expr-temp> 'name)) +;(define cx-temp:mode (elm-make-getter <c-expr-temp> 'mode)) +;(define cx-temp:value (elm-make-getter <c-expr-temp> 'value)) + +(define-getters <rtx-temp> rtx-temp (name mode value)) + +(method-make! + <rtx-temp> 'make! + (lambda (self name mode value) + (elm-set! self 'name name) + (elm-set! self 'mode mode) + (elm-set! self 'value (if value value (gen-temp name))) + self) +) + +(define (gen-temp name) + ; ??? calls to gen-c-symbol don't belong here + (string-append "tmp_" (gen-c-symbol name)) +) + +; Return a boolean indicating if X is an <rtx-temp>. + +(define (rtx-temp? x) (class-instance? <rtx-temp> x)) + +; Respond to 'get-mode messages. + +(method-make! <rtx-temp> 'get-mode (lambda (self) (elm-get self 'mode))) + +; Respond to 'get-name messages. + +(method-make! <rtx-temp> 'get-name (lambda (self) (elm-get self 'name))) + +; An environment is a list of <rtx-temp> objects. +; An environment stack is a list of environments. + +(define (rtx-env-stack-empty? env-stack) (null? env-stack)) +(define (rtx-env-stack-head env-stack) (car env-stack)) +(define (rtx-env-var-list env) env) +(define (rtx-env-empty-stack) nil) +(define (rtx-env-init-stack1 vars-alist) + (if (null? vars-alist) + nil + (cons (rtx-env-make vars-alist) nil)) +) +(define (rtx-env-empty? env) (null? env)) + +; Create an initial environment. +; VAR-LIST is a list of (name <mode> value) elements. + +(define (rtx-env-make var-list) + ; Convert VAR-LIST to an associative list of <rtx-temp> objects. + (map (lambda (var-spec) + (cons (car var-spec) + (make <rtx-temp> + (car var-spec) (cadr var-spec) (caddr var-spec)))) + var-list) +) + +; Create an initial environment with local variables. +; VAR-LIST is a list of (mode-name name) elements (the argument to `sequence'). + +(define (rtx-env-make-locals var-list) + ; Convert VAR-LIST to an associative list of <rtx-temp> objects. + (map (lambda (var-spec) + (cons (cadr var-spec) + (make <rtx-temp> + (cadr var-spec) (mode:lookup (car var-spec)) #f))) + var-list) +) + +; Push environment ENV onto the front of environment stack ENV-STACK, +; returning a new object. ENV-STACK is not modified. + +(define (rtx-env-push env-stack env) + (cons env env-stack) +) + +(define (rtx-temp-lookup env name) + ;(display "looking up:") (display name) (newline) + (let loop ((stack (rtx-env-var-list env))) + (if (null? stack) + #f + (let ((temp (assq-ref (car stack) name))) + (if temp + temp + (loop (cdr stack)))))) +) + +; Create a "closure" of EXPR using the current temp stack. + +(define (-rtx-closure-make estate expr) + (rtx-make 'closure expr (estate-env estate)) +) + +(define (rtx-env-dump env) + (let ((stack env)) + (if (rtx-env-stack-empty? stack) + (display "rtx-env stack (empty):\n") + (let loop ((stack stack) (level 0)) + (if (null? stack) + #f ; done + (begin + (display "rtx-env stack, level ") + (display level) + (display ":\n") + (for-each (lambda (var) + (display " ") + ;(display (obj:name (rtx-temp-mode (cdr var)))) + ;(display " ") + (display (rtx-temp-name (cdr var))) + (newline)) + (car stack)) + (loop (cdr stack) (+ level 1))))))) +) + +; Build, test, and analyze various kinds of rtx's. +; ??? A lot of this could be machine generated except that I don't yet need +; that much. + +(define (rtx-make kind . args) + (cons kind (-rtx-munge-mode&options args)) +) + +(define rtx-name car) +(define (rtx-kind? kind rtx) (eq? kind (rtx-name rtx))) + +(define (rtx-make-const mode value) (rtx-make 'const mode value)) +(define (rtx-make-enum mode value) (rtx-make 'enum mode value)) + +(define (rtx-constant? rtx) (memq (rtx-name rtx) '(const enum))) + +; Return value of constant RTX (either const or enum). +(define (rtx-constant-value rtx) + (case (rtx-name rtx) + ((const) (rtx-const-value rtx)) + ((enum) (enum-lookup-val (rtx-enum-value rtx))) + (else (error "rtx-constant-value: not const or enum" rtx))) +) + +(define rtx-options cadr) +(define rtx-mode caddr) +(define rtx-args cdddr) +(define rtx-arg1 cadddr) +(define (rtx-arg2 rtx) (car (cddddr rtx))) + +(define rtx-const-value rtx-arg1) +(define rtx-enum-value rtx-arg1) + +(define rtx-reg-name rtx-arg1) + +; Return register number or #f if absent. +; (reg options mode hw-name [regno [selector]]) +(define (rtx-reg-number rtx) (list-maybe-ref rtx 4)) + +; Return register selector or #f if absent. +(define (rtx-reg-selector rtx) (list-maybe-ref rtx 5)) + +; Return both register number and selector. +(define rtx-reg-index-sel cddddr) + +; Return memory address. +(define rtx-mem-addr rtx-arg1) + +; Return memory selector or #f if absent. +(define (rtx-mem-sel mem) (list-maybe-ref mem 4)) + +; Return both memory address and selector. +(define rtx-mem-index-sel cdddr) + +; Return MEM with new address NEW-ADDR. +; ??? Complicate as necessary. +(define (rtx-change-address mem new-addr) + (rtx-make 'mem + (rtx-options mem) + (rtx-mode mem) + new-addr + (rtx-mem-sel mem)) +) + +; Return argument to `symbol' rtx. +(define rtx-symbol-name rtx-arg1) + +(define (rtx-make-ifield ifield-name) (rtx-make 'ifield ifield-name)) +(define (rtx-ifield? rtx) (eq? 'ifield (rtx-name rtx))) +(define (rtx-ifield-name rtx) + (let ((ifield (rtx-arg1 rtx))) + (if (symbol? ifield) + ifield + (obj:name ifield))) +) +(define (rtx-ifield-obj rtx) + (let ((ifield (rtx-arg1 rtx))) + (if (symbol? ifield) + (current-ifield-lookup ifield) + ifield)) +) + +(define (rtx-make-operand op-name) (rtx-make 'operand op-name)) +(define (rtx-operand? rtx) (eq? 'operand (rtx-name rtx))) +(define (rtx-operand-name rtx) + (let ((operand (rtx-arg1 rtx))) + (if (symbol? operand) + operand + (obj:name operand))) +) +(define (rtx-operand-obj rtx) + (let ((operand (rtx-arg1 rtx))) + (if (symbol? operand) + (current-op-lookup operand) + operand)) +) + +(define (rtx-make-local local-name) (rtx-make 'local local-name)) +(define (rtx-local? rtx) (eq? 'local (rtx-name rtx))) +(define (rtx-local-name rtx) + (let ((local (rtx-arg1 rtx))) + (if (symbol? local) + local + (obj:name local))) +) +(define (rtx-local-obj rtx) + (let ((local (rtx-arg1 rtx))) + (if (symbol? local) + (error "can't use rtx-local-obj on local name") + local)) +) + +(define rtx-xop-obj rtx-arg1) + +;(define (rtx-opspec? rtx) (eq? 'opspec (rtx-name rtx))) +;(define (rtx-opspec-mode rtx) (rtx-mode rtx)) +;(define (rtx-opspec-hw-ref rtx) (list-ref rtx 5)) +;(define (rtx-opspec-set-op-num! rtx num) (set-car! (cddddr rtx) num)) + +(define rtx-index-of-value rtx-arg1) + +(define (rtx-make-set dest src) (rtx-make 'set dest src)) +(define rtx-set-dest rtx-arg1) +(define rtx-set-src rtx-arg2) +(define (rtx-single-set? rtx) (eq? (car rtx) 'set)) + +(define rtx-alu-op-mode rtx-mode) +(define (rtx-alu-op-arg rtx n) (list-ref rtx (+ n 3))) + +(define (rtx-boolif-op-arg rtx n) (list-ref rtx (+ n 3))) + +(define rtx-cmp-op-mode rtx-mode) +(define (rtx-cmp-op-arg rtx n) (list-ref rtx (+ n 3))) + +(define rtx-number-list-values cdddr) + +(define rtx-member-value rtx-arg1) +(define (rtx-member-set rtx) (list-ref rtx 4)) + +(define rtx-if-mode rtx-mode) +(define (rtx-if-test rtx) (rtx-arg1 rtx)) +(define (rtx-if-then rtx) (list-ref rtx 4)) +; If `else' clause is missing the result is #f. +(define (rtx-if-else rtx) (list-maybe-ref rtx 5)) + +(define (rtx-eq-attr-owner rtx) (list-ref rtx 3)) +(define (rtx-eq-attr-attr rtx) (list-ref rtx 4)) +(define (rtx-eq-attr-value rtx) (list-ref rtx 5)) + +(define (rtx-sequence-locals rtx) (cadddr rtx)) +(define (rtx-sequence-exprs rtx) (cddddr rtx)) + +; Same as rtx-sequence-locals except return in assq'able form. + +(define (rtx-sequence-assq-locals rtx) + (let ((locals (rtx-sequence-locals rtx))) + (map (lambda (local) + (list (cadr local) (car local))) + locals)) +) + +; Return a semi-pretty symbol describing RTX. +; This is used by hw to include the index in the element's name. + +(define (rtx-pretty-name rtx) + (if (pair? rtx) + (case (car rtx) + ((const) (number->string (rtx-const-value rtx))) + ((operand) (obj:name (rtx-operand-obj rtx))) + ((local) (rtx-local-name rtx)) + ((xop) (obj:name (rtx-xop-obj rtx))) + (else + (if (null? (cdr rtx)) + (car rtx) + (apply string-append + (cons (car rtx) + (map (lambda (elm) + (string-append "-" (rtx-pretty-name elm))) + (cdr rtx))))))) + (stringize rtx "-")) +) + +; RTL expression traversal support. +; Traversal (and compilation) involves validating the source form and +; converting it to internal form. +; ??? At present the internal form is also the source form (easier debugging). + +; Set to #t to debug rtx traversal. + +(define -rtx-traverse-debug? #f) + +; Container to record the current state of traversal. +; This is initialized before traversal, and modified (in a copy) as the +; traversal state changes. +; This doesn't record all traversal state, just the more static elements. +; There's no point in recording things like the parent expression and operand +; position as they change for every sub-traversal. +; The main raison d'etre for this class is so we can add more state without +; having to modify all the traversal handlers. +; ??? At present it's not a proper "class" as there's no real need. +; +; CONTEXT is a <context> object or #f if there is none. +; It is used for error messages. +; +; EXPR-FN is a dual-purpose beast. The first purpose is to just process +; the current expression and return the result. The second purpose is to +; lookup the function which will then process the expression. +; It is applied recursively to the expression and each sub-expression. +; It must be defined as +; (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) ...). +; If the result of EXPR-FN is a lambda, it is applied to +; (cons TSTATE (cdr EXPR)). TSTATE is prepended to the arguments. +; For syntax expressions if the result of EXPR-FN is #f, the operands are +; processed using the builtin traverser. +; So to repeat: EXPR-FN can process the expression, and if its result is a +; lambda then it also processes the expression. The arguments to EXPR-FN +; are (rtx-obj expr mode parent-expr op-pos tstate appstuff). The format +; of the result of EXPR-FN are (cons TSTATE (cdr EXPR)). +; The reason for the duality is that when trying to understand EXPR (e.g. when +; computing the insn format) EXPR-FN processes the expression itself, and +; when evaluating EXPR it's the result of EXPR-FN that computes the value. +; +; ENV is the current environment. This is a stack of sequence locals. +; +; COND? is a boolean indicating if the current expression is on a conditional +; execution path. This is for optimization purposes only and it is always ok +; to pass #t, except for the top-level caller which must pass #f (since the top +; level expression obviously isn't subject to any condition). +; It is used, for example, to speed up the simulator: there's no need to keep +; track of whether an operand has been assigned to (or potentially read from) +; if it's known it's always assigned to. +; +; SET? is a boolean indicating if the current expression is an operand being +; set. +; +; OWNER is the owner of the expression or #f if there is none. +; Typically it is an <insn> object. +; +; KNOWN is an alist of known values. This is used by rtx-simplify. +; Each element is (name . value) where +; NAME is either an ifield or operand name (in the future it might be a +; sequence local name), and +; VALUE is either (const mode value) or (numlist mode value1 value2 ...). +; +; DEPTH is the current traversal depth. + +(define (tstate-make context owner expr-fn env cond? set? known depth) + (vector context owner expr-fn env cond? set? known depth) +) + +(define (tstate-context state) (vector-ref state 0)) +(define (tstate-set-context! state newval) (vector-set! state 0 newval)) +(define (tstate-owner state) (vector-ref state 1)) +(define (tstate-set-owner! state newval) (vector-set! state 1 newval)) +(define (tstate-expr-fn state) (vector-ref state 2)) +(define (tstate-set-expr-fn! state newval) (vector-set! state 2 newval)) +(define (tstate-env state) (vector-ref state 3)) +(define (tstate-set-env! state newval) (vector-set! state 3 newval)) +(define (tstate-cond? state) (vector-ref state 4)) +(define (tstate-set-cond?! state newval) (vector-set! state 4 newval)) +(define (tstate-set? state) (vector-ref state 5)) +(define (tstate-set-set?! state newval) (vector-set! state 5 newval)) +(define (tstate-known state) (vector-ref state 6)) +(define (tstate-set-known! state newval) (vector-set! state 6 newval)) +(define (tstate-depth state) (vector-ref state 7)) +(define (tstate-set-depth! state newval) (vector-set! state 7 newval)) + +; Create a copy of STATE. + +(define (tstate-copy state) + ; A fast vector-copy would be nice, but this is simple and portable. + (list->vector (vector->list state)) +) + +; Create a copy of STATE with a new environment ENV. + +(define (tstate-new-env state env) + (let ((result (tstate-copy state))) + (tstate-set-env! result env) + result) +) + +; Create a copy of STATE with environment ENV pushed onto the existing +; environment list. +; There's no routine to pop the environment list as there's no current +; need for it: we make a copy of the state when we push. + +(define (tstate-push-env state env) + (let ((result (tstate-copy state))) + (tstate-set-env! result (cons env (tstate-env result))) + result) +) + +; Create a copy of STATE with a new COND? value. + +(define (tstate-new-cond? state cond?) + (let ((result (tstate-copy state))) + (tstate-set-cond?! result cond?) + result) +) + +; Create a copy of STATE with a new SET? value. + +(define (tstate-new-set? state set?) + (let ((result (tstate-copy state))) + (tstate-set-set?! result set?) + result) +) + +; Lookup NAME in the known value table. Returns the value or #f if not found. + +(define (tstate-known-lookup tstate name) + (let ((known (tstate-known tstate))) + (assq-ref known name)) +) + +; Increment the recorded traversal depth of TSTATE. + +(define (tstate-incr-depth! tstate) + (tstate-set-depth! tstate (1+ (tstate-depth tstate))) +) + +; Decrement the recorded traversal depth of TSTATE. + +(define (tstate-decr-depth! tstate) + (tstate-set-depth! tstate (1- (tstate-depth tstate))) +) + +; Traversal/compilation support. + +; Return a boolean indicating if X is a mode. + +(define (-rtx-any-mode? x) + (->bool (mode:lookup x)) +) + +; Return a boolean indicating if X is a symbol or rtx. + +(define (-rtx-symornum? x) + (or (symbol? x) (number? x)) +) + +; Traverse a list of rtx's. + +(define (-rtx-traverse-rtx-list rtx-list mode expr op-num tstate appstuff) + (map (lambda (rtx) + ; ??? Shouldn't OP-NUM change for each element? + (-rtx-traverse rtx 'RTX mode expr op-num tstate appstuff)) + rtx-list) +) + +; Cover-fn to context-error for signalling an error during rtx traversal. + +(define (-rtx-traverse-error tstate errmsg expr op-num) +; (parse-error context (string-append errmsg ", operand number " +; (number->string op-num)) +; (rtx-dump expr)) + (context-error (tstate-context tstate) + (string-append errmsg ", operand #" (number->string op-num)) + (rtx-strdump expr)) +) + +; Rtx traversers. +; These are defined as individual functions that are then built into a table +; so that we can use Hobbit's "fastcall" support. +; +; The result is either a pair of the parsed VAL and new TSTATE, +; or #f meaning there is no change (saves lots of unnecessarying cons'ing). + +(define (-rtx-traverse-options val mode expr op-num tstate appstuff) + #f +) + +(define (-rtx-traverse-anymode val mode expr op-num tstate appstuff) + (let ((val-obj (mode:lookup val))) + (if (not val-obj) + (-rtx-traverse-error tstate "expecting a mode" + expr op-num)) + #f) +) + +(define (-rtx-traverse-intmode val mode expr op-num tstate appstuff) + (let ((val-obj (mode:lookup val))) + (if (and val-obj + (or (memq (mode:class val-obj) '(INT UINT)) + (eq? val 'DFLT))) + #f + (-rtx-traverse-error tstate "expecting an integer mode" + expr op-num))) +) + +(define (-rtx-traverse-floatmode val mode expr op-num tstate appstuff) + (let ((val-obj (mode:lookup val))) + (if (and val-obj + (or (memq (mode:class val-obj) '(FLOAT)) + (eq? val 'DFLT))) + #f + (-rtx-traverse-error tstate "expecting a float mode" + expr op-num))) +) + +(define (-rtx-traverse-nummode val mode expr op-num tstate appstuff) + (let ((val-obj (mode:lookup val))) + (if (and val-obj + (or (memq (mode:class val-obj) '(INT UINT FLOAT)) + (eq? val 'DFLT))) + #f + (-rtx-traverse-error tstate "expecting a numeric mode" + expr op-num))) +) + +(define (-rtx-traverse-explnummode val mode expr op-num tstate appstuff) + (let ((val-obj (mode:lookup val))) + (if (not val-obj) + (-rtx-traverse-error tstate "expecting a mode" + expr op-num)) + (if (memq val '(DFLT VOID)) + (-rtx-traverse-error tstate "DFLT and VOID not allowed here" + expr op-num)) + #f) +) + +(define (-rtx-traverse-nonvoidmode val mode expr op-num tstate appstuff) + (if (eq? val 'VOID) + (-rtx-traverse-error tstate "mode can't be VOID" + expr op-num)) + #f +) + +(define (-rtx-traverse-voidmode val mode expr op-num tstate appstuff) + (if (memq val '(DFLT VOID)) + #f + (-rtx-traverse-error tstate "expecting mode VOID" + expr op-num)) +) + +(define (-rtx-traverse-dfltmode val mode expr op-num tstate appstuff) + (if (eq? val 'DFLT) + #f + (-rtx-traverse-error tstate "expecting mode DFLT" + expr op-num)) +) + +(define (-rtx-traverse-rtx val mode expr op-num tstate appstuff) +; Commented out 'cus it doesn't quite work yet. +; (if (not (rtx? val)) +; (-rtx-traverse-error tstate "expecting an rtx" +; expr op-num)) + (cons (-rtx-traverse val 'RTX mode expr op-num tstate appstuff) + tstate) +) + +(define (-rtx-traverse-setrtx val mode expr op-num tstate appstuff) + ; FIXME: Still need to turn it off for sub-exprs. + ; e.g. (mem (reg ...)) +; Commented out 'cus it doesn't quite work yet. +; (if (not (rtx? val)) +; (-rtx-traverse-error tstate "expecting an rtx" +; expr op-num)) + (cons (-rtx-traverse val 'SETRTX mode expr op-num + (tstate-new-set? tstate #t) + appstuff) + tstate) +) + +; This is the test of an `if'. + +(define (-rtx-traverse-testrtx val mode expr op-num tstate appstuff) +; Commented out 'cus it doesn't quite work yet. +; (if (not (rtx? val)) +; (-rtx-traverse-error tstate "expecting an rtx" +; expr op-num)) + (cons (-rtx-traverse val 'RTX mode expr op-num tstate appstuff) + (tstate-new-cond? + tstate + (not (rtx-compile-time-constant? val)))) +) + +(define (-rtx-traverse-condrtx val mode expr op-num tstate appstuff) + (if (not (pair? val)) + (-rtx-traverse-error tstate "expecting an expression" + expr op-num)) + (if (eq? (car val) 'else) + (begin + (if (!= (+ op-num 2) (length expr)) + (-rtx-traverse-error tstate + "`else' clause not last" + expr op-num)) + (cons (cons 'else + (-rtx-traverse-rtx-list + (cdr val) mode expr op-num + (tstate-new-cond? tstate #t) + appstuff)) + (tstate-new-cond? tstate #t))) + (cons (cons + ; ??? Entries after the first are conditional. + (-rtx-traverse (car val) 'RTX 'ANY expr op-num tstate appstuff) + (-rtx-traverse-rtx-list + (cdr val) mode expr op-num + (tstate-new-cond? tstate #t) + appstuff)) + (tstate-new-cond? tstate #t))) +) + +(define (-rtx-traverse-casertx val mode expr op-num tstate appstuff) + (if (or (not (list? val)) + (< (length val) 2)) + (-rtx-traverse-error tstate + "invalid `case' expression" + expr op-num)) + ; car is either 'else or list of symbols/numbers + (if (not (or (eq? (car val) 'else) + (and (list? (car val)) + (not (null? (car val))) + (all-true? (map -rtx-symornum? + (car val)))))) + (-rtx-traverse-error tstate + "invalid `case' choice" + expr op-num)) + (if (and (eq? (car val) 'else) + (!= (+ op-num 2) (length expr))) + (-rtx-traverse-error tstate "`else' clause not last" + expr op-num)) + (cons (cons (car val) + (-rtx-traverse-rtx-list + (cdr val) mode expr op-num + (tstate-new-cond? tstate #t) + appstuff)) + (tstate-new-cond? tstate #t)) +) + +(define (-rtx-traverse-locals val mode expr op-num tstate appstuff) + (if (not (list? val)) + (-rtx-traverse-error tstate "bad locals list" + expr op-num)) + (for-each (lambda (var) + (if (or (not (list? var)) + (!= (length var) 2) + (not (-rtx-any-mode? (car var))) + (not (symbol? (cadr var)))) + (-rtx-traverse-error tstate + "bad locals list" + expr op-num))) + val) + (let ((env (rtx-env-make-locals val))) + (cons val (tstate-push-env tstate env))) +) + +(define (-rtx-traverse-env val mode expr op-num tstate appstuff) + ; VAL is an environment stack. + (if (not (list? val)) + (-rtx-traverse-error tstate "environment not a list" + expr op-num)) + (cons val (tstate-new-env tstate val)) +) + +(define (-rtx-traverse-attrs val mode expr op-num tstate appstuff) +; (cons val ; (atlist-source-form (atlist-parse val "" "with-attr")) +; tstate) + #f +) + +(define (-rtx-traverse-symbol val mode expr op-num tstate appstuff) + (if (not (symbol? val)) + (-rtx-traverse-error tstate "expecting a symbol" + expr op-num)) + #f +) + +(define (-rtx-traverse-string val mode expr op-num tstate appstuff) + (if (not (string? val)) + (-rtx-traverse-error tstate "expecting a string" + expr op-num)) + #f +) + +(define (-rtx-traverse-number val mode expr op-num tstate appstuff) + (if (not (number? val)) + (-rtx-traverse-error tstate "expecting a number" + expr op-num)) + #f +) + +(define (-rtx-traverse-symornum val mode expr op-num tstate appstuff) + (if (not (or (symbol? val) (number? val))) + (-rtx-traverse-error tstate + "expecting a symbol or number" + expr op-num)) + #f +) + +(define (-rtx-traverse-object val mode expr op-num tstate appstuff) + #f +) + +; Table of rtx traversers. +; This is a vector of size rtx-max-num. +; Each entry is a list of (arg-type-name . traverser) elements +; for rtx-arg-types. + +(define -rtx-traverser-table #f) + +; Return a hash table of standard operand traversers. +; The result of each traverser is a pair of the compiled form of `val' and +; a possibly new traversal state or #f if there is no change. + +(define (-rtx-make-traverser-table) + (let ((hash-tab (make-hash-table 31)) + (traversers + (list + ; /fastcall-make is recognized by Hobbit and handled specially. + ; When not using Hobbit it is a macro that returns its argument. + (cons 'OPTIONS (/fastcall-make -rtx-traverse-options)) + (cons 'ANYMODE (/fastcall-make -rtx-traverse-anymode)) + (cons 'INTMODE (/fastcall-make -rtx-traverse-intmode)) + (cons 'FLOATMODE (/fastcall-make -rtx-traverse-floatmode)) + (cons 'NUMMODE (/fastcall-make -rtx-traverse-nummode)) + (cons 'EXPLNUMMODE (/fastcall-make -rtx-traverse-explnummode)) + (cons 'NONVOIDFLTODE (/fastcall-make -rtx-traverse-nonvoidmode)) + (cons 'VOIDFLTODE (/fastcall-make -rtx-traverse-voidmode)) + (cons 'DFLTMODE (/fastcall-make -rtx-traverse-dfltmode)) + (cons 'RTX (/fastcall-make -rtx-traverse-rtx)) + (cons 'SETRTX (/fastcall-make -rtx-traverse-setrtx)) + (cons 'TESTRTX (/fastcall-make -rtx-traverse-testrtx)) + (cons 'CONDRTX (/fastcall-make -rtx-traverse-condrtx)) + (cons 'CASERTX (/fastcall-make -rtx-traverse-casertx)) + (cons 'LOCALS (/fastcall-make -rtx-traverse-locals)) + (cons 'ENV (/fastcall-make -rtx-traverse-env)) + (cons 'ATTRS (/fastcall-make -rtx-traverse-attrs)) + (cons 'SYMBOL (/fastcall-make -rtx-traverse-symbol)) + (cons 'STRING (/fastcall-make -rtx-traverse-string)) + (cons 'NUMBER (/fastcall-make -rtx-traverse-number)) + (cons 'SYMORNUM (/fastcall-make -rtx-traverse-symornum)) + (cons 'OBJECT (/fastcall-make -rtx-traverse-object)) + ))) + + (for-each (lambda (traverser) + (hashq-set! hash-tab (car traverser) (cdr traverser))) + traversers) + + hash-tab) +) + +; Traverse the operands of EXPR, a canonicalized RTL expression. +; Here "canonicalized" means that -rtx-munge-mode&options has been called to +; insert an option list and mode if they were absent in the original +; expression. + +(define (-rtx-traverse-operands rtx-obj expr tstate appstuff) + (if -rtx-traverse-debug? + (begin + (display (spaces (* 4 (tstate-depth tstate)))) + (display "Traversing operands of: ") + (display (rtx-dump expr)) + (newline) + (rtx-env-dump (tstate-env tstate)) + (force-output) + )) + + (let loop ((operands (cdr expr)) + (op-num 0) + (arg-types (vector-ref -rtx-traverser-table (rtx-num rtx-obj))) + (arg-modes (rtx-arg-modes rtx-obj)) + (result nil) + ) + + (let ((varargs? (and (pair? arg-types) (symbol? (car arg-types))))) + + (if -rtx-traverse-debug? + (begin + (display (spaces (* 4 (tstate-depth tstate)))) + (if (null? operands) + (display "end of operands") + (begin + (display "op-num ") (display op-num) (display ": ") + (display (rtx-dump (car operands))) + (display ", ") + (display (if varargs? (car arg-types) (caar arg-types))) + (display ", ") + (display (if varargs? arg-modes (car arg-modes))) + )) + (newline) + (force-output) + )) + + (cond ((null? operands) + ; Out of operands, check if we have the expected number. + (if (or (null? arg-types) + varargs?) + (reverse! result) + (context-error (tstate-context tstate) + "missing operands" (rtx-strdump expr)))) + + ((null? arg-types) + (context-error (tstate-context tstate) + "too many operands" (rtx-strdump expr))) + + (else + (let ((type (if varargs? arg-types (car arg-types))) + (mode (let ((mode-spec (if varargs? + arg-modes + (car arg-modes)))) + ; This is small enough that this is fast enough, + ; and the number of entries should be stable. + ; FIXME: for now + (case mode-spec + ((ANY) 'DFLT) + ((NA) #f) + ((OP0) (rtx-mode expr)) + ((MATCH1) + ; If there is an explicit mode, use it. + ; Otherwise we have to look at operand 1. + (if (eq? (rtx-mode expr) 'DFLT) + 'DFLT + (rtx-mode expr))) + ((MATCH2) + ; If there is an explicit mode, use it. + ; Otherwise we have to look at operand 2. + (if (eq? (rtx-mode expr) 'DFLT) + 'DFLT + (rtx-mode expr))) + (else mode-spec)))) + (val (car operands)) + ) + + ; Look up the traverser for this kind of operand and perform it. + (let ((traverser (cdr type))) + (let ((traversed-val (fastcall6 traverser val mode expr op-num tstate appstuff))) + (if traversed-val + (begin + (set! val (car traversed-val)) + (set! tstate (cdr traversed-val)))))) + + ; Done with this operand, proceed to the next. + (loop (cdr operands) + (+ op-num 1) + (if varargs? arg-types (cdr arg-types)) + (if varargs? arg-modes (cdr arg-modes)) + (cons val result))))))) +) + +; Publically accessible version of -rtx-traverse-operands as EXPR-FN may +; need to call it. + +(define rtx-traverse-operands -rtx-traverse-operands) + +; Subroutine of -rtx-munge-mode&options. +; Return boolean indicating if X is an rtx option. + +(define (-rtx-option? x) + (and (symbol? x) + (char=? (string-ref x 0) #\:)) +) + +; Subroutine of -rtx-munge-mode&options. +; Return boolean indicating if X is an rtx option list. + +(define (-rtx-option-list? x) + (or (null? x) + (and (pair? x) + (-rtx-option? (car x)))) +) + +; Subroutine of -rtx-traverse-expr to fill in the mode if absent and to +; collect the options into one list. +; ARGS is the list of arguments to the rtx function +; (e.g. (1 2) in (add 1 2)). +; ??? "munge" is an awkward name to use here, but I like it for now because +; it's easy to grep for. +; ??? An empty option list requires a mode to be present so that the empty +; list in `(sequence () foo bar)' is unambiguously recognized as the locals +; list. Icky, sure, but less icky than the alternatives thus far. + +(define (-rtx-munge-mode&options args) + (let ((options nil) + (mode-name 'DFLT)) + ; Pick off the option list if present. + (if (and (pair? args) + (-rtx-option-list? (car args)) + ; Handle `(sequence () foo bar)'. If empty list isn't followed + ; by a mode, it is not an option list. + (or (not (null? (car args))) + (and (pair? (cdr args)) + (mode-name? (cadr args))))) + (begin + (set! options (car args)) + (set! args (cdr args)))) + ; Pick off the mode if present. + (if (and (pair? args) + (mode-name? (car args))) + (begin + (set! mode-name (car args)) + (set! args (cdr args)))) + ; Now put option list and mode back. + (cons options (cons mode-name args))) +) + +; Traverse an expression. +; For syntax expressions arguments are not pre-evaluated before calling the +; user's expression handler. Otherwise they are. +; If EXPR-FN wants to just scan the operands, rather than evaluating them, +; one thing it can do is call back to rtx-traverse-operands. +; If EXPR-FN returns #f, traverse the operands normally and return +; (rtx's-name traversed-operand1 ...). +; This is for semantic-compile's sake and all traversal handlers are +; required to do this if EXPR-FN returns #f. + +(define (-rtx-traverse-expr rtx-obj expr mode parent-expr op-pos tstate appstuff) + (let* ((expr2 (cons (car expr) + (-rtx-munge-mode&options (cdr expr)))) + (fn (fastcall7 (tstate-expr-fn tstate) + rtx-obj expr2 mode parent-expr op-pos tstate appstuff))) + (if fn + (if (procedure? fn) + ; Don't traverse operands for syntax expressions. + (if (rtx-style-syntax? rtx-obj) + (apply fn (cons tstate (cdr expr2))) + (let ((operands (-rtx-traverse-operands rtx-obj expr2 tstate appstuff))) + (apply fn (cons tstate operands)))) + fn) + (let ((operands (-rtx-traverse-operands rtx-obj expr2 tstate appstuff))) + (cons (car expr2) operands)))) +) + +; Main entry point for expression traversal. +; (Actually rtx-traverse is, but it's just a cover function for this.) +; +; The result is the result of the lambda EXPR-FN looks up in the case of +; expressions or an operand object (usually <operand>) in the case of operands. +; +; EXPR is the expression to be traversed. +; +; MODE is the name of the mode of EXPR. +; +; PARENT-EXPR is the expression EXPR is contained in. The top-level +; caller must pass #f for it. +; +; OP-POS is the position EXPR appears in PARENT-EXPR. The +; top-level caller must pass 0 for it. +; +; EXPECTED is one of `-rtx-valid-types' and indicates the expected rtx type +; or #f if it doesn't matter. +; +; TSTATE is the current traversal state. +; +; APPSTUFF is for application specific use. +; +; All macros are expanded here. User code never sees them. +; All operand shortcuts are also expand here. User code never sees them. +; These are: +; - operands, ifields, and numbers appearing where an rtx is expected are +; converted to use `operand', `ifield', or `const'. + +(define (-rtx-traverse expr expected mode parent-expr op-pos tstate appstuff) + (if -rtx-traverse-debug? + (begin + (display (spaces (* 4 (tstate-depth tstate)))) + (display "Traversing expr: ") + (display expr) + (newline) + (display (spaces (* 4 (tstate-depth tstate)))) + (display "-expected: ") + (display expected) + (newline) + (display (spaces (* 4 (tstate-depth tstate)))) + (display "-mode: ") + (display mode) + (newline) + (force-output) + )) + + (if (pair? expr) ; pair? -> cheap non-null-list? + + (let ((rtx-obj (rtx-lookup (car expr)))) + (tstate-incr-depth! tstate) + (let ((result + (if rtx-obj + (-rtx-traverse-expr rtx-obj expr mode parent-expr op-pos tstate appstuff) + (let ((rtx-obj (-rtx-macro-lookup (car expr)))) + (if rtx-obj + (-rtx-traverse (-rtx-macro-expand expr rtx-evaluator) + expected mode parent-expr op-pos tstate appstuff) + (context-error (tstate-context tstate) "unknown rtx function" + expr)))))) + (tstate-decr-depth! tstate) + result)) + + ; EXPR is not a list. + ; See if it's an operand shortcut. + (if (memq expected '(RTX SETRTX)) + + (cond ((symbol? expr) + (cond ((current-op-lookup expr) + (-rtx-traverse + (rtx-make-operand expr) ; (current-op-lookup expr)) + expected mode parent-expr op-pos tstate appstuff)) + ((rtx-temp-lookup (tstate-env tstate) expr) + (-rtx-traverse + (rtx-make-local expr) ; (rtx-temp-lookup (tstate-env tstate) expr)) + expected mode parent-expr op-pos tstate appstuff)) + ((current-ifld-lookup expr) + (-rtx-traverse + (rtx-make-ifield expr) + expected mode parent-expr op-pos tstate appstuff)) + ((enum-lookup-val expr) + (-rtx-traverse + (rtx-make-enum 'INT expr) + expected mode parent-expr op-pos tstate appstuff)) + (else + (context-error (tstate-context tstate) + "unknown operand" expr)))) + ((integer? expr) + (-rtx-traverse (rtx-make-const 'INT expr) + expected mode parent-expr op-pos tstate appstuff)) + (else + (context-error (tstate-context tstate) + "unexpected operand" + expr))) + + ; Not expecting RTX or SETRTX. + (context-error (tstate-context tstate) + "unexpected operand" + expr))) +) + +; User visible procedures to traverse an rtl expression. +; These calls -rtx-traverse to do most of the work. +; See tstate-make for an explanation of EXPR-FN. +; CONTEXT is a <context> object or #f if there is none. +; LOCALS is a list of (mode . name) elements (the locals arg to `sequence'). +; APPSTUFF is for application specific use. + +(define (rtx-traverse context owner expr expr-fn appstuff) + (-rtx-traverse expr #f 'DFLT #f 0 + (tstate-make context owner expr-fn (rtx-env-empty-stack) + #f #f nil 0) + appstuff) +) + +(define (rtx-traverse-with-locals context owner expr expr-fn locals appstuff) + (-rtx-traverse expr #f 'DFLT #f 0 + (tstate-make context owner expr-fn + (rtx-env-push (rtx-env-empty-stack) + (rtx-env-make-locals locals)) + #f #f nil 0) + appstuff) +) + +; Traverser debugger. + +(define (rtx-traverse-debug expr) + (rtx-traverse + #f #f expr + (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) + (display "-expr: ") + (display (string-append "rtx=" (obj:name rtx-obj))) + (display " expr=") + (display expr) + (display " mode=") + (display mode) + (display " parent=") + (display parent-expr) + (display " op-pos=") + (display op-pos) + (display " cond?=") + (display (tstate-cond? tstate)) + (newline) + #f) + #f + ) +) + +; Convert rtl expression EXPR from source form to compiled form. +; The expression is validated and rtx macros are expanded as well. +; CONTEXT is a <context> object or #f if there is none. +; It is used in error messages. +; EXTRA-VARS-ALIST is an association list of extra (symbol <mode> value) +; elements to be used during value lookup. +; +; This does the same operation that rtx-traverse does, except that it provides +; a standard value for EXPR-FN. +; +; ??? In the future the compiled form may be the same as the source form +; except that all elements would be converted to their respective objects. + +(define (-compile-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) +; (cond +; The intent of this is to handle sequences/closures, but is it needed? +; ((rtx-style-syntax? rtx-obj) +; ((rtx-evaluator rtx-obj) rtx-obj expr mode +; parent-expr op-pos tstate)) +; (else + (cons (car expr) ; rtx-obj + (-rtx-traverse-operands rtx-obj expr tstate appstuff)) +) + +(define (rtx-compile context expr extra-vars-alist) + (-rtx-traverse expr #f 'DFLT #f 0 + (tstate-make context #f + (/fastcall-make -compile-expr-fn) + (rtx-env-init-stack1 extra-vars-alist) + #f #f nil 0) + #f) +) + +; Various rtx utilities. + +; Dump an rtx expression. + +(define (rtx-dump rtx) + (cond ((list? rtx) (map rtx-dump rtx)) + ((object? rtx) (string-append "#<object " + (object-class-name rtx) + " " + (obj:name rtx) + ">")) + (else rtx)) +) + +; Dump an expression to a string. + +(define (rtx-strdump rtx) + (with-output-to-string + (lambda () + (display (rtx-dump rtx)))) +) + +; Return a boolean indicating if EXPR is known to be a compile-time constant. + +(define (rtx-compile-time-constant? expr) + (cond ((pair? expr) + (case (car expr) + ((const enum) #t) + (else #f))) + ((memq expr '(FALSE TRUE)) #t) + (else #f)) +) + +; Return boolean indicating if EXPR has side-effects. +; FIXME: for now punt. + +(define (rtx-side-effects? expr) + #f +) + +; Return a boolean indicating if EXPR is a "true" boolean value. +; +; ??? In RTL, #t is a synonym for (const 1). This is confusing for Schemers, +; so maybe RTL's #t should be renamed to TRUE. + +(define (rtx-true? expr) + (cond ((pair? expr) + (case (car expr) + ((const enum) (!= (rtx-constant-value expr) 0)) + (else #f))) + ((eq? expr 'TRUE) #t) + (else #f)) +) + +; Return a boolean indicating if EXPR is a "false" boolean value. +; +; ??? In RTL, #f is a synonym for (const 0). This is confusing for Schemers, +; so maybe RTL's #f should be renamed to FALSE. + +(define (rtx-false? expr) + (cond ((pair? expr) + (case (car expr) + ((const enum) (= (rtx-constant-value expr) 0)) + (else #f))) + ((eq? expr 'FALSE) #t) + (else #f)) +) + +; Return canonical boolean values. + +(define (rtx-false) (rtx-make-const 'BI 0)) +(define (rtx-true) (rtx-make-const 'BI 1)) + +; Convert EXPR to a canonical boolean if possible. + +(define (rtx-canonical-bool expr) + (cond ((rtx-side-effects? expr) expr) + ((rtx-false? expr) (rtx-false)) + ((rtx-true? expr) (rtx-true)) + (else expr)) +) + +; Return rtx values for #f/#t. + +(define (rtx-make-bool value) + (if value + (rtx-true) + (rtx-false)) +) + +; Return #t if X is an rtl expression. +; e.g. '(add WI dr simm8); + +(define (rtx? x) + (->bool + (and (pair? x) ; pair? -> cheap non-null-list? + (or (hashq-ref -rtx-func-table (car x)) + (hashq-ref -rtx-macro-table (car x))))) +) + +; RTL evaluation state. +; Applications may subclass <eval-state> if they need to add things. +; +; This is initialized before evaluation, and modified (in a copy) as the +; evaluation state changes. +; This doesn't record all evaluation state, just the less dynamic elements. +; There's no point in recording things like the parent expression and operand +; position as they change for every sub-eval. +; The main raison d'etre for this class is so we can add more state without +; having to modify all the eval handlers. + +(define <eval-state> + (class-make '<eval-state> nil + '( + ; <context> object or #f if there is none + (context . #f) + + ; Current object rtl is being evaluated for. + ; We need to be able to access the current instruction while + ; generating semantic code. However, the semantic description + ; doesn't specify it as an argument to anything (and we don't + ; want it to). So we record the value here. + (owner . #f) + + ; EXPR-FN is a dual-purpose beast. The first purpose is to + ; just process the current expression and return the result. + ; The second purpose is to lookup the function which will then + ; process the expression. It is applied recursively to the + ; expression and each sub-expression. It must be defined as + ; (lambda (rtx-obj expr mode estate) ...). + ; If the result of EXPR-FN is a lambda, it is applied to + ; (cons ESTATE (cdr EXPR)). ESTATE is prepended to the + ; arguments. + ; For syntax expressions if the result of EXPR-FN is #f, + ; the operands are processed using the builtin evaluator. + ; FIXME: This special handling of syntax expressions is + ; not currently done. + ; So to repeat: EXPR-FN can process the expression, and if its + ; result is a lambda then it also processes the expression. + ; The arguments to EXPR-FN are + ; (rtx-obj expr mode estate). + ; The arguments to the result of EXPR-FN are + ; (cons ESTATE (cdr EXPR)). + ; The reason for the duality is mostly history. + ; In time things should be simplified. + (expr-fn . #f) + + ; Current environment. This is a stack of sequence locals. + (env . ()) + + ; Current evaluation depth. This is used, for example, to + ; control indentation in generated output. + (depth . 0) + + ; Associative list of modifiers. + ; This is here to support things like `delay'. + (modifiers . ()) + ) + nil) +) + +; Create an <eval-state> object using a list of keyword/value elements. +; ARGS is a list of #:keyword/value elements. +; The result is a list of the unrecognized elements. +; Subclasses should override this method and send-next it first, then +; see if they recognize anything in the result, returning what isn't +; recognized. + +(method-make! + <eval-state> 'vmake! + (lambda (self args) + (let loop ((args args) (unrecognized nil)) + (if (null? args) + (reverse! unrecognized) ; ??? Could invoke method to initialize here. + (begin + (case (car args) + ((#:context) + (elm-set! self 'context (cadr args))) + ((#:owner) + (elm-set! self 'owner (cadr args))) + ((#:expr-fn) + (elm-set! self 'expr-fn (cadr args))) + ((#:env) + (elm-set! self 'env (cadr args))) + ((#:depth) + (elm-set! self 'depth (cadr args))) + ((#:modifiers) + (elm-set! self 'modifiers (cadr args))) + (else + ; Build in reverse order, as we reverse it back when we're done. + (set! unrecognized + (cons (cadr args) (cons (car args) unrecognized))))) + (loop (cddr args) unrecognized))))) +) + +; Accessors. + +(define-getters <eval-state> estate + (context owner expr-fn env depth modifiers) +) +(define-setters <eval-state> estate + (context owner expr-fn env depth modifiers) +) + +; Build an estate for use in producing a value from rtl. +; CONTEXT is a <context> object or #f if there is none. +; OWNER is the owner of the expression or #f if there is none. + +(define (estate-make-for-eval context owner) + (vmake <eval-state> + #:context context + #:owner owner + #:expr-fn (lambda (rtx-obj expr mode estate) + (rtx-evaluator rtx-obj))) +) + +; Create a copy of ESTATE. + +(define (estate-copy estate) + (object-copy-top estate) +) + +; Create a copy of STATE with a new environment ENV. + +(define (estate-new-env state env) + (let ((result (estate-copy state))) + (estate-set-env! result env) + result) +) + +; Create a copy of STATE with environment ENV pushed onto the existing +; environment list. +; There's no routine to pop the environment list as there's no current +; need for it: we make a copy of the state when we push. + +(define (estate-push-env state env) + (let ((result (estate-copy state))) + (estate-set-env! result (cons env (estate-env result))) + result) +) + +; Create a copy of STATE with modifiers MODS. + +(define (estate-with-modifiers state mods) + (let ((result (estate-copy state))) + (estate-set-modifiers! result (append mods (estate-modifiers result))) + result) +) + +; Convert a tstate to an estate. + +(define (tstate->estate t) + (vmake <eval-state> + #:context (tstate-context t) + #:env (tstate-env t)) +) + +; RTL expression evaluation. +; +; ??? These used eval2 at one point. Not sure which is faster but I suspect +; eval2 is by far. On the otherhand this has yet to be compiled. And this way +; is more portable, more flexible, and works with guile 1.2 (which has +; problems with eval'ing self referential vectors, though that's one reason to +; use smobs). + +; Set to #t to debug rtx evaluation. + +(define -rtx-eval-debug? #f) + +; RTX expression evaluator. +; +; EXPR is the expression to be eval'd. It must be in compiled form. +; MODE is the mode of EXPR, a <mode> object or its name. +; ESTATE is the current evaluation state. + +(define (rtx-eval-with-estate expr mode estate) + (if -rtx-eval-debug? + (begin + (display "Traversing ") + (display expr) + (newline) + (rtx-env-dump (estate-env estate)) + )) + + (if (pair? expr) ; pair? -> cheap non-null-list? + + (let* ((rtx-obj (rtx-lookup (car expr))) + (fn ((estate-expr-fn estate) rtx-obj expr mode estate))) + (if fn + (if (procedure? fn) + (apply fn (cons estate (cdr expr))) +; ; Don't eval operands for syntax expressions. +; (if (rtx-style-syntax? rtx-obj) +; (apply fn (cons estate (cdr expr))) +; (let ((operands +; (-rtx-eval-operands rtx-obj expr estate))) +; (apply fn (cons estate operands)))) + fn) + ; Leave expr unchanged. + expr)) +; (let ((operands +; (-rtx-traverse-operands rtx-obj expr estate))) +; (cons rtx-obj operands)))) + + ; EXPR is not a list + (error "argument to rtx-eval-with-estate is not a list" expr)) +) + +; Evaluate rtx expression EXPR and return the computed value. +; EXPR must already be in compiled form (the result of rtx-compile). +; OWNER is the owner of the value, used for attribute computation, +; or #f if there isn't one. +; FIXME: context? + +(define (rtx-value expr owner) + (rtx-eval-with-estate expr 'DFLT (estate-make-for-eval #f owner)) +) + +; Instruction field support. + +; Return list of ifield names refered to in EXPR. +; Assumes EXPR is more than just (ifield x). + +(define (rtl-find-ifields expr) + (let ((ifields nil)) + (letrec ((scan! (lambda (arg-list) + (for-each (lambda (arg) + (if (pair? arg) + (if (eq? (car arg) 'ifield) + (set! ifields + (cons (rtx-ifield-name arg) + ifields)) + (scan! (cdr arg))))) + arg-list)))) + (scan! (cdr expr)) + (nub ifields identity))) +) + +; Hardware rtx handlers. + +; Subroutine of hw to compute the object's name. +; The name of the operand must include the index so that multiple copies +; of a hardware object (e.g. h-gr[0], h-gr[14]) can be distinguished. +; We make some attempt to make the name pretty as it appears in generated +; files. + +(define (-rtx-hw-name hw hw-name index-arg) + (cond ((hw-scalar? hw) + hw-name) + ((rtx? index-arg) + (symbol-append hw-name '- (rtx-pretty-name index-arg))) + (else + (symbol-append hw-name ; (obj:name (op:type self)) + '- + ; (obj:name (op:index self))))) + (stringize index-arg "-")))) +) + +; Return the <operand> object described by +; HW-NAME/MODE-NAME/SELECTOR/INDEX-ARG. +; +; HW-NAME is the name of the hardware element. +; INDEX-ARG is an rtx or number of the index. +; In the case of scalar hardware elements, pass 0 for INDEX-ARG. +; MODE-NAME is the name of the mode. +; In the case of a vector of registers, INDEX-ARG is the vector index. +; In the case of a scalar register, the value is ignored, but pass 0 (??? #f?). +; SELECTOR is an rtx or number and is passed to HW-NAME to allow selection of a +; particular variant of the hardware. It's kind of like an INDEX, but along +; an atypical axis. An example is memory ASI's on Sparc. Pass +; hw-selector-default if there is no selector. +; ESTATE is the current rtx evaluation state. +; +; e.g. (hw estate WI h-gr #f (const INT 14)) +; selects register 14 of the h-gr set of registers. +; +; *** The index is passed unevaluated because for parallel execution support +; *** a variable is created with a name based on the hardware element and +; *** index, and we want a reasonably simple and stable name. We get this by +; *** stringize-ing it. +; *** ??? Though this needs to be redone anyway. +; +; ??? The specified hardware element must be either a scalar or a vector. +; Maybe in the future allow arrays although there's significant utility in +; allowing only at most a scalar index. + +(define (hw estate mode-name hw-name index-arg selector) + ; Enforce some rules to keep things in line with the current design. + (if (not (symbol? mode-name)) + (parse-error "hw" "invalid mode name" mode-name)) + (if (not (symbol? hw-name)) + (parse-error "hw" "invalid hw name" hw-name)) + (if (not (or (number? index-arg) + (rtx? index-arg))) + (parse-error "hw" "invalid index" index-arg)) + (if (not (or (number? selector) + (rtx? selector))) + (parse-error "hw" "invalid selector" selector)) + + (let ((hw (current-hw-sem-lookup-1 hw-name))) + (if (not hw) + (parse-error "hw" "invalid hardware element" hw-name)) + + (let ((mode (if (eq? mode-name 'DFLT) (hw-mode hw) (mode:lookup mode-name))) + (result (new <operand>))) ; ??? lookup-for-new? + + (if (not mode) + (parse-error "hw" "invalid mode" mode-name)) + + ; Record the selector. + (elm-xset! result 'selector selector) + + ; Create the index object. + (elm-xset! result 'index + (cond ((number? index-arg) + (make <hw-index> 'anonymous 'constant UINT index-arg)) + ((rtx? index-arg) + ; For the simulator the following could be done which + ; would save having to create a closure. + ; ??? Old code, left in for now. + ; (rtx-get estate DFLT + ; (rtx-eval (estate-context estate) + ; (estate-econfig estate) + ; index-arg rtx-evaluator)) + ; Make sure constant indices are recorded as such. + (if (rtx-constant? index-arg) + (make <hw-index> 'anonymous 'constant UINT + (rtx-constant-value index-arg)) + (make <hw-index> 'anonymous 'rtx DFLT + (-rtx-closure-make estate index-arg)))) + (else (parse-error "hw" "invalid index" index-arg)))) + + (if (not (hw-mode-ok? hw (obj:name mode) (elm-xget result 'index))) + (parse-error "hw" "invalid mode for hardware" mode-name)) + + (elm-xset! result 'type hw) + (elm-xset! result 'mode mode) + + ; The name of the operand must include the index so that multiple copies + ; of a hardware object (e.g. h-gr[0], h-gr[14]) can be distinguished. + (let ((name (-rtx-hw-name hw hw-name index-arg))) + (send result 'set-name! name) + (op:set-sem-name! result name)) + + ; Empty comment and attribute. + ; ??? Stick the arguments in the comment for debugging purposes? + (send result 'set-comment! "") + (send result 'set-atlist! atlist-empty) + + result)) +) + +; This is shorthand for (hw estate mode hw-name regno selector). +; ESTATE is the current rtx evaluation state. +; INDX-SEL is an optional register number and possible selector. +; The register number, if present, is (car indx-sel) and must be a number or +; unevaluated RTX expression. +; The selector, if present, is (cadr indx-sel) and must be a number or +; unevaluated RTX expression. +; ??? A register selector isn't supported yet. It's just an idea that's +; been put down on paper for future reference. + +(define (reg estate mode hw-name . indx-sel) + (s-hw estate mode hw-name + (if (pair? indx-sel) (car indx-sel) 0) + (if (and (pair? indx-sel) (pair? (cdr indx-sel))) + (cadr indx-sel) + hw-selector-default)) +) + +; This is shorthand for (hw estate mode h-memory addr selector). +; ADDR must be an unevaluated RTX expression. +; If present (car sel) must be a number or unevaluated RTX expression. + +(define (mem estate mode addr . sel) + (s-hw estate mode 'h-memory addr + (if (pair? sel) (car sel) hw-selector-default)) +) + +; For the rtx nodes to use. + +(define s-hw hw) + +; The program counter. +; When this code is loaded, global `pc' is nil, it hasn't been set to the +; pc operand yet (see operand-init!). We can't use `pc' inside the drn as the +; value is itself. So we use s-pc. rtl-finish! must be called after +; operand-init!. + +(define s-pc pc) + +; Conditional execution. + +; `if' in RTL has a result, like ?: in C. +; We support both: one with a result (non VOID mode), and one without (VOID mode). +; The non-VOID case must have an else part. +; MODE is the mode of the result, not the comparison. +; The comparison is expected to return a zero/non-zero value. +; ??? Perhaps this should be a syntax-expr. Later. + +(define (e-if estate mode cond then . else) + (if (> (length else) 1) + (error "if: too many elements in `else' part" else)) + (if (null? else) + (if cond then) + (if cond then (car else))) +) + +; Subroutines. +; ??? Not sure this should live here. + +(define (-subr-read errtxt . arg-list) + #f +) + +(define define-subr + (lambda arg-list + (let ((s (apply -subr-read (cons "define-subr" arg-list)))) + (if s + (current-subr-add! s)) + s)) +) + +; Misc. utilities. + +; The argument to drn,drmn,drsn must be Scheme code (or a fixed subset +; thereof). .str/.sym are used in pmacros so it makes sense to include them +; in the subset. +(define .str string-append) +(define .sym symbol-append) + +; Given (expr1 expr2 expr3 expr4), for example, +; return (fn (fn (fn expr1 expr2) expr3) expr4). + +(define (rtx-combine fn exprs) + (assert (not (null? exprs))) + (letrec ((-rtx-combine (lambda (fn exprs result) + (if (null? exprs) + result + (-rtx-combine fn + (cdr exprs) + (rtx-make fn + result + (car exprs))))))) + (-rtx-combine fn (cdr exprs) (car exprs))) +) + +; Called before a .cpu file is read in. + +(define (rtl-init!) + (set! -rtx-func-table (make-hash-table 127)) + (set! -rtx-macro-table (make-hash-table 127)) + (set! -rtx-num-next 0) + (def-rtx-funcs) + (reader-add-command! 'define-subr + "\ +Define an rtx subroutine, name/value pair list version. +" + nil 'arg-list define-subr) + *UNSPECIFIED* +) + +; Install builtins + +(define (rtl-builtin!) + *UNSPECIFIED* +) + +; Called after cpu files are loaded to add misc. remaining entries to the +; rtx handler table for use during evaluation. +; rtl-finish! must be done before ifmt-compute!, the latter will +; construct hardware objects which is done by rtx evaluation. + +(define (rtl-finish!) + (logit 2 "Building rtx operand table ...\n") + + ; Update s-pc, must be called after operand-init!. + (set! s-pc pc) + + ; Table of traversers for the various rtx elements. + (let ((hash-table (-rtx-make-traverser-table))) + (set! -rtx-traverser-table (make-vector (rtx-max-num) #f)) + (for-each (lambda (rtx-name) + (let ((rtx (rtx-lookup rtx-name))) + (if rtx + (vector-set! -rtx-traverser-table (rtx-num rtx) + (map1-improper + (lambda (arg-type) + (cons arg-type + (hashq-ref hash-table arg-type))) + (rtx-arg-types rtx)))))) + (rtx-name-list))) + + ; Initialize the operand hash table. + (set! -rtx-operand-table (make-hash-table 127)) + + ; Add the operands to the eval symbol table. + (for-each (lambda (op) + (hashq-set! -rtx-operand-table (obj:name op) op) + ) + (current-op-list)) + + ; Add ifields to the eval symbol table. + (for-each (lambda (f) + (hashq-set! -rtx-operand-table (obj:name f) f) + ) + (non-derived-ifields (current-ifld-list))) + + *UNSPECIFIED* +) diff --git a/cgen/rtx-funcs.scm b/cgen/rtx-funcs.scm new file mode 100644 index 00000000000..47bd0582264 --- /dev/null +++ b/cgen/rtx-funcs.scm @@ -0,0 +1,1002 @@ +; Standard RTL functions. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; THIS FILE CONTAINS ONE BIG FUNCTION: def-rtx-funcs. +; +; It is ok for this file to use procs "internal" to rtl.scm. +; +; Each rtx functions has two leading operands: &options, &mode; +; though `&mode' may be spelled differently. +; The "&" prefix is to indicate that the parsing of these operands is handled +; differently. They are optional and are written with leading colons +; (e.g. :SI). The leading ":" is to help the parser - all leading optional +; operands begin with ":". The order of the arguments is &options then &mode +; though there is no imposed order in written RTL. + +(define (def-rtx-funcs) + +; Do not change the indentation here. +(let +( + ; These are defined in rtl.scm. + (drn define-rtx-node) + (drsn define-rtx-syntax-node) + (dron define-rtx-operand-node) + (drmn define-rtx-macro-node) +) + +; The reason for the odd indenting above is so that emacs begins indenting the +; following code at column 1. + +; Error reporting. +; MODE is present for use in situations like non-VOID mode cond's. + +(drn (error &options &mode message) + (OPTIONS ANYMODE STRING) (NA NA NA) + MISC + (context-error (estate-context *estate*) message) +) + +; Enums +; Default mode is INT. + +(drn (enum &options &mode enum-name) + (OPTIONS NUMMODE SYMBOL) (NA NA NA) + ARG + ; When computing a value, return the enum's value. + (enum-lookup-val enum-name) +) + +; Instruction fields +; These are used in the encode/decode specs of other ifields as well as in +; instruction semantics. +; Ifields are normally specified by name, but they are subsequently wrapped +; in this. + +(dron (ifield &options &mode ifld-name) + (OPTIONS DFLTMODE SYMBOL) (NA NA NA) + ARG + (let ((f (current-ifld-lookup ifld-name))) + (make <operand> ifld-name (string-append ifld-name " used as operand") + (atlist-cons (bool-attr-make 'SEM-ONLY #t) + (obj-atlist f)) + (obj:name (ifld-hw-type f)) + (obj:name (ifld-mode f)) + (make <hw-index> 'anonymous 'ifield (ifld-mode f) f) + nil #f #f)) +) + +; Specify an operand. +; Operands are normally specified by name, but they are subsequently wrapped +; in this. + +(dron (operand &options &mode op-name) + (OPTIONS DFLTMODE SYMBOL) (NA NA NA) + ARG + (current-op-lookup op-name) +) + +; Operand naming/numbering. +; Operands are given names so that the operands as used in the semantics can +; be matched with arguments of function units. With good name choices of +; operands and function unit arguments, this is rarely necessary, but +; sometimes it is. +; +; ??? This obfuscates the semantic code a fair bit. Another way to do this +; would be to add new elements to <insn> to specify operands outside of +; the semantic code. E.g. +; (define-insn ... +; (inputs (in-gr1 src1) (in-gr2 src2)) +; (outputs (out-pc pc) (out-gr dr) (reg-14 (reg WI h-gr 14))) +; ...) +; The intent here is to continue to allow the semantic code to use names +; of operands, and not overly complicate the input/output description. +; +; In instructions, operand numbers are recorded as well, to implement +; profiling and result writeback of parallel insns. + +; Rename operand VALUE to NEW-NAME. +; VALUE is an expression whose result is an object of type <operand>. +; It can be the name of an existing operand. +; ??? Might also support numbering by allowing NEW-NAME to be a number. + +(drsn (name &options &mode new-name value) + (OPTIONS DFLTMODE SYMBOL RTX) (NA NA NA ANY) + ARG + (let ((result (object-copy (rtx-get 'DFLT value)))) + (op:set-sem-name! result new-name) + result) +) + +; Operands are generally compiled to an internal form first. +; There is a fair bit of state associated with them, and it's easier to +; work with an object than source [which might get fairly complicated if +; it expresses all the state]. +; Compiled operands are wrapped in this so that they still look like rtx. + +(dron (xop &options &mode object) + (OPTIONS DFLTMODE OBJECT) (NA NA NA) + ARG + object +) + +;(dron (opspec: &options &mode op-name op-num hw-ref attrs) +; (OPTIONS ANYMODE SYMBOL NUMBER RTX ATTRS) (NA NA NA NA ANY NA) +; ARG +; (let ((opval (rtx-eval-with-estate hw-ref mode *estate*))) +; (assert (operand? opval)) +; ; Set the specified mode, ensuring it's ok. +; ; This also makes a copy as we don't want to modify predefined +; ; operands. +; (let ((operand (op:new-mode opval mode))) +; (op:set-sem-name! operand op-name) +; (op:set-num! operand op-num) +; (op:set-cond?! operand (attr-value attrs 'COND-REF #f)) +; operand)) +;) + +; Specify a reference to a local variable. +; Local variables are normally specified by name, but they are subsequently +; wrapped in this. + +(dron (local &options &mode local-name) + (OPTIONS DFLTMODE SYMBOL) (NA NA NA) + ARG + (rtx-temp-lookup (tstate-env *tstate*) local-name) +) + +; FIXME: This doesn't work. See s-operand. +;(define (s-dup estate op-name) +; (if (not (insn? (estate-owner estate))) +; (error "dup: not processing an insn")) +; (vector-ref (insn:operands (current-current-context)) +; (op:lookup-num (insn:operands (estate-owner estate)) op-name)) +;) +; +; ??? Since operands are given names and not numbers this isn't currently used. +; +;(drsn (dup &options &mode op-name) +; (OPTIONS DFLTMODE SYMBOL) (NA NA NA) +; ;(s-dup *estate* op-name) +; (begin +; (if (not (insn? (estate-owner *estate*))) +; (error "dup: not processing an insn")) +; (vector-ref (insn:operands (estate-owner *estate*)) +; (op:lookup-num (insn:operands (estate-owner *estate*)) op-name))) +; #f +;) + +; Returns non-zero if operand NAME was referenced (read if input operand +; and written if output operand). +; ??? What about input/output operands. + +(drsn (ref &options &mode name) + (OPTIONS DFLTMODE SYMBOL) (NA NA NA) + ARG + #f +) + +; Return the index of an operand. +; For registers this is the register number. +; ??? Mode handling incomplete. + +(dron (index-of &options &mode op-rtx) + (OPTIONS DFLTMODE RTX) (NA NA ANY) + ARG + (let* ((operand (rtx-eval-with-estate op-rtx 'DFLT *estate*)) + (f (hw-index:value (op:index operand))) + (f-name (obj:name f))) + (make <operand> f-name f-name + (atlist-cons (bool-attr-make 'SEM-ONLY #t) + (obj-atlist f)) + (obj:name (ifld-hw-type f)) + (obj:name (ifld-mode f)) + (make <hw-index> 'anonymous + 'ifield + (ifld-mode f) + ; (send (op:type op) 'get-index-mode) + f) + nil #f #f)) +) + +; Same as index-of, but improves readability for registers. + +(drmn (regno reg) + (list 'index-of reg) +) + +; Hardware elements. + +; Describe a random hardware object. +; If INDX is missing, assume the element is a scalar. We pass 0 so s-hw +; doesn't have to unpack the list that would be passed if it were defined as +; (hw mode hw-name . indx). This is an internal implementation detail +; and thus harmless to the description language. +; These are implemented as syntax nodes as we must pass INDX to `s-hw' +; unevaluated. +; ??? Not currently supported. Not sure whether it should be. +;(drsn (hw &options &mode hw-elm . indx-sel) +; (OPTIONS ANYMODE SYMBOL . RTX) (NA NA NA . INT) +; ARG +; (let ((indx (if (pair? indx-sel) (car indx-sel) 0)) +; (selector (if (and (pair? indx-sel) (pair? (cdr indx-sel))) +; (cadr indx-sel) +; hw-selector-default)))) +; (s-hw *estate* mode hw-elm indx selector) +;) + +; Register accesses. +; INDX-SEL is an optional index and possible selector. +(dron (reg &options &mode hw-elm . indx-sel) + (OPTIONS ANYMODE SYMBOL . RTX) (NA NA NA . INT) + ARG + (let ((indx (if (pair? indx-sel) (car indx-sel) 0)) + (selector (if (and (pair? indx-sel) (pair? (cdr indx-sel))) + (cadr indx-sel) + hw-selector-default))) + (s-hw *estate* mode hw-elm indx selector)) +) + +; A raw-reg bypasses the getter/setter stuff. It's usually used in +; getter/setter definitions. + +(dron (raw-reg &options &mode hw-elm . indx-sel) + (OPTIONS ANYMODE SYMBOL . RTX) (NA NA NA . INT) + ARG + (let ((indx (if (pair? indx-sel) (car indx-sel) 0)) + (selector (if (and (pair? indx-sel) (pair? (cdr indx-sel))) + (cadr indx-sel) + hw-selector-default))) + (let ((result (s-hw *estate* mode hw-elm indx selector))) + (obj-cons-attr! result (bool-attr-make 'RAW #t)) + result)) +) + +; Memory accesses. +(dron (mem &options &mode addr . sel) + (OPTIONS EXPLNUMMODE RTX . RTX) (NA NA AI . INT) + ARG + (s-hw *estate* mode 'h-memory addr + (if (pair? sel) (car sel) hw-selector-default)) +) + +; Instruction execution support. +; There are no jumps, per se. A jump is a set of `pc'. + +; The program counter. +; ??? Hmmm... needed? The pc is usually specified as `pc' which is shorthand +; for (operand pc). +(dron (pc) () () ARG s-pc) + +; Fetch bytes from the instruction stream of size MODE. +; FIXME: Later need to augment this by passing an indicator to the mem-fetch +; routines that we're doing an ifetch. +; ??? wip! + +(drmn (ifetch mode pc) + (list 'mem mode pc) ; hw-selector-ispace +) + +; NUM is the instruction number. Generally it is zero but if more than one +; insn is decoded at a time, it is non-zero. This is used, for example, to +; index into the scache [as an offset from the first insn]. +; ??? wip! + +(drmn (decode mode pc insn num) + (list 'c-call mode 'EXTRACT pc insn num) +) + +; NUM is the same number passed to `decode'. +; ??? wip! + +(drmn (execute mode num) + (list 'c-call mode 'EXECUTE num) +) + +; Control Transfer Instructions + +; Sets of pc are handled like other sets so there are no branch rtx's. + +; Indicate there are N delay slots in the processing of RTX. +; N is a `const' node. +; ??? wip! + +(drn (delay &options &mode n rtx) + (OPTIONS DFLTMODE RTX RTX) (NA NA INT ANY) + MISC + #f ; (s-sequence *estate* VOID '() rtx) ; wip! +) + +; Annul the following insn if YES? is non-zero. +; PC is the address of the annuling insn. +; The target is required to define SEM_ANNUL_INSN. +; ??? wip! + +(drmn (annul yes?) + ; The pc reference here is hidden in c-code to not generate a spurious + ; pc input operand. + (list 'c-call 'VOID "SEM_ANNUL_INSN" (list 'c-code 'AI "pc") yes?) +) + +; Skip the following insn if YES? is non-zero. +; The target is required to define SEM_SKIP_INSN. +; ??? This is similar to annul. Deletion of one of them defered. +; ??? wip! + +(drn (skip &options &mode yes?) + (OPTIONS DFLTMODE RTX) (NA NA INT) + MISC + #f +) + +; Attribute support. + +; Return a boolean indicating if attribute named ATTR is VALUE in OWNER. +; If VALUE is a list, return "true" if ATTR is any of the listed values. +; ??? Don't yet support !VALUE. +; OWNER is the result of either (current-insn) or (current-mach) +; [note that canonicalization will turn them into +; (current-{insn,mach} () DFLT)]. +; The result is always of mode INT. +; FIXME: wip +; +; This is a syntax node so the args are not pre-evaluated. +; We just want the symbols. +; FIXME: Hmmm... it currently isn't a syntax node. + +(drn (eq-attr &options &mode owner attr value) + (OPTIONS DFLTMODE RTX SYMBOL SYMORNUM) (NA NA ANY NA NA) + MISC + (let ((atval (if owner + (obj-attr-value owner attr) + (attr-lookup-default attr #f)))) + (if (list? value) + (->bool (memq atval value)) + (eq? atval value))) +) + +; Get the value of attribute ATTR-NAME. +; OBJ is the result of either (current-insn) or (current-mach) +; [note that canonicalization will turn them into +; (current-{insn,mach} () DFLT)]. +; FIXME:wip + +(drn (attr &options &mode obj attr-name) + (OPTIONS DFLTMODE RTX SYMBOL) (NA NA NA NA) + MISC + #f +) + +; Same as `quote', for use in attributes cus "quote" sounds too jargonish. +; [Ok, not a strong argument for using "symbol", but so what?] + +(drsn (symbol &options &mode name) + (OPTIONS DFLTMODE SYMBOL) (NA NA NA) + ARG + name +) + +; Return the current instruction. + +(drn (current-insn &options &mode) + (OPTIONS DFLTMODE) (NA NA) + MISC + (let ((obj (estate-owner *estate*))) + (if (not (insn? obj)) + (error "current context not an insn")) + obj) +) + +; Return the currently selected machine. +; This can either be a compile-time or run-time value. + +(drn (current-mach &options &mode) + (OPTIONS DFLTMODE) (NA NA) + MISC + -rtx-current-mach +) + +; Constants. + +; FIXME: Need to consider 64 bit hosts. +(drn (const &options &mode c) + (OPTIONS NUMMODE NUMBER) (NA NA NA) + ARG + ; When computing a value, just return the constant unchanged. + c +) + +; Large mode support. + +; Combine smaller modes into a larger one. +; Arguments are specified most significant to least significant. +; ??? May also want an endian dependent argument order. That can be +; implemented on top of or beside this. +; ??? Not all of the combinations are supported in the simulator. +; They'll get added as necessary. +(drn (join &options &out-mode in-mode arg1 . arg-rest) + (OPTIONS NUMMODE NUMMODE RTX . RTX) (NA NA NA ANY . ANY) + MISC + ; FIXME: Ensure correct number of args for in/out modes. + ; FIXME: Ensure compatible modes. + #f +) + +; GCC's subreg. +; Called subword 'cus it's not exactly subreg. +; Word numbering is from most signficant (word 0) to least (word N-1). +; ??? May also want an endian dependent word ordering. That can be +; implemented on top of or beside this. +; ??? GCC plans to switch to SUBREG_BYTE. Keep an eye out for the switch +; (which is extensive so probably won't happen anytime soon). + +(drn (subword &options &mode value word-num) + (OPTIONS NUMMODE RTX RTX) (NA NA OP0 INT) + ARG + #f +) + +; ??? The split and concat stuff is just an experiment and should not be used. +; What's there now is just "thoughts put down on paper." + +(drmn (split split-mode in-mode di) + ; FIXME: Ensure compatible modes + ;(list 'c-raw-call 'BLK (string-append "SPLIT" in-mode split-mode) di) + '(const 0) +) + +(drmn (concat modes arg1 . arg-rest) + ; FIXME: Here might be the place to ensure + ; (= (length modes) (length (cons arg1 arg-rest))). + ;(cons 'c-raw-call (cons modes (cons "CONCAT" (cons arg1 arg-rest)))) + '(const 0) +) + +; Support for explicit C code. +; ??? GCC RTL calls this "unspec" which is arguably a more application +; independent name. + +(drn (c-code &options &mode text) + (OPTIONS ANYMODE STRING) (NA NA NA) + UNSPEC + #f +) + +; Invoke C functions passing them arguments from the semantic code. +; The arguments are passed as is, no conversion is done here. +; Usage is: +; (c-call mode name arg1 arg2 ...) +; which is converted into a C function call: +; name (current_cpu, arg1, arg2, ...) +; Mode is the mode of the result. +; If it is VOID this call is a statement and ';' is appended. +; Otherwise it is part of an expression. + +(drn (c-call &options &mode name . args) + (OPTIONS ANYMODE STRING . RTX) (NA NA NA . ANY) + UNSPEC + #f +) + +; Same as c-call but without implicit first arg of `current_cpu'. + +(drn (c-raw-call &options &mode name . args) + (OPTIONS ANYMODE STRING . RTX) (NA NA NA . ANY) + UNSPEC + #f +) + +; Set/get/miscellaneous + +(drn (nop &options &mode) + (OPTIONS VOIDFLTODE) (NA NA) + MISC + #f +) + +; Clobber - mark an object as modified without explaining why or how. + +(drn (clobber &options &mode object) + (OPTIONS ANYMODE RTX) (NA NA OP0) + MISC + #f +) + +; The `set' rtx. +; MODE is the mode of DST. If DFLT, use DST's default mode. +; The mode of the result is always VOID. +; +; ??? It might be more consistent to rename set -> set-trace, but that's +; too wordy. The `set' rtx is the normal one and we want the normal one to +; be the verbose one (prints result tracing messages). `set-quiet' is the +; atypical one, it doesn't print tracing messages. It may also turn out that +; a different mechanism (rather than the name "set-quiet") is used some day. +; One way would be to record the "quietness" state with the traversal state and +; use something like (with-quiet (set foo bar)) akin to with-output-to-string +; in Guile. +; +; i.e. set -> gen-set-trace +; set-quiet -> gen-set-quiet +; +; ??? One might want a `!' suffix as in `set!', but methinks that's following +; Scheme too closely. + +(drn (set &options &mode dst src) + (OPTIONS ANYMODE SETRTX RTX) (NA NA OP0 MATCH1) + SET + #f +) + +(drn (set-quiet &options &mode dst src) + (OPTIONS ANYMODE SETRTX RTX) (NA NA OP0 MATCH1) + SET + #f +) + +; Standard arithmetic operations. + +; It's nice emitting macro calls to the actual C operation in that the RTX +; expression is preserved, albeit in C. On the one hand it's one extra thing +; the programmer has to know when looking at the code. But on the other it's +; trivial stuff, and having a layer between RTX and C allows the +; macros/functions to be modified to handle unexpected situations. +; +; We do emit C directly for cases other than cpu semantics +; (e.g. the assembler). +; +; The language is defined such that we assume ANSI C semantics while avoiding +; implementation defined areas, with as few exceptions as possible. +; +; Current exceptions: +; - signed shift right assumes the sign bit is replicated. +; +; Additional notes [perhaps repeating what's in ANSI C for emphasis]: +; - callers of division and modulus fns must test for 0 beforehand +; if necessary +; - division and modulus fns have unspecified behavior for negative args +; [yes I know the C standard says implementation defined, here its +; unspecified] +; - later add versions of div/mod that have an explicit behaviour for -ve args +; - signedness is part of the rtx operation name, and is not determined +; from the arguments [elsewhere is a description of the tradeoffs] +; - ??? + +(drn (neg &options &mode s1) + (OPTIONS ANYMODE RTX) (NA NA OP0) + UNARY + #f +) + +(drn (abs &options &mode s1) + (OPTIONS ANYMODE RTX) (NA NA OP0) + UNARY + #f +) + +; For integer values this is a bitwise operation (each bit inverted). +; For floating point values this produces 1/x. +; ??? Might want different names. +(drn (inv &options &mode s1) + (OPTIONS ANYMODE RTX) (NA NA OP0) + UNARY + #f +) + +; This is a boolean operation. +; MODE is the mode of S1. The result always has mode BI. +; ??? Perhaps `mode' shouldn't be here. +(drn (not &options &mode s1) + (OPTIONS ANYMODE RTX) (NA NA OP0) + UNARY + #f +) + +(drn (add &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (sub &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +; "OF" for "overflow flag", "CF" for "carry flag", +; "s3" here must have type BI. +; For the *flag rtx's, MODE is the mode of S1,S2; the result always has +; mode BI. +(drn (addc &options &mode s1 s2 s3) + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) +(drn (add-cflag &options &mode s1 s2 s3) ; FIXME: rename to addc-cflag + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) +(drn (add-oflag &options &mode s1 s2 s3) ; FIXME: rename to addc-vflag + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) +(drn (subc &options &mode s1 s2 s3) + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) +(drn (sub-cflag &options &mode s1 s2 s3) ; FIXME: rename to subc-cflag + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) +(drn (sub-oflag &options &mode s1 s2 s3) ; FIXME: rename to subc-vflag + (OPTIONS ANYMODE RTX RTX RTX) (NA NA OP0 MATCH1 BI) + TRINARY + #f +) + +; Usurp these names so that we have consistent rtl should a program generator +; ever want to infer more about what the semantics are doing. +; For now these are just macros that expand to real rtl to perform the +; operation. + +; Return bit indicating if VALUE is zero/non-zero. +(drmn (zflag arg1 . rest) ; mode value) + (if (null? rest) ; mode missing? + (list 'eq 'DFLT arg1 0) + (list 'eq arg1 (car rest) 0)) +) + +; Return bit indicating if VALUE is negative/non-negative. +(drmn (nflag arg1 . rest) ; mode value) + (if (null? rest) ; mode missing? + (list 'lt 'DFLT arg1 0) + (list 'lt arg1 (car rest) 0)) +) + +; Multiply/divide. + +(drn (mul &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +; ??? In non-sim case, ensure s1,s2 is in right C type for right result. +; ??? Need two variants, one that avoids implementation defined situations +; [both host and target], and one that specifies implementation defined +; situations [target]. +(drn (div &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (udiv &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (mod &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (umod &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +; wip: mixed mode mul/div + +; various floating point routines + +(drn (sqrt &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA OP0) + UNARY + #f +) + +(drn (cos &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA OP0) + UNARY + #f +) + +(drn (sin &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA OP0) + UNARY + #f +) + +; min/max + +(drn (min &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +(drn (max &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +(drn (umin &options &mode s1 s2) + (OPTIONS INTMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +(drn (umax &options &mode s1 s2) + (OPTIONS INTMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +; These are bitwise operations. +(drn (and &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (or &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (xor &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +; Shift operations. + +(drn (sll &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 INT) + BINARY + #f +) +(drn (srl &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 INT) + BINARY + #f +) +; ??? In non-sim case, ensure s1 is in right C type for right result. +(drn (sra &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 INT) + BINARY + #f +) +; Rotates don't really have a sign, so doesn't matter what we say. +(drn (ror &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 INT) + BINARY + #f +) +(drn (rol &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 INT) + BINARY + #f +) +; ??? Will also need rotate-with-carry [duh...]. + +; These are boolean operations (e.g. C &&, ||). +; The result always has mode BI. +; ??? 'twould be more Schemey to take a variable number of args. +; ??? 'twould also simplify several .cpu description entries. +; On the other hand, handling an arbitrary number of args isn't supported by +; ISA's, which the main goal of what we're trying to represent. +(drn (andif &options &mode s1 s2) + (OPTIONS DFLTMODE RTX RTX) (NA NA ANY ANY) + BINARY ; IF? + #f +) +(drn (orif &options &mode s1 s2) + (OPTIONS DFLTMODE RTX RTX) (NA NA ANY ANY) + BINARY ; IF? + #f +) + +; `bitfield' is an experimental operation. +; It's not really needed but it might help simplify some things. +; +;(drn (bitfield mode src start length) +; ... +; ... +;) + +; Conversions. + +(drn (ext &options &mode s1) + (OPTIONS INTMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (zext &options &mode s1) + (OPTIONS INTMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (trunc &options &mode s1) + (OPTIONS INTMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (fext &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (ftrunc &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (float &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (ufloat &options &mode s1) + (OPTIONS FLOATMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (fix &options &mode s1) + (OPTIONS INTMODE RTX) (NA NA ANY) + UNARY + #f +) +(drn (ufix &options &mode s1) + (OPTIONS INTMODE RTX) (NA NA ANY) + UNARY + #f +) + +; Comparisons. +; MODE is the mode of S1,S2. The result always has mode BI. + +(drn (eq &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (ne &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +; ??? In non-sim case, ensure s1,s2 is in right C type for right result. +(drn (lt &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (le &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (gt &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (ge &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +; ??? In non-sim case, ensure s1,s2 is in right C type for right result. +(drn (ltu &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (leu &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (gtu &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) +(drn (geu &options &mode s1 s2) + (OPTIONS ANYMODE RTX RTX) (NA NA OP0 MATCH1) + BINARY + #f +) + +; Set membership. +; Useful in ifield assertions. + +; Return a boolean (BI mode) indicating if VALUE is in SET. +; VALUE is any constant rtx. SET is a `number-list' rtx. + +(drn (member &options &mode value set) + (OPTIONS DFLTMODE RTX RTX) (NA NA INT INT) + MISC + (begin + (if (not (rtx-constant? value)) + (context-error (estate-context *estate*) "value is not a constant" value)) + (if (not (rtx-kind? 'number-list set)) + (context-error (estate-context *estate*) "set is not a `number-list' rtx" set)) + (if (memq (rtx-constant-value value) (rtx-number-list-values set)) + (rtx-true) + (rtx-false))) +) + +(drn (number-list &options &mode value-list) + (OPTIONS INTMODE NUMBER . NUMBER) (NA NA NA . NA) + MISC + #f +) + +; Conditional execution. + +; FIXME: make syntax node? +(drn (if &options &mode cond then . else) + (OPTIONS ANYMODE TESTRTX RTX . RTX) (NA NA ANY OP0 . MATCH2) + IF + (apply e-if (append! (list *estate* mode cond then) else)) +) + +; ??? The syntax here isn't quite that of Scheme. A condition must be +; followed by a result expression. +; ??? Intermediate expressions (the ones before the last one) needn't have +; the same mode as the result. +(drsn (cond &options &mode . cond-code-list) + (OPTIONS ANYMODE . CONDRTX) (NA NA . OP0) + COND + #f +) + +; ??? Intermediate expressions (the ones before the last one) needn't have +; the same mode as the result. +(drn (case &options &mode test . case-list) + (OPTIONS ANYMODE RTX . CASERTX) (NA NA ANY . OP0) + COND + #f +) + +; Parallels and Sequences + +; This has to be a syntax node as we don't want EXPRS to be pre-evaluated. +; All semantic ops must have a mode, though here it must be VOID. +; IGNORE is for consistency with sequence. ??? Delete some day. +; ??? There's no real need for mode either. + +(drsn (parallel &options &mode ignore expr . exprs) + (OPTIONS VOIDFLTODE LOCALS RTX . RTX) (NA NA NA VOID . VOID) + SEQUENCE + #f +) + +; This has to be a syntax node to handle locals properly: they're not defined +; yet and thus pre-evaluating the expressions doesn't work. +; ??? This should create a closure. + +(drsn (sequence &options &mode locals expr . exprs) + (OPTIONS ANYMODE LOCALS RTX . RTX) (NA NA NA OP0 . OP0) + SEQUENCE + #f +) + +; Internal rtx to create a closure. +; Internal, so it does not appear in rtl.texi. + +(drsn (closure &options &mode expr env) + (OPTIONS DFLTMODE RTX ENV) (NA NA NA NA) + MISC + #f +) + +)) ; End of def-rtx-funcs diff --git a/cgen/sem-frags.scm b/cgen/sem-frags.scm new file mode 100644 index 00000000000..7e50bd0a817 --- /dev/null +++ b/cgen/sem-frags.scm @@ -0,0 +1,1236 @@ +; Semantic fragments. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Background info: +; Some improvement in pbb simulator efficiency is obtained in cases like +; the ARM where for example operand2 computation is expensive in terms of +; cpu cost, code size, and subroutine call overhead if the code is put in +; a subroutine. It could be inlined, but there are numerous occurences +; resulting in poor icache usage. +; If the computation is put in its own fragment then code size is reduced +; [improving icache usage] and subroutine call overhead is removed in a +; computed-goto simulator [arguments are passed in machine generated local +; variables]. +; +; The basic procedure here is to: +; - break all insns up into a set of statements +; This is either one statement in the case of insns that don't begin with a +; sequence, or a list of statements, one for each element in the sequence. +; - find a profitable set of common leading statements (called the "header") +; and a profitable set of common trailing statements (called the "trailer") +; What is "profitable" depends on +; - how expensive the statement is +; - how long the statement is +; - the number of insns using the statement +; - what fraction of the total insn the statement is +; - rewrite insn semantics in terms of the new header and trailer fragments +; plus a "middle" part that is whatever is left over +; - there is always a header, the middle and trailer parts are optional +; - cti insns require a header and trailer, though they can be the same +; fragment +; +; TODO: +; - check ARM orr insns which come out as header, tiny middle, trailer +; - the tiny middle seems like a waste (combine with trailer?) +; - there are 8 trailers consisting of just `nop' for ARM +; - rearranging statements to increase number and length of common sets +; - combine common middle fragments +; - parallel's not handled yet (only have to handle parallel's at the +; top level) +; - insns can also be split on timing-sensitive boundaries (pipeline, memory, +; whatever) though that is not implemented yet. This may involve rtl +; additions. +; +; Usage: +; - call sim-sfrag-init! first, to initialize +; - call sim-sfrag-analyze-insns! to create the semantic fragments +; - afterwards, call +; - sim-sfrag-insn-list +; - sim-sfrag-frag-table +; - sim-sfrag-usage-table +; - sim-sfrag-locals-list + +; Statement computation. + +; Set to #t to collect various statistics. + +(define -stmt-stats? #f) + +; Collection of computed stats. Only set if -stmt-stats? = #t. + +(define -stmt-stats #f) + +; Collection of computed statement data. Only set if -stmt-stats? = #t. + +(define -stmt-stats-data #f) + +; Create a structure recording data of all statements. +; A pair of (next-ordinal . table). + +(define (-stmt-data-make hash-size) + (cons 0 (make-vector hash-size nil)) +) + +; Accessors. + +(define (-stmt-data-table data) (cdr data)) +(define (-stmt-data-next-num data) (car data)) +(define (-stmt-data-set-next-num! data newval) (set-car! data newval)) +(define (-stmt-data-hash-size data) (vector-length (cdr data))) + +; A single statement. +; INSN semantics either consist of a single statement or a sequence of them. + +(define <statement> + (class-make '<statement> nil + '( + ; RTL code + expr + + ; Local variables of the sequence `expr' is in. + locals + + ; Ordinal of the statement. + num + + ; Costs. + ; SPEED-COST is the cost of executing fragment, relative to a + ; simple add. + ; SIZE-COST is the size of the fragment, relative to a simple + ; add. + ; ??? The cost numbers are somewhat arbitrary and subject to + ; review. + speed-cost + size-cost + + ; Users of this statement. + ; Each element is (owner-number . owner-object), + ; where owner-number is an index into the initial insn table + ; (e.g. insn-list arg of sfrag-create-cse-mapping), and + ; owner-object is the corresponding object. + users + ) + nil) +) + +(define-getters <statement> -stmt (expr locals num speed-cost size-cost users)) + +(define-setters <statement> -stmt (users)) + +; Make a <statement> object of EXPR. +; LOCALS is a list of local variables of the sequence EXPR is in. +; NUM is the ordinal of EXPR. +; SPEED-COST is the cost of executing the statement, relative to a simple add. +; SIZE-COST is the size of the fragment, relative to a simple add. +; ??? The cost numbers are somewhat arbitrary and subject to review. +; +; The user list is set to nil. + +(define (-stmt-make expr locals num speed-cost size-cost) + (make <statement> expr locals num speed-cost size-cost nil) +) + +; Add a user of STMT. + +(define (-stmt-add-user! stmt user-num user-obj) + (-stmt-set-users! stmt (cons (cons user-num user-obj) (-stmt-users stmt))) + *UNSPECIFIED* +) + +; Lookup STMT in DATA. +; CHAIN-NUM is an argument so it need only be computed once. +; The result is the found <statement> object or #f. + +(define (-frag-lookup-stmt data chain-num stmt) + (let ((table (-stmt-data-table data))) + (let loop ((stmts (vector-ref table chain-num))) + (cond ((null? stmts) + #f) + ; ??? equal? should be appropriate rtx-equal?, blah blah blah. + ((equal? (-stmt-expr (car stmts)) stmt) + (car stmts)) + (else + (loop (cdr stmts)))))) +) + +; Hash a statement. + +; Computed hash value. +; Global 'cus -frag-hash-compute! is defined globally so we can use +; /fastcall (FIXME: Need /fastcall to work on non-global procs). + +(define -frag-hash-value-tmp 0) + +(define (-frag-hash-string str) + (let loop ((chars (map char->integer (string->list str))) (result 0)) + (if (null? chars) + result + (loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff)))) +) + +(define (-frag-hash-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff) + (let ((h 0)) + (case (rtx-name expr) + ((operand) + (set! h (-frag-hash-string (symbol->string (rtx-operand-name expr))))) + ((local) + (set! h (-frag-hash-string (symbol->string (rtx-local-name expr))))) + ((const) + (set! h (rtx-const-value expr))) + (else + (set! h (rtx-num rtx-obj)))) + (set! -frag-hash-value-tmp + ; Keep number small. + (modulo (+ (* -frag-hash-value-tmp 3) h op-pos) + #xfffffff))) + + ; #f -> "continue with normal traversing" + #f +) + +(define (-frag-hash-stmt stmt locals size) + (set! -frag-hash-value-tmp 0) + (rtx-traverse-with-locals #f #f stmt -frag-hash-compute! locals #f) ; FIXME: (/fastcall-make -frag-hash-compute!)) + (modulo -frag-hash-value-tmp size) +) + +; Compute the speed/size costs of a statement. + +; Compute speed/size costs. +; Global 'cus -frag-cost-compute! is defined globally so we can use +; /fastcall (FIXME: Need /fastcall to work on non-global procs). + +(define -frag-speed-cost-tmp 0) +(define -frag-size-cost-tmp 0) + +(define (-frag-cost-compute! rtx-obj expr mode parent-expr op-pos tstate appstuff) + ; FIXME: wip + (let ((speed 0) + (size 0)) + (case (rtx-class rtx-obj) + ((ARG) + #f) ; these don't contribute to costs (at least for now) + ((SET) + ; FIXME: speed/size = 0? + (set! speed 1) + (set! size 1)) + ((UNARY BINARY TRINARY) + (set! speed 1) + (set! size 1)) + ((IF) + (set! speed 2) + (set! size 2)) + (else + (set! speed 4) + (set! size 4))) + (set! -frag-speed-cost-tmp (+ -frag-speed-cost-tmp speed)) + (set! -frag-size-cost-tmp (+ -frag-size-cost-tmp size))) + + ; #f -> "continue with normal traversing" + #f +) + +(define (-frag-stmt-cost stmt locals) + (set! -frag-speed-cost-tmp 0) + (set! -frag-size-cost-tmp 0) + (rtx-traverse-with-locals #f #f stmt -frag-cost-compute! locals #f) ; FIXME: (/fastcall-make -frag-cost-compute!)) + (cons -frag-speed-cost-tmp -frag-size-cost-tmp) +) + +; Add STMT to statement table DATA. +; CHAIN-NUM is the chain in the hash table to add STMT to. +; {SPEED,SIZE}-COST are passed through to -stmt-make. +; The result is the newly created <statement> object. + +(define (-frag-add-stmt! data chain-num stmt locals speed-cost size-cost) + (let ((stmt (-stmt-make stmt locals (-stmt-data-next-num data) speed-cost size-cost)) + (table (-stmt-data-table data))) + (vector-set! table chain-num (cons stmt (vector-ref table chain-num))) + (-stmt-data-set-next-num! data (+ 1 (-stmt-data-next-num data))) + stmt) +) + +; Return the locals in EXPR. +; If a sequence, return locals. +; Otherwise, return nil. +; The result is in assq'able form. + +(define (-frag-expr-locals expr) + (if (rtx-kind? 'sequence expr) + (rtx-sequence-assq-locals expr) + nil) +) + +; Return the statements in EXPR. +; If a sequence, return the sequence's expressions. +; Otherwise, return (list expr). + +(define (-frag-expr-stmts expr) + (if (rtx-kind? 'sequence expr) + (rtx-sequence-exprs expr) + (list expr)) +) + +; Analyze statement STMT. +; If STMT is already in STMT-DATA increment its frequency count. +; Otherwise add it. +; LOCALS are locals of the sequence STMT is in. +; USAGE-TABLE is a vector of statement index lists for each expression. +; USAGE-INDEX is the index of USAGE-TABLE to use. +; OWNER is the object of the owner of the statement. + +(define (-frag-analyze-expr-stmt! locals stmt stmt-data usage-table expr-num owner) + (logit 3 "Analyzing statement: " (rtx-strdump stmt) "\n") + (let* ((chain-num + (-frag-hash-stmt stmt locals (-stmt-data-hash-size stmt-data))) + (stmt-obj (-frag-lookup-stmt stmt-data chain-num stmt))) + + (logit 3 " chain #" chain-num "\n") + + (if (not stmt-obj) + (let* ((costs (-frag-stmt-cost stmt locals)) + (speed-cost (car costs)) + (size-cost (cdr costs))) + (set! stmt-obj (-frag-add-stmt! stmt-data chain-num stmt locals + speed-cost size-cost)) + (logit 3 " new statement, #" (-stmt-num stmt-obj) "\n")) + (logit 3 " existing statement, #" (-stmt-num stmt-obj) "\n")) + + (-stmt-add-user! stmt-obj expr-num owner) + + ; If first entry, initialize list, otherwise append to existing list. + (if (null? (vector-ref usage-table expr-num)) + (vector-set! usage-table expr-num (list (-stmt-num stmt-obj))) + (append! (vector-ref usage-table expr-num) + (list (-stmt-num stmt-obj))))) + + *UNSPECIFIED* +) + +; Analyze each statement in EXPR and add it to STMT-DATA. +; OWNER is the object of the owner of the expression. +; USAGE-TABLE is a vector of statement index lists for each expression. +; USAGE-INDEX is the index of the USAGE-TABLE entry to use. +; As each statement's ordinal is computed it is added to the usage list. + +(define (-frag-analyze-expr! expr owner stmt-data usage-table usage-index) + (logit 3 "Analyzing " (obj:name owner) ": " (rtx-strdump expr) "\n") + (let ((locals (-frag-expr-locals expr)) + (stmt-list (-frag-expr-stmts expr))) + (for-each (lambda (stmt) + (-frag-analyze-expr-stmt! locals stmt stmt-data + usage-table usage-index owner)) + stmt-list)) + *UNSPECIFIED* +) + +; Compute statement data from EXPRS, a list of expressions. +; OWNERS is a vector of objects that "own" each corresponding element in EXPRS. +; The owner is usually an <insn> object. Actually it'll probably always be +; an <insn> object but for now I want the disassociation. +; +; The result contains: +; - vector of statement lists of each expression +; - each element is (stmt1-index stmt2-index ...) where each stmtN-index is +; an index into the statement table +; - vector of statements (the statement table of the previous item) +; - each element is a <statement> object + +(define (-frag-compute-statements exprs owners) + (logit 2 "Computing statement table ...\n") + (let* ((num-exprs (length exprs)) + (hash-size + ; FIXME: This is just a quick hack to put something down on paper. + ; blah blah blah. Revisit as necessary. + (cond ((> num-exprs 300) 1019) + ((> num-exprs 100) 511) + (else 127)))) + + (let (; Hash table of expressions. + (stmt-data (-stmt-data-make hash-size)) + ; Statement index lists for each expression. + (usage-table (make-vector num-exprs nil))) + + ; Scan each expr, filling in stmt-data and usage-table. + (let loop ((exprs exprs) (exprnum 0)) + (if (not (null? exprs)) + (let ((expr (car exprs)) + (owner (vector-ref owners exprnum))) + (-frag-analyze-expr! expr owner stmt-data usage-table exprnum) + (loop (cdr exprs) (+ exprnum 1))))) + + ; Convert statement hash table to vector. + (let ((stmt-hash-table (-stmt-data-table stmt-data)) + (end (vector-length (-stmt-data-table stmt-data))) + (stmt-table (make-vector (-stmt-data-next-num stmt-data) #f))) + (let loop ((i 0)) + (if (< i end) + (begin + (map (lambda (stmt) + (vector-set! stmt-table (-stmt-num stmt) stmt)) + (vector-ref stmt-hash-table i)) + (loop (+ i 1))))) + + ; All done. Compute stats if asked to. + (if -stmt-stats? + (begin + ; See how well the hashing worked. + (set! -stmt-stats-data stmt-data) + (set! -stmt-stats + (make-vector (vector-length stmt-hash-table) #f)) + (let loop ((i 0)) + (if (< i end) + (begin + (vector-set! -stmt-stats i + (length (vector-ref stmt-hash-table i))) + (loop (+ i 1))))))) + + ; Result. + (cons usage-table stmt-table)))) +) + +; Semantic fragment selection. +; +; "semantic fragment" is the name assigned to each header/middle/trailer +; "fragment" as each may consist of more than one statement, though not +; necessarily all statements of the original sequence. + +(define <sfrag> + (class-make '<sfrag> '(<ident>) + '( + ; List of insn's using this frag. + users + + ; Ordinal's of each element of `users'. + user-nums + + ; Semantic format of insns using this fragment. + sfmt + + ; List of statement numbers that make up `semantics'. + ; Each element is an index into the stmt-table arg of + ; -frag-pick-best. + ; This is #f if the sfrag wasn't derived from some set of + ; statements. + stmt-numbers + + ; Raw rtl source of fragment. + semantics + + ; Compiled source. + compiled-semantics + + ; Boolean indicating if this frag is for parallel exec support. + parallel? + + ; Boolean indicating if this is a header frag. + ; This includes all frags that begin a sequence. + header? + + ; Boolean indicating if this is a trailer frag. + ; This includes all frags that end a sequence. + trailer? + ) + nil) +) + +(define-getters <sfrag> sfrag + (users user-nums sfmt stmt-numbers semantics compiled-semantics + parallel? header? trailer?) +) + +(define-setters <sfrag> sfrag + (header? trailer?) +) + +; Sorter to merge common fragments together. +; A and B are lists of statement numbers. + +(define (-frag-sort a b) + (cond ((null? a) + (not (null? b))) + ((null? b) + #f) + ((< (car a) (car b)) + #t) + ((> (car a) (car b)) + #f) + (else ; = + (-frag-sort (cdr a) (cdr b)))) +) + +; Return a boolean indicating if L1,L2 match in the first LEN elements. +; Each element is an integer. + +(define (-frag-list-match? l1 l2 len) + (cond ((= len 0) + #t) + ((or (null? l1) (null? l2)) + #f) + ((= (car l1) (car l2)) + (-frag-list-match? (cdr l1) (cdr l2) (- len 1))) + (else + #f)) +) + +; Return the number of expressions that match in the first LEN statements. + +(define (-frag-find-matching expr-table indices stmt-list len) + (let loop ((num-exprs 0) (indices indices)) + (cond ((null? indices) + num-exprs) + ((-frag-list-match? stmt-list + (vector-ref expr-table (car indices)) len) + (loop (+ num-exprs 1) (cdr indices))) + (else + num-exprs))) +) + +; Return a boolean indicating if making STMT-LIST a common fragment +; among several owners is profitable. +; STMT-LIST is a list of statement numbers, indices into STMT-TABLE. +; NUM-EXPRS is the number of expressions with STMT-LIST in common. + +(define (-frag-merge-profitable? stmt-table stmt-list num-exprs) + ; FIXME: wip + (and (>= num-exprs 2) + (or ; No need to include speed costs yet. + ;(>= (-frag-list-speed-cost stmt-table stmt-list) 10) + (>= (-frag-list-size-cost stmt-table stmt-list) 4))) +) + +; Return the cost of executing STMT-LIST. +; STMT-LIST is a list of statment numbers, indices into STMT-TABLE. +; +; FIXME: The yardstick to use is wip. Currently we measure things relative +; to a simple add insn which is given the value 1. + +(define (-frag-list-speed-cost stmt-table stmt-list) + ; FIXME: wip + (apply + (map (lambda (stmt-num) + (-stmt-speed-cost (vector-ref stmt-table stmt-num))) + stmt-list)) +) + +(define (-frag-list-size-cost stmt-table stmt-list) + ; FIXME: wip + (apply + (map (lambda (stmt-num) + (-stmt-size-cost (vector-ref stmt-table stmt-num))) + stmt-list)) +) + +; Compute the longest set of fragments it is desirable/profitable to create. +; The result is (number-of-matching-exprs . stmt-number-list) +; or #f if there isn't one (the longest set is the empty set). +; +; What is desirable depends on a few things: +; - how often is it used? +; - how expensive is it (size-wise and speed-wise) +; - relationship to other frags +; +; STMT-TABLE is a vector of all statements. +; STMT-USAGE-TABLE is a vector of all expressions. Each element is a list of +; statement numbers (indices into STMT-TABLE). +; INDICES is a sorted list of indices into STMT-USAGE-TABLE. +; STMT-USAGE-TABLE is processed in the order specified by INDICES. +; +; FIXME: Choosing a statement list should depend on whether there are existing +; chosen statement lists only slightly shorter. + +(define (-frag-longest-desired stmt-table stmt-usage-table indices) + ; STMT-LIST is the list of statements in the first expression. + (let ((stmt-list (vector-ref stmt-usage-table (car indices)))) + + (let loop ((len 1) (prev-num-exprs 0)) + + ; See how many subsequent expressions match at length LEN. + (let ((num-exprs (-frag-find-matching stmt-usage-table (cdr indices) + stmt-list len))) + ; If there aren't any, we're done. + ; If LEN-1 is usable, return that. + ; Otherwise there is no profitable list of fragments. + (if (= num-exprs 0) + + (let ((matching-stmt-list (list-take (- len 1) stmt-list))) + (if (-frag-merge-profitable? stmt-table matching-stmt-list + prev-num-exprs) + (cons prev-num-exprs matching-stmt-list) + #f)) + + ; Found at least 1 subsequent matching expression. + ; Extend LEN and see if we still find matching expressions. + (loop (+ len 1) num-exprs))))) +) + +; Return list of lists of objects for each unique <sformat-argbuf> in +; USER-LIST. +; Each element of USER-LIST is (insn-num . <insn> object). +; The result is a list of lists. Each element in the top level list is +; a list of elements of USER-LIST that have the same <sformat-argbuf>. +; Insns are also distinguished by being a CTI insn vs a non-CTI insn. +; CTI insns require special handling in the semantics. + +(define (-frag-split-by-sbuf user-list) + ; Sanity check. + (if (not (elm-bound? (cdar user-list) 'sfmt)) + (error "sformats not computed")) + (if (not (elm-bound? (insn-sfmt (cdar user-list)) 'sbuf)) + (error "sformat argbufs not computed")) + + (let ((result nil) + ; Find INSN in SFMT-LIST. The result is the list INSN belongs in + ; or #f. + (find-obj (lambda (sbuf-list insn) + (let ((name (obj:name (sfmt-sbuf (insn-sfmt insn))))) + (let loop ((sbuf-list sbuf-list)) + (cond ((null? sbuf-list) + #f) + ((and (eq? name + (obj:name (sfmt-sbuf (insn-sfmt (cdaar sbuf-list))))) + (eq? (insn-cti? insn) + (insn-cti? (cdaar sbuf-list)))) + (car sbuf-list)) + (else + (loop (cdr sbuf-list)))))))) + ) + (let loop ((users user-list)) + (if (not (null? users)) + (let ((try (find-obj result (cdar users)))) + (if try + (append! try (list (car users))) + (set! result (cons (list (car users)) result))) + (loop (cdr users))))) + + ; Done + result) +) + +; Return a list of desired fragments to create. +; These consist of the longest set of profitable leading statements in EXPRS. +; Each element of the result is an <sfrag> object. +; +; STMT-TABLE is a vector of all statements. +; STMT-USAGE-TABLE is a vector of statement number lists of each expression. +; OWNER-TABLE is a vector of owner objects of each corresponding expression +; in STMT-USAGE-TABLE. +; KIND is one of 'header or 'trailer. +; +; This works for trailing fragments too as we do the computation based on the +; reversed statement lists. + +(define (-frag-compute-desired-frags stmt-table stmt-usage-table owner-table kind) + (logit 2 "Computing desired " kind " frags ...\n") + + (let* ( + (stmt-usage-list + (if (eq? kind 'header) + (vector->list stmt-usage-table) + (map reverse (vector->list stmt-usage-table)))) + ; Sort STMT-USAGE-TABLE. That will bring exprs with common fragments + ; together. + (sorted-indices (sort-grade stmt-usage-list -frag-sort)) + ; List of statement lists that together yield the fragment to create, + ; plus associated users. + (desired-frags nil) + ) + + ; Update STMT-USAGE-TABLE in case we reversed the contents. + (set! stmt-usage-table (list->vector stmt-usage-list)) + + (let loop ((indices sorted-indices) (iteration 1)) + (logit 3 "Iteration " iteration "\n") + (if (not (null? indices)) + (let ((longest (-frag-longest-desired stmt-table stmt-usage-table indices))) + + (if longest + + ; Found an acceptable frag to create. + (let* ((num-exprs (car longest)) + ; Reverse statement numbers back if trailer. + (stmt-list (if (eq? kind 'header) + (cdr longest) + (reverse (cdr longest)))) + (picked-indices (list-take num-exprs indices)) + ; Need one copy of the frag for each sbuf, as structure + ; offsets will be different in generated C/C++ code. + (sfmt-users (-frag-split-by-sbuf + (map (lambda (expr-num) + (cons expr-num + (vector-ref owner-table + expr-num))) + picked-indices)))) + + (logit 3 "Creating frag of length " (length stmt-list) ", " num-exprs " users\n") + (logit 3 "Indices: " picked-indices "\n") + + ; Create an sfrag for each sbuf. + (for-each + (lambda (users) + (let* ((first-owner (cdar users)) + (sfrag + (make <sfrag> + (symbol-append (obj:name first-owner) + (if (eq? kind 'header) + '-hdr + '-trlr)) + "" + atlist-empty + (map cdr users) + (map car users) + (insn-sfmt first-owner) + stmt-list + (apply + rtx-make + (cons 'sequence + (cons 'VOID + (cons nil + (map (lambda (stmt-num) + (-stmt-expr + (vector-ref stmt-table + stmt-num))) + stmt-list))))) + #f ; compiled-semantics + #f ; parallel? + (eq? kind 'header) + (eq? kind 'trailer) + ))) + (set! desired-frags (cons sfrag desired-frags)))) + sfmt-users) + + ; Continue, dropping statements we've put into the frag. + (loop (list-drop num-exprs indices) (+ iteration 1))) + + ; Couldn't find an acceptable statement list. + ; Try again with next one. + (begin + (logit 3 "No acceptable frag found.\n") + (loop (cdr indices) (+ iteration 1))))))) + + ; Done. + desired-frags) +) + +; Return the set of desired fragments to create. +; STMT-TABLE is a vector of each statement. +; STMT-USAGE-TABLE is a vector of (stmt1-index stmt2-index ...) elements for +; each expression, where each stmtN-index is an index into STMT-TABLE. +; OWNER-TABLE is a vector of owner objects of each corresponding expression +; in STMT-USAGE-TABLE. +; +; Each expression is split in up to three pieces: header, middle, trailer. +; This computes pseudo-optimal headers and trailers (if they exist). +; The "middle" part is whatever is leftover. +; +; The result is a vector of 4 elements: +; - vector of (header middle trailer) semantic fragments for each expression +; - each element is an index into the respective table or #f if not present +; - list of header fragments, each element is an <sfrag> object +; - same but for trailer fragments +; - same but for middle fragments +; +; ??? While this is a big function, each piece is simple and straightforward. +; It's kept as one big function so we can compute each expression's sfrag list +; as we go. Though it's not much extra expense to not do this. + +(define (-frag-pick-best stmt-table stmt-usage-table owner-table) + (let ( + (num-stmts (vector-length stmt-table)) + (num-exprs (vector-length stmt-usage-table)) + ; FIXME: Shouldn't have to do vector->list. + (stmt-usage-list (vector->list stmt-usage-table)) + ; Specify result holders here, simplifies code. + (desired-header-frags #f) + (desired-trailer-frags #f) + (middle-frags #f) + ; Also allocate space for expression sfrag usage table. + ; We compute it as we go to save scanning the header and trailer + ; lists twice. + ; copy-tree is needed to avoid shared storage. + (expr-sfrags (copy-tree (make-vector (vector-length stmt-usage-table) + #(#f #f #f)))) + ) + + ; Compute desired headers. + (set! desired-header-frags + (-frag-compute-desired-frags stmt-table stmt-usage-table owner-table + 'header)) + + ; Compute the header used by each expression. + (let ((expr-hdrs-v (make-vector num-exprs #f)) + (num-hdrs (length desired-header-frags))) + (let loop ((hdrs desired-header-frags) (hdrnum 0)) + (if (< hdrnum num-hdrs) + (let ((hdr (car hdrs))) + (for-each (lambda (expr-num) + (vector-set! (vector-ref expr-sfrags expr-num) 0 + hdrnum) + (vector-set! expr-hdrs-v expr-num hdr)) + (sfrag-user-nums hdr)) + (loop (cdr hdrs) (+ hdrnum 1))))) + + ; Truncate each expression by the header it will use and then find + ; the set of desired trailers. + (let ((expr-hdrs (vector->list expr-hdrs-v))) + + (set! desired-trailer-frags + (-frag-compute-desired-frags + stmt-table + ; FIXME: Shouldn't have to use list->vector. + ; [still pass a vector, but use vector-map here instead of map] + (list->vector + (map (lambda (expr hdr) + (if hdr + (list-drop (length (sfrag-stmt-numbers hdr)) expr) + expr)) + stmt-usage-list expr-hdrs)) + owner-table + 'trailer)) + + ; Record the trailer used by each expression. + (let ((expr-trlrs-v (make-vector num-exprs #f)) + (num-trlrs (length desired-trailer-frags))) + (let loop ((trlrs desired-trailer-frags) (trlrnum 0)) + (if (< trlrnum num-trlrs) + (let ((trlr (car trlrs))) + (for-each (lambda (expr-num) + (vector-set! (vector-ref expr-sfrags expr-num) 2 + trlrnum) + (vector-set! expr-trlrs-v expr-num trlr)) + (sfrag-user-nums trlr)) + (loop (cdr trlrs) (+ trlrnum 1))))) + + ; We have the desired headers and trailers, now compute the middle + ; part for each expression. This is just what's left over. + ; ??? We don't try to cse the middle part. Though we can in the + ; future should it prove useful enough. + (logit 2 "Computing middle frags ...\n") + (let* ((expr-trlrs (vector->list expr-trlrs-v)) + (expr-middle-stmts + (map (lambda (expr hdr trlr) + (list-tail-drop + (if trlr (length (sfrag-stmt-numbers trlr)) 0) + (list-drop + (if hdr (length (sfrag-stmt-numbers hdr)) 0) + expr))) + stmt-usage-list expr-hdrs expr-trlrs))) + + ; Finally, record the middle sfrags used by each expression. + (let loop ((tmp-middle-frags nil) + (next-middle-frag-num 0) + (expr-num 0) + (expr-middle-stmts expr-middle-stmts)) + + (if (null? expr-middle-stmts) + + ; Done! + ; [The next statement executed after this is the one at the + ; end that builds the result. Maybe it should be built here + ; and this should be the last statement, but I'm trying this + ; style out for awhile.] + (set! middle-frags (reverse! tmp-middle-frags)) + + ; Does this expr have a middle sfrag? + (if (null? (car expr-middle-stmts)) + ; Nope. + (loop tmp-middle-frags + next-middle-frag-num + (+ expr-num 1) + (cdr expr-middle-stmts)) + ; Yep. + (let ((owner (vector-ref owner-table expr-num))) + (vector-set! (vector-ref expr-sfrags expr-num) + 1 next-middle-frag-num) + (loop (cons (make <sfrag> + (symbol-append (obj:name owner) '-mid) + (string-append (obj:comment owner) + ", middle part") + (obj-atlist owner) + (list owner) + (list expr-num) + (insn-sfmt owner) + (car expr-middle-stmts) + (apply + rtx-make + (cons 'sequence + (cons 'VOID + (cons nil + (map (lambda (stmt-num) + (-stmt-expr + (vector-ref stmt-table stmt-num))) + (car expr-middle-stmts)))))) + #f ; compiled-semantics + #f ; parallel? + #f ; header? + #f ; trailer? + ) + tmp-middle-frags) + (+ next-middle-frag-num 1) + (+ expr-num 1) + (cdr expr-middle-stmts)))))))))) + + ; Result. + (vector expr-sfrags + desired-header-frags + desired-trailer-frags + middle-frags)) +) + +; Given a list of expressions, return list of locals in top level sequences. +; ??? Collisions will be handled by rewriting rtl (renaming locals). +; +; This has to be done now as the cse pass must (currently) take into account +; the rewritten rtl. +; ??? This can be done later, with an appropriate enhancement to rtx-equal? +; ??? cse can be improved by ignoring local variable name (of course). + +(define (-frag-compute-locals! expr-list) + (logit 2 "Computing common locals ...\n") + (let ((result nil) + (lookup-local (lambda (local local-list) + (assq (car local) local-list))) + (local-equal? (lambda (l1 l2) + (and (eq? (car l1) (car l2)) + (mode:eq? (cadr l1) (cadr l2))))) + ) + (for-each (lambda (expr) + (let ((locals (-frag-expr-locals expr))) + (for-each (lambda (local) + (let ((entry (lookup-local local result))) + (if (and entry + (local-equal? local entry)) + #f ; already present + (set! result (cons local result))))) + locals))) + expr-list) + ; Done. + result) +) + +; Common subexpression computation. + +; Given a list of rtl expressions and their owners, return a pseudo-optimal +; set of fragments and a usage list for each owner. +; Common fragments are combined and the original expressions become a sequence +; of these fragments. The result is "pseudo-optimal" in the sense that the +; desired result is somewhat optimal, though no attempt is made at precise +; optimality. +; +; OWNERS is a list of objects that "own" each corresponding element in EXPRS. +; The owner is usually an <insn> object. Actually it'll probably always be +; an <insn> object but for now I want the disassociation. +; +; The result is a vector of six elements: +; - sfrag usage table for each owner #(header middle trailer) +; - statement table (vector of all statements, made with -stmt-make) +; - list of sequence locals used by header sfrags +; - these locals are defined at the top level so that all fragments have +; access to them +; - ??? Need to handle collisions among incompatible types. +; - header sfrags +; - trailer sfrags +; - middle sfrags + +(define (-sem-find-common-frags-1 exprs owners) + ; Sanity check. + (if (not (elm-bound? (car owners) 'sfmt)) + (error "sformats not computed")) + + ; A simple procedure that calls, in order: + ; -frag-compute-locals! + ; -frag-compute-statements + ; -frag-pick-best + ; The rest is shuffling of results. + + ; Internally it's easier if OWNERS is a vector. + (let ((owners (list->vector owners)) + (locals (-frag-compute-locals! exprs))) + + ; Collect statement usage data. + (let ((stmt-usage (-frag-compute-statements exprs owners))) + (let ((stmt-usage-table (car stmt-usage)) + (stmt-table (cdr stmt-usage))) + + ; Compute the frags we want to create. + ; These are in general sequences of statements. + (let ((desired-frags + (-frag-pick-best stmt-table stmt-usage-table owners))) + (let ( + (expr-sfrags (vector-ref desired-frags 0)) + (headers (vector-ref desired-frags 1)) + (trailers (vector-ref desired-frags 2)) + (middles (vector-ref desired-frags 3)) + ) + ; Result. + (vector expr-sfrags stmt-table locals + headers trailers middles)))))) +) + +; Cover proc of -sem-find-common-frags-1. +; See its documentation. + +(define (sem-find-common-frags insn-list) + (-sem-find-common-frags-1 + (begin + (logit 2 "Simplifying/canonicalizing rtl ...\n") + (map (lambda (insn) + ; Must pass canonicalized and macro-expanded rtl. + (rtx-simplify #f insn (insn-semantics insn) + (-build-known-values insn))) + insn-list)) + insn-list) +) + +; Subroutine of sfrag-create-cse-mapping to compute INSN's fragment list. +; FRAG-USAGE is a vector of 3 elements: #(header middle trailer). +; Each element is a fragment number or #f if not present. +; Numbers in FRAG-USAGE are indices relative to their respective subtables +; of FRAG-TABLE (which is a vector of all 3 tables concatenated together). +; NUM-HEADERS,NUM-TRAILERS are used to compute absolute indices. +; +; No header may have been created. This happens when +; it's not profitable (or possible) to merge this insn's +; leading statements with other insns. Ditto for +; trailer. However, each cti insn must have a header +; and a trailer (for pc handling setup and change). +; Try to use the middle fragment if present. Otherwise, +; use the x-header,x-trailer virtual insns. + +(define (-sfrag-compute-frag-list! insn frag-usage frag-table num-headers num-trailers x-header-relnum x-trailer-relnum) + ; `(list #f)' is so append! works. The #f is deleted before returning. + (let ((result (list #f)) + (header (vector-ref frag-usage 0)) + (middle (and (vector-ref frag-usage 1) + (+ (vector-ref frag-usage 1) + num-headers num-trailers))) + (trailer (and (vector-ref frag-usage 2) + (+ (vector-ref frag-usage 2) + num-headers))) + (x-header-num x-header-relnum) + (x-trailer-num (+ x-trailer-relnum num-headers)) + ) + + ; cse'd header created? + (if header + ; Yep. + (append! result (list header)) + ; Nope. Use the middle frag if present, otherwise use x-header. + ; Can't use the trailer fragment because by definition it is shared + ; among several insns. + (if middle + ; Mark the middle frag as the header frag. + (sfrag-set-header?! (vector-ref frag-table middle) #t) + ; No middle, use x-header. + (append! result (list x-header-num)))) + + ; middle fragment present? + (if middle + (append! result (list middle))) + + ; cse'd trailer created? + (if trailer + ; Yep. + (append! result (list trailer)) + ; Nope. Use the middle frag if present, otherwise use x-trailer. + ; Can't use the header fragment because by definition it is shared + ; among several insns. + (if middle + ; Mark the middle frag as the trailer frag. + (sfrag-set-trailer?! (vector-ref frag-table middle) #t) + ; No middle, use x-trailer. + (append! result (list x-trailer-num)))) + + ; Done. + (cdr result)) +) + +; Subroutine of sfrag-create-cse-mapping to find the fragment number of the +; x-header/x-trailer virtual frags. + +(define (-frag-lookup-virtual frag-list name) + (let loop ((i 0) (frag-list frag-list)) + (if (null? frag-list) + (assert (not "expected virtual insn not present")) + (if (eq? name (obj:name (car frag-list))) + i + (loop (+ i 1) (cdr frag-list))))) +) + +; Handle complex case, find set of common header and trailer fragments. +; The result is a vector of: +; - fragment table (a vector) +; - table mapping used fragments for each insn (a list) +; - locals list + +(define (sfrag-create-cse-mapping insn-list) + (logit 1 "Creating semantic fragments for pbb engine ...\n") + + (let ((cse-data (sem-find-common-frags insn-list))) + + ; Extract the results of sem-find-common-frags. + (let ((sfrag-usage-table (vector-ref cse-data 0)) + (stmt-table (vector-ref cse-data 1)) + (locals-list (vector-ref cse-data 2)) + (header-list1 (vector-ref cse-data 3)) + (trailer-list1 (vector-ref cse-data 4)) + (middle-list (vector-ref cse-data 5))) + + ; Create two special frags: x-header, x-trailer. + ; These are used by insns that don't have one or the other. + ; Header/trailer table indices are already computed for each insn + ; so append x-header/x-trailer to the end. + (let ((header-list + (append header-list1 + (list + (make <sfrag> + 'x-header + "header fragment for insns without one" + (atlist-parse '(VIRTUAL) "" "semantic frag computation") + nil ; users + nil ; user ordinals + (insn-sfmt (current-insn-lookup 'x-before)) + #f ; stmt-numbers + (rtx-make 'nop) + #f ; compiled-semantics + #f ; parallel? + #t ; header? + #f ; trailer? + )))) + (trailer-list + (append trailer-list1 + (list + (make <sfrag> + 'x-trailer + "trailer fragment for insns without one" + (atlist-parse '(VIRTUAL) "" "semantic frag computation") + nil ; users + nil ; user ordinals + (insn-sfmt (current-insn-lookup 'x-before)) + #f ; stmt-numbers + (rtx-make 'nop) + #f ; compiled-semantics + #f ; parallel? + #f ; header? + #t ; trailer? + ))))) + + (let ((num-headers (length header-list)) + (num-trailers (length trailer-list)) + (num-middles (length middle-list))) + + ; Combine the three sfrag tables (headers, trailers, middles) into + ; one big one. + (let ((frag-table (list->vector (append header-list + trailer-list + middle-list))) + (x-header-relnum (-frag-lookup-virtual header-list 'x-header)) + (x-trailer-relnum (-frag-lookup-virtual trailer-list 'x-trailer)) + ) + ; Convert sfrag-usage-table to one that refers to the one big + ; sfrag table. + (logit 2 "Computing insn frag usage ...\n") + (let ((insn-frags + (map (lambda (insn frag-usage) + (-sfrag-compute-frag-list! insn frag-usage + frag-table + num-headers num-trailers + x-header-relnum + x-trailer-relnum)) + insn-list + ; FIXME: vector->list + (vector->list sfrag-usage-table))) + ) + (logit 1 "Done fragment creation.\n") + (vector frag-table insn-frags locals-list))))))) +) + +; Data analysis interface. + +(define -sim-sfrag-init? #f) +(define (sim-sfrag-init?) -sim-sfrag-init?) + +; Keep in globals for now, simplifies debugging. +; evil globals, blah blah blah. +(define -sim-sfrag-insn-list #f) +(define -sim-sfrag-frag-table #f) +(define -sim-sfrag-usage-table #f) +(define -sim-sfrag-locals-list #f) + +(define (sim-sfrag-insn-list) + (assert -sim-sfrag-init?) + -sim-sfrag-insn-list +) +(define (sim-sfrag-frag-table) + (assert -sim-sfrag-init?) + -sim-sfrag-frag-table +) +(define (sim-sfrag-usage-table) + (assert -sim-sfrag-init?) + -sim-sfrag-usage-table +) +(define (sim-sfrag-locals-list) + (assert -sim-sfrag-init?) + -sim-sfrag-locals-list +) + +(define (sim-sfrag-init!) + (set! -sim-sfrag-init? #f) + (set! -sim-sfrag-insn-list #f) + (set! -sim-sfrag-frag-table #f) + (set! -sim-sfrag-usage-table #f) + (set! -sim-sfrag-locals-list #f) +) + +(define (sim-sfrag-analyze-insns!) + (if (not -sim-sfrag-init?) + (begin + (set! -sim-sfrag-insn-list (non-multi-insns (non-alias-insns (current-insn-list)))) + (let ((frag-data (sfrag-create-cse-mapping -sim-sfrag-insn-list))) + (set! -sim-sfrag-frag-table (vector-ref frag-data 0)) + (set! -sim-sfrag-usage-table (vector-ref frag-data 1)) + (set! -sim-sfrag-locals-list (vector-ref frag-data 2))) + (set! -sim-sfrag-init? #t))) + + *UNSPECIFIED* +) + +; Testing support. + +(define (-frag-small-test-data) + '( + (a . (sequence VOID ((SI tmp)) (set DFLT tmp rm) (set DFLT rd rm))) + (b . (sequence VOID ((SI tmp)) (set DFLT tmp rm) (set DFLT rd rm))) + (c . (set DFLT rd rm)) + ) +) + +(define (-frag-test-data) + (cons + (map (lambda (insn) + ; Must pass canonicalized and macro-expanded rtl. + (rtx-simplify #f insn (insn-semantics insn) + (-build-known-values insn))) + (non-multi-insns (non-alias-insns (current-insn-list)))) + (non-multi-insns (non-alias-insns (current-insn-list)))) +) + +(define test-sfrag-table #f) +(define test-stmt-table #f) +(define test-locals-list #f) +(define test-header-list #f) +(define test-trailer-list #f) +(define test-middle-list #f) + +(define (frag-test-run) + (let* ((test-data (-frag-test-data)) + (frag-data (sem-find-common-frags (car test-data) (cdr test-data)))) + (set! test-sfrag-table (vector-ref frag-data 0)) + (set! test-stmt-table (vector-ref frag-data 1)) + (set! test-locals-list (vector-ref frag-data 2)) + (set! test-header-list (vector-ref frag-data 3)) + (set! test-trailer-list (vector-ref frag-data 4)) + (set! test-middle-list (vector-ref frag-data 5)) + ) + *UNSPECIFIED* +) diff --git a/cgen/semantics.scm b/cgen/semantics.scm new file mode 100644 index 00000000000..11595876f03 --- /dev/null +++ b/cgen/semantics.scm @@ -0,0 +1,879 @@ +; Routines for instruction semantic analysis (including rtx-simplify). +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Semantic expression compilation. +; This is more involved than normal rtx compilation as we need to keep +; track of the inputs and outputs. Various attributes that can be derived +; from the code are also computed. + +; Subroutine of -simplify-expr-fn to compare two values for equality. +; If both are constants and they're equal return #f/#t. +; INVERT? = #f -> return #t if equal, #t -> return #f if equal. +; Returns 'unknown if either argument is not a constant. + +(define (rtx-const-equal arg0 arg1 invert?) + (if (and (rtx-constant? arg0) + (rtx-constant? arg1)) + (if invert? + (!= (rtx-constant-value arg0) + (rtx-constant-value arg1)) + (= (rtx-constant-value arg0) + (rtx-constant-value arg1))) + 'unknown) +) + +; Subroutine of -simplify-expr-fn to see if MAYBE-CONST is one of NUMBER-LIST. +; NUMBER-LIST is a `number-list' rtx. +; INVERT? is #t if looking for non-membership. +; #f/#t is only returned for definitive answers. +; If INVERT? is #f: +; - return #f if MAYBE-CONST is not in NUMBER-LIST +; - return #t if MAYBE-CONST is in NUMBER-LIST and it has only one member +; - return 'member if MAYBE-CONST is in NUMBER-LIST and it has many members +; - otherwise return 'unknown +; If INVERT? is #t: +; - return #t if MAYBE-CONST is not in NUMBER-LIST +; - return #f if MAYBE-CONST is in NUMBER-LIST and it has only one member +; - return 'member if MAYBE-CONST is in NUMBER-LIST and it has many members +; - otherwise return 'unknown + +(define (rtx-const-list-equal maybe-const number-list invert?) + (assert (rtx-kind? 'number-list number-list)) + (if (rtx-constant? maybe-const) + (let ((values (rtx-number-list-values number-list))) + (if invert? + (if (memq (rtx-constant-value maybe-const) values) + (if (= (length values) 1) + #f + 'member) + #t) + (if (memq (rtx-constant-value maybe-const) values) + (if (= (length values) 1) + #t + 'member) + #f))) + 'unknown) +) + +; Subroutine of -simplify-expr-fn to simplify an eq-attr of (current-mach). +; CONTEXT is a <context> object or #f if there is none. + +(define (rtx-simplify-eq-attr-mach rtx context) + (let ((attr (rtx-eq-attr-attr rtx)) + (value (rtx-eq-attr-value rtx))) + ; If all currently selected machs will yield the same value + ; for the attribute, we can simplify. + (let ((values (map (lambda (m) + (obj-attr-value m attr)) + (current-mach-list)))) + ; Ensure at least one mach is selected. + (if (null? values) + (context-error context "rtx simplification, no machs selected" + (rtx-strdump rtx))) + ; All values equal to the first one? + (if (all-true? (map (lambda (val) + (equal? val (car values))) + values)) + (if (equal? value + ; Convert internal boolean attribute value + ; #f/#t to external value FALSE/TRUE. + ; FIXME:revisit. + (case (car values) + ((#f) 'FALSE) + ((#t) 'TRUE) + (else (car values)))) + (rtx-true) + (rtx-false)) + ; couldn't simplify + rtx))) +) + +; Subroutine of -simplify-expr-fn to simplify an eq-attr of (current-insn). + +(define (rtx-simplify-eq-attr-insn rtx insn context) + (let ((attr (rtx-eq-attr-attr rtx)) + (value (rtx-eq-attr-value rtx))) + (if (not (insn? insn)) + (context-error context + "No current insn for `(current-insn)'" + (rtx-strdump rtx))) + (let ((attr-value (obj-attr-value insn attr))) + (if (eq? value attr-value) + (rtx-true) + (rtx-false)))) +) + +; Subroutine of rtx-simplify. +; This is the EXPR-FN argument to rtx-traverse. + +(define (-simplify-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) + + ;(display "Processing ") (display (rtx-dump expr)) (newline) + + (case (rtx-name expr) + + ((not) + (let* ((arg (-rtx-traverse (rtx-alu-op-arg expr 0) + 'RTX + (rtx-alu-op-mode expr) + expr 1 tstate appstuff)) + (no-side-effects? (not (rtx-side-effects? arg)))) + (cond ((and no-side-effects? (rtx-false? arg)) + (rtx-true)) + ((and no-side-effects? (rtx-true? arg)) + (rtx-false)) + (else (rtx-make 'not (rtx-alu-op-mode expr) arg))))) + + ((orif) + (let ((arg0 (-rtx-traverse (rtx-boolif-op-arg expr 0) + 'RTX 'DFLT expr 0 tstate appstuff)) + (arg1 (-rtx-traverse (rtx-boolif-op-arg expr 1) + 'RTX 'DFLT expr 1 tstate appstuff))) + (let ((no-side-effects-0? (not (rtx-side-effects? arg0))) + (no-side-effects-1? (not (rtx-side-effects? arg1)))) + (cond ((and no-side-effects-0? (rtx-true? arg0)) + (rtx-true)) + ((and no-side-effects-0? (rtx-false? arg0)) + (rtx-canonical-bool arg1)) + ; Value of arg0 is unknown or has side-effects. + ((and no-side-effects-1? (rtx-true? arg1)) + (if no-side-effects-0? + (rtx-true) + (rtx-make 'orif arg0 (rtx-true)))) + ((and no-side-effects-1? (rtx-false? arg1)) + arg0) + (else + (rtx-make 'orif arg0 arg1)))))) + + ((andif) + (let ((arg0 (-rtx-traverse (rtx-boolif-op-arg expr 0) + 'RTX 'DFLT expr 0 tstate appstuff)) + (arg1 (-rtx-traverse (rtx-boolif-op-arg expr 1) + 'RTX 'DFLT expr 1 tstate appstuff))) + (let ((no-side-effects-0? (not (rtx-side-effects? arg0))) + (no-side-effects-1? (not (rtx-side-effects? arg1)))) + (cond ((and no-side-effects-0? (rtx-false? arg0)) + (rtx-false)) + ((and no-side-effects-0? (rtx-true? arg0)) + (rtx-canonical-bool arg1)) + ; Value of arg0 is unknown or has side-effects. + ((and no-side-effects-1? (rtx-false? arg1)) + (if no-side-effects-0? + (rtx-false) + (rtx-make 'andif arg0 (rtx-false)))) + ((and no-side-effects-1? (rtx-true? arg1)) + arg0) + (else + (rtx-make 'andif arg0 arg1)))))) + + ; Fold if's to their then or else part if we can determine the + ; result of the test. + ((if) + (let ((test + ; ??? Was this but that calls rtx-traverse again which + ; resets the temp stack! + ; (rtx-simplify context (caddr expr)))) + (-rtx-traverse (rtx-if-test expr) 'RTX 'DFLT expr 1 tstate appstuff))) + (cond ((rtx-true? test) + (-rtx-traverse (rtx-if-then expr) 'RTX mode expr 2 tstate appstuff)) + ((rtx-false? test) + (if (rtx-if-else expr) + (-rtx-traverse (rtx-if-else expr) 'RTX mode expr 3 tstate appstuff) + ; Sanity check, mode must be VOID. + (if (or (mode:eq? 'DFLT (rtx-mode expr)) + (mode:eq? 'VOID (rtx-mode expr))) + (rtx-make 'nop) + (error "rtx-simplify: non-void-mode `if' missing `else' part" expr)))) + ; Can't simplify. + ; We could traverse the then/else clauses here, but it's simpler + ; to have our caller do it. The cost is retraversing `test'. + (else #f)))) + + ((eq ne) + (let ((name (rtx-name expr)) + (cmp-mode (rtx-cmp-op-mode expr)) + (arg0 (-rtx-traverse (rtx-cmp-op-arg expr 0) 'RTX + (rtx-cmp-op-mode expr) + expr 1 tstate appstuff)) + (arg1 (-rtx-traverse (rtx-cmp-op-arg expr 1) 'RTX + (rtx-cmp-op-mode expr) + expr 2 tstate appstuff))) + (if (or (rtx-side-effects? arg0) (rtx-side-effects? arg1)) + (rtx-make name cmp-mode arg0 arg1) + (case (rtx-const-equal arg0 arg1 (rtx-kind? 'ne expr)) + ((#f) (rtx-false)) + ((#t) (rtx-true)) + (else + ; That didn't work. See if we have an ifield/operand with a + ; known range of values. + (case (rtx-name arg0) + ((ifield) + (let ((known-val (tstate-known-lookup tstate + (rtx-ifield-name arg0)))) + (if (and known-val (rtx-kind? 'number-list known-val)) + (case (rtx-const-list-equal arg1 known-val (rtx-kind? 'ne expr)) + ((#f) (rtx-false)) + ((#t) (rtx-true)) + (else + (rtx-make name cmp-mode arg0 arg1))) + (rtx-make name cmp-mode arg0 arg1)))) + ((operand) + (let ((known-val (tstate-known-lookup tstate + (rtx-operand-name arg0)))) + (if (and known-val (rtx-kind? 'number-list known-val)) + (case (rtx-const-list-equal arg1 known-val (rtx-kind? 'ne expr)) + ((#f) (rtx-false)) + ((#t) (rtx-true)) + (else + (rtx-make name cmp-mode arg0 arg1))) + (rtx-make name cmp-mode arg0 arg1)))) + (else + (rtx-make name cmp-mode arg0 arg1)))))))) + + ; Recognize attribute requests of current-insn, current-mach. + ((eq-attr) + (cond ((rtx-kind? 'current-mach (rtx-eq-attr-owner expr)) + (rtx-simplify-eq-attr-mach expr (tstate-context tstate))) + ((rtx-kind? 'current-insn (rtx-eq-attr-owner expr)) + (rtx-simplify-eq-attr-insn expr (tstate-owner tstate) (tstate-context tstate))) + (else expr))) + + ((ifield) + (let ((known-val (tstate-known-lookup tstate (rtx-ifield-name expr)))) + ; If the value is a single number, return that. + ; It can be one of several, represented as a number list. + (if (and known-val (rtx-constant? known-val)) + known-val ; (rtx-make 'const 'INT known-val) + #f))) + + ((operand) + (let ((known-val (tstate-known-lookup tstate (rtx-operand-name expr)))) + ; If the value is a single number, return that. + ; It can be one of several, represented as a number list. + (if (and known-val (rtx-constant? known-val)) + known-val ; (rtx-make 'const 'INT known-val) + #f))) + + ; Leave EXPR unchanged and continue. + (else #f)) +) + +; Simplify an rtl expresion. +; EXPR must be in source form. +; The result is a possibly simplified EXPR, still in source form. +; +; CONTEXT is a <context> object, used for error messages. +; OWNER is the owner of the expression (e.g. <insn>) or #f if there is none. +; +; KNOWN is an alist of known values. Each element is (name . value) where +; NAME is an ifield/operand name and VALUE is a const/number-list rtx. +; FIXME: Need ranges, later. +; +; The following operations are performed: +; - unselected machine dependent code is removed (eq-attr of (current-mach)) +; - if's are reduced to either then/else if we can determine that the test is +; a compile-time constant +; - orif/andif +; - eq/ne +; - not +; +; ??? Will become more intelligent as needed. + +(define (rtx-simplify context owner expr known) + (-rtx-traverse expr #f 'DFLT #f 0 + (tstate-make context owner + (/fastcall-make -simplify-expr-fn) + (rtx-env-empty-stack) + #f #f known 0) + #f) +) + +; Utilities for equation solving. +; ??? At the moment this is only focused on ifield assertions. +; ??? That there exist more sophisticated versions than this one can take +; as a given. This works for the task at hand and will evolve or be replaced +; as necessary. +; ??? This makes the simplifying assumption that no expr has side-effects. + +; Subroutine of rtx-solve. +; This is the EXPR-FN argument to rtx-traverse. + +(define (-solve-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) + #f ; wip +) + +; Return a boolean indicating if {expr} equates to "true". +; If the expression can't be reduced to #f/#t, return '?. +; ??? Use rtx-eval instead of rtx-traverse? +; +; EXPR must be in source form. +; CONTEXT is a <context> object, used for error messages. +; OWNER is the owner of the expression (e.g. <insn>) or #f if there is none. +; KNOWN is an alist of known values. Each element is (name . value) where +; NAME is an ifield/operand name and VALUE is a const/number-list rtx. +; FIXME: Need ranges, later. +; +; This is akin to rtx-simplify except it's geared towards solving ifield +; assertions. It's not unreasonable to combine them. The worry is the +; efficiency lost. +; ??? Will become more intelligent as needed. + +(define (rtx-solve context owner expr known) + ; First simplify, then solve. + (let* ((simplified-expr (rtx-simplify context owner expr known)) + (maybe-solved-expr + simplified-expr) ; FIXME: for now +; (-rtx-traverse simplified-expr #f 'DFLT #f 0 +; (tstate-make context owner +; (/fastcall-make -solve-expr-fn) +; (rtx-env-empty-stack) +; #f #f known 0) +; #f)) + ) + (cond ((rtx-true? maybe-solved-expr) #t) + ((rtx-false? maybe-solved-expr) #f) + (else '?))) +) + +; Subroutine of -rtx-find-op to determine if two modes are equivalent. +; Two modes are equivalent if they're equal, or if their sem-mode fields +; are equal. + +(define (-rtx-mode-equiv? m1 m2) + (or (eq? m1 m2) + (let ((mode1 (mode:lookup m1)) + (mode2 (mode:lookup m2))) + (let ((s1 (mode:sem-mode mode1)) + (s2 (mode:sem-mode mode2))) + (eq? (if s1 (obj:name s1) m1) (if s2 (obj:name s2) m2))))) +) + +; Subroutine of semantic-compile to find OP in OP-LIST. +; OP-LIST is a list of operand expressions: (type expr mode name indx-sel). +; The result is the list element or #f if not found. +; TYPE is one of -op- reg mem. +; EXPR is the constructed `xop' rtx expression for the operand, +; ignored in the search. +; MODE must match, as defined by -rtx-mode-equiv?. +; NAME is the hardware element name, ifield name, or '-op-'. +; INDX-SEL must match if present in either. +; +; ??? Does this need to take "conditionally-referenced" into account? + +(define (-rtx-find-op op op-list) + (let ((type (car op)) + (mode (caddr op)) + (name (cadddr op)) + (indx-sel (car (cddddr op)))) + ; The first cdr is to drop the dummy first arg. + (let loop ((op-list (cdr op-list))) + (cond ((null? op-list) #f) + ((eq? type (caar op-list)) + (let ((try (car op-list))) + (if (and (eq? name (cadddr try)) + (-rtx-mode-equiv? mode (caddr try)) + (equal? indx-sel (car (cddddr try)))) + try + (loop (cdr op-list))))) + (else (loop (cdr op-list)))))) +) + +; Subroutine of semantic-compile to determine how the operand in +; position OP-POS of EXPR is used. +; The result is one of 'use, 'set, 'set-quiet. +; "use" means "input operand". + +(define (-rtx-ref-type expr op-pos) + ; operand 0 is the option list, operand 1 is the mode + ; (if you want to complain, fine, it's not like it would be unexpected) + (if (= op-pos 2) + (case (car expr) + ((set) 'set) + ((set-quiet clobber) 'set-quiet) + (else 'use)) + 'use) +) + +; Subroutine of semantic-compile:process-expr!, to simplify it. +; Looks up the operand in the current set, returns it if found, +; otherwise adds it. +; REF-TYPE is one of 'use, 'set, 'set-quiet. +; Adds COND-CTI/UNCOND-CTI to SEM-ATTRS if the operand is a set of the pc. + +(define (-build-operand! op-name op mode tstate ref-type op-list sem-attrs) + ;(display (list op-name mode ref-type)) (newline) (force-output) + (let* ((mode (mode-real-name (if (eq? mode 'DFLT) + (op:mode op) + mode))) + ; The first #f is a placeholder for the object. + (try (list '-op- #f mode op-name #f)) + (existing-op (-rtx-find-op try op-list))) + + (if (and (pc? op) + (memq ref-type '(set set-quiet))) + (append! sem-attrs + (list (if (tstate-cond? tstate) 'COND-CTI 'UNCOND-CTI)))) + + ; If already present, return the object, otherwise add it. + (if existing-op + + (cadr existing-op) + + ; We can't set the operand number yet 'cus we don't know it. + ; However, when it's computed we'll need to set all associated + ; operands. This is done by creating shared rtx (a la gcc) - the + ; operand number then need only be updated in one place. + + (let ((xop (op:new-mode op mode))) + (op:set-cond?! xop (tstate-cond? tstate)) + ; Set the object rtx in `try', now that we have it. + (set-car! (cdr try) (rtx-make 'xop xop)) + ; Add the operand to in/out-ops. + (append! op-list (list try)) + (cadr try)))) +) + +; Subroutine of semantic-compile:process-expr!, to simplify it. + +(define (-build-reg-operand! expr tstate op-list) + (let* ((hw-name (rtx-reg-name expr)) + (hw (current-hw-sem-lookup-1 hw-name))) + + (if hw + ; If the mode is DFLT, use the object's natural mode. + (let* ((mode (mode-real-name (if (eq? (rtx-mode expr) 'DFLT) + (obj:name (hw-mode hw)) + (rtx-mode expr)))) + (indx-sel (rtx-reg-index-sel expr)) + ; #f is a place-holder for the object (filled in later) + (try (list 'reg #f mode hw-name indx-sel)) + (existing-op (-rtx-find-op try op-list))) + + ; If already present, return the object, otherwise add it. + (if existing-op + + (cadr existing-op) + + (let ((xop (apply reg (cons (tstate->estate tstate) + (cons mode + (cons hw-name indx-sel)))))) + (op:set-cond?! xop (tstate-cond? tstate)) + ; Set the object rtx in `try', now that we have it. + (set-car! (cdr try) (rtx-make 'xop xop)) + ; Add the operand to in/out-ops. + (append! op-list (list try)) + (cadr try)))) + + (parse-error "FIXME" "unknown reg" expr))) +) + +; Subroutine of semantic-compile:process-expr!, to simplify it. + +(define (-build-mem-operand! expr tstate op-list) + (let ((mode (rtx-mode expr)) + (indx-sel (rtx-mem-index-sel expr))) + + (if (memq mode '(DFLT VOID)) + (parse-error "FIXME" "memory must have explicit mode" expr)) + + (let* ((try (list 'mem #f mode 'h-memory indx-sel)) + (existing-op (-rtx-find-op try op-list))) + + ; If already present, return the object, otherwise add it. + (if existing-op + + (cadr existing-op) + + (let ((xop (apply mem (cons (tstate->estate tstate) + (cons mode indx-sel))))) + (op:set-cond?! xop (tstate-cond? tstate)) + ; Set the object in `try', now that we have it. + (set-car! (cdr try) (rtx-make 'xop xop)) + ; Add the operand to in/out-ops. + (append! op-list (list try)) + (cadr try))))) +) + +; Subroutine of semantic-compile:process-expr!, to simplify it. + +(define (-build-ifield-operand! expr tstate op-list) + (let* ((f-name (rtx-ifield-name expr)) + (f (current-ifld-lookup f-name))) + + (if (not f) + (parse-error "FIXME" "unknown ifield" f-name)) + + (let* ((mode (obj:name (ifld-mode f))) + (try (list '-op- #f mode f-name #f)) + (existing-op (-rtx-find-op try op-list))) + + ; If already present, return the object, otherwise add it. + (if existing-op + + (cadr existing-op) + + (let ((xop (make <operand> f-name f-name + (atlist-cons (bool-attr-make 'SEM-ONLY #t) + (obj-atlist f)) + (obj:name (ifld-hw-type f)) + mode + (make <hw-index> 'anonymous + 'ifield (ifld-mode f) f) + nil #f #f))) + (set-car! (cdr try) (rtx-make 'xop xop)) + (append! op-list (list try)) + (cadr try))))) +) + +; Subroutine of semantic-compile:process-expr!, to simplify it. +; +; ??? There are various optimizations (both space usage in ARGBUF and time +; spent in semantic code) that can be done on code that uses index-of +; (see i960's movq insn). Later. + +(define (-build-index-of-operand! expr tstate op-list) + (if (not (and (rtx? (rtx-index-of-value expr)) + (rtx-kind? 'operand (rtx-index-of-value expr)))) + (parse-error "FIXME" "only `(index-of operand)' is currently supported" + expr)) + + (let ((op (rtx-operand-obj (rtx-index-of-value expr)))) + (let ((indx (op:index op))) + (if (not (eq? (hw-index:type indx) 'ifield)) + (parse-error "FIXME" "only ifield indices are currently supported" + expr)) + (let* ((f (hw-index:value indx)) + (f-name (obj:name f))) + ; The rest of this is identical to -build-ifield-operand!. + (let* ((mode (obj:name (ifld-mode f))) + (try (list '-op- #f mode f-name #f)) + (existing-op (-rtx-find-op try op-list))) + + ; If already present, return the object, otherwise add it. + (if existing-op + + (cadr existing-op) + + (let ((xop (make <operand> f-name f-name + (atlist-cons (bool-attr-make 'SEM-ONLY #t) + (obj-atlist f)) + (obj:name (ifld-hw-type f)) + mode + (make <hw-index> 'anonymous + 'ifield + (ifld-mode f) + ; (send (op:type op) 'get-index-mode) + f) + nil #f #f))) + (set-car! (cdr try) (rtx-make 'xop xop)) + (append! op-list (list try)) + (cadr try))))))) +) + +; Build the tstate known value list for INSN. +; This built from the ifield-assertion list. + +(define (-build-known-values insn) + (let ((expr (insn-ifield-assertion insn))) + (if expr + (case (rtx-name expr) + ((eq) + (if (and (rtx-kind? 'ifield (rtx-cmp-op-arg expr 0)) + (rtx-constant? (rtx-cmp-op-arg expr 1))) + (list (cons (rtx-ifield-name (rtx-cmp-op-arg expr 0)) + (rtx-cmp-op-arg expr 1))) + nil)) + ((member) + (if (rtx-kind? 'ifield (rtx-member-value expr)) + (list (cons (rtx-ifield-name (rtx-member-value expr)) + (rtx-member-set expr))) + nil)) + (else nil)) + nil)) +) + +; Structure to record the result of semantic-compile. + +(define (csem-make compiled-code inputs outputs attributes) + (vector compiled-code inputs outputs attributes) +) + +; Accessors. + +(define (csem-code csem) (vector-ref csem 0)) +(define (csem-inputs csem) (vector-ref csem 1)) +(define (csem-outputs csem) (vector-ref csem 2)) +(define (csem-attrs csem) (vector-ref csem 3)) + +; Traverse each element in SEM-CODE-LIST, converting them to canonical form, +; and computing the input and output operands. +; The result is an object of four elements (built with csem-make). +; The first is a list of the canonical form of each element in SEM-CODE-LIST: +; operand and ifield elements specified without `operand' or `ifield' have it +; prepended, and operand numbers are computed for each operand. +; Operand numbers are needed when emitting "write" handlers for LIW cpus. +; Having the operand numbers available is also useful for efficient +; modeling: recording operand references can be done with a bitmask (one host +; insn), and the code to do the modeling can be kept out of the code that +; performs the insn. +; The second is the list of input <operand> objects. +; The third is the list of output <operand> objects. +; The fourth is an <attr-list> object of attributes that can be computed from +; the semantics. +; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT. +; ??? Combine *-CTI into an enum attribute. +; +; CONTEXT is a <context> object or #f if there is none. +; INSN is the <insn> object. +; +; ??? Specifying operand ordinals in the source would simplify this and speed +; it up. On the other hand that makes the source form more complex. Maybe the +; complexity will prove necessary, but following the goal of "incremental +; complication", we don't do this yet. +; Another way to simplify this and speed it up would be to add lists of +; input/output operands to the instruction description. +; +; ??? This calls rtx-simplify which calls rtx-traverse as it's simpler to +; simplify EXPR first, and then compile it. On the other hand it's slower +; (two calls to rtx-traverse!). + +(define (semantic-compile context insn sem-code-list) + (for-each (lambda (rtx) (assert (rtx? rtx))) + sem-code-list) + + (let* + ; String for error messages. + ((errtxt "semantic compilation") + + ; These record the result of traversing SEM-CODE-LIST. + ; They're lists of (type object mode name [args ...]). + ; TYPE is one of: -op- reg mem. + ; `-op-' is just something unique and is only used internally. + ; OBJECT is the constructed <operand> object. + ; The first element is just a dummy so that append! always works. + (in-ops (list (list #f))) + (out-ops (list (list #f))) + + ; List of attributes computed from SEM-CODE-LIST. + ; The first element is just a dummy so that append! always works. + (sem-attrs (list #f)) + + ; Called for expressions encountered in SEM-CODE-LIST. + ; Don't waste cpu here, this is part of the slowest piece in CGEN. + (process-expr! + (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) + (case (car expr) + + ; Registers. + ((reg) (let ((ref-type (-rtx-ref-type parent-expr op-pos)) + ; ??? could verify reg is a scalar + (regno (or (rtx-reg-number expr) 0))) + ; The register number is either a number or an + ; expression. + ; ??? This is a departure from GCC RTL that might have + ; significant ramifications. On the other hand in cases + ; where it matters the expression could always be + ; required to reduce to a constant (or some such). + (cond ((number? regno) #t) + ((form? regno) + (rtx-traverse-operands rtx-obj expr tstate appstuff)) + (else (parse-error errtxt + "invalid register number" + regno))) + (-build-reg-operand! expr tstate + (if (eq? ref-type 'use) + in-ops + out-ops)))) + + ; Memory. + ((mem) (let ((ref-type (-rtx-ref-type parent-expr op-pos))) + (rtx-traverse-operands rtx-obj expr tstate appstuff) + (-build-mem-operand! expr tstate + (if (eq? ref-type 'use) + in-ops + out-ops)))) + + ; Operands. + ((operand) (let ((op (rtx-operand-obj expr)) + (ref-type (-rtx-ref-type parent-expr op-pos))) + (-build-operand! (obj:name op) op mode tstate ref-type + (if (eq? ref-type 'use) + in-ops + out-ops) + sem-attrs))) + + ; Give operand new name. + ((name) (let ((result (-rtx-traverse (caddr expr) 'RTX mode + parent-expr op-pos tstate appstuff))) + (if (not (operand? result)) + (error "name: invalid argument:" expr result)) + (op:set-sem-name! result (cadr expr)) + ; (op:set-num! result (caddr expr)) + result)) + + ; Specify a reference to a local variable + ((local) expr) ; nothing to do + + ; Instruction fields. + ((ifield) (let ((ref-type (-rtx-ref-type parent-expr op-pos))) + (if (not (eq? ref-type 'use)) + (parse-error errtxt "can't set an `ifield'" expr)) + (-build-ifield-operand! expr tstate in-ops))) + + ; Hardware indices. + ; For registers this is the register number. + ; For memory this is the address. + ; For constants, this is the constant. + ((index-of) (let ((ref-type (-rtx-ref-type parent-expr op-pos))) + (if (not (eq? ref-type 'use)) + (parse-error errtxt "can't set an `index-of'" expr)) + (-build-index-of-operand! expr tstate in-ops))) + + ; Machine generate the SKIP-CTI attribute. + ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f) + + ; Machine generate the DELAY-SLOT attribute. + ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f) + + ; If this is a syntax expression, the operands won't have been + ; processed, so tell our caller we want it to by returning #f. + ; We do the same for non-syntax expressions to keep things + ; simple. This requires collaboration with the traversal + ; handlers which are defined to do what we want if we return #f. + (else #f)))) + + ; Whew. We're now ready to traverse the expression. + ; Traverse the expression recording the operands and building objects + ; for most elements in the source representation. + ; This also performs various simplifications. + ; In particular machine dependent code for non-selected machines + ; is discarded. + (compiled-exprs (map (lambda (expr) + (rtx-traverse + context + insn + (rtx-simplify context insn expr + (-build-known-values insn)) + process-expr! + #f)) + sem-code-list)) + ) + + ;(display "in: ") (display in-ops) (newline) + ;(display "out: ") (display out-ops) (newline) + ;(force-output) + + ; Now that we have the nub of all input and output operands, + ; we can assign operand numbers. Inputs and outputs are not defined + ; separately, output operand numbers follow inputs. This simplifies the + ; code which keeps track of such things: it can use one variable. + ; The assignment is defined to be arbitrary. If there comes a day + ; when we need to prespecify operand numbers, revisit. + ; The operand lists are sorted to avoid spurious differences in generated + ; code (for example unnecessary extra entries can be created in the + ; ARGBUF struct). + + ; Drop dummy first arg and sort operand lists. + (let ((sorted-ins + (sort (map (lambda (op) + (rtx-xop-obj (cadr op))) + (cdr in-ops)) + (lambda (a b) (string<? (obj:name a) (obj:name b))))) + (sorted-outs + (sort (map (lambda (op) + (rtx-xop-obj (cadr op))) + (cdr out-ops)) + (lambda (a b) (string<? (obj:name a) (obj:name b))))) + (sem-attrs (cdr sem-attrs))) + + (let ((in-op-nums (iota (length sorted-ins))) + (out-op-nums (iota (length sorted-ins) (length sorted-outs)))) + + (for-each (lambda (op num) (op:set-num! op num)) + sorted-ins in-op-nums) + (for-each (lambda (op num) (op:set-num! op num)) + sorted-outs out-op-nums) + + (let ((dump (lambda (op) + (string-append " " + (obj:name op) + " " + (number->string (op:num op)) + "\n")))) + (logit 4 + "Input operands:\n" + (map dump sorted-ins) + "Output operands:\n" + (map dump sorted-outs) + "End of operands.\n")) + + (csem-make compiled-exprs sorted-ins sorted-outs + (atlist-parse sem-attrs "" "semantic attributes"))))) +) + +; Traverse SEM-CODE-LIST, computing attributes derivable from it. +; The result is an <attr-list> object of attributes that can be computed from +; the semantics. +; The possibilities are: UNCOND-CTI, COND-CTI, SKIP-CTI, DELAY-SLOT. +; This computes the same values as semantic-compile, but for speed is +; focused on attributes only. +; ??? Combine *-CTI into an enum attribute. +; +; CONTEXT is a <context> object or #f if there is none. +; INSN is the <insn> object. + +(define (semantic-attrs context insn sem-code-list) + (for-each (lambda (rtx) (assert (rtx? rtx))) + sem-code-list) + + (let* + ; String for error messages. + ((errtxt "semantic attribute computation") + + ; List of attributes computed from SEM-CODE-LIST. + ; The first element is just a dummy so that append! always works. + (sem-attrs (list #f)) + + ; Called for expressions encountered in SEM-CODE-LIST. + (process-expr! + (lambda (rtx-obj expr mode parent-expr op-pos tstate appstuff) + (case (car expr) + + ((operand) (if (and (eq? 'pc (obj:name (rtx-operand-obj expr))) + (memq (-rtx-ref-type parent-expr op-pos) + '(set set-quiet))) + (append! sem-attrs + (if (tstate-cond? tstate) + ; Don't change these to '(FOO), since + ; we use append!. + (list 'COND-CTI) + (list 'UNCOND-CTI))))) + ((skip) (append! sem-attrs (list 'SKIP-CTI)) #f) + ((delay) (append! sem-attrs (list 'DELAY-SLOT)) #f) + + ; If this is a syntax expression, the operands won't have been + ; processed, so tell our caller we want it to by returning #f. + ; We do the same for non-syntax expressions to keep things + ; simple. This requires collaboration with the traversal + ; handlers which are defined to do what we want if we return #f. + (else #f)))) + + ; Traverse the expression recording the attributes. + (traversed-exprs (map (lambda (expr) + (rtx-traverse + context + insn + (rtx-simplify context insn expr + (-build-known-values insn)) + process-expr! + #f)) + sem-code-list)) + ) + + (let + ; Drop dummy first arg. + ((sem-attrs (cdr sem-attrs))) + (atlist-parse sem-attrs "" "semantic attributes"))) +) diff --git a/cgen/sim-arch.scm b/cgen/sim-arch.scm new file mode 100644 index 00000000000..394f68cef6c --- /dev/null +++ b/cgen/sim-arch.scm @@ -0,0 +1,181 @@ +; Simulator generator support routines. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Utilities of cgen-arch.h. + +; Return C macro definitions of the various supported cpus. + +(define (-gen-cpuall-defines) + "" ; nothing yet +) + +; Return C declarations of misc. support stuff. +; ??? Modes are now defined in sim/common/cgen-types.h but we will need +; target specific modes. + +(define (-gen-support-decls) + (string-append +; (gen-enum-decl 'mode_type "mode types" +; "MODE_" +; ; Aliases are not distinct from their real mode so ignore +; ; them here. +; (append (map list (map obj:name +; (mode-list-non-alias-values))) +; '((max)))) +; "#define MAX_MODES ((int) MODE_MAX)\n\n" + ) +) + +; Utilities of cgen-cpuall.h. + +; Subroutine of -gen-cpuall-includes. + +(define (-gen-cpu-header cpu prefix) + (string-append "#include \"" prefix (cpu-file-transform cpu) ".h\"\n") +) + +; Return C code to include all the relevant headers for each cpu family, +; conditioned on ifdef WANT_CPU_@CPU@. + +(define (-gen-cpuall-includes) + (string-list + "/* Include files for each cpu family. */\n\n" + (string-list-map (lambda (cpu) + (let* ((cpu-name (gen-sym cpu)) + (CPU-NAME (string-upcase cpu-name))) + (string-list "#ifdef WANT_CPU_" CPU-NAME "\n" + (-gen-cpu-header cpu "eng") + "#include \"cgen-engine.h\"\n" + (-gen-cpu-header cpu "cpu") + ; FIXME: Shorten "decode" to "dec". + (-gen-cpu-header cpu "decode") + "#endif\n\n"))) + (current-cpu-list)) + ) +) + +; Subroutine of -gen-cpuall-decls to generate cpu-specific structure entries. +; The result is "struct <cpu>_<type-name> <member-name>;". +; INDENT is the amount to indent by. +; CPU is the cpu object. + +(define (-gen-cpu-specific-decl indent cpu type-name member-name) + (let* ((cpu-name (gen-sym cpu)) + (CPU-NAME (string-upcase cpu-name))) + (string-append + "#ifdef WANT_CPU_" CPU-NAME "\n" + (spaces indent) + "struct " cpu-name "_" type-name " " member-name ";\n" + "#endif\n")) +) + +; Return C declarations of cpu-specific structs. +; These are defined here to achieve a simple and moderately type-safe +; inheritance. In the non-cpu-specific files, these structs consist of +; just the baseclass. In cpu-specific files, the baseclass is augmented +; with the cpu-specific data. + +(define (-gen-cpuall-decls) + (string-list + (gen-argbuf-type #f) + (gen-scache-type #f) + ) +) + +; Top level generators for non-cpu-specific files. + +; Generate arch.h +; This file defines non cpu family specific data about the architecture +; and also data structures that combine all variants (e.g. cpu struct). +; It is intended to be included before sim-basics.h and sim-base.h. + +(define (cgen-arch.h) + (logit 1 "Generating arch.h ...\n") + + (string-write + (gen-copyright "Simulator header for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "#ifndef @ARCH@_ARCH_H\n" + "#define @ARCH@_ARCH_H\n" + "\n" + "#define TARGET_BIG_ENDIAN 1\n\n" ; FIXME + ;(gen-mem-macros) + ;"/* FIXME: split into 32/64 parts */\n" + ;"#define WI SI\n" + ;"#define UWI USI\n" + ;"#define AI USI\n\n" + -gen-cpuall-defines + -gen-support-decls + -gen-arch-model-decls + "#endif /* @ARCH@_ARCH_H */\n" + ) +) + +; Generate arch.c +; This file defines non cpu family specific data about the architecture. + +(define (cgen-arch.c) + (logit 1 "Generating arch.c ...\n") + + (string-write + (gen-copyright "Simulator support for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#include \"sim-main.h\" +#include \"bfd.h\" + +" + -gen-mach-data + ) +) + +; Generate cpuall.h +; This file pulls together all of the cpu variants .h's. +; It is intended to be included after sim-base.h/cgen-sim.h. + +(define (cgen-cpuall.h) + (logit 1 "Generating cpuall.h ...\n") + + (string-write + (gen-copyright "Simulator CPU header for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "#ifndef @ARCH@_CPUALL_H\n" + "#define @ARCH@_CPUALL_H\n" + "\n" + -gen-cpuall-includes + -gen-mach-decls + -gen-cpuall-decls + "#endif /* @ARCH@_CPUALL_H */\n" + ) +) + +; Generate ops.c +; No longer used. + +(define (cgen-ops.c) + (logit 1 "Generating ops.c ...\n") + + (string-write + (gen-copyright "Simulator operational support for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#define MEMOPS_DEFINE_INLINE + +#include \"config.h\" +#include <signal.h> +#include \"ansidecl.h\" +#include \"bfd.h\" +#include \"tconfig.h\" +#include \"cgen-sim.h\" +#include \"memops.h\" + +/* FIXME: wip */ +int pow2masks[] = { + 0, 0, 1, -1, 3, -1, -1, -1, 7, -1, -1, -1, -1, -1, -1, -1, 15 +}; + +" + gen-mode-defs + ) +) diff --git a/cgen/sim-cpu.scm b/cgen/sim-cpu.scm new file mode 100644 index 00000000000..a8e50ba38b8 --- /dev/null +++ b/cgen/sim-cpu.scm @@ -0,0 +1,1231 @@ +; CPU family related simulator generator, excluding decoding and model support. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Notes: +; - Add support to generate copies of semantic code and perform constant +; folding based on selected mach. This would collapse out untaken branches +; of tests on (current-mach). + +; Utilities of cgen-cpu.h. + +; Print various parameters of the cpu family. +; A "cpu family" here is a collection of variants of a particular architecture +; that share sufficient commonality that they can be handled together. + +(define (-gen-cpu-defines) + (string-append + "\ +/* Maximum number of instructions that are fetched at a time. + This is for LIW type instructions sets (e.g. m32r). */ +#define MAX_LIW_INSNS " (number->string (state-liw-insns)) + "\n\ + +/* Maximum number of instructions that can be executed in parallel. */ +#define MAX_PARALLEL_INSNS " (number->string (state-parallel-insns)) + "\n\n" +; (gen-enum-decl '@cpu@_virtual +; "@cpu@ virtual insns" +; "@ARCH@_INSN_" ; not @CPU@ to match CGEN_INSN_TYPE in opc.h +; '((x-invalid 0) +; (x-before -1) (x-after -2) +; (x-begin -3) (x-chain -4) (x-cti-chain -5))) + ) +) + +; Return a boolean indicating if hardware element HW needs storage allocated +; for it in the SIM_CPU struct. + +(define (hw-need-storage? hw) + (and (register? hw) (not (obj-has-attr? hw 'VIRTUAL))) +) + +; Return C type declarations of all of the hardware elements. +; The name of the type is prepended with the cpu family name. + +(define (-gen-hardware-types) + (string-list + "/* CPU state information. */\n" + "typedef struct {\n" + " /* Hardware elements. */\n" + " struct {\n" + (string-list-map (lambda (hw) + (string-list + (gen-decl hw) + (gen-obj-sanitize hw + (string-list + (send hw 'gen-get-macro) + (send hw 'gen-set-macro))) + )) + (find hw-need-storage? (current-hw-list))) + " } hardware;\n" + "#define CPU_CGEN_HW(cpu) (& (cpu)->cpu_data.hardware)\n" + ;" /* CPU profiling state information. */\n" + ;" struct {\n" + ;(string-list-map (lambda (hw) (send hw 'gen-profile-decl)) + ; (find hw-profilable? (current-hw-list))) + ;" } profile;\n" + ;"#define CPU_CGEN_PROFILE(cpu) (& (cpu)->cpu_data.profile)\n" + "} @CPU@_CPU_DATA;\n\n" + ; If there are any virtual regs, output get/set macros for them. + (let ((virtual-regs (find (lambda (hw) + (and (register? hw) + (obj-has-attr? hw 'VIRTUAL))) + (current-hw-list))) + (orig-with-parallel? (with-parallel?)) + (result "")) + (set-with-parallel?! #f) + (if (not (null? virtual-regs)) + (set! result + (string-list + "/* Virtual regs. */\n\n" + (string-list-map (lambda (hw) + (logit 3 "Generating get/set for " (obj:name hw) + " ...\n") + (gen-obj-sanitize hw + (string-list + (send hw 'gen-get-macro) + (send hw 'gen-set-macro)))) + virtual-regs) + "\n" + ))) + (set-with-parallel?! orig-with-parallel?) + result) + ) +) + +; Return the declaration of register access functions. + +(define (-gen-cpu-reg-access-decls) + (string-list + "/* Cover fns for register access. */\n" + (string-list-map (lambda (hw) + (gen-reg-access-decl hw + "@cpu@" + (gen-type hw) + (hw-scalar? hw))) + (find register? (current-hw-list))) + "\n" + "/* These must be hand-written. */\n" + "extern CPUREG_FETCH_FN @cpu@_fetch_register;\n" + "extern CPUREG_STORE_FN @cpu@_store_register;\n" + "\n") +) + +; Generate type of struct holding model state while executing. + +(define (-gen-model-decls) + (logit 2 "Generating model decls ...\n") + (string-list + (string-list-map + (lambda (model) + (string-list + "typedef struct {\n" + (if (null? (model:state model)) + " int empty;\n" ; ensure struct isn't empty so it compiles + (string-map (lambda (var) + (string-append " " + (mode:c-type (mode:lookup (cadr var))) + " " + (gen-c-symbol (car var)) + ";\n")) + (model:state model))) + "} MODEL_" (string-upcase (gen-sym model)) "_DATA;\n\n" + )) + (current-model-list)) + ) +) + +; Utility of -gen-extract-macros to generate a macro to define the local +; vars to contain extracted field values and the code to assign them +; for <iformat> IFMT. + +(define (-gen-extract-ifmt-macro ifmt) + (logit 2 "Processing format " (obj:name ifmt) " ...\n") + (string-list + (gen-define-ifmt-ifields ifmt "" #t #f) + (gen-extract-ifmt-ifields ifmt "" #t #f) + ; We don't need an extra blank line here as gen-extract-ifields adds one. + ) +) + +; Generate macros to extract instruction fields. + +(define (-gen-extract-macros) + (logit 2 "Generating extraction macros ...\n") + (string-list + "\ +/* Macros to simplify extraction, reading and semantic code. + These define and assign the local vars that contain the insn's fields. */ +\n" + (string-list-map -gen-extract-ifmt-macro (current-ifmt-list)) + ) +) + +; Utility of -gen-parallel-exec-type to generate the definition of one +; structure in PAREXEC. +; SFMT is an <sformat> object. + +(define (-gen-parallel-exec-elm sfmt) + (string-append + " struct { /* " (obj:comment sfmt) " */\n" + (let ((sem-ops + ((if (with-parallel-write?) sfmt-out-ops sfmt-in-ops) sfmt))) + (if (null? sem-ops) + " int empty;\n" ; ensure struct isn't empty so it compiles + (string-map + (lambda (op) + (logit 2 "Processing operand " (obj:name op) " of format " + (obj:name sfmt) " ...\n") + (if (with-parallel-write?) + (let ((index-type (and (op-save-index? op) + (gen-index-type op sfmt)))) + (string-append " " (gen-type op) + " " (gen-sym op) ";\n" + (if index-type + (string-append " " index-type + " " (gen-sym op) "_idx;\n") + ""))) + (string-append " " + (gen-type op) + " " + (gen-sym op) + ";\n"))) + sem-ops))) + " } " (gen-sym sfmt) ";\n" + ) +) + +; Generate the definition of the structure that holds register values, etc. +; for use during parallel execution. When instructions are executed parallelly +; either +; - their inputs are read before their outputs are written. Thus we have to +; fetch the input values of several instructions before executing any of them. +; - or their outputs are queued here first and then written out after all insns +; have executed. +; The fetched/queued values are stored in an array of PAREXEC structs, one +; element per instruction. + +(define (-gen-parallel-exec-type) + (logit 2 "Generating PAREXEC type ...\n") + (string-append + (if (with-parallel-write?) + "/* Queued output values of an instruction. */\n" + "/* Fetched input values of an instruction. */\n") + "\ + +struct parexec { + union {\n" + (string-map -gen-parallel-exec-elm (current-sfmt-list)) + "\ + } operands; + /* For conditionally written operands, bitmask of which ones were. */ + int written; +};\n\n" + ) +) + +; Generate the TRACE_RECORD struct definition. +; This struct will hold all necessary data for doing tracing and profiling +; (e.g. register numbers). The goal is to remove all tracing code from the +; semantic code. Then the fast/full distinction needn't use conditionals to +; discard/include the tracing/profiling code. + +(define (-gen-trace-record-type) + (string-list + "\ +/* Collection of various things for the trace handler to use. */ + +typedef struct trace_record { + IADDR pc; + /* FIXME:wip */ +} TRACE_RECORD; +\n" + ) +) + +; Utilities of cgen-cpu.c + +; Get/set fns for every register. + +(define (-gen-cpu-reg-access-defns) + (string-list-map + (lambda (hw) + (let ((scalar? (hw-scalar? hw)) + (name (obj:name hw)) + (getter (hw-getter hw)) + (setter (hw-setter hw))) + (gen-reg-access-defn hw + "@cpu@" + (gen-type hw) + scalar? + (if getter + (string-append + " return GET_" + (string-upcase (gen-c-symbol name)) + " (" + (if scalar? "" "regno") + ");\n") + (string-append + " return CPU (" + (gen-c-symbol name) + (if scalar? "" "[regno]") + ");\n")) + (if setter + (string-append + " SET_" + (string-upcase (gen-c-symbol name)) + " (" + (if scalar? "" "regno, ") + "newval);\n") + (string-append + " CPU (" + (gen-c-symbol name) + (if scalar? "" "[regno]") + ") = newval;\n"))))) + (find (lambda (hw) (register? hw)) + (current-hw-list))) +) + +; Generate a function to record trace results in a trace record. + +(define (-gen-cpu-record-results) + (string-list + "\ +/* Record trace results for INSN. */ + +void +@cpu@_record_trace_results (SIM_CPU *current_cpu, CGEN_INSN *insn, + int *indices, TRACE_RECORD *tr) +{\n" + "}\n" + ) +) + +; Utilities of cgen-read.c. +; Parallel-read support is not currently used by any port and this code +; has been left to bitrot. Don't delete it just yet. + +; Return C code to fetch and save all input operands to instructions with +; <sformat> SFMT. + +(define (-gen-read-args sfmt) + (string-map (lambda (op) (op:read op sfmt)) + (sfmt-in-ops sfmt)) +) + +; Utility of -gen-read-switch to generate a switch case for <sformat> SFMT. + +(define (-gen-read-case sfmt) + (logit 2 "Processing read switch case for \"" (obj:name sfmt) "\" ...\n") + (string-list + " CASE (read, READ_" (string-upcase (gen-sym sfmt)) ") : " + "/* " (obj:comment sfmt) " */\n" + " {\n" + (if (with-scache?) + (gen-define-field-macro sfmt) + "") + (gen-define-parallel-operand-macro sfmt) + (gen-define-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) + (gen-extract-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) + (-gen-read-args sfmt) + (gen-undef-parallel-operand-macro sfmt) + (if (with-scache?) + (gen-undef-field-macro sfmt) + "") + " }\n" + " BREAK (read);\n\n" + ) +) + +; Generate the guts of a C switch statement to read insn operands. +; The switch is based on instruction formats. + +(define (-gen-read-switch) + (logit 2 "Processing readers ...\n") + (string-write-map -gen-read-case (current-sfmt-list)) +) + +; Utilities of cgen-write.c. + +; This is the other way of implementing parallel execution support. +; Instead of fetching all the input operands first, write all the output +; operands and their addresses to holding variables, and then run a +; post-processing pass to update the cpu state. +; +; There are separate implementations for semantics as functions and semantics +; as one big switch. For the function case we create a function that is a +; switch on each semantic format and loops writing each insn's results back. +; For the switch case we add cases to the switch to handle the write back, +; and it is up to the pbb compiler to include them in the generated "code". + +; Return C code to fetch and save all output operands to instructions with +; <sformat> SFMT. + +(define (-gen-write-args sfmt) + (string-map (lambda (op) (op:write op sfmt)) + (sfmt-out-ops sfmt)) +) + +; Utility of gen-write-switch to generate a switch case for <sformat> SFMT. +; If INSN is non-#f, it is the <insn> object of the insn in which case +; the case is named after the insn not the format. This is done because +; current sem-switch support emits one handler per insn instead of per sfmt. + +(define (-gen-write-case sfmt insn) + (logit 2 "Processing write switch case for \"" (obj:name sfmt) "\" ...\n") + (string-list + (if insn + (string-list /indent + "CASE (sem, INSN_WRITE_" + (string-upcase (gen-sym insn)) ") : ") + (string-list /indent + "case @CPU@_" + (string-upcase (gen-sym sfmt)) " : ")) + "/* " + (if insn + (string-list (insn-syntax insn)) + (obj:comment sfmt)) + " */\n" + /indent " {\n" + (if insn + (string-list + /indent + " SEM_ARG sem_arg = SEM_SEM_ARG (vpc, sc);\n" + /indent + " const ARGBUF *abuf = SEM_ARGBUF (sem_arg)->fields.write.abuf;\n") + "") + (if (with-scache?) + (gen-define-field-macro sfmt) + "") + (gen-define-parallel-operand-macro sfmt) + /indent + " int UNUSED written = abuf->written;\n" + ;(gen-define-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) - used by cgen-read.c + ;(gen-extract-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) - used by cgen-read.c + (if insn + (string-list /indent " IADDR UNUSED pc = abuf->addr;\n") + "") + (if (and insn (insn-cti? insn)) + (string-list /indent + " SEM_BRANCH_INIT\n") ; no trailing `;' on purpose + "") + (if insn + (string-list /indent " vpc = SEM_NEXT_VPC (sem_arg, pc, 0);\n") + "") + "\n" + (/indent-add 4) + (-gen-write-args sfmt) + (/indent-add -4) + "\n" + (if (and insn (insn-cti? insn)) + (string-list /indent " SEM_BRANCH_FINI (vpc);\n") + "") + (gen-undef-parallel-operand-macro sfmt) + (if (with-scache?) + (gen-undef-field-macro sfmt) + "") + /indent " }\n" + (if insn + (string-list /indent " NEXT (vpc);\n") + (string-list /indent " break;\n")) + "\n" + ) +) + +; Generate the guts of a C switch statement to write insn operands. +; The switch is based on instruction formats. +; ??? This will generate cases for formats that don't need it. +; E.g. on the m32r all 32 bit insns can't be executed in parallel. +; It's easier to generate the code anyway so we do. + +(define (-gen-write-switch) + (logit 2 "Processing writers ...\n") + (string-write-map (lambda (sfmt) + (-gen-write-case sfmt #f)) + (current-sfmt-list)) +) + +; Utilities of cgen-semantics.c. + +; Return name of semantic fn for INSN. + +(define (-gen-sem-fn-name insn) + ;(string-append "sem_" (gen-sym insn)) + (gen-sym insn) +) + +; Return semantic fn table entry for INSN. + +(define (-gen-sem-fn-table-entry insn) + (string-list + " { " + "@CPU@_INSN_" + (string-upcase (gen-sym insn)) + ", " + "SEM_FN_NAME (@cpu@," (-gen-sem-fn-name insn) ")" + " },\n" + ) +) + +; Return C code to define a table of all semantic fns and a function to +; add the info to the insn descriptor table. + +(define (-gen-semantic-fn-table) + (string-write + "\ +/* Table of all semantic fns. */ + +static const struct sem_fn_desc sem_fns[] = {\n" + + (lambda () + (string-write-map -gen-sem-fn-table-entry + (non-alias-insns (current-insn-list)))) + + "\ + { 0, 0 } +}; + +/* Add the semantic fns to IDESC_TABLE. */ + +void +SEM_FN_NAME (@cpu@,init_idesc_table) (SIM_CPU *current_cpu) +{ + IDESC *idesc_table = CPU_IDESC (current_cpu); + const struct sem_fn_desc *sf; + int mach_num = MACH_NUM (CPU_MACH (current_cpu)); + + for (sf = &sem_fns[0]; sf->fn != 0; ++sf) + { + const CGEN_INSN *insn = idesc_table[sf->index].idata; + int valid_p = (CGEN_INSN_VIRTUAL_P (insn) + || CGEN_INSN_MACH_HAS_P (insn, mach_num)); +#if FAST_P + if (valid_p) + idesc_table[sf->index].sem_fast = sf->fn; + else + idesc_table[sf->index].sem_fast = SEM_FN_NAME (@cpu@,x_invalid); +#else + if (valid_p) + idesc_table[sf->index].sem_full = sf->fn; + else + idesc_table[sf->index].sem_full = SEM_FN_NAME (@cpu@,x_invalid); +#endif + } +} +\n" + ) +) + +; Return C code to perform the semantics of INSN. + +(define (gen-semantic-code insn) + ; Indicate generating code for INSN. + ; Use the compiled form if available. + ; The case when they're not available is for virtual insns. + (let ((sem (insn-compiled-semantics insn))) + (if sem + (rtl-c-parsed VOID sem nil + #:rtl-cover-fns? #t #:owner insn) + (rtl-c VOID (insn-semantics insn) nil + #:rtl-cover-fns? #t #:owner insn))) +) + +; Return definition of C function to perform INSN. +; This version handles the with-scache case. + +(define (-gen-scache-semantic-fn insn) + (logit 2 "Processing semantics for " (obj:name insn) ": \"" (insn-syntax insn) "\" ...\n") + (set! -with-profile? -with-profile-fn?) + (let ((profile? (and (with-profile?) + (not (obj-has-attr? insn 'VIRTUAL)))) + (parallel? (with-parallel?)) + (cti? (insn-cti? insn)) + (insn-len (insn-length-bytes insn))) + (string-list + "/* " (obj:name insn) ": " (insn-syntax insn) " */\n\n" + "static SEM_PC\n" + "SEM_FN_NAME (@cpu@," (gen-sym insn) ")" + (if (and parallel? (not (with-generic-write?))) + " (SIM_CPU *current_cpu, SEM_ARG sem_arg, PAREXEC *par_exec)\n" + " (SIM_CPU *current_cpu, SEM_ARG sem_arg)\n") + "{\n" + (gen-define-field-macro (insn-sfmt insn)) + (if (and parallel? (not (with-generic-write?))) + (gen-define-parallel-operand-macro (insn-sfmt insn)) + "") + " ARGBUF *abuf = SEM_ARGBUF (sem_arg);\n" + ; Unconditionally written operands are not recorded here. + " int UNUSED written = 0;\n" + ; The address of this insn, needed by extraction and semantic code. + ; Note that the address recorded in the cpu state struct is not used. + ; For faster engines that copy will be out of date. + " IADDR UNUSED pc = abuf->addr;\n" + (if (and cti? (not parallel?)) + " SEM_BRANCH_INIT\n" ; no trailing `;' on purpose + "") + (string-list " SEM_PC vpc = SEM_NEXT_VPC (sem_arg, pc, " + (number->string insn-len) + ");\n") + "\n" + (gen-semantic-code insn) "\n" + ; Only update what's been written if some are conditionally written. + ; Otherwise we know they're all written so there's no point in + ; keeping track. + (if (-any-cond-written? (insn-sfmt insn)) + " abuf->written = written;\n" + "") + (if (and cti? (not parallel?)) + " SEM_BRANCH_FINI (vpc);\n" + "") + " return vpc;\n" + (if (and parallel? (not (with-generic-write?))) + (gen-undef-parallel-operand-macro (insn-sfmt insn)) + "") + (gen-undef-field-macro (insn-sfmt insn)) + "}\n\n" + )) +) + +; Return definition of C function to perform INSN. +; This version handles the without-scache case. +; ??? TODO: multiword insns. + +(define (-gen-no-scache-semantic-fn insn) + (logit 2 "Processing semantics for " (obj:name insn) ": \"" (insn-syntax insn) "\" ...\n") + (set! -with-profile? -with-profile-fn?) + (let ((profile? (and (with-profile?) + (not (obj-has-attr? insn 'VIRTUAL)))) + (parallel? (with-parallel?)) + (cti? (insn-cti? insn)) + (insn-len (insn-length-bytes insn))) + (string-list + "/* " (obj:name insn) ": " (insn-syntax insn) " */\n\n" + "static SEM_STATUS\n" + "SEM_FN_NAME (@cpu@," (gen-sym insn) ")" + (if (and parallel? (not (with-generic-write?))) + " (SIM_CPU *current_cpu, SEM_ARG sem_arg, PAREXEC *par_exec, CGEN_INSN_INT insn)\n" + " (SIM_CPU *current_cpu, SEM_ARG sem_arg, CGEN_INSN_INT insn)\n") + "{\n" + (if (and parallel? (not (with-generic-write?))) + (gen-define-parallel-operand-macro (insn-sfmt insn)) + "") + " SEM_STATUS status = 0;\n" ; ??? wip + " ARGBUF *abuf = SEM_ARGBUF (sem_arg);\n" + ; Unconditionally written operands are not recorded here. + " int UNUSED written = 0;\n" + " IADDR UNUSED pc = GET_H_PC ();\n" + (if (and cti? (not parallel?)) + " SEM_BRANCH_INIT\n" ; no trailing `;' on purpose + "") + (string-list " SEM_PC vpc = SEM_NEXT_VPC (sem_arg, pc, " + (number->string insn-len) + ");\n") + (string-list (gen-define-ifmt-ifields (insn-ifmt insn) " " #f #t) + (gen-sfmt-op-argbuf-defns (insn-sfmt insn)) + (gen-extract-ifmt-ifields (insn-ifmt insn) " " #f #t) + (gen-sfmt-op-argbuf-assigns (insn-sfmt insn))) + "\n" + (gen-semantic-code insn) "\n" + ; Only update what's been written if some are conditionally written. + ; Otherwise we know they're all written so there's no point in + ; keeping track. + (if (-any-cond-written? (insn-sfmt insn)) + " abuf->written = written;\n" + "") + ; SEM_{,N}BRANCH_FINI are user-supplied macros. + (if (not parallel?) + (string-list + (if cti? + " SEM_BRANCH_FINI (vpc, " + " SEM_NBRANCH_FINI (vpc, ") + (gen-bool-attrs (obj-atlist insn) gen-attr-mask) + ");\n") + "") + " return status;\n" + (if (and parallel? (not (with-generic-write?))) + (gen-undef-parallel-operand-macro (insn-sfmt insn)) + "") + "}\n\n" + )) +) + +(define (-gen-all-semantic-fns) + (logit 2 "Processing semantics ...\n") + (let ((insns (non-alias-insns (current-insn-list)))) + (if (with-scache?) + (string-write-map -gen-scache-semantic-fn insns) + (string-write-map -gen-no-scache-semantic-fn insns))) +) + +; Utility of -gen-sem-case to return the mask of operands always written +; to in <sformat> SFMT. +; ??? Not currently used. + +(define (-uncond-written-mask sfmt) + (apply + (map (lambda (op) + (if (op:cond? op) + 0 + (logsll 1 (op:num op)))) + (sfmt-out-ops sfmt))) +) + +; Utility of -gen-sem-case to return #t if any operand in <sformat> SFMT is +; conditionally written to. + +(define (-any-cond-written? sfmt) + (any-true? (map op:cond? (sfmt-out-ops sfmt))) +) + +; Generate a switch case to perform INSN. + +(define (-gen-sem-case insn parallel?) + (logit 2 "Processing " + (if parallel? "parallel " "") + "semantic switch case for \"" (insn-syntax insn) "\" ...\n") + (set! -with-profile? -with-profile-sw?) + (let ((cti? (insn-cti? insn)) + (insn-len (insn-length-bytes insn))) + (string-list + ; INSN_ is prepended here and not elsewhere to avoid name collisions + ; with symbols like AND, etc. + " CASE (sem, " + "INSN_" + (if parallel? "PAR_" "") + (string-upcase (gen-sym insn)) ") : " + "/* " (insn-syntax insn) " */\n" + "{\n" + " SEM_ARG sem_arg = SEM_SEM_ARG (vpc, sc);\n" + " ARGBUF *abuf = SEM_ARGBUF (sem_arg);\n" + (if (with-scache?) + (gen-define-field-macro (insn-sfmt insn)) + "") + (if (and parallel? (not (with-generic-write?))) + (gen-define-parallel-operand-macro (insn-sfmt insn)) + "") + ; Unconditionally written operands are not recorded here. + " int UNUSED written = 0;\n" + ; The address of this insn, needed by extraction and semantic code. + ; Note that the address recorded in the cpu state struct is not used. + " IADDR UNUSED pc = abuf->addr;\n" + (if (and cti? (not parallel?)) + " SEM_BRANCH_INIT\n" ; no trailing `;' on purpose + "") + (if (with-scache?) + "" + (string-list (gen-define-ifmt-ifields (insn-ifmt insn) " " #f #t) + (gen-extract-ifmt-ifields (insn-ifmt insn) " " #f #t) + "\n")) + (string-list " vpc = SEM_NEXT_VPC (sem_arg, pc, " + (number->string insn-len) + ");\n") + "\n" + (gen-semantic-code insn) "\n" + ; Only update what's been written if some are conditionally written. + ; Otherwise we know they're all written so there's no point in + ; keeping track. + (if (-any-cond-written? (insn-sfmt insn)) + " abuf->written = written;\n" + "") + (if (and cti? (not parallel?)) + " SEM_BRANCH_FINI (vpc);\n" + "") + (if (and parallel? (not (with-generic-write?))) + (gen-undef-parallel-operand-macro (insn-sfmt insn)) + "") + (if (with-scache?) + (gen-undef-field-macro (insn-sfmt insn)) + "") + "}\n" + " NEXT (vpc);\n\n" + )) +) + +(define (-gen-sem-switch) + (logit 2 "Processing semantic switch ...\n") + ; Turn parallel execution support off. + (let ((orig-with-parallel? (with-parallel?))) + (set-with-parallel?! #f) + (let ((result + (string-write-map (lambda (insn) (-gen-sem-case insn #f)) + (non-alias-insns (current-insn-list))))) + (set-with-parallel?! orig-with-parallel?) + result)) +) + +; Generate the guts of a C switch statement to execute parallel instructions. +; This switch is included after the non-parallel instructions in the semantic +; switch. +; +; ??? We duplicate the writeback case for each insn, even though we only need +; one case per insn format. The former keeps the code for each insn +; together and might improve cache usage. On the other hand the latter +; reduces the amount of code, though it is believed that in this particular +; instance the win isn't big enough. + +(define (-gen-parallel-sem-switch) + (logit 2 "Processing parallel insn semantic switch ...\n") + ; Turn parallel execution support on. + (let ((orig-with-parallel? (with-parallel?))) + (set-with-parallel?! #t) + (let ((result + (string-write-map (lambda (insn) + (string-list (-gen-sem-case insn #t) + (-gen-write-case (insn-sfmt insn) insn))) + (parallel-insns (current-insn-list))))) + (set-with-parallel?! orig-with-parallel?) + result)) +) + +; Top level file generators. + +; Generate cpu-<cpu>.h + +(define (cgen-cpu.h) + (logit 1 "Generating " (gen-cpu-name) " cpu.h ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + ; Tell the rtl->c translator we're not the simulator. + ; ??? Minimizes changes in generated code until this is changed. + ; RTL->C happens for field decoding. + (rtl-c-config! #:rtl-cover-fns? #f) + + (string-write + (gen-copyright "CPU family header for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifndef CPU_@CPU@_H +#define CPU_@CPU@_H + +" + -gen-cpu-defines + -gen-hardware-types + -gen-cpu-reg-access-decls + -gen-model-decls + (lambda () (gen-argbuf-type #t)) + (lambda () (gen-scache-type #t)) + -gen-extract-macros + (if (and (with-parallel?) (not (with-generic-write?))) + -gen-parallel-exec-type + "") + -gen-trace-record-type + "#endif /* CPU_@CPU@_H */\n" + ) +) + +; Generate cpu-<cpu>.c + +(define (cgen-cpu.c) + (logit 1 "Generating " (gen-cpu-name) " cpu.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + ; Initialize rtl generation. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright "Misc. support for CPU family @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#define WANT_CPU @cpu@ +#define WANT_CPU_@CPU@ + +#include \"sim-main.h\" +#include \"cgen-ops.h\" + +" + -gen-cpu-reg-access-defns + -gen-cpu-record-results + ) +) + +; Generate read.c + +(define (cgen-read.c) + (logit 1 "Generating " (gen-cpu-name) " read.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support off. + (set-with-parallel?! #f) + + ; Tell the rtx->c translator we are the simulator. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright (string-append "Simulator instruction operand reader for " + (current-arch-name) ".") + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifdef DEFINE_LABELS + + /* The labels have the case they have because the enum of insn types + is all uppercase and in the non-stdc case the fmt symbol is built + into the enum name. */ + + static struct { + int index; + void *label; + } labels[] = {\n" + + (lambda () + (string-write-map (lambda (insn) + (string-append " { " + "@CPU@_INSN_" + (string-upcase (gen-sym insn)) + ", && case_read_READ_" + (string-upcase (gen-sym (insn-sfmt insn))) + " },\n")) + (non-alias-insns (current-insn-list)))) + + " { 0, 0 } + }; + int i; + + for (i = 0; labels[i].label != 0; ++i) + CPU_IDESC (current_cpu) [labels[i].index].read = labels[i].label; + +#undef DEFINE_LABELS +#endif /* DEFINE_LABELS */ + +#ifdef DEFINE_SWITCH + +{\n" + (if (with-scache?) + "\ + SEM_ARG sem_arg = sc; + ARGBUF *abuf = SEM_ARGBUF (sem_arg); + + SWITCH (read, sem_arg->read)\n" + "\ + SWITCH (read, decode->read)\n") + "\ + { + +" + + -gen-read-switch + + "\ + } + ENDSWITCH (read) /* End of read switch. */ +} + +#undef DEFINE_SWITCH +#endif /* DEFINE_SWITCH */ +" + ) +) + +; Generate write.c + +(define (cgen-write.c) + (logit 1 "Generating " (gen-cpu-name) " write.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support off. + (set-with-parallel?! #f) + + ; Tell the rtx->c translator we are the simulator. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright (string-append "Simulator instruction operand writer for " + (current-arch-name) ".") + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +/* Write cached results of 1 or more insns executed in parallel. */ + +void +@cpu@_parallel_write (SIM_CPU *cpu, SCACHE *sbufs, PAREXEC *pbufs, int ninsns) +{\n" + (if (with-scache?) + "\ + SEM_ARG sem_arg = sc; + ARGBUF *abuf = SEM_ARGBUF (sem_arg);\n" + "") + "\ + + do + { + ARGBUF *abuf = SEM_ARGBUF (sbufs); + + switch (abuf->idesc->write) + { +\n" + + ;(/indent-add 8) + -gen-write-switch + ;(/indent-add -8) + + "\ + } + } + while (--ninsns > 0); +} +" + ) +) + +; Generate semantics.c +; Each instruction is implemented in its own function. + +(define (cgen-semantics.c) + (logit 1 "Generating " (gen-cpu-name) " semantics.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + ; Tell the rtx->c translator we are the simulator. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright "Simulator instruction semantics for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#define WANT_CPU @cpu@ +#define WANT_CPU_@CPU@ + +#include \"sim-main.h\" +#include \"cgen-mem.h\" +#include \"cgen-ops.h\" + +#undef GET_ATTR +#define GET_ATTR(cpu, num, attr) \ +CGEN_ATTR_VALUE (NULL, abuf->idesc->attrs, CGEN_INSN_##attr) + +/* This is used so that we can compile two copies of the semantic code, + one with full feature support and one without that runs fast(er). + FAST_P, when desired, is defined on the command line, -DFAST_P=1. */ +#if FAST_P +#define SEM_FN_NAME(cpu,fn) XCONCAT3 (cpu,_semf_,fn) +#undef TRACE_RESULT +#define TRACE_RESULT(cpu, abuf, name, type, val) +#else +#define SEM_FN_NAME(cpu,fn) XCONCAT3 (cpu,_sem_,fn) +#endif +\n" + + -gen-all-semantic-fns + ; Put the table at the end so we don't have to declare all the sem fns. + -gen-semantic-fn-table + ) +) + +; Generate sem-switch.c. +; Each instruction is a case in a switch(). +; This file consists of just the switch(). It is included by mainloop.c. + +(define (cgen-sem-switch.c) + (logit 1 "Generating " (gen-cpu-name) " sem-switch.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support off. + ; It is later turned on/off when generating the actual semantic code. + (set-with-parallel?! #f) + + ; Tell the rtx->c translator we are the simulator. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright "Simulator instruction semantics for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + + "\ +#ifdef DEFINE_LABELS + + /* The labels have the case they have because the enum of insn types + is all uppercase and in the non-stdc case the insn symbol is built + into the enum name. */ + + static struct { + int index; + void *label; + } labels[] = {\n" + + (lambda () + (string-write-map (lambda (insn) + (string-append " { " + "@CPU@_INSN_" + (string-upcase (gen-sym insn)) + ", && case_sem_INSN_" + (string-upcase (gen-sym insn)) + " },\n")) + (non-alias-insns (current-insn-list)))) + + (if (state-parallel-exec?) + (lambda () + (string-write-map (lambda (insn) + (string-append " { " + "@CPU@_INSN_PAR_" + (string-upcase (gen-sym insn)) + ", && case_sem_INSN_PAR_" + (string-upcase (gen-sym insn)) + " },\n" + " { " + "@CPU@_INSN_WRITE_" + (string-upcase (gen-sym insn)) + ", && case_sem_INSN_WRITE_" + (string-upcase (gen-sym insn)) + " },\n")) + (parallel-insns (current-insn-list)))) + "") + + " { 0, 0 } + }; + int i; + + for (i = 0; labels[i].label != 0; ++i) + { +#if FAST_P + CPU_IDESC (current_cpu) [labels[i].index].sem_fast_lab = labels[i].label; +#else + CPU_IDESC (current_cpu) [labels[i].index].sem_full_lab = labels[i].label; +#endif + } + +#undef DEFINE_LABELS +#endif /* DEFINE_LABELS */ + +#ifdef DEFINE_SWITCH + +/* If hyper-fast [well not unnecessarily slow] execution is selected, turn + off frills like tracing and profiling. */ +/* FIXME: A better way would be to have TRACE_RESULT check for something + that can cause it to be optimized out. Another way would be to emit + special handlers into the instruction \"stream\". */ + +#if FAST_P +#undef TRACE_RESULT +#define TRACE_RESULT(cpu, abuf, name, type, val) +#endif + +#undef GET_ATTR +#define GET_ATTR(cpu, num, attr) \ +CGEN_ATTR_VALUE (NULL, abuf->idesc->attrs, CGEN_INSN_##attr) + +{ + +#if WITH_SCACHE_PBB + +/* Branch to next handler without going around main loop. */ +#define NEXT(vpc) goto * SEM_ARGBUF (vpc) -> semantic.sem_case +SWITCH (sem, SEM_ARGBUF (vpc) -> semantic.sem_case) + +#else /* ! WITH_SCACHE_PBB */ + +#define NEXT(vpc) BREAK (sem) +#ifdef __GNUC__ +#if FAST_P + SWITCH (sem, SEM_ARGBUF (sc) -> idesc->sem_fast_lab) +#else + SWITCH (sem, SEM_ARGBUF (sc) -> idesc->sem_full_lab) +#endif +#else + SWITCH (sem, SEM_ARGBUF (sc) -> idesc->num) +#endif + +#endif /* ! WITH_SCACHE_PBB */ + + { + +" + + -gen-sem-switch + + (if (state-parallel-exec?) + -gen-parallel-sem-switch + "") + + " + } + ENDSWITCH (sem) /* End of semantic switch. */ + + /* At this point `vpc' contains the next insn to execute. */ +} + +#undef DEFINE_SWITCH +#endif /* DEFINE_SWITCH */ +" + ) +) + +; Generate mainloop.in. +; ??? Not currently used. + +(define (cgen-mainloop.in) + (logit 1 "Generating mainloop.in ...\n") + + (string-write + "cat <<EOF >/dev/null\n" + (gen-copyright "Simulator main loop for @arch@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "EOF\n" + "\ + +# Syntax: +# /bin/sh mainloop.in init|support|{full,fast}-{extract,exec}-{scache,nocache} + +# ??? There's lots of conditional compilation here. +# After a few more ports are done, revisit. + +case \"x$1\" in + +xsupport) + +cat <<EOF +/*xsupport*/ +EOF + +;; + +xinit) + +cat <<EOF +/*xinit*/ +EOF + +;; + +xfull-extract-* | xfast-extract-*) + +cat <<EOF +{ +" + (rtl-c VOID insn-extract nil #:rtl-cover-fns? #t) +"} +EOF + +;; + +xfull-exec-* | xfast-exec-*) + +cat <<EOF +{ +" + (rtl-c VOID insn-execute nil #:rtl-cover-fns? #t) +"} +EOF + +;; + +*) + echo \"Invalid argument to mainloop.in: $1\" >&2 + exit 1 + ;; + +esac +" + ) +) diff --git a/cgen/sim-decode.scm b/cgen/sim-decode.scm new file mode 100644 index 00000000000..2285c2825e7 --- /dev/null +++ b/cgen/sim-decode.scm @@ -0,0 +1,592 @@ +; Decoder generation. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Names of various global vars. + +; Name of insn descriptor table var. +(define IDESC-TABLE-VAR "@cpu@_insn_data") + +; Return decode entries for each insn. +; ??? At one point we generated one variable per instruction rather than one +; big array. It doesn't matter too much (yet). Generating one big array is +; simpler. + +(define (-gen-decode-insn-globals insn-list) + ; Print the higher detailed stuff at higher verbosity. + (logit 2 "Processing decode insn globals ...\n") + + (string-write + + (if (and (with-parallel?) (not (with-parallel-only?))) + "\ +/* Insn can't be executed in parallel. + Or is that \"do NOt Pass to Air defense Radar\"? :-) */ +#define NOPAR (-1) +\n" + "") + + "\ +/* The instruction descriptor array. + This is computed at runtime. Space for it is not malloc'd to save a + teensy bit of cpu in the decoder. Moving it to malloc space is trivial + but won't be done until necessary (we don't currently support the runtime + addition of instructions nor an SMP machine with different cpus). */ +static IDESC " IDESC-TABLE-VAR "[@CPU@_INSN_MAX]; + +/* Commas between elements are contained in the macros. + Some of these are conditionally compiled out. */ + +static const struct insn_sem @cpu@_insn_sem[] = +{\n" + + (string-list-map + (lambda (insn) + (let ((name (gen-sym insn)) + (pbb? (obj-has-attr? insn 'PBB)) + (virtual? (insn-virtual? insn))) + (string-list + " { " + (if virtual? + (string-append "VIRTUAL_INSN_" (string-upcase name) ", ") + (string-append "@ARCH@_INSN_" (string-upcase name) ", ")) + "@CPU@_INSN_" (string-upcase name) ", " + "@CPU@_" (-gen-fmt-enum (insn-sfmt insn)) + (if (and (with-parallel?) (not (with-parallel-only?))) + (string-list + (if (insn-parallel? insn) + (string-append ", @CPU@_INSN_PAR_" + (string-upcase name) + ", " + (if (with-parallel-read?) + "@CPU@_INSN_READ_" + "@CPU@_INSN_WRITE_") + (string-upcase name)) + ", NOPAR, NOPAR ")) + "") + " },\n"))) + insn-list) + + "\ +}; + +static const struct insn_sem @cpu@_insn_sem_invalid = { + VIRTUAL_INSN_X_INVALID, @CPU@_INSN_X_INVALID, @CPU@_SFMT_EMPTY" + (if (and (with-parallel?) (not (with-parallel-only?))) + ", NOPAR, NOPAR" + "") + " +}; +\n" + ) +) + +; Return enum name of format FMT. + +(define (-gen-fmt-enum fmt) + (string-upcase (gen-sym fmt)) +) + +; Generate decls for the insn descriptor table type IDESC. + +(define (-gen-idesc-decls) + (string-append "\ +extern const IDESC *@cpu@_decode (SIM_CPU *, IADDR, + CGEN_INSN_INT," + (if (adata-integral-insn? CURRENT-ARCH) + " CGEN_INSN_INT,\n" + "\n") + "\ + ARGBUF *); +extern void @cpu@_init_idesc_table (SIM_CPU *); +extern void @cpu@_sem_init_idesc_table (SIM_CPU *); +extern void @cpu@_semf_init_idesc_table (SIM_CPU *); +\n") +) + +; Return definition of C function to initialize the IDESC table. +; @cpu@_init_idesc_table is defined here as it depends on with-parallel? +; and thus can't be defined in sim/common. + +(define (-gen-idesc-init-fn) + (string-append "\ +/* Initialize an IDESC from the compile-time computable parts. */ + +static INLINE void +init_idesc (SIM_CPU *cpu, IDESC *id, const struct insn_sem *t) +{ + const CGEN_INSN *insn_table = CGEN_CPU_INSN_TABLE (CPU_CPU_DESC (cpu))->init_entries; + + id->num = t->index; + id->sfmt = t->sfmt; + if ((int) t->type <= 0) + id->idata = & cgen_virtual_insn_table[- (int) t->type]; + else + id->idata = & insn_table[t->type]; + id->attrs = CGEN_INSN_ATTRS (id->idata); + /* Oh my god, a magic number. */ + id->length = CGEN_INSN_BITSIZE (id->idata) / 8; + +#if WITH_PROFILE_MODEL_P + id->timing = & MODEL_TIMING (CPU_MODEL (cpu)) [t->index]; + { + SIM_DESC sd = CPU_STATE (cpu); + SIM_ASSERT (t->index == id->timing->num); + } +#endif + + /* Semantic pointers are initialized elsewhere. */ +} + +/* Initialize the instruction descriptor table. */ + +void +@cpu@_init_idesc_table (SIM_CPU *cpu) +{ + IDESC *id,*tabend; + const struct insn_sem *t,*tend; + int tabsize = @CPU@_INSN_MAX; + IDESC *table = " IDESC-TABLE-VAR "; + + memset (table, 0, tabsize * sizeof (IDESC)); + + /* First set all entries to the `invalid insn'. */ + t = & @cpu@_insn_sem_invalid; + for (id = table, tabend = table + tabsize; id < tabend; ++id) + init_idesc (cpu, id, t); + + /* Now fill in the values for the chosen cpu. */ + for (t = @cpu@_insn_sem, tend = t + sizeof (@cpu@_insn_sem) / sizeof (*t); + t != tend; ++t) + { + init_idesc (cpu, & table[t->index], t);\n" + + (if (and (with-parallel?) (not (with-parallel-only?))) + "\ + if (t->par_index != NOPAR) + { + init_idesc (cpu, &table[t->par_index], t); + table[t->index].par_idesc = &table[t->par_index]; + }\n" + "") + + (if (and (with-parallel-write?) (not (with-parallel-only?))) + "\ + if (t->par_index != NOPAR) + { + init_idesc (cpu, &table[t->write_index], t); + table[t->par_index].par_idesc = &table[t->write_index]; + }\n" + "") + + "\ + } + + /* Link the IDESC table into the cpu. */ + CPU_IDESC (cpu) = table; +} + +") +) + +; Instruction field extraction support. +; Two implementations are provided, one for !with-scache and one for +; with-scache. +; +; Extracting ifields is a three phase process. First the ifields are +; extracted and stored in local variables. Then any ifields requiring +; additional processing for operands are handled. Then in the with-scache +; case the results are stored in a struct for later retrieval by the semantic +; code. +; +; The !with-scache case does this processing in the semantic function, +; except it doesn't need the last step (it doesn't need to store the results +; in a struct for later use). +; +; The with-scache case extracts the ifields in the decode function. +; Furthermore, we use <sformat-argbuf> to reduce the quantity of structures +; created (this helps semantic-fragment pbb engines). + +; Return C code to record <ifield> F for the semantic handler +; in a local variable rather than an ARGBUF struct. + +(define (-gen-record-argbuf-ifld f sfmt) + (string-append " " (gen-ifld-argbuf-ref f) + " = " (gen-extracted-ifld-value f) ";\n") +) + +; Return three of arguments to TRACE: +; string argument to fprintf, character indicating type of third arg, value. +; The type is one of: x. + +(define (-gen-trace-argbuf-ifld f sfmt) + (string-append + ; FIXME: Add method to return fprintf format string. + ", \"" (gen-sym f) " 0x%x\"" + ", 'x'" + ", " (gen-extracted-ifld-value f)) +) + +; Instruction field extraction support cont'd. +; Hardware support. + +; gen-extract method. +; For the default case we use the ifield as is, which is output elsewhere. + +(method-make! + <hardware-base> 'gen-extract + (lambda (self op sfmt local?) + "") +) + +; gen-trace-extract method. +; Return appropriate arguments for TRACE_EXTRACT. + +(method-make! + <hardware-base> 'gen-trace-extract + (lambda (self op sfmt) + "") +) + +; Extract the necessary fields into ARGBUF. + +(method-make! + <hw-register> 'gen-extract + (lambda (self op sfmt local?) + (if (hw-cache-addr? self) + (string-append " " + (if local? + (gen-hw-index-argbuf-name (op:index op)) + (gen-hw-index-argbuf-ref (op:index op))) + " = & " + (gen-cpu-ref (gen-sym (op:type op))) + (gen-array-ref (gen-extracted-ifld-value (op-ifield op))) + ";\n") + "")) +) + +; Return appropriate arguments for TRACE_EXTRACT. + +(method-make! + <hw-register> 'gen-trace-extract + (lambda (self op sfmt) + (if (hw-cache-addr? self) + (string-append + ; FIXME: Add method to return fprintf format string. + ", \"" (gen-sym op) " 0x%x\"" + ", 'x'" + ", " (gen-extracted-ifld-value (op-ifield op))) + "")) +) + +; Extract the necessary fields into ARGBUF. + +(method-make! + <hw-address> 'gen-extract + (lambda (self op sfmt local?) + (string-append " " + (if local? + (gen-hw-index-argbuf-name (op:index op)) + (gen-hw-index-argbuf-ref (op:index op))) + " = " + (gen-extracted-ifld-value (op-ifield op)) + ";\n")) +) + +; Return appropriate arguments for TRACE_EXTRACT. + +(method-make! + <hw-address> 'gen-trace-extract + (lambda (self op sfmt) + (string-append + ; FIXME: Add method to return fprintf format string. + ", \"" (gen-sym op) " 0x%x\"" + ", 'x'" + ", " (gen-extracted-ifld-value (op-ifield op)))) +) + +; Instruction field extraction support cont'd. +; Operand support. + +; Return C code to record the field for the semantic handler. +; In the case of a register, this is usually the address of the register's +; value (if CACHE-ADDR). +; LOCAL? indicates whether to record the value in a local variable or in +; the ARGBUF struct. +; ??? Later allow target to provide an `extract' expression. + +(define (-gen-op-extract op sfmt local?) + (send (op:type op) 'gen-extract op sfmt local?) +) + +; Return three of arguments to TRACE_EXTRACT: +; string argument to fprintf, character indicating type of third arg, value. +; The type is one of: x. + +(define (-gen-op-trace-extract op sfmt) + (send (op:type op) 'gen-trace-extract op sfmt) +) + +; Return C code to define local vars to hold processed ifield data for +; <sformat> SFMT. +; This is used when !with-scache. +; Definitions of the extracted ifields is handled elsewhere. + +(define (gen-sfmt-op-argbuf-defns sfmt) + (let ((operands (sfmt-extracted-operands sfmt))) + (string-list-map (lambda (op) + (let ((var-spec (sfmt-op-sbuf-elm op sfmt))) + (if var-spec + (string-append " " + (cadr var-spec) + " " + (car var-spec) + ";\n") + ""))) + operands)) +) + +; Return C code to assign values to the local vars that hold processed ifield +; data for <sformat> SFMT. +; This is used when !with-scache. +; Assignment of the extracted ifields is handled elsewhere. + +(define (gen-sfmt-op-argbuf-assigns sfmt) + (let ((operands (sfmt-extracted-operands sfmt))) + (string-list-map (lambda (op) + (-gen-op-extract op sfmt #t)) + operands)) +) + +; Instruction field extraction support cont'd. +; Emit extraction section of decode function. + +; Return C code to record insn field data for <sformat> SFMT. +; This is used when with-scache. + +(define (-gen-record-args sfmt) + (let ((operands (sfmt-extracted-operands sfmt)) + (iflds (sfmt-needed-iflds sfmt))) + (string-list + " /* Record the fields for the semantic handler. */\n" + (string-list-map (lambda (f) (-gen-record-argbuf-ifld f sfmt)) + iflds) + (string-list-map (lambda (op) (-gen-op-extract op sfmt #f)) + operands) + " TRACE_EXTRACT (current_cpu, abuf, (current_cpu, pc, " + "\"" (gen-sym sfmt) "\"" + (string-list-map (lambda (f) (-gen-trace-argbuf-ifld f sfmt)) + iflds) + (string-list-map (lambda (op) (-gen-op-trace-extract op sfmt)) + operands) + ", (char *) 0));\n" + )) +) + +; Return C code to record insn field data for profiling. +; Also recorded are operands not mentioned in the fields but mentioned +; in the semantic code. +; +; FIXME: Register usage may need to be tracked as an array of longs. +; If there are more than 32 regs, we can't know which until build time. +; ??? For now we only handle reg sets of 32 or less. +; +; ??? The other way to obtain register numbers is to defer computing them +; until they're actually needed. It will speed up execution when not doing +; profiling, though the speed up is only for the extraction phase. +; On the other hand the current way has one memory reference per register +; number in the profiling routines. For RISC this can be a lose, though for +; more complicated instruction sets it could be a win as all the computation +; is kept to the extraction phase. If someone wants to put forth some real +; data, this might then be changed (or at least noted). + +(define (-gen-record-profile-args sfmt) + (let ((in-ops (find op-profilable? (sfmt-in-ops sfmt))) + (out-ops (find op-profilable? (sfmt-out-ops sfmt))) + ) + (if (and (null? in-ops) (null? out-ops)) + "" + (string-list + "#if WITH_PROFILE_MODEL_P\n" + " /* Record the fields for profiling. */\n" + " if (PROFILE_MODEL_P (current_cpu))\n" + " {\n" + (string-list-map (lambda (op) (op:record-profile op sfmt #f)) + in-ops) + (string-list-map (lambda (op) (op:record-profile op sfmt #t)) + out-ops) + " }\n" + "#endif\n" + ))) +) + +; Return C code that extracts the fields of <sformat> SFMT. +; +; Extraction is based on formats to reduce the amount of code generated. +; However, we also need to emit code which records the hardware elements used +; by the semantic code. This is currently done by recording this information +; with the format. + +(define (-gen-extract-case sfmt) + (logit 2 "Processing extractor for \"" (sfmt-key sfmt) "\" ...\n") + (string-list + " extract_" (gen-sym sfmt) ":\n" + " {\n" + " const IDESC *idesc = &" IDESC-TABLE-VAR "[itype];\n" + " CGEN_INSN_INT insn = " + (if (adata-integral-insn? CURRENT-ARCH) + "entire_insn;\n" + "base_insn;\n") + (gen-define-field-macro sfmt) + (gen-define-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) + "\n" + (gen-extract-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f) + "\n" + (-gen-record-args sfmt) + "\n" + (-gen-record-profile-args sfmt) + (gen-undef-field-macro sfmt) + " return idesc;\n" + " }\n\n" + ) +) + +; For each format, return its extraction function. + +(define (-gen-all-extractors) + (logit 2 "Processing extractors ...\n") + (string-list-map -gen-extract-case (current-sfmt-list)) +) + +; Generate top level decoder. +; INITIAL-BITNUMS is a target supplied list of bit numbers to use to +; build the first decode table. If nil, we compute 8 bits of it (FIXME) +; ourselves. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; FIXME: Need to be perfect for every subtable, or allow target more control. +; Leave for later (and don't give target more control until oodles of effort +; have been spent trying to be perfect! ... or close enough). + +(define (-gen-decode-fn insn-list initial-bitnums lsb0?) + + ; Compute the initial DECODE-BITSIZE as the minimum of all insn lengths. + ; The caller of @cpu@_decode must fetch and pass exactly this number of bits + ; of the instruction. + ; ??? Make this a parameter later but only if necessary. + + (let ((decode-bitsize (apply min (map insn-base-mask-length insn-list)))) + + ; Compute INITIAL-BITNUMS if not supplied. + ; 0 is passed for the start bit (it is independent of lsb0?) + (if (null? initial-bitnums) + (set! initial-bitnums (decode-get-best-bits insn-list nil + 0 ; startbit + 8 ; max + decode-bitsize + lsb0?))) + + ; All set. gen-decoder does the hard part, we just print out the result. + (let ((decode-code (gen-decoder insn-list initial-bitnums + decode-bitsize + " " lsb0? + (current-insn-lookup 'x-invalid)))) + + (string-write + "\ +/* Given an instruction, return a pointer to its IDESC entry. */ + +const IDESC * +@cpu@_decode (SIM_CPU *current_cpu, IADDR pc, + CGEN_INSN_INT base_insn," + (if (adata-integral-insn? CURRENT-ARCH) + " CGEN_INSN_INT entire_insn,\n" + "\n") + "\ + ARGBUF *abuf) +{ + /* Result of decoder. */ + @CPU@_INSN_TYPE itype; + + { + CGEN_INSN_INT insn = base_insn; +\n" + + decode-code + + "\ + } +\n" + + (if (with-scache?) + (string-list "\ + /* The instruction has been decoded, now extract the fields. */\n\n" + -gen-all-extractors) + ; Without the scache, extraction is defered until the semantic code. + (string-list "\ + /* Extraction is defered until the semantic code. */ + + done: + return &" IDESC-TABLE-VAR "[itype];\n")) + + "\ +}\n" + ))) +) + +; Entry point. Generate decode.h. + +(define (cgen-decode.h) + (logit 1 "Generating " (gen-cpu-name) " decode.h ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + (string-write + (gen-copyright "Decode header for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#ifndef @CPU@_DECODE_H +#define @CPU@_DECODE_H + +" + -gen-idesc-decls + (lambda () (gen-cpu-insn-enum-decl (current-cpu) + (non-multi-insns (non-alias-insns (current-insn-list))))) + (lambda () (gen-sfmt-enum-decl (current-sfmt-list))) + gen-model-fn-decls + "#endif /* @CPU@_DECODE_H */\n" + ) +) + +; Entry point. Generate decode.c. + +(define (cgen-decode.c) + (logit 1 "Generating " (gen-cpu-name) " decode.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + ; Tell the rtx->c translator we are the simulator. + (rtl-c-config! #:rtl-cover-fns? #t) + + (string-write + (gen-copyright "Simulator instruction decoder for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#define WANT_CPU @cpu@ +#define WANT_CPU_@CPU@ + +#include \"sim-main.h\" +#include \"sim-assert.h\"\n\n" + + (lambda () (-gen-decode-insn-globals (non-multi-insns (non-alias-insns (current-insn-list))))) + -gen-idesc-init-fn + (lambda () (-gen-decode-fn (non-multi-insns (real-insns (current-insn-list))) + (state-decode-assist) + (current-arch-insn-lsb0?))) + ) +) diff --git a/cgen/sim-model.scm b/cgen/sim-model.scm new file mode 100644 index 00000000000..eb42c93af23 --- /dev/null +++ b/cgen/sim-model.scm @@ -0,0 +1,394 @@ +; Simulator model support, plus misc. things associated with a cpu family. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; Return C code to define cpu implementation properties. + +(define (-gen-cpu-imp-properties) + (string-list + "\ +/* The properties of this cpu's implementation. */ + +static const MACH_IMP_PROPERTIES @cpu@_imp_properties = +{ + sizeof (SIM_CPU), +#if WITH_SCACHE + sizeof (SCACHE) +#else + 0 +#endif +};\n\n" + ) +) + +; Insn modeling support. + +; Generate code to profile hardware elements. +; ??? Not currently used. + +(define (-gen-hw-profile-code) + ; Fetch profilable input and output operands of the semantic code. + (let ((in-ops (find op-profilable? (sfmt-in-ops (insn-sfmt insn)))) + (out-ops (find op-profilable? (sfmt-out-ops (insn-sfmt insn))))) + (string-list + ; For each operand, record its being get/set. + (string-list-map (lambda (op) (send op 'gen-profile-code insn #f)) + in-ops) + (string-list-map (lambda (op) (send op 'gen-profile-code insn #t)) + out-ops) + )) +) + +; Return decls of hardware element profilers. +; ??? Not currently used. + +(define (-gen-hw-profile-decls) + (string-list + "/* Hardware profiling handlers. */\n\n" + (string-list-map (lambda (hw) + (string-append "extern void @cpu@_model_mark_get_" + (gen-sym hw) " (SIM_CPU *" + (if (hw-scalar? hw) + "" + ", int") ; FIXME: get index type + ");\n" + "extern void @cpu@_model_mark_set_" + (gen-sym hw) " (SIM_CPU *" + (if (hw-scalar? hw) + "" + ", int") ; FIXME: get index type + ");\n")) + (find hw-profilable? (current-hw-list))) + "\n" + ) +) + +; Return name of profiling handler for MODEL, UNIT. +; Also called by sim.scm. + +(define (gen-model-unit-fn-name model unit) + (string-append "@cpu@_model_" (gen-sym model) "_" (gen-sym unit)) +) + +; Return decls of all insn model handlers. +; This is called from sim-decode.scm. + +(define (gen-model-fn-decls) + (let ((gen-args (lambda (args) + (gen-c-args (map (lambda (arg) + (string-append + (mode:c-type (mode:lookup (cadr arg))) + " /*" (car arg) "*/")) + (find (lambda (arg) + ; Indices of scalars not passed. + (not (null? (cdr arg)))) + args))))) + ) + + (string-list + ; -gen-hw-profile-decls + "/* Function unit handlers (user written). */\n\n" + (string-list-map + (lambda (model) + (string-list-map (lambda (unit) + (string-append + "extern int " + (gen-model-unit-fn-name model unit) + " (SIM_CPU *, const IDESC *," + " int /*unit_num*/, int /*referenced*/" + (gen-args (unit:inputs unit)) + (gen-args (unit:outputs unit)) + ");\n")) + (model:units model))) + (current-model-list)) + "\n" + "/* Profiling before/after handlers (user written) */\n\n" + "extern void @cpu@_model_insn_before (SIM_CPU *, int /*first_p*/);\n" + "extern void @cpu@_model_insn_after (SIM_CPU *, int /*last_p*/, int /*cycles*/);\n" + "\n" + )) +) + +; Return name of profile handler for INSN, MODEL. + +(define (-gen-model-insn-fn-name model insn) + (string-append "model_" (gen-sym model) "_" (gen-sym insn)) +) + +; Return function to model INSN. + +(define (-gen-model-insn-fn model insn) + (logit 2 "Processing modeling for " (obj:name insn) ": \"" (insn-syntax insn) "\" ...\n") + (string-list + "static int\n" + (-gen-model-insn-fn-name model insn) + ; sem_arg is a void * to keep cgen specific stuff out of sim-model.h + " (SIM_CPU *current_cpu, void *sem_arg)\n" + "{\n" + (if (with-scache?) + (gen-define-field-macro (insn-sfmt insn)) + "") + " const ARGBUF * UNUSED abuf = SEM_ARGBUF ((SEM_ARG) sem_arg);\n" + " const IDESC * UNUSED idesc = abuf->idesc;\n" + ; or: idesc = & CPU_IDESC (current_cpu) [" + ; (gen-cpu-insn-enum (mach-cpu (model:mach model)) insn) + ; "];\n" + " int cycles = 0;\n" + (send insn 'gen-profile-locals model) + (if (with-scache?) + "" + (string-list + " IADDR UNUSED pc = GET_H_PC ();\n" + " CGEN_INSN_INT insn = abuf->insn;\n" + (gen-define-ifmt-ifields (insn-ifmt insn) " " #f #t) + (gen-sfmt-op-argbuf-defns (insn-sfmt insn)) + (gen-extract-ifmt-ifields (insn-ifmt insn) " " #f #t) + (gen-sfmt-op-argbuf-assigns (insn-sfmt insn)))) + ; Emit code to model the insn. Function units are handled here. + (send insn 'gen-profile-code model "cycles") + " return cycles;\n" + (if (with-scache?) + (gen-undef-field-macro (insn-sfmt insn)) + "") + "}\n\n") +) + +; Return insn modeling handlers. +; ??? Might wish to reduce the amount of output by combining identical cases. +; ??? Modelling of insns could be table driven, but that puts constraints on +; generality. + +(define (-gen-model-insn-fns) + (string-write + "/* Model handlers for each insn. */\n\n" + (lambda () (string-write-map + (lambda (model) + (string-write-map + (lambda (insn) (-gen-model-insn-fn model insn)) + (real-insns (current-insn-list)))) + (current-model-list))) + ) +) + +; Generate timing table entry for function unit U while executing INSN. +; U is a <unit> object. +; ARGS is a list of overriding arguments from INSN. + +(define (-gen-insn-unit-timing model insn u args) + (string-append + "{ " + "(int) " (unit:enum u) ", " + (number->string (unit:issue u)) ", " + (let ((cycles (assq-ref args 'cycles))) + (if cycles + (number->string (car cycles)) + (number->string (unit:done u)))) + " }, " + ) +) + +; Generate timing table entry for MODEL for INSN. + +(define (-gen-insn-timing model insn) + ; Instruction timing is stored as an associative list based on the model. + (let ((timing (assq (obj:name model) (insn-timing insn)))) + ;(display timing) (newline) + (string-list + " { " + (gen-cpu-insn-enum (mach-cpu (model:mach model)) insn) + ", " + (if (obj-has-attr? insn 'VIRTUAL) + "0" + (-gen-model-insn-fn-name model insn)) + ", { " + (string-drop + -2 + (if (not timing) + (-gen-insn-unit-timing model insn (model-default-unit model) nil) + (let ((units (timing:units (cdr timing)))) + (string-map (lambda (iunit) + (-gen-insn-unit-timing model insn + (iunit:unit iunit) + (iunit:args iunit))) + units)))) + " } },\n" + )) +) + +; Generate model timing table for MODEL. + +(define (-gen-model-timing-table model) + (string-write + "/* Model timing data for `" (obj:name model) "'. */\n\n" + "static const INSN_TIMING " (gen-sym model) "_timing[] = {\n" + (lambda () (string-write-map (lambda (insn) (-gen-insn-timing model insn)) + (non-alias-insns (current-insn-list)))) + "};\n\n" + ) +) + +; Return C code to define model profiling support stuff. + +(define (-gen-model-profile-data) + (string-write + "/* We assume UNIT_NONE == 0 because the tables don't always terminate\n" + " entries with it. */\n\n" + (lambda () (string-write-map -gen-model-timing-table (current-model-list))) + ) +) + +; Return C code to define the model table for MACH. + +(define (-gen-mach-model-table mach) + (string-list + "\ +static const MODEL " (gen-sym mach) "_models[] =\n{\n" + (string-list-map (lambda (model) + (string-list " { " + "\"" (obj:name model) "\", " + "& " (gen-sym (model:mach model)) "_mach, " + (model:enum model) ", " + "TIMING_DATA (& " + (gen-sym model) + "_timing[0]), " + (gen-sym model) "_model_init" + " },\n")) + (find (lambda (model) (eq? (obj:name mach) + (obj:name (model:mach model)))) + (current-model-list))) + " { 0 }\n" + "};\n\n" + ) +) + +; Return C code to define model init fn. + +(define (-gen-model-init-fn model) + (string-list "\ +static void\n" +(gen-sym model) "_model_init (SIM_CPU *cpu) +{ + CPU_MODEL_DATA (cpu) = (void *) zalloc (sizeof (MODEL_" + (string-upcase (gen-sym model)) + "_DATA)); +}\n\n" + ) +) + +; Return C code to define model data and support fns. + +(define (-gen-model-defns) + (string-write + (lambda () (string-write-map -gen-model-init-fn (current-model-list))) + "#if WITH_PROFILE_MODEL_P +#define TIMING_DATA(td) td +#else +#define TIMING_DATA(td) 0 +#endif\n\n" + (lambda () (string-write-map -gen-mach-model-table (current-mach-list))) + ) +) + +; Return C definitions for this cpu family variant. + +(define (-gen-cpu-defns) + (string-list "\ + +static void +@cpu@_prepare_run (SIM_CPU *cpu) +{ + if (CPU_IDESC (cpu) == NULL) + @cpu@_init_idesc_table (cpu); +} + +static const CGEN_INSN * +@cpu@_get_idata (SIM_CPU *cpu, int inum) +{ + return CPU_IDESC (cpu) [inum].idata; +} + +") +) + +; Return C code to define the machine data. + +(define (-gen-mach-defns) + (string-list-map + (lambda (mach) + (gen-obj-sanitize + mach + (string-list "\ +static void\n" +(gen-sym mach) "_init_cpu (SIM_CPU *cpu) +{ + CPU_REG_FETCH (cpu) = " (gen-sym (mach-cpu mach)) "_fetch_register; + CPU_REG_STORE (cpu) = " (gen-sym (mach-cpu mach)) "_store_register; + CPU_PC_FETCH (cpu) = " (gen-sym (mach-cpu mach)) "_h_pc_get; + CPU_PC_STORE (cpu) = " (gen-sym (mach-cpu mach)) "_h_pc_set; + CPU_GET_IDATA (cpu) = @cpu@_get_idata; + CPU_MAX_INSNS (cpu) = @CPU@_INSN_MAX; + CPU_INSN_NAME (cpu) = cgen_insn_name; + CPU_FULL_ENGINE_FN (cpu) = @cpu@_engine_run_full; +#if WITH_FAST + CPU_FAST_ENGINE_FN (cpu) = @cpu@_engine_run_fast; +#else + CPU_FAST_ENGINE_FN (cpu) = @cpu@_engine_run_full; +#endif +} + +const MACH " (gen-sym mach) "_mach = +{ + \"" (obj:name mach) "\", " + "\"" (mach-bfd-name mach) "\", " + (mach-enum mach) ",\n" + " " (number->string (cpu-word-bitsize (mach-cpu mach))) ", " + ; FIXME: addr-bitsize: delete + (number->string (cpu-word-bitsize (mach-cpu mach))) ", " + "& " (gen-sym mach) "_models[0], " + "& " (gen-sym (mach-cpu mach)) "_imp_properties, + " (gen-sym mach) "_init_cpu, + @cpu@_prepare_run +}; + +"))) + + (current-mach-list)) +) + +; Top level file generators. + +; Generate model.c + +(define (cgen-model.c) + (logit 1 "Generating " (gen-cpu-name) " model.c ...\n") + + (sim-analyze-insns!) + + ; Turn parallel execution support on if cpu needs it. + (set-with-parallel?! (state-parallel-exec?)) + + (string-write + (gen-copyright "Simulator model support for @cpu@." + CURRENT-COPYRIGHT CURRENT-PACKAGE) + "\ +#define WANT_CPU @cpu@ +#define WANT_CPU_@CPU@ + +#include \"sim-main.h\" + +/* The profiling data is recorded here, but is accessed via the profiling + mechanism. After all, this is information for profiling. */ + +#if WITH_PROFILE_MODEL_P + +" + -gen-model-insn-fns + -gen-model-profile-data +"#endif /* WITH_PROFILE_MODEL_P */\n\n" + + -gen-model-defns + -gen-cpu-imp-properties + -gen-cpu-defns + -gen-mach-defns + ) +) diff --git a/cgen/sim-test.scm b/cgen/sim-test.scm new file mode 100644 index 00000000000..42cf2fa32e9 --- /dev/null +++ b/cgen/sim-test.scm @@ -0,0 +1,244 @@ +; CPU description file generator for the simulator testsuite. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; This is invoked to build allinsn.exp and a script to run to +; generate allinsn.s and allinsn.d. + +; Specify which application. +(set! APPLICATION 'SIM-TEST) + +; Called before/after the .cpu file has been read. + +(define (sim-test-init!) (opcodes-init!)) +(define (sim-test-finish!) (opcodes-finish!)) + +; Called after .cpu file has been read and global error checks are done. +; We use the `tmp' member to record the syntax split up into its components. + +(define (sim-test-analyze!) + (opcodes-analyze!) + (map (lambda + (insn) (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn)))) + (current-insn-list)) + *UNSPECIFIED* +) + +; Methods to compute test data. +; The result is a list of strings to be inserted in the assembler +; in the operand's position. + +(method-make! + <hw-asm> 'test-data + (lambda (self n) + ; FIXME: floating point support + (let ((signed (list 0 1 -1 2 -2)) + (unsigned (list 0 1 2 3 4)) + (mode (elm-get self 'mode))) + (map number->string + (list-take n + (if (eq? (mode:class mode) 'UINT) + unsigned + signed))))) +) + +(method-make! + <keyword> 'test-data + (lambda (self n) + (let* ((values (elm-get self 'values)) + (n (min n (length values)))) + ; FIXME: Need to handle mach variants. + (map car (list-take n values)))) +) + +(method-make! + <hw-address> 'test-data + (lambda (self n) + (let ((test-data '("foodata" "4" "footext" "-4"))) + (list-take n test-data))) +) + +(method-make! + <hw-iaddress> 'test-data + (lambda (self n) + (let ((test-data '("footext" "4" "foodata" "-4"))) + (list-take n test-data))) +) + +(method-make-forward! <hw-register> 'indices '(test-data)) +(method-make-forward! <hw-immediate> 'values '(test-data)) + +; This can't use method-make-forward! as we need to call op:type to +; resolve the hardware reference. + +(method-make! + <operand> 'test-data + (lambda (self n) + (send (op:type self) 'test-data n)) +) + +; Given an operand, return a set of N test data. +; e.g. For a keyword operand, return a random subset. +; For a number, return N numbers. + +(define (operand-test-data op n) + (send op 'test-data n) +) + +; Given the broken out assembler syntax string, return the list of operand +; objects. + +(define (extract-operands syntax-list) + (let loop ((result nil) (l syntax-list)) + (cond ((null? l) (reverse result)) + ((object? (car l)) (loop (cons (car l) result) (cdr l))) + (else (loop result (cdr l))))) +) + +; Given a list of operands for an instruction, return the test set +; (all possible combinations). +; N is the number of testcases for each operand. +; The result has N to-the-power (length OP-LIST) elements. + +(define (build-test-set op-list n) + (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list)) + (len (length op-list))) + ; FIXME: Make slicker later. + (cond ((=? len 0) (list (list))) + ((=? len 1) test-data) + (else (list (map car test-data))))) +) + +; Given an assembler expression and a set of operands build a testcase. +; SYNTAX-LIST is a list of syntax elements (characters) and <operand> objects. +; TEST-DATA is a list of strings, one element per operand. +; FIXME: wip + +(define (build-sim-testcase syntax-list test-data) + (logit 3 "Building a testcase for: " + (map (lambda (sl) + (string-append " " + (cond ((string? sl) + sl) + ((operand? sl) + (obj:name sl)) + (else + (with-output-to-string + (lambda () (display sl))))))) + syntax-list) + ", test data: " + (map (lambda (td) (list " " td)) + test-data) + "\n") + (let loop ((result nil) (sl syntax-list) (td test-data)) + ;(display (list result sl td "\n")) + (cond ((null? sl) + (string-append "\t" + (apply string-append (reverse result)) + "\n")) + ((string? (car sl)) + (loop (cons (car sl) result) (cdr sl) td)) + (else (loop (cons (car td) result) (cdr sl) (cdr td))))) +) + +; Generate a set of testcases for INSN. +; FIXME: wip + +(define (gen-sim-test insn) + (logit 2 "Generating sim test set for " (obj:name insn) " ...\n") + (string-append + "\t.global " (gen-sym insn) "\n" + (gen-sym insn) ":\n" + (let* ((syntax-list (insn-tmp insn)) + (op-list (extract-operands syntax-list)) + (test-set (build-test-set op-list 2))) + (string-map (lambda (test-data) + (build-sim-testcase syntax-list test-data)) + test-set)) + ) +) + +; Generate the shell script that builds the .cgs files. +; .cgs are .s files except that there may be other .s files in the directory +; and we want the .exp driver script to easily find the files. +; +; Eventually it would be nice to generate as much of the testcase as possible. +; For now we just generate the template and leave the programmer to fill in +; the guts of the test (i.e. set up various registers, execute the insn to be +; tested, and then verify the results). +; Clearly some hand generated testcases will also be needed, but this +; provides a good start for each instruction. + +(define (cgen-build.sh) + (logit 1 "Generating sim-build.sh ...\n") + (string-append + "\ +#/bin/sh +# Generate test result data for " (current-arch-name) " simulator testing. +# This script is machine generated. +# It is intended to be run in the testsuite source directory. +# +# Syntax: /bin/sh sim-build.sh + +# Put results here, so we preserve the existing set for comparison. +rm -rf tmpdir +mkdir tmpdir +cd tmpdir +\n" + + (string-map (lambda (insn) + (string-append + "cat <<EOF > " (gen-file-name (obj:name insn)) ".cgs\n" + ; FIXME: Need to record assembler line comment char in .cpu. + "# " (current-arch-name) " testcase for " (backslash "$" (insn-syntax insn)) "\n" + "# mach: " + (let ((machs (insn-machs insn))) + (if (null? machs) + "all" + (string-drop1 (string-map (lambda (mach) + (string-append "," mach)) + machs)))) + "\n\n" + "\t.include \"testutils.inc\"\n\n" + "\tstart\n\n" + (gen-sim-test insn) + "\n\tpass\n" + "EOF\n\n")) + (non-alias-insns (current-insn-list))) + ) +) + +; Generate the dejagnu allinsn.exp file that drives the tests. + +(define (cgen-allinsn.exp) + (logit 1 "Generating sim-allinsn.exp ...\n") + (string-append + "\ +# " (string-upcase (current-arch-name)) " simulator testsuite. + +if [istarget " (current-arch-name) "*-*-*] { + # load support procs (none yet) + # load_lib cgen.exp + + # all machines + set all_machs \"" + (string-drop1 (string-map (lambda (m) + (string-append " " + (gen-sym m))) + (current-mach-list))) + "\" + + # The .cgs suffix is for \"cgen .s\". + foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.cgs]] { + # If we're only testing specific files and this isn't one of them, + # skip it. + if ![runtest_file_p $runtests $src] { + continue + } + + run_sim_test $src $all_machs + } +}\n" + ) +) diff --git a/cgen/sim.scm b/cgen/sim.scm new file mode 100644 index 00000000000..7f2b6b0a92f --- /dev/null +++ b/cgen/sim.scm @@ -0,0 +1,2019 @@ +; Simulator generator support routines. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. + +; One goal of this file is to provide cover functions for all methods. +; i.e. this file fills in the missing pieces of the interface between +; the application independent part of CGEN (i.e. the code loaded by read.scm) +; and the application dependent part (i.e. sim-*.scm). +; `send' is not intended to appear in sim-*.scm. +; [It still does but that's to be fixed.] + +; Specify which application. +(set! APPLICATION 'SIMULATOR) + +; Cover functions for various methods. + +; Return the C type of something. This isn't always a mode. + +(define (gen-type self) (send self 'gen-type)) + +; Return the C type of an index's value or #f if not needed (scalar). + +(define (gen-index-type op sfmt) + (let ((index-mode (send op 'get-index-mode))) + (if index-mode + (mode:c-type index-mode) + #f)) +) + +; Misc. state info. + +; Currently supported options: +; with-scache +; generate code to use the scache +; This is an all or nothing option, either scache is used or it's not. +; with-profile fn|sw +; generate code to do profiling in the semantic function +; code (fn) or in the semantic switch (sw) +; with-generic-write +; For architectures that have parallel execution. +; Execute the semantics by recording the results in a generic buffer, +; and doing a post-semantics writeback pass. +; with-parallel-only +; Only generate parallel versions of each insn. +; copyright fsf|cygnus +; emit an FSF or Cygnus copyright (temporary, pending decision) +; package gnusim|cygsim +; indicate the software package + +; #t if the scache is being used +(define -with-scache? #f) +(define (with-scache?) -with-scache?) + +; #t if we're generating profiling code +; Each of the function and switch semantic code can have profiling. +; The options as passed are stored in -with-profile-{fn,sw}?, and +; -with-profile? is set at code generation time. +(define -with-profile-fn? #f) +(define -with-profile-sw? #f) +(define -with-profile? #f) +(define (with-profile?) -with-profile?) +(define (with-any-profile?) (or -with-profile-fn? -with-profile-sw?)) + +; Handle parallel execution with generic writeback pass. +(define -with-generic-write? #f) +(define (with-generic-write?) -with-generic-write?) + +; Only generate parallel versions of each insn. +(define -with-parallel-only? #f) +(define (with-parallel-only?) -with-parallel-only?) + +; String containing copyright text. +(define CURRENT-COPYRIGHT #f) + +; String containing text defining the package we're generating code for. +(define CURRENT-PACKAGE #f) + +; Initialize the options. + +(define (option-init!) + (set! -with-scache? #f) + (set! -with-profile-fn? #f) + (set! -with-profile-sw? #f) + (set! -with-generic-write? #f) + (set! -with-parallel-only? #f) + (set! CURRENT-COPYRIGHT copyright-fsf) + (set! CURRENT-PACKAGE package-gnu-simulators) + *UNSPECIFIED* +) + +; Handle an option passed in from the command line. + +(define (option-set! name value) + (case name + ((with-scache) (set! -with-scache? #t)) + ((with-profile) (cond ((equal? value '("fn")) + (set! -with-profile-fn? #t)) + ((equal? value '("sw")) + (set! -with-profile-sw? #t)) + (else (error "invalid with-profile value" value)))) + ((with-generic-write) (set! -with-generic-write? #t)) + ((with-parallel-only) (set! -with-parallel-only? #t)) + ((copyright) (cond ((equal? value '("fsf")) + (set! CURRENT-COPYRIGHT copyright-fsf)) + ((equal? value '("cygnus")) + (set! CURRENT-COPYRIGHT copyright-cygnus)) + (else (error "invalid copyright value" value)))) + ((package) (cond ((equal? value '("gnusim")) + (set! CURRENT-PACKAGE package-gnu-simulators)) + ((equal? value '("cygsim")) + (set! CURRENT-PACKAGE package-cygnus-simulators)) + (else (error "invalid package value" value)))) + (else (error "unknown option" name)) + ) + *UNSPECIFIED* +) + +; #t if the cpu can execute insns parallely. +; This one isn't passed on the command line, but we follow the convention +; of prefixing these things with `with-'. +; While processing operand reading (or writing), parallel execution support +; needs to be turned off, so it is up to the appropriate cgen-foo.c proc to +; set-with-parallel?! appropriately. +(define -with-parallel? #f) +(define (with-parallel?) -with-parallel?) +(define (set-with-parallel?! flag) (set! -with-parallel? flag)) + +; Kind of parallel support. +; If 'read, read pre-processing is done. +; If 'write, write post-processing is done. +; ??? At present we always use write post-processing, though the previous +; version used read pre-processing. Not sure supporting both is useful +; in the long run. +(define -with-parallel-kind 'write) +; #t if parallel support is provided by read pre-processing. +(define (with-parallel-read?) + (and -with-parallel? (eq? -with-parallel-kind 'read)) +) +; #t if parallel support is provided by write post-processing. +(define (with-parallel-write?) + (and -with-parallel? (eq? -with-parallel-kind 'write)) +) + +; Misc. utilities. + +; All machine generated cpu elements are accessed through a cover macro +; to hide the details of the underlying implementation. + +(define c-cpu-macro "CPU") + +(define (gen-cpu-ref sym) + (string-append c-cpu-macro " (" sym ")") +) + +; Instruction field support code. + +; Return a <c-expr> object of the value of an ifield. + +(define (-cxmake-ifld-val mode f) + (if (with-scache?) + ; ??? Perhaps a better way would be to defer evaluating the src of a + ; set until the method processing the dest. + (cx:make-with-atlist mode (gen-ifld-argbuf-ref f) + (atlist-make "" (bool-attr-make 'CACHED #t))) + (cx:make mode (gen-extracted-ifld-value f))) +) + +; Type system. + +; Methods: +; gen-type - return C code representing the type +; gen-sym-decl - generate decl using the provided symbol +; gen-sym-get-macro - generate GET macro for accessing CPU elements +; gen-sym-set-macro - generate SET macro for accessing CPU elements + +; Scalar type + +(method-make! + <scalar> 'gen-type + (lambda (self) (mode:c-type (elm-get self 'mode))) +) + +(method-make! + <scalar> 'gen-sym-decl + (lambda (self sym comment) + (string-append + " /* " comment " */\n" + " " (send self 'gen-type) " " + (gen-c-symbol sym) ";\n")) +) + +(method-make! + <scalar> 'gen-sym-get-macro + (lambda (self sym comment) + (let ((sym (gen-c-symbol sym))) + (gen-get-macro sym "" (gen-cpu-ref sym)))) +) + +(method-make! + <scalar> 'gen-sym-set-macro + (lambda (self sym comment) + (let ((sym (gen-c-symbol sym))) + (gen-set-macro sym "" (gen-cpu-ref sym)))) +) + +(method-make! <scalar> 'gen-ref (lambda (self sym index estate) sym)) + +; Array type + +(method-make! + <array> 'gen-type + (lambda (self) (mode:c-type (elm-get self 'mode))) +) + +(method-make! + <array> 'gen-sym-decl + (lambda (self sym comment) + (string-append + " /* " comment " */\n" + " " (send self 'gen-type) " " + (gen-c-symbol sym) + (gen-array-ref (elm-get self 'dimensions)) + ";\n") + ) +) + +(method-make! + <array> 'gen-sym-get-macro + (lambda (self sym comment) + (let ((sym (gen-c-symbol sym)) + (rank (length (elm-get self 'dimensions)))) + (string-append + "#define GET_" (string-upcase sym) + "(" (string-drop 2 (gen-macro-args rank)) ") " + (gen-cpu-ref sym) (gen-array-ref (macro-args rank)) "\n" + ))) +) + +(method-make! + <array> 'gen-sym-set-macro + (lambda (self sym comment) + (let ((sym (gen-c-symbol sym)) + (rank (length (elm-get self 'dimensions)))) + (string-append + "#define SET_" (string-upcase sym) + "(" (string-drop 2 (gen-macro-args rank)) ", x) " + "(" (gen-cpu-ref sym) (gen-array-ref (macro-args rank)) + " = (x))\n" + ))) +) + +; Return a reference to the array. +; SYM is the name of the array. +; INDEX is either a single index object or a (possibly empty) list of objects, +; one object per dimension. + +(method-make! + <array> 'gen-ref + (lambda (self sym index estate) + (let ((gen-index1 (lambda (idx) + (string-append "[" + (-gen-hw-index idx estate) + "]")))) + (string-append sym + (cond ((list? index) (string-map gen-index1 index)) + (else (gen-index1 index)))))) +) + +; Integers +; +;(method-make! +; <integer> 'gen-type +; (lambda (self) +; (mode:c-type (mode-find (elm-get self 'bits) +; (if (has-attr? self 'UNSIGNED) +; 'UINT 'INT))) +; ) +;) +; +;(method-make! <integer> 'gen-sym-decl (lambda (self sym comment) "")) +;(method-make! <integer> 'gen-sym-get-macro (lambda (self sym comment) "")) +;(method-make! <integer> 'gen-sym-set-macro (lambda (self sym comment) "")) + +; Hardware descriptions support code. +; +; Various operations are required for each h/w object to support the various +; things the simulator will want to do with it. +; +; Methods: +; gen-decl +; gen-get-macro - Generate definition of the GET access macro. +; gen-set-macro - Generate definition of the SET access macro. +; gen-write - Same as gen-read except done on output operands +; cxmake-get - Return a <c-expr> object to fetch the value. +; gen-set-quiet - Set the value. +; ??? Could just call this gen-set as there is no gen-set-trace +; but for consistency with the messages passed to operands +; we use this same. +; gen-type - C type to use to record value. +; ??? Delete and just use get-mode? +; save-index? - return #t if an index needs to be saved for parallel +; execution post-write processing +; gen-profile-decl +; gen-record-profile +; get-mode +; gen-profile-locals +; gen-sym-decl - Return a C declaration using the provided symbol. +; gen-sym-get-macro - Generate default GET access macro. +; gen-sym-set-macro - Generate default SET access macro. +; gen-ref - Return a C reference to the object. + +; Generate CPU state struct entries. + +(method-make! + <hardware-base> 'gen-decl + (lambda (self) + (send self 'gen-sym-decl (obj:name self) (obj:comment self))) +) + +(method-make-virtual! <hardware-base> 'gen-sym-decl (lambda (self sym comment) "")) + +; Return a C reference to a hardware object. + +(method-make! <hardware-base> 'gen-ref (lambda (self sym index estate) sym)) + +; Each hardware type must provide its own gen-write method. + +(method-make! + <hardware-base> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (error "gen-write method not overridden:" self)) +) + +; gen-type handler, must be overridden + +(method-make-virtual! + <hardware-base> 'gen-type + (lambda (self) (error "gen-type not overridden:" self)) +) + +(method-make! <hardware-base> 'gen-profile-decl (lambda (self) "")) + +; Default gen-record-profile method. + +(method-make! + <hardware-base> 'gen-record-profile + (lambda (self index sfmt estate) + "") ; nothing to do +) + +; Default cxmake-get method. +; Return a <c-expr> object of the value of SELF. +; ESTATE is the current rtl evaluator state. +; INDEX is a <hw-index> object. It must be an ifield. +; SELECTOR is a hardware selector RTX. + +(method-make! + <hardware-base> 'cxmake-get + (lambda (self estate mode index selector) + (if (not (eq? 'ifield (hw-index:type index))) + (error "not an ifield hw-index" index)) + (-cxmake-ifld-val mode (hw-index:value index))) +) + +; Handle gen-get-macro/gen-set-macro. + +(method-make! + <hardware-base> 'gen-get-macro + (lambda (self) + "") +) + +(method-make! + <hardware-base> 'gen-set-macro + (lambda (self) + "") +) + +; PC support + +; 'gen-set-quiet helper for PC values. +; NEWVAL is a <c-expr> object of the value to be assigned. +; If OPTIONS contains #:direct, set the PC directly, bypassing semantic +; code considerations. +; ??? OPTIONS support wip. Probably want a new form (or extend existing form) +; of rtx: that takes a variable number of named arguments. +; ??? Another way to get #:direct might be (raw-reg h-pc). + +(define (-hw-gen-set-quiet-pc self estate mode index selector newval . options) + (if (not (send self 'pc?)) (error "Not a PC:" self)) + (cond ((memq #:direct options) + (-hw-gen-set-quiet self estate mode index selector newval)) + ((has-attr? newval 'CACHED) + (string-append "SEM_BRANCH_VIA_CACHE (current_cpu, sem_arg, " + (cx:c newval) + ", vpc);\n")) + (else + (string-append "SEM_BRANCH_VIA_ADDR (current_cpu, sem_arg, " + (cx:c newval) + ", vpc);\n"))) +) + +(method-make! <hw-pc> 'gen-set-quiet -hw-gen-set-quiet-pc) + +; Handle updates of the pc during parallel execution. +; This is done in a post-processing pass after semantic evaluation. +; SFMT is the <sformat>. +; OP is the operand. +; ACCESS-MACRO is the runtime C macro to use to fetch indices computed +; during semantic evaluation. +; +; ??? This wouldn't be necessary if gen-set-quiet were a virtual method. +; At this point I'm reluctant to willy nilly make methods virtual. + +(method-make! + <hw-pc> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (string-append " " + (send self 'gen-set-quiet estate VOID index hw-selector-default + (cx:make DFLT (string-append access-macro + " (" (gen-sym op) ")"))))) +) + +(method-make! + <hw-pc> 'cxmake-skip + (lambda (self estate yes?) + (cx:make VOID + (string-append "if (" + yes? + ")\n" + " SEM_SKIP_INSN (current_cpu, sem_arg, vpc);\n"))) +) + +; Registers. + +; Forward these methods onto TYPE. +(method-make-virtual-forward! <hw-register> 'type '(gen-type gen-sym-decl)) +(method-make-forward! <hw-register> 'type '(gen-ref + gen-sym-get-macro + gen-sym-set-macro)) + +; For parallel instructions supported by queueing outputs for later update, +; return a boolean indicating if an index needs to be recorded. +; An example of when the index isn't needed is if the index can be determined +; during extraction. + +(method-make! + <hw-register> 'save-index? + (lambda (self op) + ; FIXME: Later handle case where register number is determined at runtime. + #f) +) + +; Handle updates of registers during parallel execution. +; This is done in a post-processing pass after semantic evaluation. +; SFMT is the <sformat>. +; OP is the <operand>. +; ACCESS-MACRO is the runtime C macro to use to fetch indices computed +; during semantic evaluation. +; FIXME: May need mode of OP. + +(method-make! + <hw-register> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + ; First get a hw-index object to use during indexing. + ; Some indices, e.g. memory addresses, are computed during semantic + ; evaluation. Others are computed during the extraction phase. + (let ((index (send index 'get-write-index self sfmt op access-macro))) + (string-append " " + (send self 'gen-set-quiet estate mode index hw-selector-default + (cx:make DFLT (string-append access-macro + " (" (gen-sym op) ")")))))) +) + +(method-make! + <hw-register> 'gen-profile-decl + (lambda (self) + (string-append + " /* " (obj:comment self) " */\n" + " unsigned long " (gen-c-symbol (obj:name self)) ";\n")) +) + +(method-make! + <hw-register> 'gen-record-profile + (lambda (self index sfmt estate) + ; FIXME: Need to handle scalars. + (-gen-hw-index-raw index estate)) +) + +(method-make! + <hw-register> 'gen-get-macro + (lambda (self) + (let ((getter (elm-get self 'get)) + (mode (send self 'get-mode))) + (if getter + (let ((args (car getter)) + (expr (cadr getter))) + (gen-get-macro (gen-sym self) + (if (hw-scalar? self) "" "index") + (rtl-c mode expr + (if (hw-scalar? self) + nil + (list (list (car args) 'UINT "index"))) + #:rtl-cover-fns? #t))) + (send self 'gen-sym-get-macro + (obj:name self) (obj:comment self))))) +) + +(method-make! + <hw-register> 'gen-set-macro + (lambda (self) + (let ((setter (elm-get self 'set)) + (mode (send self 'get-mode))) + (if setter + (let ((args (car setter)) + (expr (cadr setter))) + (gen-set-macro2 (gen-sym self) + (if (hw-scalar? self) + "" + "index") + "x" + (rtl-c VOID ; not `mode', sets have mode VOID + expr + (if (hw-scalar? self) + (list (list (car args) (hw-mode self) "(x)")) + (list (list (car args) 'UINT "(index)") + (list (cadr args) (hw-mode self) "(x)"))) + #:rtl-cover-fns? #t #:macro? #t))) + (send self 'gen-sym-set-macro + (obj:name self) (obj:comment self))))) +) + +; Utility to build a <c-expr> object to fetch the value of a register. + +(define (-hw-cxmake-get hw estate mode index selector) + (let ((mode (if (mode:eq? 'DFLT mode) + (send hw 'get-mode) + mode)) + (getter (hw-getter hw))) + ; If the register is accessed via a cover function/macro, do it. + ; Otherwise fetch the value from the cached address or from the CPU struct. + (cx:make mode + (cond (getter + (let ((scalar? (hw-scalar? hw)) + (c-index (-gen-hw-index index estate))) + (string-append "GET_" + (string-upcase (gen-sym hw)) + " (" + (if scalar? "" c-index) + ")"))) + ((and (hw-cache-addr? hw) ; FIXME: redo test + (eq? 'ifield (hw-index:type index))) + (string-append + "* " + (if (with-scache?) + (gen-hw-index-argbuf-ref index) + (gen-hw-index-argbuf-name index)))) + (else (gen-cpu-ref (send hw 'gen-ref + (gen-sym hw) index estate)))))) +) + +(method-make! <hw-register> 'cxmake-get -hw-cxmake-get) + +; raw-reg: support +; ??? raw-reg: support is wip + +(method-make! + <hw-register> 'cxmake-get-raw + (lambda (self estate mode index selector) + (let ((mode (if (mode:eq? 'DFLT mode) + (send self 'get-mode) + mode))) + (cx:make mode (gen-cpu-ref (send self 'gen-ref + (gen-sym self) index estate))))) +) + +; Utilities to generate C code to assign a variable to a register. + +(define (-hw-gen-set-quiet hw estate mode index selector newval) + (let ((setter (hw-setter hw))) + (cond (setter + (let ((scalar? (hw-scalar? hw)) + (c-index (-gen-hw-index index estate))) + (string-append "SET_" + (string-upcase (gen-sym hw)) + " (" + (if scalar? "" (string-append c-index ", ")) + (cx:c newval) + ");\n"))) + ((and (hw-cache-addr? hw) ; FIXME: redo test + (eq? 'ifield (hw-index:type index))) + (string-append "* " + (if (with-scache?) + (gen-hw-index-argbuf-ref index) + (gen-hw-index-argbuf-name index)) + " = " (cx:c newval) ";\n")) + (else (string-append (gen-cpu-ref (send hw 'gen-ref + (gen-sym hw) index estate)) + " = " (cx:c newval) ";\n")))) +) + +(method-make! <hw-register> 'gen-set-quiet -hw-gen-set-quiet) + +; raw-reg: support +; ??? wip + +(method-make! + <hw-register> 'gen-set-quiet-raw + (lambda (self estate mode index selector newval) + (string-append (gen-cpu-ref (send self 'gen-ref + (gen-sym self) index estate)) + " = " (cx:c newval) ";\n")) +) + +; Return name of C access function for getting/setting a register. + +(define (gen-reg-getter-fn hw prefix) + (string-append prefix "_" (gen-sym hw) "_get") +) + +(define (gen-reg-setter-fn hw prefix) + (string-append prefix "_" (gen-sym hw) "_set") +) + +; Generate decls for access fns of register HW, beginning with +; PREFIX, using C type TYPE. +; SCALAR? is #t if the register is a scalar. Otherwise it is #f and the +; register is a bank of registers. + +(define (gen-reg-access-decl hw prefix type scalar?) + (string-append + type " " + (gen-reg-getter-fn hw prefix) + " (SIM_CPU *" + (if scalar? "" ", UINT") + ");\n" + "void " + (gen-reg-setter-fn hw prefix) + " (SIM_CPU *, " + (if scalar? "" "UINT, ") + type ");\n" + ) +) + +; Generate defns of access fns of register HW, beginning with +; PREFIX, using C type TYPE. +; SCALAR? is #t if the register is a scalar. Otherwise it is #f and the +; register is a bank of registers. +; GET/SET-CODE are C fragments to get/set the value. +; ??? Inlining left for later. + +(define (gen-reg-access-defn hw prefix type scalar? get-code set-code) + (string-append + "/* Get the value of " (obj:name hw) ". */\n\n" + type "\n" + (gen-reg-getter-fn hw prefix) + " (SIM_CPU *current_cpu" + (if scalar? "" ", UINT regno") + ")\n{\n" + get-code + "}\n\n" + "/* Set a value for " (obj:name hw) ". */\n\n" + "void\n" + (gen-reg-setter-fn hw prefix) + " (SIM_CPU *current_cpu, " + (if scalar? "" "UINT regno, ") + type " newval)\n" + "{\n" + set-code + "}\n\n") +) + +; Memory support. + +(method-make! + <hw-memory> 'cxmake-get + (lambda (self estate mode index selector) + (let ((mode (if (mode:eq? 'DFLT mode) + (hw-mode self) + mode)) + (default-selector? (hw-selector-default? selector))) + (cx:make mode + (string-append "GETMEM" (obj:name mode) + (if default-selector? "" "ASI") + " (" + "current_cpu, pc, " + (-gen-hw-index index estate) + (if default-selector? + "" + (string-append ", " + (-gen-hw-selector selector))) + ")")))) +) + +(method-make! + <hw-memory> 'gen-set-quiet + (lambda (self estate mode index selector newval) + (let ((mode (if (mode:eq? 'DFLT mode) + (hw-mode self) + mode)) + (default-selector? (hw-selector-default? selector))) + (string-append "SETMEM" (obj:name mode) + (if default-selector? "" "ASI") + " (" + "current_cpu, pc, " + (-gen-hw-index index estate) + (if default-selector? + "" + (string-append ", " + (-gen-hw-selector selector))) + ", " (cx:c newval) ");\n"))) +) + +(method-make-virtual-forward! <hw-memory> 'type '(gen-type)) +(method-make-virtual! <hw-memory> 'gen-sym-decl (lambda (self sym comment) "")) +(method-make! <hw-memory> 'gen-sym-get-macro (lambda (self sym comment) "")) +(method-make! <hw-memory> 'gen-sym-set-macro (lambda (self sym comment) "")) + +; For parallel instructions supported by queueing outputs for later update, +; return the type of the index or #f if not needed. + +(method-make! + <hw-memory> 'save-index? + (lambda (self op) + ; In the case of the complete memory address being an immediate + ; argument, we can return #f (later). + AI) +) + +(method-make! + <hw-memory> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (let ((index (send index 'get-write-index self sfmt op access-macro))) + (string-append " " + (send self 'gen-set-quiet estate mode index + hw-selector-default + (cx:make DFLT (string-append access-macro " (" + (gen-sym op) + ")")))))) +) + +; Immediates, addresses. + +; Forward these methods onto TYPE. +(method-make-virtual-forward! <hw-immediate> 'type '(gen-type gen-sym-decl)) +(method-make-forward! <hw-immediate> 'type '(gen-sym-get-macro + gen-sym-set-macro)) + +(method-make! + <hw-immediate> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (error "gen-write of <hw-immediate> shouldn't happen")) +) + +; FIXME. +(method-make-virtual! <hw-address> 'gen-type (lambda (self) "ADDR")) +(method-make-virtual! <hw-address> 'gen-sym-decl (lambda (self sym comment) "")) +(method-make! <hw-address> 'gen-sym-get-macro (lambda (self sym comment) "")) +(method-make! <hw-address> 'gen-sym-set-macro (lambda (self sym comment) "")) + +; Return a <c-expr> object of the value of SELF. +; ESTATE is the current rtl evaluator state. +; INDEX is a hw-index object. It must be an ifield. +; Needed because we record our own copy of the ifield in ARGBUF. +; SELECTOR is a hardware selector RTX. + +(method-make! + <hw-address> 'cxmake-get + (lambda (self estate mode index selector) + (if (not (eq? 'ifield (hw-index:type index))) + (error "not an ifield hw-index" index)) + (if (with-scache?) + (cx:make mode (gen-hw-index-argbuf-ref index)) + (cx:make mode (gen-hw-index-argbuf-name index)))) +) + +(method-make! + <hw-address> 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (error "gen-write of <hw-address> shouldn't happen")) +) + +; FIXME: revisit. +(method-make-virtual! <hw-iaddress> 'gen-type (lambda (self) "IADDR")) + +; Return a <c-expr> object of the value of SELF. +; ESTATE is the current rtl evaluator state. +; INDEX is a <hw-index> object. It must be an ifield. +; Needed because we record our own copy of the ifield in ARGBUF, +; *and* because we want to record in the result the 'CACHED attribute +; since instruction addresses based on ifields are fixed [and thus cacheable]. +; SELECTOR is a hardware selector RTX. + +(method-make! + <hw-iaddress> 'cxmake-get + (lambda (self estate mode index selector) + (if (not (eq? 'ifield (hw-index:type index))) + (error "not an ifield hw-index" index)) + (if (with-scache?) + ; ??? Perhaps a better way would be to defer evaluating the src of a + ; set until the method processing the dest. + (cx:make-with-atlist mode (gen-hw-index-argbuf-ref index) + (atlist-make "" (bool-attr-make 'CACHED #t))) + (cx:make mode (gen-hw-index-argbuf-name index)))) +) + +; Hardware index support code. + +; Return the index to use by the gen-write method. +; In the cases where this is needed (the index isn't known until insn +; execution time), the index is computed along with the value to be stored, +; so this is easy. + +(method-make! + <hw-index> 'get-write-index + (lambda (self hw sfmt op access-macro) + (if (memq (hw-index:type self) '(scalar constant str-expr ifield)) + self + (let ((index-mode (send hw 'get-index-mode))) + (if index-mode + (make <hw-index> 'anonymous 'str-expr index-mode + (string-append access-macro " (" (-op-index-name op) ")")) + (hw-index-scalar))))) +) + +; Return the name of the PAREXEC structure member holding a hardware index +; for operand OP. + +(define (-op-index-name op) + (string-append (gen-sym op) "_idx") +) + +; Cover fn to hardware indices to generate the actual C code. +; INDEX is the hw-index object (i.e. op:index). +; The result is a string of C code. +; FIXME:wip + +(define (-gen-hw-index-raw index estate) + (let ((type (hw-index:type index)) + (mode (hw-index:mode index)) + (value (hw-index:value index))) + (case type + ((scalar) "") + ; special case UINT to cut down on unnecessary verbosity. + ; ??? May wish to handle more similarily. + ((constant) (if (mode:eq? 'UINT mode) + (number->string value) + (string-append "((" (mode:c-type mode) ") " + (number->string value) + ")"))) + ((str-expr) value) + ((rtx) (rtl-c-with-estate estate mode value)) + ((ifield) (if (= (ifld-length value) 0) + "" + (gen-extracted-ifld-value value))) + ((operand) (cx:c (send value 'cxmake-get estate mode (op:index value) + (op:selector value) #f))) + (else (error "-gen-hw-index-raw: invalid index:" index)))) +) + +; Same as -gen-hw-index-raw except used where speedups are possible. +; e.g. doing array index calcs at extraction time. + +(define (-gen-hw-index index estate) + (let ((type (hw-index:type index)) + (mode (hw-index:mode index)) + (value (hw-index:value index))) + (case type + ((scalar) "") + ((constant) (string-append "((" (mode:c-type mode) ") " + (number->string value) + ")")) + ((str-expr) value) + ((rtx) (rtl-c-with-estate estate mode value)) + ((ifield) (if (= (ifld-length value) 0) + "" + (cx:c (-cxmake-ifld-val mode value)))) + ((operand) (cx:c (send value 'cxmake-get estate mode (op:index value) + (op:selector value)))) + (else (error "-gen-hw-index: invalid index:" index)))) +) + +; Return address where HW is stored. + +(define (-gen-hw-addr hw estate index) + (let ((setter (hw-setter hw))) + (cond ((and (hw-cache-addr? hw) ; FIXME: redo test + (eq? 'ifield (hw-index:type index))) + (if (with-scache?) + (gen-hw-index-argbuf-ref index) + (gen-hw-index-argbuf-name index))) + (else + (string-append "& " + (gen-cpu-ref (send hw 'gen-ref + (gen-sym hw) index estate)))))) +) + +; Return a <c-expr> object of the value of a hardware index. + +(method-make! + <hw-index> 'cxmake-get + (lambda (self estate mode) + (let ((mode (if (mode:eq? 'DFLT mode) (elm-get self 'mode) mode))) + ; If MODE is VOID, abort. + (if (mode:eq? 'VOID mode) + (error "hw-index:cxmake-get: result needs a mode" self)) + (cx:make (if (mode:host? mode) + ; FIXME: Temporary hack to generate same code as before. + (let ((xmode (object-copy-top mode))) + (obj-cons-attr! xmode (bool-attr-make 'FORCE-C #t)) + xmode) + mode) + (-gen-hw-index self estate)))) +) + +; Hardware selector support code. + +; Generate C code for SEL. + +(define (-gen-hw-selector sel) + (rtl-c 'INT sel nil) +) + +; Instruction operand support code. + +; Methods: +; gen-type - Return C type to use to hold operand's value. +; gen-read - Record an operand's value prior to parallely executing +; several instructions. Not used if gen-write used. +; gen-write - Write back an operand's value after parallely executing +; several instructions. Not used if gen-read used. +; cxmake-get - Return C code to fetch the value of an operand. +; gen-set-quiet - Return C code to set the value of an operand. +; gen-set-trace - Return C code to set the value of an operand, and print +; a result trace message. ??? Ideally this will go away when +; trace record support is complete. + +; Return the C type of an operand. +; Generally we forward things on to TYPE, but for the actual type we need to +; use the get-mode method. + +;(method-make-forward! <operand> 'type '(gen-type)) +(method-make! + <operand> 'gen-type + (lambda (self) + ; First get the mode. + (let ((mode (send self 'get-mode))) + ; If it's VOID use the type's type. + (if (mode:eq? 'DFLT mode) + (send (op:type self) 'gen-type) + (mode:c-type mode)))) +) + +; Extra pc operand methods. + +(method-make! + <pc> 'cxmake-get + (lambda (self estate mode index selector) + (let ((mode (if (mode:eq? 'DFLT mode) + (send self 'get-mode) + mode))) + ; The enclosing function must set `pc' to the correct value. + (cx:make mode "pc"))) +) + +(method-make! + <pc> 'cxmake-skip + (lambda (self estate yes?) + (send (op:type self) 'cxmake-skip estate + (rtl-c INT yes? nil #:rtl-cover-fns? #t))) +) + +; For parallel write post-processing, we don't want to defer setting the pc. +; ??? Not sure anymore. +;(method-make! +; <pc> 'gen-set-quiet +; (lambda (self estate mode index selector newval) +; (-op-gen-set-quiet self estate mode index selector newval))) +;(method-make! +; <pc> 'gen-set-trace +; (lambda (self estate mode index selector newval) +; (-op-gen-set-trace self estate mode index selector newval))) + +; Name of C macro to access parallel execution operand support. + +(define -par-operand-macro "OPRND") + +; Return C code to fetch an operand's value and save it away for the +; semantic handler. This is used to handle parallel execution of several +; instructions where all inputs of all insns are read before any outputs are +; written. +; For operands, the word `read' is only used in this context. + +(define (op:read op sfmt) + (let ((estate (estate-make-for-normal-rtl-c nil nil))) + (send op 'gen-read estate sfmt -par-operand-macro)) +) + +; Return C code to write an operand's value. +; This is used to handle parallel execution of several instructions where all +; outputs are written to temporary spots first, and then a final +; post-processing pass is run to update cpu state. +; For operands, the word `write' is only used in this context. + +(define (op:write op sfmt) + (let ((estate (estate-make-for-normal-rtl-c nil nil))) + (send op 'gen-write estate sfmt -par-operand-macro)) +) + +; Default gen-read method. +; This is used to help support targets with parallel insns. +; Either this or gen-write (but not both) is used. + +(method-make! + <operand> 'gen-read + (lambda (self estate sfmt access-macro) + (string-append " " + access-macro " (" + (gen-sym self) + ") = " + ; Pass #f for the index -> use the operand's builtin index. + ; Ditto for the selector. + (cx:c (send self 'cxmake-get estate DFLT #f #f)) + ";\n")) +) + +; Forward gen-write onto the <hardware> object. + +(method-make! + <operand> 'gen-write + (lambda (self estate sfmt access-macro) + (let ((write-back-code (send (op:type self) 'gen-write estate + (op:index self) (op:mode self) + sfmt self access-macro))) + ; If operand is conditionally written, we have to check that first. + ; ??? If two (or more) operands are written based on the same condition, + ; all the tests can be collapsed together. Not sure that's a big + ; enough win yet. + (if (op:cond? self) + (string-append " if (written & (1 << " + (number->string (op:num self)) + "))\n" + " {\n" + " " write-back-code + " }\n") + write-back-code))) +) + +; Return <c-expr> object to get the value of an operand. +; ESTATE is the current rtl evaluator state. +; If INDEX is non-#f use it, otherwise use (op:index self). +; This special handling of #f for INDEX is *only* supported for operands +; in cxmake-get, gen-set-quiet, and gen-set-trace. +; Ditto for SELECTOR. + +(method-make! + <operand> 'cxmake-get + (lambda (self estate mode index selector) + (let ((mode (if (mode:eq? 'DFLT mode) + (send self 'get-mode) + mode)) + (index (if index index (op:index self))) + (selector (if selector selector (op:selector self)))) + ; If the instruction could be parallely executed with others and we're + ; doing read pre-processing, the operand has already been fetched, we + ; just have to grab the cached value. + ; ??? reg-raw: support wip + (cond ((obj-has-attr? self 'RAW) + (send (op:type self) 'cxmake-get-raw estate mode index selector)) + ((with-parallel-read?) + (cx:make-with-atlist mode + (string-append -par-operand-macro + " (" (gen-sym self) ")") + nil)) ; FIXME: want CACHED attr if present + ((op:getter self) + (let ((args (car (op:getter self))) + (expr (cadr (op:getter self)))) + (rtl-c mode expr + (if (= (length args) 0) + nil + (list (list (car args) 'UINT index))) + #:rtl-cover-fns? #t))) + (else + (send (op:type self) 'cxmake-get estate mode index selector))))) +) + +; Utilities to implement gen-set-quiet/gen-set-trace. + +(define (-op-gen-set-quiet op estate mode index selector newval) + (send (op:type op) 'gen-set-quiet estate mode index selector newval) +) + +; Return C code to call the appropriate queued-write handler. +; ??? wip + +(define (-op-gen-queued-write op estate mode index selector newval) + (let* ((hw (op:type op)) + (setter (hw-setter hw)) + (sem-mode (mode:sem-mode mode))) + (string-append + " " + "sim_queue_" + ; FIXME: clean up (pc? op) vs (memory? hw) + ; FIXME: (send 'pc?) is a temporary hack, (pc? op) didn't work + (cond ((send hw 'pc?) + (string-append + (if setter + "fn_" + "") + "pc")) + (else + (string-append + (cond ((memory? hw) + "mem_") + ((hw-scalar? hw) + "scalar_") + (else "")) + (if setter + "fn_" + "") + (string-downcase (if sem-mode + (mode-real-name sem-mode) + (mode-real-name mode)))))) + "_write (current_cpu" + ; ??? May need to include h/w id some day. + (if setter + (string-append ", " (gen-reg-setter-fn hw "@cpu@")) + "") + (cond ((hw-scalar? hw) + "") + (setter + (string-append ", " (-gen-hw-index index estate))) + ((memory? hw) + (string-append ", " (-gen-hw-index index estate))) + (else + (string-append ", " (-gen-hw-addr (op:type op) estate index)))) + ", " + newval + ");\n")) +) + +(define (-op-gen-set-quiet-parallel op estate mode index selector newval) + (if (with-generic-write?) + (-op-gen-queued-write op estate mode index selector (cx:c newval)) + (string-append + (if (op-save-index? op) + (string-append " " + -par-operand-macro " (" (-op-index-name op) ")" + " = " (-gen-hw-index index estate) ";\n") + "") + " " + -par-operand-macro " (" (gen-sym op) ")" + " = " (cx:c newval) ";\n")) +) + +(define (-op-gen-set-trace op estate mode index selector newval) + (string-append + " {\n" + " " (mode:c-type mode) " opval = " (cx:c newval) ";\n" + " " (send (op:type op) 'gen-set-quiet estate mode index selector + (cx:make-with-atlist mode "opval" (cx:atlist newval))) + (if (op:cond? op) + (string-append " written |= (1 << " + (number->string (op:num op)) + ");\n") + "") +; TRACE_RESULT_<MODE> (cpu, abuf, hwnum, opnum, value); +; For each insn record array of operand numbers [or indices into +; operand instance table]. +; Could just scan the operand table for the operand or hardware number, +; assuming the operand number is stored in `op'. + " TRACE_RESULT (current_cpu, abuf" + ", " (send op 'gen-pretty-name mode) + ", " (mode:printf-type mode) + ", opval);\n" + " }\n") +) + +(define (-op-gen-set-trace-parallel op estate mode index selector newval) + (string-append + " {\n" + " " (mode:c-type mode) " opval = " (cx:c newval) ";\n" + (if (with-generic-write?) + (-op-gen-queued-write op estate mode index selector "opval") + (string-append + (if (op-save-index? op) + (string-append " " + -par-operand-macro " (" (-op-index-name op) ")" + " = " (-gen-hw-index index estate) ";\n") + "") + " " -par-operand-macro " (" (gen-sym op) ")" + " = opval;\n")) + (if (op:cond? op) + (string-append " written |= (1 << " + (number->string (op:num op)) + ");\n") + "") +; TRACE_RESULT_<MODE> (cpu, abuf, hwnum, opnum, value); +; For each insn record array of operand numbers [or indices into +; operand instance table]. +; Could just scan the operand table for the operand or hardware number, +; assuming the operand number is stored in `op'. + " TRACE_RESULT (current_cpu, abuf" + ", " (send op 'gen-pretty-name mode) + ", " (mode:printf-type mode) + ", opval);\n" + " }\n") +) + +; Return C code to set the value of an operand. +; NEWVAL is a <c-expr> object of the value to store. +; If INDEX is non-#f use it, otherwise use (op:index self). +; This special handling of #f for INDEX is *only* supported for operands +; in cxmake-get, gen-set-quiet, and gen-set-trace. +; Ditto for SELECTOR. + +(method-make! + <operand> 'gen-set-quiet + (lambda (self estate mode index selector newval) + (let ((mode (if (mode:eq? 'DFLT mode) + (send self 'get-mode) + mode)) + (index (if index index (op:index self))) + (selector (if selector selector (op:selector self)))) + ; ??? raw-reg: support wip + (cond ((obj-has-attr? self 'RAW) + (send (op:type self) 'gen-set-quiet-raw estate mode index selector newval)) + ((with-parallel-write?) + (-op-gen-set-quiet-parallel self estate mode index selector newval)) + (else + (-op-gen-set-quiet self estate mode index selector newval))))) +) + +; Return C code to set the value of an operand and print TRACE_RESULT message. +; NEWVAL is a <c-expr> object of the value to store. +; If INDEX is non-#f use it, otherwise use (op:index self). +; This special handling of #f for INDEX is *only* supported for operands +; in cxmake-get, gen-set-quiet, and gen-set-trace. +; Ditto for SELECTOR. + +(method-make! + <operand> 'gen-set-trace + (lambda (self estate mode index selector newval) + (let ((mode (if (mode:eq? 'DFLT mode) + (send self 'get-mode) + mode)) + (index (if index index (op:index self))) + (selector (if selector selector (op:selector self)))) + ; ??? raw-reg: support wip + (cond ((obj-has-attr? self 'RAW) + (send (op:type self) 'gen-set-quiet-raw estate mode index selector newval)) + ((with-parallel-write?) + (-op-gen-set-trace-parallel self estate mode index selector newval)) + (else + (-op-gen-set-trace self estate mode index selector newval))))) +) + +; Define and undefine C macros to tuck away details of instruction format used +; in the parallel execution functions. See gen-define-field-macro for a +; similar thing done for extraction/semantic functions. + +(define (gen-define-parallel-operand-macro sfmt) + (string-append "#define " -par-operand-macro "(f) " + "par_exec->operands." + (gen-sym sfmt) + ".f\n") +) + +(define (gen-undef-parallel-operand-macro sfmt) + (string-append "#undef " -par-operand-macro "\n") +) + +; Operand profiling and parallel execution support. + +(method-make! + <operand> 'save-index? + (lambda (self) (send (op:type self) 'save-index? self)) +) + +; Return boolean indicating if operand OP needs its index saved +; (for parallel write post-processing support). + +(define (op-save-index? op) + (send op 'save-index?) +) + +; Return C code to record profile data for modeling use. +; In the case of a register, this is usually the register's number. +; This shouldn't be called in the case of a scalar, the code should be +; smart enough to know there is no need. + +(define (op:record-profile op sfmt out?) + (let ((estate (estate-make-for-normal-rtl-c nil nil))) + (send op 'gen-record-profile sfmt out? estate)) +) + +; Return C code to record the data needed for profiling operand SELF. +; This is done during extraction. + +(method-make! + <operand> 'gen-record-profile + (lambda (self sfmt out? estate) + (if (hw-scalar? (op:type self)) + "" + (string-append " " + (gen-argbuf-ref (string-append (if out? "out_" "in_") + (gen-sym self))) + " = " + (send (op:type self) 'gen-record-profile + (op:index self) sfmt estate) + ";\n"))) +) + +; Return C code to track profiling of operand SELF. +; This is usually called by the x-after handler. + +(method-make! + <operand> 'gen-profile-code + (lambda (self insn out?) + (string-append " " + "@cpu@_model_mark_" + (if out? "set_" "get_") + (gen-sym (op:type self)) + " (current_cpu" + (if (hw-scalar? (op:type self)) + "" + (string-append ", " + (gen-argbuf-ref + (string-append (if out? "out_" "in_") + (gen-sym self))))) + ");\n")) +) + +; CPU, mach, model support. + +; Return the declaration of the cpu/insn enum. + +(define (gen-cpu-insn-enum-decl cpu insn-list) + (gen-enum-decl "@cpu@_insn_type" + "instructions in cpu family @cpu@" + "@CPU@_INSN_" + (append! (map (lambda (i) + (cons (obj:name i) + (cons '- + (atlist-attrs (obj-atlist i))))) + insn-list) + (if (with-parallel?) + (apply append! + (map (lambda (i) + (list + (cons (symbol-append 'par- (obj:name i)) + (cons '- + (atlist-attrs (obj-atlist i)))) + (cons (symbol-append 'write- (obj:name i)) + (cons '- + (atlist-attrs (obj-atlist i)))))) + (parallel-insns insn-list))) + nil) + (list '(max)))) +) + +; Return the enum of INSN in cpu family CPU. +; In addition to CGEN_INSN_TYPE, an enum is created for each insn in each +; cpu family. This collapses the insn enum space for each cpu to increase +; cache efficiently (since the IDESC table is similarily collapsed). + +(define (gen-cpu-insn-enum cpu insn) + (string-upcase (string-append "@CPU@_INSN_" (gen-sym insn))) +) + +; Return C code to declare the machine data. + +(define (-gen-mach-decls) + (string-append + (string-map (lambda (mach) + (gen-obj-sanitize mach + (string-append "extern const MACH " + (gen-sym mach) + "_mach;\n"))) + (current-mach-list)) + "\n") +) + +; Return C code to define the machine data. + +(define (-gen-mach-data) + (string-append + "const MACH *sim_machs[] =\n{\n" + (string-map (lambda (mach) + (gen-obj-sanitize + mach + (string-append "#ifdef " (gen-have-cpu (mach-cpu mach)) "\n" + " & " (gen-sym mach) "_mach,\n" + "#endif\n"))) + (current-mach-list)) + " 0\n" + "};\n\n" + ) +) + +; Return C declarations of cpu model support stuff. +; ??? This goes in arch.h but a better place is each cpu.h. + +(define (-gen-arch-model-decls) + (string-append + (gen-enum-decl 'model_type "model types" + "MODEL_" + (append (map (lambda (model) + (cons (obj:name model) + (cons '- + (atlist-attrs (obj-atlist model))))) + (current-model-list)) + '((max)))) + "#define MAX_MODELS ((int) MODEL_MAX)\n\n" + (gen-enum-decl 'unit_type "unit types" + "UNIT_" + (cons '(none) + (append + ; "apply append" squeezes out nils. + (apply append + ; create <model_name>-<unit-name> for each unit + (map (lambda (model) + (let ((units (model:units model))) + (if (null? units) + nil + (map (lambda (unit) + (cons (symbol-append (obj:name model) '- + (obj:name unit)) + (cons '- (atlist-attrs (obj-atlist model))))) + units)))) + (current-model-list))) + '((max))))) + ; FIXME: revisit MAX_UNITS + "#define MAX_UNITS (" + (number->string + (apply max + (map (lambda (lengths) (apply max lengths)) + (map (lambda (insn) + (let ((timing (insn-timing insn))) + (if (null? timing) + '(1) + (map (lambda (insn-timing) + (length (timing:units (cdr insn-timing)))) + timing)))) + (current-insn-list))))) + ")\n\n" + ) +) + +; Function units. + +(method-make! <unit> 'gen-decl (lambda (self) "")) + +; Lookup operand named OP-NAME in INSN. +; Returns #f if OP-NAME is not an operand of INSN. +; IN-OUT is 'in to request an input operand, 'out to request an output operand, +; and 'in-out to request either (though if an operand is used for input and +; output then the input version is returned). +; FIXME: Move elsewhere. + +(define (insn-op-lookup op-name insn in-out) + (letrec ((lookup (lambda (op-list) + (cond ((null? op-list) #f) + ((eq? op-name (op:sem-name (car op-list))) (car op-list)) + (else (lookup (cdr op-list))))))) + (case in-out + ((in) (lookup (sfmt-in-ops (insn-sfmt insn)))) + ((out) (lookup (sfmt-out-ops (insn-sfmt insn)))) + ((in-out) (or (lookup (sfmt-in-ops (insn-sfmt insn))) + (lookup (sfmt-out-ops (insn-sfmt insn))))) + (else (error "insn-op-lookup: bad arg:" in-out)))) +) + +; Return C code to profile a unit's usage. +; UNIT-NUM is number of the unit in INSN. +; OVERRIDES is a list of (name value) pairs, where +; - NAME is a spec name, one of cycles, pred, in, out. +; The only ones we're concerned with are in,out. They map operand names +; as they appear in the semantic code to operand names as they appear in +; the function unit spec. +; - VALUE is the operand to NAME. For in,out it is (NAME VALUE) where +; - NAME is the name of an input/output arg of the unit. +; - VALUE is the name of the operand as it appears in semantic code. +; +; ??? This is a big sucker, though half of it is just the definitions +; of utility fns. + +(method-make! + <unit> 'gen-profile-code + (lambda (self unit-num insn overrides cycles-var-name) + (let ( + (inputs (unit:inputs self)) + (outputs (unit:outputs self)) + + ; Return C code to initialize UNIT-REFERENCED-VAR to be a bit mask + ; of operands of UNIT that were read/written by INSN. + ; INSN-REFERENCED-VAR is a bitmask of operands read/written by INSN. + ; All we have to do is map INSN-REFERENCED-VAR to + ; UNIT-REFERENCED-VAR. + ; ??? For now we assume all input operands are read. + (gen-ref-arg (lambda (arg num in-out) + (let* ((op-name (assq-ref overrides (car arg))) + (op (insn-op-lookup (if op-name + (car op-name) + (car arg)) + insn in-out)) + (insn-referenced-var "insn_referenced") + (unit-referenced-var "referenced")) + (if op + (if (op:cond? op) + (string-append " " + "if (" + insn-referenced-var + " & (1 << " + (number->string (op:num op)) + ")) " + unit-referenced-var + " |= 1 << " + (number->string num) + ";\n") + (string-append " " + unit-referenced-var + " |= 1 << " + (number->string num) + ";\n")) + "")))) + + ; Initialize unit argument ARG. + ; OUT? is #f for input args, #t for output args. + (gen-arg-init (lambda (arg out?) + (if (or + ; Ignore scalars. + (null? (cdr arg)) + ; Ignore remapped arg, handled elsewhere. + (assq (car arg) overrides) + ; Ignore operands not in INSN. + (not (insn-op-lookup (car arg) insn + (if out? 'out 'in)))) + "" + (string-append " " + (if out? "out_" "in_") + (gen-c-symbol (car arg)) + " = " + (gen-argbuf-ref + (string-append (if out? "out_" "in_") + (gen-c-symbol (car arg)))) + ";\n")))) + + ; Return C code to declare variable to hold unit argument ARG. + ; OUT? is #f for input args, #t for output args. + (gen-arg-decl (lambda (arg out?) + (if (null? (cdr arg)) ; ignore scalars + "" + (string-append " " + (mode:c-type (mode:lookup (cadr arg))) + " " + (if out? "out_" "in_") + (gen-c-symbol (car arg)) + " = " + (if (null? (cddr arg)) + "0" + (number->string (caddr arg))) + ";\n")))) + + ; Return C code to pass unit argument ARG to the handler. + ; OUT? is #f for input args, #t for output args. + (gen-arg-arg (lambda (arg out?) + (if (null? (cdr arg)) ; ignore scalars + "" + (string-append ", " + (if out? "out_" "in_") + (gen-c-symbol (car arg)))))) + ) + + (string-list + " {\n" + " int referenced = 0;\n" + " int UNUSED insn_referenced = abuf->written;\n" + ; Declare variables to hold unit arguments. + (string-map (lambda (arg) (gen-arg-decl arg #f)) + inputs) + (string-map (lambda (arg) (gen-arg-decl arg #t)) + outputs) + ; Initialize 'em, being careful not to initialize an operand that + ; has an override. + (let (; Make a list of names of in/out overrides. + (in-overrides (find-apply cadr + (lambda (elm) (eq? (car elm) 'in)) + overrides)) + (out-overrides (find-apply cadr + (lambda (elm) (eq? (car elm) 'out)) + overrides))) + (string-list + (string-map (lambda (arg) + (if (memq (car arg) in-overrides) + "" + (gen-arg-init arg #f))) + inputs) + (string-map (lambda (arg) + (if (memq (car arg) out-overrides) + "" + (gen-arg-init arg #t))) + outputs))) + (string-map (lambda (arg) + (case (car arg) + ((pred) "") + ((cycles) "") + ((in) + (if (caddr arg) + (string-append " in_" + (gen-c-symbol (cadr arg)) + " = " + (gen-argbuf-ref + (string-append + "in_" + (gen-c-symbol (caddr arg)))) + ";\n") + "")) + ((out) + (if (caddr arg) + (string-append " out_" + (gen-c-symbol (cadr arg)) + " = " + (gen-argbuf-ref + (string-append + "out_" + (gen-c-symbol (caddr arg)))) + ";\n") + "")) + (else + (parse-error "insn function unit spec" + "invalid spec" arg)))) + overrides) + ; Create bitmask indicating which args were referenced. + (string-map (lambda (arg num) (gen-ref-arg arg num 'in)) + inputs + (iota (length inputs))) + (string-map (lambda (arg num) (gen-ref-arg arg num 'out)) + outputs + (iota (length inputs) + (length outputs))) + ; Emit the call to the handler. + " " cycles-var-name " += " + (gen-model-unit-fn-name (unit:model self) self) + " (current_cpu, idesc" + ", " (number->string unit-num) + ", referenced" + (string-map (lambda (arg) (gen-arg-arg arg #f)) + inputs) + (string-map (lambda (arg) (gen-arg-arg arg #t)) + outputs) + ");\n" + " }\n" + ))) +) + +; Return C code to profile an insn-specific unit's usage. +; UNIT-NUM is number of the unit in INSN. + +(method-make! + <iunit> 'gen-profile-code + (lambda (self unit-num insn cycles-var-name) + (let ((args (iunit:args self)) + (unit (iunit:unit self))) + (send unit 'gen-profile-code unit-num insn args cycles-var-name))) +) + +; ARGBUF generation. +; ARGBUF support is put in cpuall.h, which doesn't depend on sim-cpu.scm, +; so this support is here. + +; Utility of -gen-argbuf-fields-union to generate the definition for +; <sformat-abuf> SBUF. + +(define (-gen-argbuf-elm sbuf) + (logit 2 "Processing sbuf format " (obj:name sbuf) " ...\n") + (string-list + " struct { /* " (obj:comment sbuf) " */\n" + (let ((elms (sbuf-elms sbuf))) + (if (null? elms) + " int empty;\n" + (string-list-map (lambda (elm) + (string-append " " + (cadr elm) + " " + (car elm) + ";\n")) + (sbuf-elms sbuf)))) + " } " (gen-sym sbuf) ";\n") +) + +; Utility of gen-argbuf-type to generate the union of extracted ifields. + +(define (-gen-argbuf-fields-union) + (string-list + "\ +/* Instruction argument buffer. */ + +union sem_fields {\n" + (string-list-map -gen-argbuf-elm (current-sbuf-list)) + "\ +#if WITH_SCACHE_PBB + /* Writeback handler. */ + struct { + /* Pointer to argbuf entry for insn whose results need writing back. */ + const struct argbuf *abuf; + } write; + /* x-before handler */ + struct { + /*const SCACHE *insns[MAX_PARALLEL_INSNS];*/ + int first_p; + } before; + /* x-after handler */ + struct { + int empty; + } after; + /* This entry is used to terminate each pbb. */ + struct { + /* Number of insns in pbb. */ + int insn_count; + /* Next pbb to execute. */ + SCACHE *next; + SCACHE *branch_target; + } chain; +#endif +};\n\n" + ) +) + +; Generate the definition of the structure that records arguments. +; This is a union of structures with one structure for each insn format. +; It also includes hardware profiling information and miscellaneous +; administrivia. +; CPU-DATA? is #t if data for the currently selected cpu is to be included. + +(define (gen-argbuf-type cpu-data?) + (logit 2 "Generating ARGBUF type ...\n") + (string-list + (if (and cpu-data? (with-scache?)) + (-gen-argbuf-fields-union) + "") + (if cpu-data? "" "#ifndef WANT_CPU\n") + "\ +/* The ARGBUF struct. */ +struct argbuf { + /* These are the baseclass definitions. */ + IADDR addr; + const IDESC *idesc; + char trace_p; + char profile_p; + /* ??? Temporary hack for skip insns. */ + char skip_count; + char unused; + /* cpu specific data follows */\n" + (if cpu-data? + (if (with-scache?) + "\ + union sem semantic; + int written; + union sem_fields fields;\n" + "\ + CGEN_INSN_INT insn; + int written;\n") + "") + "};\n" + (if cpu-data? "" "#endif\n") + "\n" + ) +) + +; Generate the definition of the structure that records a cached insn. +; This is cpu family specific (member `argbuf' is) so it is machine generated. +; CPU-DATA? is #t if data for the currently selected cpu is to be included. + +(define (gen-scache-type cpu-data?) + (logit 2 "Generating SCACHE type ...\n") + (string-append + (if cpu-data? "" "#ifndef WANT_CPU\n") + "\ +/* A cached insn. + + ??? SCACHE used to contain more than just argbuf. We could delete the + type entirely and always just use ARGBUF, but for future concerns and as + a level of abstraction it is left in. */ + +struct scache { + struct argbuf argbuf;\n" + (if (with-generic-write?) "\ + int first_insn_p; + int last_insn_p;\n" "") + "};\n" + (if cpu-data? "" "#endif\n") + "\n" + ) +) + +; Mode support. + +; Generate a table of mode data. +; For now all we need is the names. + +(define (gen-mode-defs) + (string-append + "const char *mode_names[] = {\n" + (string-map (lambda (m) + (string-append " \"" (string-upcase (obj:name m)) "\",\n")) + ; We don't treat aliases as being different from the real + ; mode here, so ignore them. + (mode-list-non-alias-values)) + "};\n\n" + ) +) + +; Insn profiling support. + +; Generate declarations for local variables needed for modelling code. + +(method-make! + <insn> 'gen-profile-locals + (lambda (self model) +; (let ((cti? (or (has-attr? self 'UNCOND-CTI) +; (has-attr? self 'COND-CTI)))) +; (string-append +; (if cti? " int UNUSED taken_p = 0;\n" "") +; )) + "") +) + +; Generate C code to profile INSN. + +(method-make! + <insn> 'gen-profile-code + (lambda (self model cycles-var-name) + (string-list + (let ((timing (assq-ref (insn-timing self) (obj:name model)))) + (if timing + (string-list-map (lambda (iunit unit-num) + (send iunit 'gen-profile-code unit-num self cycles-var-name)) + (timing:units timing) + (iota (length (timing:units timing)))) + (send (model-default-unit model) 'gen-profile-code 0 self nil cycles-var-name))) + )) +) + +; .cpu file loading support + +; Only run sim-analyze-insns! once. +(define -sim-insns-analyzed? #f) + +; List of computed sformat argument buffers. +(define -sim-sformat-abuf-list #f) +(define (current-sbuf-list) -sim-sformat-abuf-list) + +; Called before/after the .cpu file has been read in. + +(define (sim-init!) + (set! -sim-insns-analyzed? #f) + (set! -sim-sformat-abuf-list #f) + *UNSPECIFIED* +) + +(define (sim-finish!) + ; Add begin,chain,before,after,invalid handlers if not provided. + ; The code generators should first look for x-foo-@cpu@, then for x-foo. + ; ??? This is good enough for the first pass. Will eventually need to use + ; less C and more RTL. + + (let ((all (stringize (current-arch-isa-name-list) ","))) + + (define-full-insn 'x-begin "pbb begin handler" + `(VIRTUAL PBB (ISA ,all)) + "--begin--" () () '(c-code VOID "\ + { +#if WITH_SCACHE_PBB_@CPU@ +#ifdef DEFINE_SWITCH + /* In the switch case FAST_P is a constant, allowing several optimizations + in any called inline functions. */ + vpc = @cpu@_pbb_begin (current_cpu, FAST_P); +#else + vpc = @cpu@_pbb_begin (current_cpu, STATE_RUN_FAST_P (CPU_STATE (current_cpu))); +#endif +#endif + } +") nil) + + (define-full-insn 'x-chain "pbb chain handler" + `(VIRTUAL PBB (ISA ,all)) + "--chain--" () () '(c-code VOID "\ + { +#if WITH_SCACHE_PBB_@CPU@ + vpc = @cpu@_pbb_chain (current_cpu, sem_arg); +#ifdef DEFINE_SWITCH + BREAK (sem); +#endif +#endif + } +") nil) + + (define-full-insn 'x-cti-chain "pbb cti-chain handler" + `(VIRTUAL PBB (ISA ,all)) + "--cti-chain--" () () '(c-code VOID "\ + { +#if WITH_SCACHE_PBB_@CPU@ +#ifdef DEFINE_SWITCH + vpc = @cpu@_pbb_cti_chain (current_cpu, sem_arg, + pbb_br_type, pbb_br_npc); + BREAK (sem); +#else + /* FIXME: Allow provision of explicit ifmt spec in insn spec. */ + vpc = @cpu@_pbb_cti_chain (current_cpu, sem_arg, + CPU_PBB_BR_TYPE (current_cpu), + CPU_PBB_BR_NPC (current_cpu)); +#endif +#endif + } +") nil) + + (define-full-insn 'x-before "pbb begin handler" + `(VIRTUAL PBB (ISA ,all)) + "--before--" () () '(c-code VOID "\ + { +#if WITH_SCACHE_PBB_@CPU@ + @cpu@_pbb_before (current_cpu, sem_arg); +#endif + } +") nil) + + (define-full-insn 'x-after "pbb after handler" + `(VIRTUAL PBB (ISA ,all)) + "--after--" () () '(c-code VOID "\ + { +#if WITH_SCACHE_PBB_@CPU@ + @cpu@_pbb_after (current_cpu, sem_arg); +#endif + } +") nil) + + (define-full-insn 'x-invalid "invalid insn handler" + `(VIRTUAL (ISA ,all)) + "--invalid--" () () (list 'c-code 'VOID (string-append "\ + { + /* Update the recorded pc in the cpu state struct. + Only necessary for WITH_SCACHE case, but to avoid the + conditional compilation .... */ + SET_H_PC (pc); + /* Virtual insns have zero size. Overwrite vpc with address of next insn + using the default-insn-bitsize spec. When executing insns in parallel + we may want to queue the fault and continue execution. */ + vpc = SEM_NEXT_VPC (sem_arg, pc, " (number->string (bits->bytes (state-default-insn-bitsize))) "); + vpc = sim_engine_invalid_insn (current_cpu, pc, vpc); + } +")) nil)) + + *UNSPECIFIED* +) + +; Called after file is read in and global error checks are done +; to initialize tables. + +(define (sim-analyze!) + *UNSPECIFIED* +) + +; Scan insns, analyzing semantics and computing instruction formats. +; 'twould be nice to do this in sim-analyze! but it doesn't know whether this +; needs to be done or not (which is determined by what files are being +; generated). Since this is an expensive operation, we defer doing this +; to the files that need it. + +(define (sim-analyze-insns!) + ; This can only be done if one isa and one cpu family is being kept. + (assert-keep-one) + + (if (not -sim-insns-analyzed?) + + (begin + (arch-analyze-insns! CURRENT-ARCH + #f ; don't include aliases + #t) ; do analyze the semantics + + ; Compute the set of sformat argument buffers. + (set! -sim-sformat-abuf-list (compute-sformat-argbufs! (current-sfmt-list))) + + (set! -sim-insns-analyzed? #t))) + + ; Do our own error checking. + (assert (current-insn-lookup 'x-invalid)) + + *UNSPECIFIED* +) + +; For debugging. + +(define (cgen-all-arch) + (string-write + cgen-arch.h + cgen-arch.c + cgen-cpuall.h + ;cgen-mem-ops.h + ;cgen-sem-ops.h + ;cgen-ops.c + ) +) + +(define (cgen-all-cpu) + (string-write + cgen-cpu.h + cgen-cpu.c + cgen-decode.h + cgen-decode.c + ;cgen-extract.c + cgen-read.c + cgen-write.c + cgen-semantics.c + cgen-sem-switch.c + cgen-model.c + ;cgen-mainloop.in + ) +) diff --git a/cgen/simplify.inc b/cgen/simplify.inc new file mode 100644 index 00000000000..7ccd6fd2d38 --- /dev/null +++ b/cgen/simplify.inc @@ -0,0 +1,198 @@ +; Collection of macros to simplify .cpu file writing. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Enums. + +; Define a normal enum without using name/value pairs. +; This is currently the same as define-full-enum but it needn't remain +; that way (it's define-full-enum that would change). + +(define-pmacro (define-normal-enum name comment attrs prefix vals) + "\ +Define a normal enum, fixed number of arguments. +" + (define-full-enum name comment attrs prefix vals) +) + +; Define a normal insn enum. + +(define-pmacro (define-normal-insn-enum name comment attrs prefix fld vals) + "\ +Define a normal instruction opcode enum. +" + (define-full-insn-enum name comment attrs prefix fld vals) +) + +; Instruction fields. + +; Normally, fields are unsigned have no encode/decode needs. + +(define-pmacro (define-normal-ifield name comment attrs start length) + "Define a normal instruction field.\n" + (define-full-ifield name comment attrs start length UINT #f #f) +) + +; For those who don't like typing. + +(define-pmacro df + "Shorthand form of define-full-ifield.\n" + define-full-ifield +) +(define-pmacro dnf + "Shorthand form of define-normal-ifield.\n" + define-normal-ifield +) + +; Define a normal multi-ifield. +; FIXME: The define-normal version for ifields doesn't include the mode. + +(define-pmacro (define-normal-multi-ifield name comment attrs + mode subflds insert extract) + "Define a normal multi-part instruction field.\n" + (define-full-multi-ifield name comment attrs mode subflds insert extract) +) + +; For those who don't like typing. + +(define-pmacro dnmf + "Shorthand form of define-normal-multi-ifield.\n" + define-normal-multi-ifield +) + +; Simple multi-ifields: mode is UINT, default insert/extract support. + +(define-pmacro (dsmf name comment attrs subflds) + "Define a simple multi-part instruction field.\n" + (define-full-multi-ifield name comment attrs UINT subflds #f #f) +) + +; Hardware. + +; Simpler version for most hardware elements. +; Allow special assembler support specification but no semantic-name or +; get/set specs. + +(define-pmacro (define-normal-hardware name comment attrs type + indices values handlers) + "\ +Define a normal hardware element. +" + (define-full-hardware name comment attrs name type + indices values handlers () () ()) +) + +; For those who don't like typing. + +(define-pmacro dnh + "Shorthand form of define-normal-hardware.\n" + define-normal-hardware +) + +; Simpler version of dnh that leaves out the indices, values, handlers, +; get, set, and layout specs. +; This is useful for 1 bit registers. +; ??? While dsh and dnh aren't that distinguishable when perusing a .cpu file, +; they both take a fixed number of positional arguments, and dsh is a proper +; subset of dnh with all arguments in the same positions, so methinks things +; are ok. + +(define-pmacro (define-simple-hardware name comment attrs type) + "\ +Define a simple hardware element (usually a scalar register). +" + (define-full-hardware name comment attrs name type () () () () () ()) +) + +(define-pmacro dsh + "Shorthand form of define-simple-hardware.\n" + define-simple-hardware +) + +; Operands. + +(define-pmacro (define-normal-operand name comment attrs type index) + "Define a normal operand.\n" + (define-full-operand name comment attrs type DFLT index () () ()) +) + +; For those who don't like typing. +; FIXME: dno? + +(define-pmacro dnop + "Shorthand form of define-normal-operand.\n" + define-normal-operand +) + +(define-pmacro (dndo x-name x-mode x-args + x-syntax x-base-ifield x-encoding x-ifield-assertion + x-getter x-setter) + "Define a normal derived operand." + (define-derived-operand + (name x-name) + (mode x-mode) + (args x-args) + (syntax x-syntax) + (base-ifield x-base-ifield) + (encoding x-encoding) + (ifield-assertion x-ifield-assertion) + (getter x-getter) + (setter x-setter) + ) +) + +; Instructions. + +; Define an instruction object, normal version. +; At present all fields must be specified. +; Fields ifield-assertion is absent. + +(define-pmacro (define-normal-insn name comment attrs syntax fmt semantics timing) + "Define a normal instruction.\n" + (define-full-insn name comment attrs syntax fmt () semantics timing) +) + +; To reduce the amount of typing. +; Note that this is the same name as the D'ni in MYST. Oooohhhh..... +; this must be the right way to go. :-) + +(define-pmacro dni + "Shorthand form of define-normal-insn.\n" + define-normal-insn +) + +; Macro instructions. + +; Define a macro-insn object, normal version. +; This only supports expanding to one real insn. + +(define-pmacro (define-normal-macro-insn name comment attrs syntax expansion) + "Define a normal macro instruction.\n" + (define-full-minsn name comment attrs syntax expansion) +) + +; To reduce the amount of typing. + +(define-pmacro dnmi + "Shorthand form of define-normal-macro-insn.\n" + define-normal-macro-insn +) + +; Modes. +; ??? Not currently available for use. +; +; Define Normal Mode +; +;(define-pmacro (define-normal-mode name comment attrs bits bytes +; non-mode-c-type printf-type sem-mode ptr-to host?) +; "Define a normal mode.\n" +; (define-full-mode name comment attrs bits bytes +; non-mode-c-type printf-type sem-mode ptr-to host?) +;) +; +; For those who don't like typing. +;(define-pmacro dnm +; "Shorthand form of define-normal-mode.\n" +; define-normal-mode +;) diff --git a/cgen/slib/genwrite.scm b/cgen/slib/genwrite.scm new file mode 100644 index 00000000000..f57d773daf2 --- /dev/null +++ b/cgen/slib/genwrite.scm @@ -0,0 +1,270 @@ +;;"genwrite.scm" generic write used by pretty-print and truncated-print. +;; Copyright (c) 1991, Marc Feeley +;; Author: Marc Feeley (feeley@iro.umontreal.ca) +;; Distribution restrictions: none + +(define (generic-write obj display? width output) + + (define (read-macro? l) + (define (length1? l) (and (pair? l) (null? (cdr l)))) + (let ((head (car l)) (tail (cdr l))) + (case head + ((QUOTE QUASIQUOTE UNQUOTE UNQUOTE-SPLICING) (length1? tail)) + (else #f)))) + + (define (read-macro-body l) + (cadr l)) + + (define (read-macro-prefix l) + (let ((head (car l)) (tail (cdr l))) + (case head + ((QUOTE) "'") + ((QUASIQUOTE) "`") + ((UNQUOTE) ",") + ((UNQUOTE-SPLICING) ",@")))) + + (define (out str col) + (and col (output str) (+ col (string-length str)))) + + (define (wr obj col) + + (define (wr-expr expr col) + (if (read-macro? expr) + (wr (read-macro-body expr) (out (read-macro-prefix expr) col)) + (wr-lst expr col))) + + (define (wr-lst l col) + (if (pair? l) + (let loop ((l (cdr l)) + (col (and col (wr (car l) (out "(" col))))) + (cond ((not col) col) + ((pair? l) + (loop (cdr l) (wr (car l) (out " " col)))) + ((null? l) (out ")" col)) + (else (out ")" (wr l (out " . " col)))))) + (out "()" col))) + + (cond ((pair? obj) (wr-expr obj col)) + ((null? obj) (wr-lst obj col)) + ((vector? obj) (wr-lst (vector->list obj) (out "#" col))) + ((boolean? obj) (out (if obj "#t" "#f") col)) + ((number? obj) (out (number->string obj) col)) + ((symbol? obj) (out (symbol->string obj) col)) + ((procedure? obj) (out "#[procedure]" col)) + ((string? obj) (if display? + (out obj col) + (let loop ((i 0) (j 0) (col (out "\"" col))) + (if (and col (< j (string-length obj))) + (let ((c (string-ref obj j))) + (if (or (char=? c #\\) + (char=? c #\")) + (loop j + (+ j 1) + (out "\\" + (out (substring obj i j) + col))) + (loop i (+ j 1) col))) + (out "\"" + (out (substring obj i j) col)))))) + ((char? obj) (if display? + (out (make-string 1 obj) col) + (out (case obj + ((#\space) "space") + ((#\newline) "newline") + (else (make-string 1 obj))) + (out "#\\" col)))) + ((input-port? obj) (out "#[input-port]" col)) + ((output-port? obj) (out "#[output-port]" col)) + ((eof-object? obj) (out "#[eof-object]" col)) + ((keyword? obj) (let* ((o (symbol->string + (keyword-dash-symbol obj))) + (oo (list->string + (append (list #\# #\:) + (cdr (string->list o)))))) + (out oo col))) + (else (out "#[unknown]" col)))) + + (define (pp obj col) + + (define (spaces n col) + (if (> n 0) + (if (> n 7) + (spaces (- n 8) (out " " col)) + (out (substring " " 0 n) col)) + col)) + + (define (indent to col) + (and col + (if (< to col) + (and (out (make-string 1 #\newline) col) (spaces to 0)) + (spaces (- to col) col)))) + + (define (pr obj col extra pp-pair) + (if (or (pair? obj) (vector? obj)) ; may have to split on multiple lines + (let ((result '()) + (left (min (+ (- (- width col) extra) 1) max-expr-width))) + (generic-write obj display? #f + (lambda (str) + (set! result (cons str result)) + (set! left (- left (string-length str))) + (> left 0))) + (if (> left 0) ; all can be printed on one line + (out (reverse-string-append result) col) + (if (pair? obj) + (pp-pair obj col extra) + (pp-list (vector->list obj) (out "#" col) extra pp-expr)))) + (wr obj col))) + + (define (pp-expr expr col extra) + (if (read-macro? expr) + (pr (read-macro-body expr) + (out (read-macro-prefix expr) col) + extra + pp-expr) + (let ((head (car expr))) + (if (symbol? head) + (let ((proc (style head))) + (if proc + (proc expr col extra) + (if (> (string-length (symbol->string head)) + max-call-head-width) + (pp-general expr col extra #f #f #f pp-expr) + (pp-call expr col extra pp-expr)))) + (pp-list expr col extra pp-expr))))) + + ; (head item1 + ; item2 + ; item3) + (define (pp-call expr col extra pp-item) + (let ((col* (wr (car expr) (out "(" col)))) + (and col + (pp-down (cdr expr) col* (+ col* 1) extra pp-item)))) + + ; (item1 + ; item2 + ; item3) + (define (pp-list l col extra pp-item) + (let ((col (out "(" col))) + (pp-down l col col extra pp-item))) + + (define (pp-down l col1 col2 extra pp-item) + (let loop ((l l) (col col1)) + (and col + (cond ((pair? l) + (let ((rest (cdr l))) + (let ((extra (if (null? rest) (+ extra 1) 0))) + (loop rest + (pr (car l) (indent col2 col) extra pp-item))))) + ((null? l) + (out ")" col)) + (else + (out ")" + (pr l + (indent col2 (out "." (indent col2 col))) + (+ extra 1) + pp-item))))))) + + (define (pp-general expr col extra named? pp-1 pp-2 pp-3) + + (define (tail1 rest col1 col2 col3) + (if (and pp-1 (pair? rest)) + (let* ((val1 (car rest)) + (rest (cdr rest)) + (extra (if (null? rest) (+ extra 1) 0))) + (tail2 rest col1 (pr val1 (indent col3 col2) extra pp-1) col3)) + (tail2 rest col1 col2 col3))) + + (define (tail2 rest col1 col2 col3) + (if (and pp-2 (pair? rest)) + (let* ((val1 (car rest)) + (rest (cdr rest)) + (extra (if (null? rest) (+ extra 1) 0))) + (tail3 rest col1 (pr val1 (indent col3 col2) extra pp-2))) + (tail3 rest col1 col2))) + + (define (tail3 rest col1 col2) + (pp-down rest col2 col1 extra pp-3)) + + (let* ((head (car expr)) + (rest (cdr expr)) + (col* (wr head (out "(" col)))) + (if (and named? (pair? rest)) + (let* ((name (car rest)) + (rest (cdr rest)) + (col** (wr name (out " " col*)))) + (tail1 rest (+ col indent-general) col** (+ col** 1))) + (tail1 rest (+ col indent-general) col* (+ col* 1))))) + + (define (pp-expr-list l col extra) + (pp-list l col extra pp-expr)) + + (define (pp-LAMBDA expr col extra) + (pp-general expr col extra #f pp-expr-list #f pp-expr)) + + (define (pp-IF expr col extra) + (pp-general expr col extra #f pp-expr #f pp-expr)) + + (define (pp-COND expr col extra) + (pp-call expr col extra pp-expr-list)) + + (define (pp-CASE expr col extra) + (pp-general expr col extra #f pp-expr #f pp-expr-list)) + + (define (pp-AND expr col extra) + (pp-call expr col extra pp-expr)) + + (define (pp-LET expr col extra) + (let* ((rest (cdr expr)) + (named? (and (pair? rest) (symbol? (car rest))))) + (pp-general expr col extra named? pp-expr-list #f pp-expr))) + + (define (pp-BEGIN expr col extra) + (pp-general expr col extra #f #f #f pp-expr)) + + (define (pp-DO expr col extra) + (pp-general expr col extra #f pp-expr-list pp-expr-list pp-expr)) + + ; define formatting style (change these to suit your style) + + (define indent-general 2) + + (define max-call-head-width 5) + + (define max-expr-width 50) + + (define (style head) + (case head + ((LAMBDA LET* LETREC DEFINE) pp-LAMBDA) + ((IF SET!) pp-IF) + ((COND) pp-COND) + ((CASE) pp-CASE) + ((AND OR) pp-AND) + ((LET) pp-LET) + ((BEGIN) pp-BEGIN) + ((DO) pp-DO) + (else #f))) + + (pr obj col 0 pp-expr)) + + (if width + (out (make-string 1 #\newline) (pp obj 0)) + (wr obj 0))) + +; (reverse-string-append l) = (apply string-append (reverse l)) + +(define (reverse-string-append l) + + (define (rev-string-append l i) + (if (pair? l) + (let* ((str (car l)) + (len (string-length str)) + (result (rev-string-append (cdr l) (+ i len)))) + (let loop ((j 0) (k (- (- (string-length result) i) len))) + (if (< j len) + (begin + (string-set! result k (string-ref str j)) + (loop (+ j 1) (+ k 1))) + result))) + (make-string i))) + + (rev-string-append l 0)) diff --git a/cgen/slib/pp.scm b/cgen/slib/pp.scm new file mode 100644 index 00000000000..4b245a36325 --- /dev/null +++ b/cgen/slib/pp.scm @@ -0,0 +1,10 @@ +;"pp.scm" Pretty-print + +; (pretty-print obj port) pretty prints 'obj' on 'port'. The current +; output port is used if 'port' is not specified. + +(define (pp:pretty-print obj . opt) + (let ((port (if (pair? opt) (car opt) (current-output-port)))) + (generic-write obj #f 79 (lambda (s) (display s port) #t)))) + +(define pretty-print pp:pretty-print) diff --git a/cgen/slib/sort.scm b/cgen/slib/sort.scm new file mode 100644 index 00000000000..782f075b77a --- /dev/null +++ b/cgen/slib/sort.scm @@ -0,0 +1,151 @@ +;;; "sort.scm" Defines: sorted?, merge, merge!, sort, sort! +;;; Author : Richard A. O'Keefe (based on Prolog code by D.H.D.Warren) + +;;; Updated: 11 June 1991 +;;; Modified for scheme library: Aubrey Jaffer 19 Sept. 1991 + +;;; (sorted? sequence less?) +;;; is true when sequence is a list (x0 x1 ... xm) or a vector #(x0 ... xm) +;;; such that for all 1 <= i <= m, +;;; (not (less? (list-ref list i) (list-ref list (- i 1)))). + +(define (sort:sorted? seq less?) + (cond + ((null? seq) + #t) + ((vector? seq) + (let ((n (vector-length seq))) + (if (<= n 1) + #t + (do ((i 1 (+ i 1))) + ((or (= i n) + (less? (vector-ref seq (- i 1)) + (vector-ref seq i))) + (= i n)) )) )) + (else + (let loop ((last (car seq)) (next (cdr seq))) + (or (null? next) + (and (not (less? (car next) last)) + (loop (car next) (cdr next)) )) )) )) + + +;;; (merge a b less?) +;;; takes two lists a and b such that (sorted? a less?) and (sorted? b less?) +;;; and returns a new list in which the elements of a and b have been stably +;;; interleaved so that (sorted? (merge a b less?) less?). +;;; Note: this does _not_ accept vectors. See below. + +(define (sort:merge a b less?) + (cond + ((null? a) b) + ((null? b) a) + (else (let loop ((x (car a)) (a (cdr a)) (y (car b)) (b (cdr b))) + ;; The loop handles the merging of non-empty lists. It has + ;; been written this way to save testing and car/cdring. + (if (less? y x) + (if (null? b) + (cons y (cons x a)) + (cons y (loop x a (car b) (cdr b)) )) + ;; x <= y + (if (null? a) + (cons x (cons y b)) + (cons x (loop (car a) (cdr a) y b)) )) )) )) + + +;;; (merge! a b less?) +;;; takes two sorted lists a and b and smashes their cdr fields to form a +;;; single sorted list including the elements of both. +;;; Note: this does _not_ accept vectors. + +(define (sort:merge! a b less?) + (define (loop r a b) + (if (less? (car b) (car a)) + (begin + (set-cdr! r b) + (if (null? (cdr b)) + (set-cdr! b a) + (loop b a (cdr b)) )) + ;; (car a) <= (car b) + (begin + (set-cdr! r a) + (if (null? (cdr a)) + (set-cdr! a b) + (loop a (cdr a) b)) )) ) + (cond + ((null? a) b) + ((null? b) a) + ((less? (car b) (car a)) + (if (null? (cdr b)) + (set-cdr! b a) + (loop b a (cdr b))) + b) + (else ; (car a) <= (car b) + (if (null? (cdr a)) + (set-cdr! a b) + (loop a (cdr a) b)) + a))) + + + +;;; (sort! sequence less?) +;;; sorts the list or vector sequence destructively. It uses a version +;;; of merge-sort invented, to the best of my knowledge, by David H. D. +;;; Warren, and first used in the DEC-10 Prolog system. R. A. O'Keefe +;;; adapted it to work destructively in Scheme. + +(define (sort:sort! seq less?) + (define (step n) + (cond + ((> n 2) + (let* ((j (quotient n 2)) + (a (step j)) + (k (- n j)) + (b (step k))) + (sort:merge! a b less?))) + ((= n 2) + (let ((x (car seq)) + (y (cadr seq)) + (p seq)) + (set! seq (cddr seq)) + (if (less? y x) (begin + (set-car! p y) + (set-car! (cdr p) x))) + (set-cdr! (cdr p) '()) + p)) + ((= n 1) + (let ((p seq)) + (set! seq (cdr seq)) + (set-cdr! p '()) + p)) + (else + '()) )) + (if (vector? seq) + (let ((n (vector-length seq)) + (vec seq)) + (set! seq (vector->list seq)) + (do ((p (step n) (cdr p)) + (i 0 (+ i 1))) + ((null? p) vec) + (vector-set! vec i (car p)) )) + ;; otherwise, assume it is a list + (step (length seq)) )) + +;;; (sort sequence less?) +;;; sorts a vector or list non-destructively. It does this by sorting a +;;; copy of the sequence. My understanding is that the Standard says +;;; that the result of append is always "newly allocated" except for +;;; sharing structure with "the last argument", so (append x '()) ought +;;; to be a standard way of copying a list x. + +(define (sort:sort seq less?) + (if (vector? seq) + (list->vector (sort:sort! (vector->list seq) less?)) + (sort:sort! (append seq '()) less?))) + +;;; eof + +(define sorted? sort:sorted?) +(define merge sort:merge) +(define merge! sort:merge!) +(define sort sort:sort) +(define sort! sort:sort!) diff --git a/cgen/sparc.cpu b/cgen/sparc.cpu new file mode 100644 index 00000000000..e60f9d9348d --- /dev/null +++ b/cgen/sparc.cpu @@ -0,0 +1,612 @@ +; SPARC CPU description. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Notes: +; - sparc64 support wip +; - fp support todo +; - source file layout wip +; - cpu family layout wip +; - page numbers refered to here are to the sparc architecture reference +; manuals (v8,v9). + +(include "simplify.inc") + +(define-arch + (name sparc) + (comment "Sun SPARC architecture") + (insn-lsb0? #t) + ; This list isn't currently intended to be identical to BFD's sparc mach + ; list. In time if and when there's a need. + ; While following the goal of incremental complication, v6,v7,sparclet don't + ; appear here either. + (machs sparc-v8 sparclite sparc-v9 sparc-v9a) + ;(default-mach sparc-v8) + (isas sparc) +) + +; Macros to simplify MACH attribute specification. +(define-pmacro (MACH32) (MACH sparc-v8,sparclite)) +(define-pmacro (MACH64) (MACH sparc-v9,sparc-v9a)) + +; Attribute to simplify machine specific RTL. +(define-attr + (type boolean) + (name ARCH64) + (comment "`true' for sparc64 machs") +) + +(define-isa + (name sparc) + (base-insn-bitsize 32) ; number of bits that can be initially fetched + ; Initial bitnumbers to decode insns by. + (decode-assist (31 30 24 23 22 21 20 19)) ; 0 1 7 8 9 10 11 12 +) + +; The instruction fetch/execute cycle. +; This is split into two parts as sometimes more than one instruction is +; decoded at once. +; The `const 0' argument to decode/execute is used to distinguish +; multiple instructions processed at the same time (e.g. m32r). +; +; ??? This is wip, and not currently used. +; ??? To be moved into define-arch and define-cpu. +; ??? It might simplify things to separate the execute process from the +; one that updates the PC. + +; This is how to fetch and extract the fields of an instruction. + +;(define-extract +; (sequence ((USI insn)) +; (set-quiet insn (ifetch: USI pc)) +; (decode pc insn (const 0)) +; ) +;) + +; This is how to execute an extracted instruction. + +;(define-execute +; (sequence ((AI new_pc)) +; (set-quiet new_pc (execute AI (const 0))) +; ; QI mode means just do an assignment, not a jump. +; ; FIXME: VOID also means something special. Perhaps there's a way +; ; to use a mode other than QI (WI?) and have something cleaner? +; (if (attr: HOSTINT insn (const 0) DELAY-SLOT) +; (if (andif (attr: BI insn (const 0) ANNUL) h-annul-p) +; (c-call "do_annul") +; (sequence () ; in delay slot +; (set-quiet QI pc h-npc) +; (set-quiet AI h-npc new_pc))) +; (sequence () ; not in delay slot +; (set-quiet QI pc h-npc) +; (set-quiet AI h-npc (add new_pc (const 4)))) +; )) +;) + +; Instruction fields. + +(dnf f-op "op" () 31 2) +(dnf f-op2 "op2" () 24 3) +(dnf f-op3 "op3" () 24 6) +(dnf f-rs1 "rs1" () 18 5) +(dnf f-rs2 "rs2" () 4 5) +(dnf f-rd "rd" () 29 5) +(dnf f-rd-res "rd" (RESERVED) 29 5) +(dnf f-i "i" () 13 1) +(df f-simm13 "simm13" () 12 13 INT #f #f) +(dnf f-imm22 "imm22" () 21 22) +(define-ifield (name f-hi22) (comment "hi22") (attrs) + (start 21) (length 22) + ; shifting done elsewhere + ;(encode (value pc) (srl WI value (const 10))) + ;(decode (value pc) (sll WI value (const 10))) +) +(dnf f-a "a" () 29 1) +(dnf f-fmt2-cond "fmt2 cond" () 28 4) +(df f-disp22 "disp22" (PCREL-ADDR) 21 22 INT + ((value pc) (sra WI (sub WI value pc) (const WI 2))) + ((value pc) (add WI (sll WI value (const WI 2)) pc))) +(df f-disp30 "disp30" (PCREL-ADDR) 29 30 INT + ((value pc) (sra WI (sub WI value pc) (const WI 2))) + ((value pc) (add WI (sll WI value (const WI 2)) pc))) +(dnf f-opf "opf" () 13 9) +(dnf f-res-12-8 "reserved bits of simm13 field when i=0" (RESERVED) 12 8) +(dnf f-simm10 "simm10" () 9 10) +(dnf f-fmt2-cc "cc" () 21 2) +(dnf f-fmt3-cc "fmt3 cc" () 26 2) +(dnf f-x "x" () 12 1) +(dnf f-shcnt32 "shcnt32" () 4 5) +(dnf f-fcn "fcn" () 29 5) +(dnf f-imm-asi "asi" () 12 8) +(dnf f-asi "asi" () 12 8) +(dnf f-res-asi "reserved bits in asi position" (RESERVED) 12 8) +(dnf f-fmt4-cc "fmt4 cc" () 12 2) +(dnf f-soft-trap "soft trap" () 6 7) +(dnf f-opf-low5 "opf low5" () 9 5) +(dnf f-opf-low6 "opf low6" () 10 6) +(dnf f-opf-cc "cc" () 13 3) + +; Enums of opcodes, special insn values, etc. +; ??? Some of this to be moved and/or split up into sparc{32,64}.cpu. + +(define-normal-insn-enum insn-op + "main insn opcode field, v8 page ???, v9 page 267" + () OP_ f-op + ; order is important, the numbers here are actually part of symbols + ; (e.g. OP_0, OP_1, OP_2, OP_3) so they must be strings. + ("0" "1" "2" "3") +) + +(define-normal-insn-enum insn-op2 + "op2 insn type, v8 page ???, v9 page 267" + () OP2_ f-op2 + ; order is important + ; ??? some of these are for v9 only (ok?) + (UNIMP BPCC BICC BPR SETHI FBPFCC FBFCC RESERVED) +) + +(define-normal-insn-enum insn-fmt2 + "op=2 op3 values, v8 page ??, v9 page 268" + () OP3_ f-op3 + ( + (ADD 0) (ADDCC 16) ; v9 page 135 + (ADDX 8) (ADDXCC 24) ; v8 page ?? + (ADDC 8 ARCH64) (ADDCCC 24 ARCH64) ; v9 page 135 + (SUB 4) (SUBCC 20) ; v9 page 230 + (SUBX 12) (SUBXCC 28) ; v8 page ?? + (SUBC 12 ARCH64) (SUBCCC 28 ARCH64) ; v9 page 230 + (AND 1) (ANDCC 17) (ANDN 5) (ANDNCC 21) + (OR 2) (ORCC 18) (ORN 6) (ORNCC 22) + (XOR 3) (XORCC 19) (XNOR 7) (XNORCC 23) + (SLL #x25) (SRL #x26) (SRA #x27) + (MULSCC #x24 !ARCH64) ; v8 page 112 + (UMUL #xa) (SMUL #xb) (UMULCC #x1a) (SMULCC #x1b) ; v8 page 113 + (UDIV #xe) (SDIV #xf) (UDIVCC #x1e) (SDIVCC #x1f) + + (FPOPS1 #x34) (FPOPS2 #x35) + + (SAVE #x3c) (RESTORE #x3d) ; v8 page 117 + (RETT #x39) ; v8 page 127 + (JMPL #x38) ; v8 page 126 + + (RDY #x28) (RDASR #x28) ; v8 page 131 + (WRY #x30) (WRASR #x30) ; v8 page 133 + + ; v8 page 131 + (RDPSR #x29 !ARCH64) (RDWIM #x2a !ARCH64) (RDTBR #x2b !ARCH64) + ; v8 page 133 + (WRPSR #x31 !ARCH64) (WRWIM #x32 !ARCH64) (WRTBR #x33 !ARCH64) + + ; v9 page 155 + (DONE_RETRY #x3e ARCH64) + ; v9 page 165 + (FLUSH #x3b ARCH64) + ; v9 page 167 + (FLUSHW #x2b ARCH64) + ; v9 page 169 + (IMPDEP1 #x36 ARCH64) (IMPDEP2 #x37 ARCH64) + ; v9 page 183 + (MEMBAR #x28 ARCH64) + ; v9 page 191 + (MOVCC #x2c ARCH64) + ) +) + +(define-normal-insn-enum insn-fmt3 + "op=3 op3 values, v8 page ???, v9 page 269" + () OP3_ f-op3 + (; order is important + LDUW LDUB LDUH LDD + STW STB STH STD + (LDSW - ARCH64) LDSB LDSH (LDX - ARCH64) + RES12 LDSTUB (STX - ARCH64) SWAP + + LDUWA LDUBA LDUHA LDDA + STWA STBA STHA STDA + (LDSWA - ARCH64) LDSBA LDSHA (LDXA - ARCH64) + RES28 LDSTUBA (STXA - ARCH64) SWAPA + + LDF (LDFSR #x21) (LDXFSR #x21) LDQF LDDF + STF (STFSR #x25) (STXFSR #x25) STQF STDF + RES40 RES41 RES42 RES43 + RES44 PREFETCH RES46 RES47 + + LDFA RES49 LDQFA LDDFA + STFA RES53 STQFA STDFA + RES56 RES57 RES58 RES59 + (CASA - ARCH64) (PREFETCHA - ARCH64) (CASXA - ARCH64) RES63 + ) +) + +(define-normal-insn-enum rd-insn + "rd insn type" + () RD_ f-rd + (; order is important + Y RES1 CCR ASI TICK PC FPRS ASR7 + ASR8 ASR9 ASR10 ASR11 ASR12 ASR13 ASR14 MEMBAR_STBAR + ) +) + +(define-normal-insn-enum wr-insn + "wr insn type" + () WR_ f-rd + (; order is important + Y RES1 CCR ASI ASR4 ASR5 FPRS ASR7 + ASR8 ASR9 ASR10 ASR11 ASR12 ASR13 ASR14 SIGM + ) +) + +; The standard condition code tests. + +(define-normal-insn-enum cc-tests + "condition code tests, v8 page ???, v9 page 144" + () "" f-fmt2-cond + ( + (CC_A 8) ; always + (CC_N 0) ; never + (CC_NE 9) ; not equal + (CC_NZ 9) ; not zero + (CC_E 1) ; equal + (CC_Z 1) ; zero + (CC_G 10) ; greater + (CC_LE 2) ; less or equal + (CC_GE 11) ; greater or equal + (CC_L 3) ; less + (CC_GU 12) ; unsigned greater + (CC_LEU 4) ; unsigned less or equal + (CC_CC 13) ; carry clear + (CC_GEU 13) ; unsigned greater or equal + (CC_CS 5) ; carry set + (CC_LU 5) ; unsigned less than + (CC_POS 14) ; positive + (CC_NEG 6) ; negative + (CC_VC 15) ; overflow clear + (CC_VS 7) ; overflow set + ) +) + +; Floating point condition code tests. + +(define-normal-insn-enum fcc-tests + "condition code tests, v8 page ???, v9 page 138" + () "FCOND_" f-fmt2-cond + ( + (A 8) ; always + (N 0) ; never + (U 7) ; unordered + (G 6) ; greater + (UG 5) ; unordered or greater + (L 4) ; less + (UL 3) ; unordered or less + (LG 2) ; less or greater + (NE 1) ; less or greater or unordered (not equal) + (E 9) ; equal + (UE 10) ; unordered or equal + (GE 11) ; greater or equal + (UGE 12) ; unordered or greater or equal + (LE 13) ; less or equal + (ULE 14) ; unordered or less or equal + (O 15) ; equal or less or greater (ordered) + ) +) + +(define-normal-insn-enum fcc-value "fcc value" () FCC_ f-fmt2-cc + (EQ LT GT UN) +) + +(define-normal-insn-enum fpop1 + "fp op 1, v8 page ???, v9 page 270" + () FPOPS1_ f-opf + ( + (FMOVS 1) (FMOVD 2) (FMOVQ 3) + (FNEGS 5) (FNEGD 6) (FNEGQ 7) + (FABSS 9) (FABSD 10) (FABSQ 11) + (FSQRTS #x29) (FSQRTD #x2a) (FSQRTQ #x2b) + (FADDS #x41) (FADDD #x42) (FADDQ #x43) + (FSUBS #x45) (FSUBD #x46) (FSUBQ #x47) + (FMULS #x49) (FMULD #x4a) (FMULQ #x4b) + (FDIVS #x4d) (FDIVD #x4e) (FDIVQ #x4f) + (FSMULD #x69) (FDMULQ #x6e) + (FSTOX #x81) (FDTOX #x82) (FQTOX #x83) + (FXTOS #x84) (FXTOD #x88) (FXTOQ #x8c) + (FITOS #xc4) (FDTOS #xc6) (FQTOS #xc7) + (FITOD #xc8) (FSTOD #xc9) (FQTOD #xcb) + (FITOQ #xcc) (FSTOQ #xcd) (FDTOQ #xce) + (FSTOI #xd1) (FDTOI #xd2) (FQTOI #xd3) + (MAX 511) + ) +) + +; ??? check MACH64, are all v9 only? + +(define-normal-insn-enum fpop2 + "fp op 2, v9 page 271" + (ARCH64) FPOPS2_ f-opf + ( + (FCMPS #x51) (FCMPD #x52) (FCMPQ #x53) + (FCMPSE #x55) (FCMPDE #x56) (FCMPQE #x57) + (FMOVSFCC0 #x01) (FMOVDFCC0 #x02) (FMOVQFCC0 #x03) + (FMOVSFCC1 #x41) (FMOVDFCC1 #x42) (FMOVQFCC1 #x43) + (FMOVSFCC2 #x81) (FMOVDFCC2 #x82) (FMOVQFCC2 #x83) + (FMOVSFCC3 #xc1) (FMOVDFCC3 #xc2) (FMOVQFCC3 #xc3) + (FMOVSICC #x101) (FMOVDICC #x102) (FMOVQICC #x103) + (FMOVSXCC #x181) (FMOVDXCC #x182) (FMOVQXCC #x183) + (FMOVRZS #x25) (FMOVRZD #x26) (FMOVRZQ #x27) + (FMOVRLEZS #x45) (FMOVRLEZD #x46) (FMOVRLEZQ #x47) + (FMOVRLZS #x65) (FMOVRLZD #x66) (FMOVRLZQ #x67) + (FMOVRNZS #xa5) (FMOVRNZD #xa6) (FMOVRNZQ #xa7) + (FMOVRGZS #xc5) (FMOVRGZD #xc6) (FMOVRGZQ #xc7) + (FMOVRGEZS #xe5) (FMOVRGEZD #xe6) (FMOVRGEZQ #xe7) + (MAX 511) + ) +) + +; Hardware pieces. +; These are common to all (or most all) machs. + +(dnh h-pc "program counter" (PC PROFILE) (pc) () () ()) + +(define-hardware + (name h-npc) + (comment "next pc") + (attrs PC) + (type register WI) +) + +(define-keyword + (name gr-names) + (print-name h-gr) + (prefix "%") + (values (fp 30) (sp 14) + (g0 0) (g1 1) (g2 2) (g3 3) (g4 4) (g5 5) (g6 6) (g7 7) + (o0 8) (o1 9) (o2 10) (o3 11) (o4 12) (o5 13) (o6 14) (o7 15) + (l0 16) (l1 17) (l2 18) (l3 19) (l4 20) (l5 21) (l6 22) (l7 23) + (i0 24) (i1 25) (i2 26) (i3 27) (i4 28) (i5 29) (i6 30) (i7 31) + ) +) + +; The general registers are accessed via a level of indirection to handle +; the register windows. h-gr provides the top level entry point which is +; indirected through various means depending upon the register window +; implementation of the day. To be solidified in time. +; +; ??? Separation of h-gr for sparc32/64 is currently an experiment. + +(define-hardware + (name h-gr) ; h-gr32 + ;(semantic-name h-gr) + (comment "sparc32 general registers") + (attrs PROFILE VIRTUAL (MACH32)) + (type register SI (32)) + (indices extern-keyword gr-names) ; keyword "%" (h-gr-indices)) + (get (index) (c-call SI "GET_H_GR_RAW" index)) + (set (index newval) (c-call VOID "SET_H_GR_RAW" index newval)) +) + +(define-hardware + (name h-gr) ; h-gr64 + ;(semantic-name h-gr) + (comment "sparc64 general registers") + (attrs PROFILE VIRTUAL (MACH64)) + (type register DI (32)) + (indices extern-keyword gr-names) ; keyword "%" (h-gr-indices)) + (get (index) (c-call SI "GET_H_GR_RAW" index)) + (set (index newval) (c-call VOID "SET_H_GR_RAW" index newval)) +) + +(define-hardware + (name h-a) + (comment "annul bit") + (type immediate (UINT 1)) + (values keyword "" (("" 0) (",a" 1))) +) + +; The condition code bits. +(dsh h-icc-c "icc carry bit" () (register BI)) +(dsh h-icc-n "icc negative bit" () (register BI)) +(dsh h-icc-v "icc overflow bit" () (register BI)) +(dsh h-icc-z "icc zero bit" () (register BI)) + +; The extended condition code bits of v9. +(dsh h-xcc-c "xcc carry bit" (ARCH64) (register BI)) +(dsh h-xcc-n "xcc negative bit" (ARCH64) (register BI)) +(dsh h-xcc-v "xcc overflow bit" (ARCH64) (register BI)) +(dsh h-xcc-z "xcc zero bit" (ARCH64) (register BI)) + +; Misc. regs. + +; h-y is virtual because the real value is kept in the asr array. +; ??? wip is get/set fields +(define-hardware + (name h-y) + (comment "y register") + (attrs VIRTUAL) + (type register WI) + (get () (reg WI h-asr 0)) + (set (newval) (set (reg WI h-asr 0) newval)) +) + +(dnh h-asr "ancilliary state registers" () + (register WI (32)) + (keyword "%" + ( + (y 0) + (asr0 0) (asr1 1) (asr2 2) (asr3 3) + (asr4 4) (asr5 5) (asr6 6) (asr7 7) + (asr8 8) (asr9 9) (asr10 10) (asr11 11) + (asr12 12) (asr13 13) (asr14 14) (asr15 15) + (asr16 16) (asr17 17) (asr18 18) (asr19 19) + (asr20 20) (asr21 21) (asr22 22) (asr23 23) + (asr24 24) (asr25 25) (asr26 26) (asr27 27) + (asr28 28) (asr29 29) (asr30 30) (asr31 31) + )) + () + () +) ; FIXME:wip + +; This assists the simulator engine, not part of the architecture. +; ??? There should be an attribute for these critters. +(dsh h-annul-p "annul next insn? - assists execution" () (register BI)) + +; %lo,%hi,etc. + +(dnh h-lo10 "signed low 10 bits" () + (immediate (UINT 10)) ; integer (UNSIGNED) 10)) + () () () +) + +(dnh h-lo13 "signed low 13 bits" () + (immediate (INT 13)) ; integer (SIGNED) 13)) + () () () +) + +(dnh h-hi22 "unsigned high 22 bits" () + (immediate (UINT 22)) ; integer (UNSIGNED) 22)) + () () () +) + +; Instruction Operands. + +(dnop rs1 "source register 1" () h-gr f-rs1) +(dnop rs2 "source register 2" () h-gr f-rs2) +(dnop rd "destination register" () h-gr f-rd) + +; double-reg args to ldd,std + +(define-operand + (name rdd) + (comment "rd as two registers") + (type h-gr) + (index f-rd) +; (get (args self index) +; (mode (DI) +; (eq (and index (const 1)) (const 0)) ; predicate, even regs only +; (make: DI SI +; (reg h-gr index) +; (reg h-gr (add index (const 1))))) +; ) +; (set (args self index newval) +; (mode (DI) +; (eq (and index (const 1)) (const 0)) ; predicate, even regs only +; (sequence () +; (set (reg h-gr index) +; (slice: SI DI newval (const 0))) +; (set (reg h-gr (add index (const 1))) +; (slice: SI DI newval (const 1))))) +; ) +; (asm (parse "rdd")) +) + +(dnop simm13 "13 bit signed immediate" () h-lo13 f-simm13) +(dnop imm22 "22 bit unsigned immediate" () h-uint f-imm22) + +(dnop a "annul bit" () h-a f-a) + +(dnop icc-c "carry flag" (SEM-ONLY) h-icc-c f-nil) +(dnop icc-v "overflow flag" (SEM-ONLY) h-icc-v f-nil) +(dnop icc-n "negative flag" (SEM-ONLY) h-icc-n f-nil) +(dnop icc-z "zero flag" (SEM-ONLY) h-icc-z f-nil) + +(dnop xcc-c "extended carry flag" (SEM-ONLY) h-xcc-c f-nil) +(dnop xcc-v "extended overflow flag" (SEM-ONLY) h-xcc-v f-nil) +(dnop xcc-n "extended negative flag" (SEM-ONLY) h-xcc-n f-nil) +(dnop xcc-z "extended zero flag" (SEM-ONLY) h-xcc-z f-nil) + +; These two map h-asr to f-rs1 and f-rd so we have something to use in +; the assembler spec, insn format, and semantic fields. +; FIXME: 'twould be nice if we could do this mapping on the fly in the +; define-insn (i.e. the old (%0,%1 stuff)). +(dnop rdasr "read asr operand" () h-asr f-rs1) +(dnop wrasr "write asr operand" () h-asr f-rd) + +(dnop asi "asi field" () h-uint f-asi) + +(dnop disp22 "22 bit displacement" () h-iaddr f-disp22) +(dnop disp30 "30 bit displacement" () h-iaddr f-disp30) + +(define-operand + (name lo10) + (comment "10 bit signed immediate, for %lo()") + (type h-lo10) + (index f-simm10) + (handlers (parse "lo10")) +) +(define-operand + (name lo13) + (comment "13 bit signed immediate, for %lo()") + (type h-lo13) + (index f-simm13) + (handlers (parse "lo13")) +) +(define-operand + (name hi22) + (comment "22 bit unsigned immediate, for %hi()") + (type h-hi22) + (index f-hi22) + (handlers (parse "hi22") (print "hi22")) +) + +; SPARC specific instruction attributes used: + +(define-attr + (for insn) + (type boolean) + (name TRAP) + (comment "insn is a trap insn") +) + +(define-attr + (for insn) + (type boolean) + (name V9-DEPRECATED) + (comment "insn is deprecated in v9") +) + +; Globally useful macros. + +; CC is one of icc,xcc. +; ??? Might want canonical forms of these. +; ??? Maybe move this to a library. +; ??? bitfields still on todo list +(define-pmacro (test-always cc) (const 1)) +(define-pmacro (test-never cc) (const 0)) +(define-pmacro (test-ne cc) (not (.sym cc -z))) +(define-pmacro (test-eq cc) (.sym cc -z)) +(define-pmacro (test-gt cc) (not (or (.sym cc -z) (xor (.sym cc -n) (.sym cc -v))))) +(define-pmacro (test-le cc) (or (.sym cc -z) (xor (.sym cc -n) (.sym cc -v)))) +(define-pmacro (test-ge cc) (not (xor (.sym cc -n) (.sym cc -v)))) +(define-pmacro (test-lt cc) (xor (.sym cc -n) (.sym cc -v))) +(define-pmacro (test-gtu cc) (not (or (.sym cc -c) (.sym cc -z)))) +(define-pmacro (test-leu cc) (or (.sym cc -c) (.sym cc -z))) +(define-pmacro (test-geu cc) (not (.sym cc -c))) +(define-pmacro (test-ltu cc) (.sym cc -c)) +(define-pmacro (test-pos cc) (not (.sym cc -n))) +(define-pmacro (test-neg cc) (.sym cc -n)) +(define-pmacro (test-vc cc) (not (.sym cc -v))) +(define-pmacro (test-vs cc) (.sym cc -v)) + +(define-pmacro (uncond-br-sem test cc) + (delay (const 1) + (sequence () + (if (test cc) + (set pc disp22)) + (annul a))) +) +(define-pmacro (cond-br-sem test cc) + (delay (const 1) + (if (test cc) + (set pc disp22) + (annul a))) +) + +; The rest is broken out into various files. + +(if (keep-mach? (sparc-v8 sparclite)) + (include "sparc32.cpu")) + +(if (keep-mach? (sparc-v9 sparc-v9a)) + (include "sparc64.cpu")) + +(include "sparccom.cpu") +(include "sparcfpu.cpu") diff --git a/cgen/sparc.opc b/cgen/sparc.opc new file mode 100644 index 00000000000..cbc025b2916 --- /dev/null +++ b/cgen/sparc.opc @@ -0,0 +1,180 @@ +/* SPARC opcode support. -*- C -*- + Copyright (C) 2000 Red Hat, Inc. + This file is part of CGEN. + This file is copyrighted with the GNU General Public License. + See file COPYING for details. */ + +/* This file is an addendum to sparc.cpu. Heavy use of C code isn't + appropriate in .cpu files, so it resides here. This especially applies + to assembly/disassembly where parsing/printing can be quite involved. + Such things aren't really part of the specification of the cpu, per se, + so .cpu files provide the general framework and .opc files handle the + nitty-gritty details as necessary. + + Each section is delimited with start and end markers. + + <cpu>-opc.h additions use: "-- opc.h" + <cpu>-opc.c additions use: "-- opc.c" + <cpu>-asm.c additions use: "-- asm.c" + <cpu>-dis.c additions use: "-- dis.c" +*/ + +/* -- opc.h */ + +#undef CGEN_DIS_HASH_SIZE +#define CGEN_DIS_HASH_SIZE 256 +#undef CGEN_DIS_HASH +extern const unsigned int sparc_cgen_opcode_bits[]; +#define CGEN_DIS_HASH(buffer, insn) \ +((((insn) >> 24) & 0xc0) \ + | (((insn) & sparc_cgen_opcode_bits[((insn) >> 30) & 3]) >> 19)) + +/* -- */ + +/* -- asm.c */ + +/* It is important that we only look at insn code bits as that is how the + opcode table is hashed. OPCODE_BITS is a table of valid bits for each + of the main types (0,1,2,3). */ +const unsigned int sparc_cgen_opcode_bits[4] = { + 0x01c00000, 0x0, 0x01f80000, 0x01f80000 +}; + +/* Handle %lo(). */ + +static const char * +parse_lo10 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (strncasecmp (*strp, "%lo(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (od, strp, opindex, BFD_RELOC_LO10, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + value &= 0x3ff; + *valuep = value; + return errmsg; + } + + return cgen_parse_unsigned_integer (od, strp, opindex, valuep); +} + +static const char * +parse_lo13 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (strncasecmp (*strp, "%lo(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (od, strp, opindex, BFD_RELOC_LO10, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + value &= 0x3ff; + *valuep = value; + return errmsg; + } + + return cgen_parse_unsigned_integer (od, strp, opindex, valuep); +} + +/* Handle %hi(). */ + +static const char * +parse_hi22 (cd, strp, opindex, valuep) + CGEN_CPU_DESC cd; + const char **strp; + int opindex; + unsigned long *valuep; +{ + const char *errmsg; + enum cgen_parse_operand_result result_type; + bfd_vma value; + + if (strncasecmp (*strp, "%hi(", 4) == 0) + { + *strp += 4; + errmsg = cgen_parse_address (od, strp, opindex, BFD_RELOC_HI22, + &result_type, &value); + if (**strp != ')') + return "missing `)'"; + ++*strp; + if (result_type == CGEN_PARSE_OPERAND_RESULT_NUMBER) + value >>= 10; + *valuep = value; + return errmsg; + } + + return cgen_parse_unsigned_integer (od, strp, opindex, valuep); +} + +/* -- */ + +/* -- dis.c */ + +/* Include "%hi(foo)" in sethi output. */ + +static void +print_hi22 (cd, dis_info, value, attrs, pc, length) + CGEN_CPU_DESC cd; + PTR dis_info; + long value; + unsigned int attrs; + bfd_vma pc; + int length; +{ + disassemble_info *info = (disassemble_info *) dis_info; + (*info->fprintf_func) (info->stream, "%%hi(0x%lx)", value << 10); +} + +#undef CGEN_PRINT_INSN +#define CGEN_PRINT_INSN my_print_insn + +static int +my_print_insn (cd, pc, info) + CGEN_CPU_DESC cd; + bfd_vma pc; + disassemble_info *info; +{ + char buffer[CGEN_MAX_INSN_SIZE]; + char *buf = buffer; + int status; + unsigned long insn_value; + int len; + + /* Read the base part of the insn. */ + + status = (*info->read_memory_func) (pc, buf, 4, info); + if (status != 0) + { + (*info->memory_error_func) (status, pc, info); + return -1; + } + + len = print_insn (od, pc, info, buf, 4); + if (len != 0) + return len; + + /* CGEN doesn't handle this insn yet. Fall back on old way. */ + return old_print_insn_sparc (pc, info); +} + +/* -- */ diff --git a/cgen/sparc32.cpu b/cgen/sparc32.cpu new file mode 100644 index 00000000000..7634223d407 --- /dev/null +++ b/cgen/sparc32.cpu @@ -0,0 +1,170 @@ +; SPARC32 CPU description. -*- Scheme -*- +; This file contains elements specific to sparc32. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Notes: +; - sparc64 support wip +; - fp support todo +; - source file layout wip +; - cpu family layout wip + +; ??? For the nonce there is one cpu family to cover all 32 bit sparcs. +; It's not clear this will work, but following the goal of incremental +; complication .... + +(define-cpu + (name sparc32) + (comment "SPARC 32 bit architecture") + (endian big) + (word-bitsize 32) + ; Generated files have a "32" suffix. + (file-transform "32") +) + +(define-mach + (name sparc-v8) + (comment "sparc v8") + (cpu sparc32) + (bfd-name "sparc") +) + +(define-mach + (name sparclite) + (comment "Fujitsu sparclite") + (cpu sparc32) + (bfd-name "sparc_sparclite") +) + +; sparc32 models + +(define-model + (name sparc32-def) + (comment "sparc32 default") + (attrs) + (mach sparc-v8) + ; wip + (pipeline p-foo "" () ((fetch) (decode) (execute) (memory) (writeback))) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () () () ()) +) + +; sparc32 enums of opcodes, special insn values, etc. + +; sparc32 hardware pieces. + +; ??? impl,ver are left as part of h-psr (change maybe later) +(define-hardware + (name h-psr) + (comment "psr register") + (type register USI) + (get () (c-call USI "@cpu@_get_h_psr_handler")) + (set (newval) (c-call VOID "@cpu@_set_h_psr_handler" newval)) +) + +(dsh h-s "supervisor bit" () (register BI)) +(dsh h-ps "previous supervisor bit" () (register BI)) + +(dsh h-pil "processor interrupt level" () (register UQI)) + +(dsh h-et "enable traps bit" () (register BI)) + +(define-hardware + (name h-tbr) + (comment "trap base register") + (type register WI) + ;CPU (h_tbr) = (CPU (h_tbr) & 0xff0) | ((newval) & 0xfffff000); + (set (newval) (set (raw-reg WI h-tbr) + (or WI (and WI (raw-reg WI h-tbr) (const #xff0)) + (and WI newval (const #xfffff000))))) +) + +(define-hardware + (name h-cwp) + (comment "current window pointer") + (type register UQI) + (set (newval) (c-call VOID "@cpu@_set_h_cwp_handler" newval)) +) + +(define-hardware + (name h-wim) + (comment "window invalid mask") + (type register USI) + ; ??? These just put ideas down so I can play with them. Ignore. + ;(get (value index) (and SI value (c-code SI "((1 << NWINDOWS) - 1)"))) + ;(get (self mode index insn) + ; (c-code USI "(CPU (h_wim) & ((1 << NWINDOWS) - 1))")) + ;(set (self mode index insn newval) + ; (s-eval `(set SI ,self (and SI ,newval (const #xff))))) + (get () (and (raw-reg USI h-wim) + (sub (sll (const 1) (c-raw-call SI "GET_NWINDOWS")) (const 1)))) +) + +(dsh h-ag "alternate global indicator" () (register QI)) + +; Coprocessor support. + +(dsh h-ec "enable coprocessor bit" () (register BI)) + +; Floating point support. +; wip. +; - currently evaluating the various possibilities + +(dsh h-ef "enable fpu bit" () (register BI)) + +(dsh h-fsr "floating point status register" () (register USI)) + +; sparc32 instruction definitions. + +; Special register move operations. + +; %y is handled by the asr insns + +(dni rd-asr "read asr" () + "rd $rdasr,$rd" ; note: `rdasr' is for ReaD asr, `rd' is for Reg Dest. + (+ OP_2 OP3_RDASR rd rdasr (f-i 0) (f-simm13 0)) + (set rd rdasr) + ()) +(dni wr-asr "write asr" () + "wr $rs1,$rs2,$wrasr" + (+ OP_2 OP3_WRASR wrasr rs1 rs2 (f-i 0) (f-res-asi 0)) + (set wrasr (xor rs1 rs2)) + ()) +(dni wr-asr-imm "write-imm asr" () + "wr $rs1,$simm13,$wrasr" + (+ OP_2 OP3_WRASR wrasr rs1 (f-i 1) simm13) + (set wrasr (xor rs1 simm13)) + ()) + +(define-pmacro (rdwr-op name op3 asm-name reg-name) + (begin + (dni (.sym rd- name) (.str "read " name) () + (.str "rd " asm-name ",$rd") + (+ OP_2 (.sym OP3_RD op3) rd (f-rs1 0) (f-i 0) (f-simm13 0)) + (set rd (reg WI reg-name)) + ()) + (dni (.sym wr- name) (.str "write " name) () + (.str "wr $rs1,$rs2," asm-name) + (+ OP_2 (.sym OP3_WR op3) (f-rd 0) rs1 rs2 (f-i 0) (f-res-asi 0)) + (set (reg WI reg-name) (xor rs1 rs2)) + ()) + (dni (.sym wr- name -imm) (.str "write-imm " name) () + (.str "wr $rs1,$simm13," asm-name) + (+ OP_2 (.sym OP3_WR op3) (f-rd 0) rs1 (f-i 1) simm13) + (set (reg WI reg-name) (xor rs1 simm13)) + ()) + ) +) + +(rdwr-op psr PSR "%psr" h-psr) +(rdwr-op wim WIM "%wim" h-wim) +(rdwr-op tbr TBR "%tbr" h-tbr) + +; TODO: +; - rdy,wry +; - stbar +; - flush +; - ldc, lddc, ldcsr, stc, stdc, stcsr, stdcq +; - cbccc, cpop diff --git a/cgen/sparc64.cpu b/cgen/sparc64.cpu new file mode 100644 index 00000000000..1c4301b5532 --- /dev/null +++ b/cgen/sparc64.cpu @@ -0,0 +1,422 @@ +; SPARC64 CPU description. -*- Scheme -*- +; This file contains elements specific to sparc64. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Notes: +; - sparc64 support wip +; - fp support todo +; - source file layout wip +; - cpu family layout wip + +; ??? For the nonce there is one cpu family to cover all 64 bit sparcs. +; It's not clear this will work, but following the goal of incremental +; complication .... + +(define-cpu + (name sparc64) + (comment "SPARC 64 bit architecture") + (endian big) ; ??? big insn, either data + (word-bitsize 64) + ; Generated files have a "64" suffix. + (file-transform "64") +) + +(define-mach + (name sparc-v9) + (comment "sparc v9") + ;(attrs S64-P) + (cpu sparc64) + (bfd-name "sparc_v9") +) + +(define-mach + (name sparc-v9a) + (comment "sparc v9a (sparc-v9 + vis)") + ;(attrs S64-P) + (cpu sparc64) + (bfd-name "sparc_v9a") +) + +; sparc64 models + +(define-model + (name sparc64-def) + (comment "sparc64 default") + (attrs) + (mach sparc-v9) + ; wip (Meaning, yes I know this is inaccurate, duh ... + ; When I have time I'll finish this up right. + ; Support for some of this isn't even implemented yet and support for the + ; rest will be rewritten.) + (pipeline p-foo "" () ((fetch) (decode) (execute) (memory) (writeback))) + (unit u-exec "Execution Unit" () + 1 1 ; issue done + () () () ()) +) + +; sparc64 instruction fields + +(dnf f-fmt2-cc1 "cc" ((MACH64)) 21 1) +(dnf f-fmt2-cc0 "cc" ((MACH64)) 20 1) +(dnf f-p "p" ((MACH64)) 19 1) +(dnf f-fmt2-rcond "fmt2 rcond" ((MACH64)) 27 3) +(df f-disp19 "disp19" (PCREL-ADDR (MACH64)) 13 19 INT #f #f) +(dnf f-fmt3-rcond "fmt3 rcond" ((MACH64)) 19 3) +(dnf f-shcnt64 "shcnt64" ((MACH64)) 5 6) +(dnf f-fmt4-cond "cond" ((MACH64)) 14 4) +(dnf f-fmt4-ccx-hi "ccx hi" ((MACH64)) 13 1) +(dnf f-fmt4-ccx-lo "ccx lo" ((MACH64)) 19 2) +(dnf f-fmt4-rcond "fmt4 rcond" ((MACH64)) 19 3) +(dnf f-fmt4-cc2 "fmt4 cc2" ((MACH64)) 18 1) +(dnf f-fmt4-cc1-0 "fmt4 cc1,cc0" ((MACH64)) 12 2) +(dnf f-fmt4-res10-6 "reserved bits in movcc insns" (RESERVED (MACH64)) 10 6) + +; The disp16 field requires a bit of special handling as it is split in two. +(df f-disp16-hi "disp16 hi" ((MACH64)) 10 2 INT #f #f) +(dnf f-disp16-lo "disp16 lo" ((MACH64)) 18 14) +(dnmf f-disp16 "disp16" (PCREL-ADDR (MACH64)) INT + (f-disp16-hi f-disp16-lo) + (sequence () ; insert + (set (ifield f-disp16-hi) (srl (ifield f-disp16) (const 14))) + (set (ifield f-disp16-lo) (and (ifield f-disp16) (const #x3fff))) + ) + (sequence () ; extract + ; ??? where will pc be added? + (set (ifield f-disp16) (or (sll (ifield f-disp16-hi) (const 14)) + (ifield f-disp16-low))) + ) +) + +(dnf f-res-18-19 "reserved bits in done/retry" (RESERVED (MACH64)) 18 19) + +; sparc64 enums of opcodes, special insn values, etc. + +(define-normal-insn-enum insn-rcond "rcond op values" () RCOND_ f-fmt2-rcond + ( + (BRZ 1) + (BRLEZ 2) + (BRLZ 3) + (BRNZ 5) + (BRGZ 6) + (BRGEZ 7) + ) +) + +; sparc64 hardware pieces. + +(dsh h-ver "version" ((MACH64)) (register UDI)) + +(dsh h-pstate "processor state" ((MACH64)) (register UDI)) + +(dsh h-tba "trap base address" ((MACH64)) (register UDI)) + +; FIXME: These are a stack of values. +(dsh h-tt "trap type" ((MACH64)) (register UDI)) +(dsh h-tpc "trap pc" ((MACH64)) (register UDI)) +(dsh h-tnpc "trap npc" ((MACH64)) (register UDI)) +(dsh h-tstate "trap state" ((MACH64)) (register UDI)) + +(dsh h-tl "trap level" ((MACH64)) (register UQI)) + +(dsh h-asi "address space identifier" ((MACH64)) (register UQI)) + +(dsh h-tick "tick counter" ((MACH64)) (register UDI)) + +(dsh h-cansave "savable window registers" ((MACH64)) (register UDI)) +(dsh h-canrestore "restorable window registers" ((MACH64)) (register UDI)) +(dsh h-otherwin "other window registers" ((MACH64)) (register UDI)) +(dsh h-cleanwin "clean window registers" ((MACH64)) (register UDI)) + +(dsh h-wstate "window state" ((MACH64)) (register UDI)) + +(define-hardware + (name h-ixcc) + (comment "condition code selector") + (attrs (MACH64)) + (type immediate (UINT 1)) + (values keyword "%" (("icc" 0) ("xcc" 1))) +) + +(define-hardware + (name h-p) + (comment "prediction bit") + (attrs (MACH64)) + (type immediate (UINT 1)) + (values keyword "" (("" 0) (",pf" 0) (",pt" 1))) +) + +; sparc64 operands + +(dnop ixcc "%icc,%xcc arg to bpcc insns" ((MACH64)) h-ixcc f-fmt2-cc1) + +(dnop p "prediction bit" ((MACH64)) h-p f-p) + +(dnop disp16 "16 bit displacement" ((MACH64)) h-iaddr f-disp16) +(dnop disp19 "19 bit displacement" ((MACH64)) h-iaddr f-disp19) + +; sparc64 branches + +(dnf f-bpr-res28-1 "reserved bit 28 in bpr insn" (RESERVED (MACH64)) 28 1) + +(define-pmacro (bpr-cbranch name comment rcond-op comp-op) + (dni name (.str comment ", v9 page 136") + ((MACH64)) + (.str name "$a$p $rs1,$disp16") + (+ OP_0 a (f-bpr-res28-1 0) (.sym RCOND_ rcond-op) + OP2_BPR p rs1 disp16) + (delay (const 1) + (if (comp-op rs1 (const 0)) + (set pc disp16) + (annul a))) + ()) +) +(bpr-cbranch beqz "beqz" BRZ eq) +(bpr-cbranch bgez "bgez" BRGEZ ge) +(bpr-cbranch bgtz "bgtz" BRGZ gt) +(bpr-cbranch blez "blez" BRLEZ le) +(bpr-cbranch bltz "bltz" BRLZ lt) +(bpr-cbranch bnez "bnez" BRNZ ne) + +(define-pmacro (bpcc-branch bname comment cond test br-sem) + (dni (.sym bpcc- bname) + (.str "branch with prediction %icc " comment ", v9 page 146") + ((MACH64)) + (.str bname "$a$p %icc,$disp19") + (+ OP_0 a cond OP2_BPCC (f-fmt2-cc1 0) (f-fmt2-cc0 0) p disp19) + (br-sem test icc) + ()) + (dni (.sym bpcc- bname) + (.str "branch with prediction %xcc " comment ", v9 page 146") + ((MACH64)) + (.str bname "$a$p %xcc,$disp19") + (+ OP_0 a cond OP2_BPCC (f-fmt2-cc1 1) (f-fmt2-cc0 0) p disp19) + (br-sem test xcc) + ()) +) +; test-*,uncond-br-sem,cond-br-sem are defined in sparc.cpu. +(bpcc-branch ba "always" CC_A test-always uncond-br-sem) +(bpcc-branch bn "never" CC_N test-never uncond-br-sem) +(bpcc-branch bne "ne" CC_NE test-ne cond-br-sem) +(bpcc-branch be "eq" CC_E test-eq cond-br-sem) +(bpcc-branch bg "gt" CC_G test-gt cond-br-sem) +(bpcc-branch ble "le" CC_LE test-le cond-br-sem) +(bpcc-branch bge "ge" CC_GE test-ge cond-br-sem) +(bpcc-branch bl "lt" CC_L test-lt cond-br-sem) +(bpcc-branch bgu "gtu" CC_GU test-gtu cond-br-sem) +(bpcc-branch bleu "leu" CC_LEU test-leu cond-br-sem) +(bpcc-branch bcc "geu" CC_CC test-geu cond-br-sem) +(bpcc-branch bcs "ltu" CC_CS test-ltu cond-br-sem) +(bpcc-branch bpos "pos" CC_POS test-pos cond-br-sem) +(bpcc-branch bneg "neg" CC_NEG test-neg cond-br-sem) +(bpcc-branch bvc "vc" CC_VC test-vc cond-br-sem) +(bpcc-branch bvs "vs" CC_VS test-vs cond-br-sem) + +; Misc. + +(dni done "done, v9 page 155" ((MACH64)) + "done" + (+ OP_2 (f-fcn 0) OP3_DONE_RETRY (f-res-18-19 0)) + (c-call "@cpu@_done" pc) + () +) +(dni retry "retry, v9 page 155" ((MACH64)) + "done" + (+ OP_2 (f-fcn 1) OP3_DONE_RETRY (f-res-18-19 0)) + (c-call "@cpu@_retry" pc) + () +) + +(dni flush "flush instruction memory rs1+rs2, v9 page 165" ((MACH64)) + "flush" + (+ OP_2 (f-rd 0) OP3_FLUSH rs1 (f-i 0) (f-res-asi 0) rs2) + (c-call "@cpu@_flush" pc (add rs1 rs2)) + () +) +(dni flush-imm "flush instruction memory rs1+simm13, v9 page 165" ((MACH64)) + "flush" + (+ OP_2 (f-rd 0) OP3_FLUSH rs1 (f-i 1) simm13) + (c-call "@cpu@_flush" pc (add rs1 simm13)) + () +) + +(dni flushw "flush register windows, v9 page 167" ((MACH64)) + "flushw" + (+ OP_2 (f-rd 0) OP3_FLUSHW (f-rs1 0) (f-i 0) (f-simm13 0)) + (c-call "@cpu@_flushw" pc) + () +) + +; On sparc64 unimp is called illtrap. + +(dnmi illtrap "illegal instruction trap, v9 page 168" ((MACH64)) + "illtrap $imm22" + (emit unimp imm22) +) + +; Impdep insns + +(dnf f-impdep5 "5 bit field in impdep insns" ((MACH64)) 29 5) +(dnf f-impdep19 "19 bit field in impdep insns" ((MACH64)) 18 19) + +(dnop impdep5 "5 bit arg in impdep insns" ((MACH64)) h-uint f-impdep5) +(dnop impdep19 "19 bit arg in impdep insns" ((MACH64)) h-uint f-impdep19) + +(dni impdep1 "implementation dependent instruction 1, v9 page 169" + ((MACH64)) + "impdep1 $impdep5,$impdep19" + (+ OP_2 impdep5 OP3_IMPDEP1 impdep19) + (c-call "@cpu@_impdep1" pc impdep5 impdep19) + () +) +(dni impdep2 "implementation dependent instruction 1, v9 page 169" + ((MACH64)) + "impdep2 $impdep5,$impdep19" + (+ OP_2 impdep5 OP3_IMPDEP2 impdep19) + (c-call "@cpu@_impdep2" pc impdep5 impdep19) + () +) + +; Memory barrier insn + +(dnf f-membar-res12-6 "reserved bits 12-7 in membar insn" + (RESERVED (MACH64)) 12 6) +(dnf f-cmask "cmask field in membar insn" ((MACH64)) 6 3) +(dnf f-mmask "mmask field in membar insn" ((MACH64)) 3 4) +(dnf f-membarmask "cmask+mmask field in membar insn" ((MACH64)) 6 7) + +(define-hardware + (name h-membarmask) + (comment "membar mask") + (attrs (MACH64)) + (type immediate (UINT 7)) + (values keyword "" ( + ("#StoreStore" #x8) + ("#LoadStore" #x4) + ("#StoreLoad" #x2) + ("#LoadLoad" #x1) + ("#Sync" #x40) + ("#MemIssue" #x20) + ("#Lookaside" #x10) + )) +) + +(define-operand + (name membarmask) + (comment "cmask+mmask arg in membar insn") + (attrs (MACH64)) + (type h-membarmask) + (index f-membarmask) + (handlers (parse "membar_mask") + (print "membar_mask")) +) + +(dni membar "memory barrier, v9 page 183" + ((MACH64)) + "member $membarmask" ; ${membar-mask} + (+ OP_2 (f-rd 0) OP3_MEMBAR (f-rs1 15) (f-i 1) (f-membar-res12-6 0) + membarmask) + (c-call "@cpu@_membar" pc membarmask) + () +) + +; Conditional move insns + +(df f-simm11 "11 bit signed immediate field" ((MACH64)) 10 11 INT #f #f) + +(dnop simm11 "11 bit signed immediate arg to condition move insns" + ((MACH64)) h-sint f-simm11) + +(define-pmacro (cond-move-1 name comment mnemonic cc-prefix cc-name cc-opcode + src-name src-opcode cond test) + (dni name + (.str "move %" cc-name " " comment ", v9 page 191") + ((MACH64)) + (.str mnemonic " " cc-prefix cc-name ",$" src-name ",$rd") + (.splice + OP_2 rd OP3_MOVCC cond + (.unsplice cc-opcode) (.unsplice src-opcode)) + (if (test cc-name) + (set rd src-name)) + ()) +) + +(define-pmacro (cond-move name comment cond test) + (begin + (cond-move-1 (.sym name -icc) comment + name "%" icc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 0)) + rs2 ((f-i 0) (f-fmt4-res10-6 0) rs2) + cond test) + (cond-move-1 (.sym name -imm-icc) comment + name "%" icc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 0)) + simm11 ((f-i 1) simm11) + cond test) + (cond-move-1 (.sym name -xcc) comment + name "%" xcc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 2)) + rs2 ((f-i 0) (f-fmt4-res10-6 0) rs2) + cond test) + (cond-move-1 (.sym name -imm-xcc) comment + name "%" xcc ((f-fmt4-cc2 1) (f-fmt4-cc1-0 2)) + simm11 ((f-i 1) simm11) + cond test) + ) +) +; test-* are defined in sparc.cpu. +(cond-move mova "always" CC_A test-always) +(cond-move movn "never" CC_N test-never) +(cond-move movne "ne" CC_NE test-ne) +(cond-move move "eq" CC_E test-eq) +(cond-move movg "gt" CC_G test-gt) +(cond-move movle "le" CC_LE test-le) +(cond-move movge "ge" CC_GE test-ge) +(cond-move movl "lt" CC_L test-lt) +(cond-move movgu "gtu" CC_GU test-gtu) +(cond-move movleu "leu" CC_LEU test-leu) +(cond-move movcc "geu" CC_CC test-geu) +(cond-move movcs "ltu" CC_CS test-ltu) +(cond-move movpos "pos" CC_POS test-pos) +(cond-move movneg "neg" CC_NEG test-neg) +(cond-move movvc "vc" CC_VC test-vc) +(cond-move movvs "vs" CC_VS test-vs) + +; Arithmetic binary ops + +(define-pmacro (v8-addx-rename old new) + (begin + (dnmi new + (.str old " in v8 is " new " in v9, v9 page 135") () + (.str new " $rs1,$rs2,$rd") + (emit old rs1 rs2 rd)) + (dnmi (.sym new -imm) + (.str old " in v8 is " new " in v9, v9 page 135") () + (.str new " $rs1,$simm13,$rd") + (emit old rs1 simm13 rd)) + ) +) +(v8-addx-rename addx addc) +(v8-addx-rename addxcc addccc) + +; Binary boolean ops + +(define-pmacro (s64-set-bool-flags x) + (sequence () + (set icc-z (zflag (trunc SI x))) + (set icc-n (nflag (trunc SI x))) + (set icc-c (const 0)) + (set icc-v (const 0)) + (set xcc-z (zflag x)) + (set xcc-n (nflag x)) + (set xcc-c (const 0)) + (set xcc-v (const 0)) + ) +) + +; Multiply/Divide + +; FIXME: flags handling incomplete +; FIXME: div-binop is in sparccom.cpu which is included later. +;(div-binop s64-sdiv "sdiv" MACH64 SDIV div ext: (s64-set-bool-flags rd)) +;(div-binop s64-udiv "udiv" MACH64 UDIV div zext: (s64-set-bool-flags rd)) + +; TODO +; - casa, casxa diff --git a/cgen/sparccom.cpu b/cgen/sparccom.cpu new file mode 100644 index 00000000000..2c8e7fc89ed --- /dev/null +++ b/cgen/sparccom.cpu @@ -0,0 +1,766 @@ +; SPARC 32/64 CPU description. -*- Scheme -*- +; This file contains instructions common to both sparc32/sparc64. +; It also contains sparc32/64 specific insns, but only when they are a variant +; of a collection of common ones. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Notes: +; - sparc64 support wip +; - fp support todo +; - source file layout wip +; - cpu family layout wip + +; Lots of sparc insns have either reg/reg or reg/simm13 cases. */ + +(define-pmacro (op3-reg-fmt op3-code) + (+ OP_2 op3-code rd rs1 rs2 (f-i 0) (f-res-asi 0)) +) +(define-pmacro (op3-imm-fmt op3-code) + (+ OP_2 op3-code rd rs1 (f-i 1) simm13) +) + +; Load/Store ops + +(define-pmacro (ld-op name comment attrs op3 mode dest) + (begin + (dnmi (.sym name "-reg+g0") comment attrs + (.str name " [$rs1],$" dest) + (emit (.sym name -reg+reg) rs1 (rs2 0) dest)) + (dnmi (.sym name "-reg+0") comment attrs + (.str name " [$rs1],$" dest) + (emit (.sym name -reg+imm) rs1 (simm13 0) dest)) + (dni (.sym name "-reg+reg") comment attrs + (.str name " [$rs1+$rs2],$" dest) + (+ OP_3 op3 dest rs1 (f-i 0) (f-res-asi 0) rs2) + (set mode dest (mem mode (add WI rs1 rs2))) + ()) + (dni (.sym name "-reg+imm") comment attrs + (.str name " [$rs1+$simm13],$" dest) + (+ OP_3 op3 dest rs1 (f-i 1) simm13) + (set mode dest (mem mode (add WI rs1 simm13))) + ()) + (dnmi (.sym name "-reg/asi") comment attrs + (.str name " [$rs1]$asi,$" dest) + (emit (.sym name -reg+reg/asi) rs1 (rs2 0) asi dest)) + (dni (.sym name "-reg+reg/asi") comment attrs + (.str name " [$rs1+$rs2]$asi,$" dest) + (+ OP_3 (.sym op3 A) dest rs1 (f-i 0) asi rs2) + (set mode dest (mem mode (add WI rs1 rs2))) + ()) + ) +) +(ld-op ldsb "load signed byte" () OP3_LDSB QI rd) +(ld-op ldub "load unsigned byte" () OP3_LDUB UQI rd) +(ld-op ldsh "load signed halfword" () OP3_LDSH HI rd) +(ld-op lduh "load unsigned halfword" () OP3_LDUH UHI rd) +(ld-op ldsw "load signed word" () OP3_LDSW SI rd) +(ld-op lduw "load unsigned word" () OP3_LDUW USI rd) +(ld-op ldx "load extended word" ((MACH64)) OP3_LDX DI rd) + +; Aliases are treated as such (ALIAS attribute) so we can use ld-op. +; ??? Perhaps lduw should be the alias. Let's leave it like this for now. +(ld-op ld "load word" (ALIAS) OP3_LDUW SI rd) + +; ??? This would work with special operand get/set support but +; it's not clear this case justifies implementing that yet. +;(ld-op ldd "load double reg" () OP3_LDD DI rdd) + +(dnmi ldd-reg+g0 "load double reg, reg+g0" () + "ldd [$rs1],$rdd" + (emit ldd-reg+reg rs1 (rs2 0) rdd) +) +(dnmi ldd-reg+0 "load double reg, reg+0" () + "ldd [$rs1],$rdd" + (emit ldd-reg+imm rs1 (simm13 0) rdd) +) +(dni ldd-reg+reg "load double reg, reg+reg" () + "ldd [$rs1+$rs2],$rdd" + (+ OP_3 OP3_LDD rdd rs1 (f-i 0) (f-res-asi 0) rs2) + (sequence ((DI temp)) + (set temp (mem DI (add WI rs1 rs2))) + (set rdd (subword SI temp (const 0))) + (set (reg h-gr (add (regno rdd) (const 1))) + (subword SI temp (const 1)))) + () +) +(dni ldd-reg+imm "load double reg, reg+imm" () + "ldd [$rs1+$simm13],$rdd" + (+ OP_3 OP3_LDD rdd rs1 (f-i 1) simm13) + (sequence () + (set rdd (mem SI (add WI rs1 simm13))) + (set (reg h-gr (add (regno rdd) (const 1))) + (mem SI (add rs1 (add simm13 (const 4)))))) + () +) +(dnmi ldd-reg/asi "load double reg, reg+g0/asi" () + "ldd [$rs1]$asi,$rdd" + (emit ldd-reg+reg/asi rs1 (rs2 0) asi rdd) +) +(dni ldd-reg+reg/asi "load double reg, reg+reg/asi" () + "ldd [$rs1+$rs2]$asi,$rdd" + (+ OP_3 OP3_LDDA rdd rs1 (f-i 0) asi rs2) + (sequence () + (set rdd (mem SI (add WI rs1 rs2))) + (set (reg h-gr (add (regno rdd) (const 1))) + (mem SI (add rs1 (add rs2 (const 4)))))) + () +) + +(define-pmacro (st-op name comment attrs op3 mode src) + (begin + (dnmi (.sym name "-reg+g0") comment attrs + (.str name " $" src ",[$rs1]") + (emit (.sym name -reg+reg) src rs1 (rs2 0))) + (dnmi (.sym name "-reg+0") comment attrs + (.str name " $" src ",[$rs1]") + (emit (.sym name -reg+imm) src rs1 (simm13 0))) + (dni (.sym name "-reg+reg") comment attrs + (.str name " $" src ",[$rs1+$rs2]") + (+ OP_3 op3 src rs1 (f-i 0) (f-res-asi 0) rs2) + (set mode (mem mode (add WI rs1 rs2)) src) + ()) + (dni (.sym name "-reg+imm") comment attrs + (.str name " $" src ",[$rs1+$simm13]") + (+ OP_3 op3 src rs1 (f-i 1) simm13) + (set mode (mem mode (add WI rs1 simm13)) src) + ()) + (dnmi (.sym name "-reg/asi") comment attrs + (.str name " $" src ",[$rs1]$asi") + (emit (.sym name -reg+reg/asi) src rs1 (rs2 0) asi)) + (dni (.sym name "-reg+reg/asi") comment attrs + (.str name " $" src ",[$rs1+$rs2]$asi") + (+ OP_3 (.sym op3 A) src rs1 (f-i 0) asi rs2) + (set mode (mem mode (add WI rs1 rs2)) src) + ()) + ) +) +(st-op stb "store byte" () OP3_STB QI rd) +(st-op sth "store halfword" () OP3_STH HI rd) +(st-op st "store word" () OP3_STW SI rd) +(st-op stx "store extended word" ((MACH64)) OP3_STX DI rd) + +; ??? This would work with special operand get/set support but +; it's not clear this case justifies implementing that yet. +;(st-op std "store double reg" () OP3_STD DI rdd) + +(dnmi std-reg+g0 "store double reg, reg+g0" () + "std $rdd,[$rs1]" + (emit std-reg+reg rdd rs1 (rs2 0)) +) +(dnmi std-reg+0 "store double reg, reg+0" () + "std $rdd,[$rs1]" + (emit std-reg+imm rdd rs1 (simm13 0)) +) +(dni std-reg+reg "store double reg, reg+reg" () + "std $rdd,[$rs1+$rs2]" + (+ OP_3 OP3_STD rdd rs1 (f-i 0) (f-res-asi 0) rs2) + (sequence () + (set (mem SI (add rs1 rs2)) rdd) + (set (mem SI (add rs1 (add rs2 (const 4)))) + (reg h-gr (add (regno rdd) (const 1))))) + () +) +(dni std-reg+imm "store double reg, reg+imm" () + "std $rdd,[$rs1+$simm13]" + (+ OP_3 OP3_STD rdd rs1 (f-i 1) simm13) + (sequence () + (set (mem SI (add rs1 simm13)) rdd) + (set (mem SI (add rs1 (add simm13 (const 4)))) + (reg h-gr (add (regno rdd) (const 1))))) + () +) +(dnmi std-reg/asi "store double reg, reg+g0/asi" () + "std $rdd,[$rs1]$asi" + (emit std-reg+reg/asi rdd rs1 (rs2 0) asi) +) +(dni std-reg+reg/asi "store double reg, reg+reg/asi" () + "std $rdd,[$rs1+$rs2]$asi" + (+ OP_3 OP3_STDA rdd rs1 (f-i 0) asi rs2) + (sequence () + (set (mem SI (add rs1 rs2)) rdd) + (set (mem SI (add rs1 (add rs2 (const 4)))) + (reg h-gr (add (regno rdd) (const 1))))) + () +) + +; nop +; A nop is defined to be a sethi of %g0. +; This needn't be a macro-insn, but making it one greatly simplifies decode.c +; as code needn't be generated to confirm hi22 == 0. +; On the other hand spending a little time in the decoder is often worth it. + +(dnmi nop "nop" + () + "nop" + (emit sethi (rd 0) (hi22 0)) +) + +; sethi + +(dni sethi "sethi" () + "sethi $hi22,$rd" + (+ OP_0 rd OP2_SETHI hi22) + (set rd (sll USI hi22 (const 10))) ; (set SI rd hi22) + () +) + +; Add/Subtract + +(define-pmacro (s32-set-addc-flags a b carry) + (sequence ((SI x)) + (set x (addc a b carry)) + (set icc-c (add-cflag a b carry)) + (set icc-v (add-oflag a b carry)) + (set icc-n (nflag x)) + (set icc-z (zflag x))) +) +(define-pmacro (s32-set-subc-flags a b carry) + (sequence ((SI x)) + (set x (subc a b carry)) + (set icc-c (sub-cflag a b carry)) + (set icc-v (sub-oflag a b carry)) + (set icc-n (nflag x)) + (set icc-z (zflag x))) +) + +(define-pmacro (s64-set-addc-flags a b carry) + (sequence ((SI x32) (DI x)) + (set x (addc a b carry)) + (set x32 x) + (set icc-c (add-cflag SI a b carry)) + (set icc-v (add-oflag SI a b carry)) + (set icc-n (nflag x32)) + (set icc-z (zflag x32)) + (set xcc-c (add-cflag a b carry)) + (set xcc-v (add-oflag a b carry)) + (set xcc-n (nflag x)) + (set xcc-z (zflag x))) +) +(define-pmacro (s64-set-subc-flags a b carry) + (sequence ((SI x32) (DI x)) + (set x (subc a b carry)) + (set x32 x) + (set icc-c (sub-cflag SI a b carry)) + (set icc-v (sub-oflag SI a b carry)) + (set icc-n (nflag x32)) + (set icc-z (zflag x32)) + (set xcc-c (sub-cflag a b carry)) + (set xcc-v (sub-oflag a b carry)) + (set xcc-n (nflag x)) + (set xcc-z (zflag x))) +) + +(define-pmacro (arith-binop name comment page attrs op3 sem-op) + (begin + (dni name + (.str comment ", " page) + attrs + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (set rd (sem-op rs1 rs2)) + ()) + (dni (.sym name -imm) + (.str comment " immediate, " page) + attrs + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (set rd (sem-op rs1 simm13)) + ()) + ) +) +(define-pmacro (arith-cc-binop name comment page attrs op3 sem-op + s32-set-flags s64-set-flags) + (begin + (dni name + (.str comment ", setting cc, " page) + attrs + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence () + (if (eq-attr (current-mach) ARCH64 TRUE) + (s64-set-flags rs1 rs2 (const 0)) + (s32-set-flags rs1 rs2 (const 0))) + (set rd (sem-op rs1 rs2)) + ) + ()) + (dni (.sym name -imm) + (.str comment " immediate, setting cc, " page) + attrs + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (sequence () + (if (eq-attr (current-mach) ARCH64 TRUE) + (s64-set-flags rs1 simm13 (const 0)) + (s32-set-flags rs1 simm13 (const 0))) + (set rd (sem-op rs1 simm13)) + ) + ()) + ) +) +(arith-binop add "add" "v8 page ??, v9 page 135" () OP3_ADD add) +(arith-binop sub "subtract" "v8 page ??, v9 page 230" () OP3_SUB sub) +(arith-cc-binop addcc "add" "v8 page ??, v9 page 135" () OP3_ADDCC add + s32-set-addc-flags s64-set-addc-flags) +(arith-cc-binop subcc "subtract" "v8 page ??, v9 page 230" () OP3_SUBCC sub + s32-set-subc-flags s64-set-subc-flags) + +; Same except include carry bit. + +(define-pmacro (arith-carry-binop name comment page attrs op3 sem-op) + (begin + (dni name + (.str comment " with carry, " page) + attrs + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (set rd (sem-op rs1 rs2 icc-c)) + ()) + (dni (.sym name -imm) + (.str comment " immediate with carry, " page) + attrs + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (set rd (sem-op rs1 simm13 icc-c)) + ()) + ) +) +(define-pmacro (arith-carry-cc-binop name comment page attrs op3 sem-op set-flags) + (begin + (dni name + (.str comment " with carry, setting cc, " page) + attrs + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence () + (set-flags rs1 rs2 icc-c) + (set rd (sem-op rs1 rs2 icc-c)) + ) + ()) + (dni (.sym name -imm) + (.str comment " immediate with carry, setting cc, " page) + attrs + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (sequence () + (set-flags rs1 simm13 icc-c) + (set rd (sem-op rs1 simm13 icc-c)) + ) + ()) + ) +) +; mach32 versions +(arith-carry-binop addx "add" "v8 page ??" ((MACH32)) OP3_ADDX addc) +(arith-carry-binop subx "subtract" "v8 page ??" ((MACH32)) OP3_SUBX subc) +(arith-carry-cc-binop addxcc "add" "v8 page ??" ((MACH32)) OP3_ADDXCC addc + s32-set-addc-flags) +(arith-carry-cc-binop subxcc "subtract" "v8 page ??" ((MACH32)) OP3_SUBXCC subc + s32-set-subc-flags) +; mach64 versions +; same as mach32 except mnemonic is different +(arith-carry-binop addc "add" "v9 page 135" ((MACH64)) OP3_ADDC addc) +(arith-carry-binop subc "subtract" "v9 page 230" ((MACH64)) OP3_SUBC subc) +(arith-carry-cc-binop addccc "add" "v9 page 135" ((MACH64)) OP3_ADDCCC addc + s64-set-addc-flags) +(arith-carry-cc-binop subccc "subtract" "v9 page 230" ((MACH64)) OP3_SUBCCC subc + s64-set-subc-flags) + +; Binary boolean ops + +(define-pmacro (s32-set-bool-flags x) + (sequence () + (set icc-z (zflag x)) + (set icc-n (nflag x)) + (set icc-c (const 0)) + (set icc-v (const 0)) + ) +) +(define-pmacro (s64-set-bool-flags x) + (sequence () + (set icc-z (zflag (trunc SI x))) + (set icc-n (nflag (trunc SI x))) + (set icc-c (const 0)) + (set icc-v (const 0)) + (set xcc-z (zflag x)) + (set xcc-n (nflag x)) + (set xcc-c (const 0)) + (set xcc-v (const 0)) + ) +) + +(define-pmacro (bool-binop name page op3 sem-op) + (begin + (dni name (.str name ", " page) () + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (set rd (sem-op rs1 rs2)) + ()) + (dni (.sym name -imm) (.str name " immediate, " page) () + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (set rd (sem-op rs1 simm13)) + ()) + (dni (.sym name cc) (.str name ", setting cc, " page) () + (.str name "cc $rs1,$rs2,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence () + (if (eq-attr (current-mach) ARCH64 TRUE) + (s64-set-bool-flags (sem-op rs1 rs2)) + (s32-set-bool-flags (sem-op rs1 rs2))) + (set rd (sem-op rs1 rs2)) + ) + ()) + (dni (.sym name cc-imm) (.str name " immediate, setting cc, " page) () + (.str name "cc $rs1,$simm13,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 (f-i 1) simm13) + (sequence () + (if (eq-attr (current-mach) ARCH64 TRUE) + (s64-set-bool-flags (sem-op rs1 simm13)) + (s32-set-bool-flags (sem-op rs1 simm13))) + (set rd (sem-op rs1 simm13)) + ) + ()) + ) +) +(bool-binop and "v9 page 181" OP3_AND and) +(bool-binop or "v9 page 181" OP3_OR or) +(bool-binop xor "v9 page 181" OP3_XOR xor) + +; Early experiments. +;(dsmn (andn a b) (list 'and a (list 'inv b))) +;(dsmn (orn a b) (list 'or a (list 'inv b))) +;(dsmn (xorn a b) (list 'xor a (list 'inv b))) + +(define-pmacro (sem-andn a b) (and a (inv b))) +(define-pmacro (sem-orn a b) (or a (inv b))) +(define-pmacro (sem-xorn a b) (xor a (inv b))) + +(bool-binop andn "v9 page 181" OP3_ANDN sem-andn) +(bool-binop orn "v9 page 181" OP3_ORN sem-orn) +(bool-binop xnor "v9 page 181" OP3_XNOR sem-xorn) + +; Shifts + +(define-pmacro (shift-binop name comment op3 sem-op) + (begin + (dni name comment () + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (set rd (sem-op rs1 (and rs2 (const 31)))) + ()) + (dni (.sym name -imm) (.str comment -imm) () + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + ; ??? v9 uses only the low bits. v8? + (set rd (sem-op rs1 (and simm13 (const 31)))) + ()) + ) +) +(shift-binop sll "shift left logical" OP3_SLL sll) +(shift-binop srl "shift right logical" OP3_SRL srl) +(shift-binop sra "shift right arithmetic" OP3_SRA sra) + +; Multiply/Divide + +(define-pmacro (mult-binop name comment op3 sem-op ext-op) + (begin + (dni name comment () + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence ((DI res)) + (set res (sem-op (ext-op DI rs1) (ext-op DI rs2))) + (set (reg WI h-y) (trunc SI (srl res (const 32)))) + (set rd (trunc SI res)) + ) + ()) + (dni (.sym name -imm) (.str comment -imm) () + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (sequence ((DI res)) + (set res (sem-op (ext-op DI rs1) (ext-op DI simm13))) + (set (reg WI h-y) (trunc SI (srl res (const 32)))) + (set rd (trunc SI res)) + ) + ()) + (dni (.sym name -cc) (.str comment -cc) () + (.str name "cc $rs1,$rs2,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence ((DI res)) + (set res (sem-op (ext-op DI rs1) (ext-op DI rs2))) + (set (reg WI h-y) (trunc SI (srl res (const 32)))) + (set rd (trunc SI res)) + ; We use bool-flags here 'cus it works (FIXME:revisit). + ; We can't use rd here 'cus it might be %g0. + (s32-set-bool-flags (trunc SI res)) + ) + ()) + (dni (.sym name -cc-imm) (.str comment -cc-imm) () + (.str name "cc $rs1,$simm13,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 (f-i 1) simm13) + (sequence ((DI res)) + (set res (sem-op (ext-op DI rs1) (ext-op DI simm13))) + (set (reg WI h-y) (trunc SI (srl res (const 32)))) + (set rd (trunc SI res)) + ; We use bool-flags here 'cus it works (FIXME:revisit). + ; We can't use rd here 'cus it might be %g0. + (s32-set-bool-flags (trunc SI res)) + ) + ()) + ) +) +(mult-binop smul "smul" OP3_SMUL mul ext) +(mult-binop umul "umul" OP3_UMUL mul zext) + +(define-pmacro (div-binop name comment mach-attrs op3 sem-op ext-op set-flags) + (begin + (dni name (.str comment ", v9 page 152") ((mach-attrs)) + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence ((DI dividend)) + (set dividend (join DI SI (reg SI h-y) rs1)) + (set rd (trunc SI (sem-op dividend (ext-op DI rs2)))) + ; FIXME: Overflow,etc. handling. + ) + ()) + (dni (.sym name -imm) (.str comment -imm ", v9 page 152") ((mach-attrs)) + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (sequence ((DI dividend)) + (set dividend (join DI SI (reg SI h-y) rs1)) + (set rd (trunc SI (sem-op dividend (ext-op DI simm13)))) + ; FIXME: Overflow,etc. handling. + ) + ()) + (dni (.sym name -cc) (.str comment -cc ", v9 page 152") ((mach-attrs)) + (.str name "cc $rs1,$rs2,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence ((DI dividend)) + (set dividend (join DI SI (reg SI h-y) rs1)) + (set rd (trunc SI (sem-op dividend (ext-op DI rs2)))) + ; FIXME: Overflow,etc. handling. + set-flags + ) + ()) + (dni (.sym name -cc-imm) (.str comment -cc-imm ", v9 page 152") ((mach-attrs)) + (.str name "cc $rs1,$simm13,$rd") + (+ OP_2 (.sym op3 CC) rd rs1 (f-i 1) simm13) + (sequence ((DI dividend)) + (set dividend (join DI SI (reg SI h-y) rs1)) + (set rd (trunc SI (sem-op dividend (ext-op DI simm13)))) + ; FIXME: Overflow,etc. handling. + set-flags + ) + ()) + ) +) +(div-binop sdiv "sdiv" MACH32 OP3_SDIV div ext (s32-set-bool-flags rd)) +(div-binop udiv "udiv" MACH32 OP3_UDIV div zext (s32-set-bool-flags rd)) + +; Multiply/Step + +(dni mulscc "multiply step" () + "mulscc $rs1,$rs2,$rd" + (+ OP_2 OP3_MULSCC rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (sequence ((SI tmp) (SI add-tmp) (SI rd-tmp)) + ; v8 page 112, step 2 + (set tmp (srl SI rs1 (const 1))) + (if (ne (xor BI (reg BI h-icc-n) (reg BI h-icc-v)) + (const 0)) + (set tmp (or SI tmp (const SI #x80000000)))) + ; step 3 + (if (ne (and SI (reg SI h-y) (const 1)) (const 0)) + (set add-tmp rs2) + (set add-tmp (const 0))) + ; step 4 + (set rd-tmp (add tmp add-tmp)) + ; step 5 + (s32-set-addc-flags tmp add-tmp (const 0)) + ;(set (reg UQI h-cc) (addc-cc tmp add-tmp (const 0))) + ; step 6 + (set (reg SI h-y) (srl SI (reg SI h-y) (const 1))) + (if (ne (and SI rs1 (const 1)) (const 0)) + (set (reg SI h-y) (or SI (reg SI h-y) (const SI #x80000000)))) + ; rd first created in rd-tmp so step 6 gets right value for rs1 + (set SI rd rd-tmp) + ) + () +) + +; Window ops +; V8 page 117 + +(define-pmacro (window-binop name comment op3 handler) + (begin + (dni name comment () + (.str name " $rs1,$rs2,$rd") + (+ OP_2 op3 rd rs1 rs2 (f-i 0) (f-res-asi 0)) + (set rd (c-call WI handler pc rs1 rs2)) + ()) + (dni (.sym name -imm) (.str comment -imm) () + (.str name " $rs1,$simm13,$rd") + (+ OP_2 op3 rd rs1 (f-i 1) simm13) + (set rd (c-call WI handler pc rs1 simm13)) + ()) + ) +) +(window-binop save "save caller's window" OP3_SAVE "@cpu@_do_save") +(window-binop restore "restore caller's window" OP3_RESTORE "@cpu@_do_restore") + +; Trap stuff + +(dni rett "return from trap" () + "rett $rs1,$rs2" + (+ OP_2 OP3_RETT (f-rd 0) rs1 rs2 (f-i 0) (f-res-asi 0)) + (delay (const 1) + (set pc (c-call WI "@cpu@_do_rett" pc rs1 rs2))) + () +) +(dni rett-imm "return from trap, immediate" () + "rett $rs1,$simm13" + (+ OP_2 OP3_RETT (f-rd 0) rs1 (f-i 1) simm13) + (delay (const 1) + (set pc (c-call WI "@cpu@_do_rett" pc rs1 simm13))) + () +) + +; Misc. + +(dni unimp "unimplemented" () + "unimp $imm22" + (+ OP_0 (f-rd-res 0) OP2_UNIMP imm22) + (c-call VOID "@arch@_do_unimp" pc imm22) + () +) + +; Subroutine calls, returns. + +(dnmi call-reg,0 "call reg,0" () + "call $rs1,0" ; FIXME: what's the ,0 suffix for? + (emit jmpl rs1 (rd 15) (rs2 0)) +) + +(dnmi call-reg "call reg" () + "call $rs1" + (emit jmpl rs1 (rd 15) (rs2 0)) +) + +(dnmi call,0 "call,0" () + "call $disp30,0" ; FIXME: what's the ,0 suffix for? + (emit call disp30) +) + +(dni call "call" (DELAY-SLOT) + "call $disp30" + (+ OP_1 disp30) + (sequence () + (set (reg h-gr 15) pc) + (delay (const 1) + (set pc disp30))) + () +) + +(dni jmpl "jmpl" (DELAY-SLOT) + "jmpl $rs1+$rs2,$rd" + (op3-reg-fmt OP3_JMPL) + (sequence () + (set rd pc) + (delay (const 1) + (set pc (add WI rs1 rs2)))) + () +) + +(dni jmpl-imm "jmpl" (DELAY-SLOT) + "jmpl $rs1+$simm13,$rd" + (op3-imm-fmt OP3_JMPL) + (sequence () + (set rd pc) + (delay (const 1) + (set pc (add WI rs1 simm13)))) + () +) + +;(dsn (icc-op op) (cx:make BI (string-append "icc (" op ")"))) +;(dsn (icc-op op) (list 'c-call: 'BI "icc" (reg UQI h-cc) (.str op))) +;(dsmn (icc-op op) (list 'c-call: 'BI "icc" '(reg UQI h-cc) (.str op))) +;(define-pmacro (icc-op op) (c-call BI "icc" (reg UQI h-cc) (.str op))) + +; Branches + +(define-pmacro (bicc-branch bname tname comment cond test br-sem) + (begin + (dni bname (.str "branch " comment) (V9-DEPRECATED) + (.str bname "$a $disp22") + (+ OP_0 a cond OP2_BICC disp22) + (br-sem test icc) + ()) + (dni tname (.str "trap " comment) (TRAP) + (.str tname " $rs1,$rs2") + (+ OP_2 (f-a 0) cond (f-op3 #x3a) rs1 (f-i 0) (f-res-asi 0) rs2) + (if (test icc) + (set pc (c-call IAI "@cpu@_sw_trap" pc rs1 rs2))) + ()) + (dni (.sym tname -imm) (.str "trap-imm " comment) (TRAP) + (.str tname " $rs1,$simm13") + (+ OP_2 (f-a 0) cond (f-op3 #x3a) rs1 (f-i 1) simm13) + (if (test icc) + (set pc (c-call IAI "@cpu@_sw_trap" pc rs1 simm13))) + ()) + ) +) +; test-*,uncond-br-sem,cond-br-sem are defined in sparc.cpu. +(bicc-branch ba ta "always" CC_A test-always uncond-br-sem) +(bicc-branch bn tn "never" CC_N test-never uncond-br-sem) +(bicc-branch bne tne "ne" CC_NE test-ne cond-br-sem) +(bicc-branch be te "eq" CC_E test-eq cond-br-sem) +(bicc-branch bg tg "gt" CC_G test-gt cond-br-sem) +(bicc-branch ble tle "le" CC_LE test-le cond-br-sem) +(bicc-branch bge tge "ge" CC_GE test-ge cond-br-sem) +(bicc-branch bl tl "lt" CC_L test-lt cond-br-sem) +(bicc-branch bgu tgu "gtu" CC_GU test-gtu cond-br-sem) +(bicc-branch bleu tleu "leu" CC_LEU test-leu cond-br-sem) +(bicc-branch bcc tcc "geu" CC_CC test-geu cond-br-sem) +(bicc-branch bcs tcs "ltu" CC_CS test-ltu cond-br-sem) +(bicc-branch bpos tpos "pos" CC_POS test-pos cond-br-sem) +(bicc-branch bneg tneg "neg" CC_NEG test-neg cond-br-sem) +(bicc-branch bvc tvc "vc" CC_VC test-vc cond-br-sem) +(bicc-branch bvs tvs "vs" CC_VS test-vs cond-br-sem) + +; Atomic load/stores. + +(define-pmacro (atomic-op name comment attrs op3 do_fn) + (begin + (dnmi (.sym name "-reg") comment attrs + (.str name " [$rs1],$rd") + (emit (.sym name -reg+reg) rs1 (rs2 0) rd)) + (dnmi (.sym name "-reg+0") comment attrs + (.str name " [$rs1],$rd") + (emit (.sym name -reg+imm) rs1 (simm13 0) rd)) + (dni (.sym name "-reg+reg") comment attrs + (.str name " [$rs1+$rs2],$rd") + (+ OP_3 op3 rd rs1 (f-i 0) (f-res-asi 0) rs2) + (c-call do_fn pc (regno rd) rs1 rs2 (const -1)) + ()) + (dni (.sym name "-reg+imm") comment attrs + (.str name " [$rs1+$simm13],$rd") + (+ OP_3 op3 rd rs1 (f-i 1) simm13) + (c-call do_fn pc (regno rd) rs1 simm13 (const -1)) + ()) + (dnmi (.sym name "-reg/asi") comment attrs + (.str name " [$rs1]$asi,$rd") + (emit (.sym name "-reg+reg/asi") rs1 (rs2 0) asi rd)) + (dni (.sym name "-reg+reg/asi") comment attrs + (.str name " [$rs1+$rs2]$asi,$rd") + (+ OP_3 (.sym op3 A) rd rs1 (f-i 0) asi rs2) + (c-call do_fn pc (regno rd) rs1 rs2 asi) + ()) + ) +) +(atomic-op ldstub "atomic load-store unsigned byte, v9 page 179" () + OP3_LDSTUB "@cpu@_do_ldstub") +(atomic-op swap "atomic swap reg with mem" (V9-DEPRECATED) + OP3_SWAP "@cpu@_do_swap") + +; TODO: +; - tagged add/sub +; - synthetic insns diff --git a/cgen/sparcfpu.cpu b/cgen/sparcfpu.cpu new file mode 100644 index 00000000000..dbbd10ea3f5 --- /dev/null +++ b/cgen/sparcfpu.cpu @@ -0,0 +1,527 @@ +; SPARC 32/64 FPU description. -*- Scheme -*- +; This file contains fpu instructions common to both sparc32/sparc64. +; It also contains sparc32/64 specific insns, but only when they are a variant +; of a collection of common ones (at least that's the current theory). +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; FP support is defined even for cpu's without an fpu as the instructions +; still have to be assembled and the simulator still has to recognize them +; so that the appropriate trap can be generated. +; +; The physical registers are stored as an array of SI values: here `SI' +; denotes "set of 32 bits" rather than "32 bit signed integer". +; +; wip: currently evaluating the various possibilities + +; Floating point hardware. + +; The description needs to know whether the fpu is present. +; Creating a utility register for this purposes seems reasonable. +; Might want an attribute to denote it as such. + +(dsh h-fpu? "h/w fpu present?" () (register BI)) +(dnop fpu? "h/w fpu present?" () h-fpu? f-nil) + +(define-pmacro (build-freg-name n) ((.sym f n) n)) + +(define-hardware + (name h-fr32) + (semantic-name h-fr) + (comment "sparc32 floating point regs") + (attrs (MACH32)) + (type register SI (32)) + (indices keyword "%" (.map build-freg-name (.iota 32))) +) +(define-hardware + (name h-fr64) + (semantic-name h-fr) + (comment "sparc64 floating point regs") + (attrs (MACH64)) + (type register SI (64)) + (indices keyword "%" (.map build-freg-name (.iota 64))) +) + +(define-hardware + (name h-frd32) + (semantic-name h-frd) + (comment "sparc32 double precision floating point regs") + (attrs VIRTUAL (MACH32)) + (type register DI (16)) + ; ??? This works, but multiple copies of all the register names might be + ; unpalatable. Another way is to specify a register table plus a constraint. + ;(indices keyword "%" (.map build-freg-name (.iota 16 0 2))) + (get (index) (join DI SI + (reg h-fr index) + (reg h-fr (add index 1)))) + (set (index newval) + (sequence () + (set (reg h-fr index) (subword SI newval 0)) + (set (reg h-fr (add index 1)) (subword SI newval 1)))) +) + +(define-hardware + (name h-frq32) + (semantic-name h-frq) + (comment "sparc32 quad precision floating point regs") + (attrs VIRTUAL (MACH32)) + (type register TF (8)) + (indices keyword "%" (.map build-freg-name (.iota 8 0 4))) + (get (index) (join TF SI + (reg h-fr index) + (reg h-fr (add index (const 1))) + (reg h-fr (add index (const 2))) + (reg h-fr (add index (const 3))))) + (set (index newval) + (sequence () + (set (reg h-fr index) (subword SI newval 0)) + (set (reg h-fr (add index (const 1))) (subword SI newval 1)) + (set (reg h-fr (add index (const 2))) (subword SI newval 2)) + (set (reg h-fr (add index (const 3))) (subword SI newval 3)))) +) + +(define-hardware + (name h-frd64) + (semantic-name h-frd) + (comment "sparc64 double precision floating point regs") + (attrs VIRTUAL (MACH64)) + (type register DF (32)) + (indices keyword "%" (.map build-freg-name (.iota 32 0 2))) + (get (index) (join DF SI + (reg h-fr index) + (reg h-fr (add index (const 1))))) + (set (index newval) + (sequence () + (set (reg h-fr index) (subword SI newval 0)) + (set (reg h-fr (add index (const 1))) (subword SI newval 1)))) +) + +(define-hardware + (name h-frq64) + (semantic-name h-frq) + (comment "sparc64 quad precision floating point regs") + (attrs VIRTUAL (MACH64)) + (type register TF (16)) + (indices keyword "%" (.map build-freg-name (.iota 16 0 4))) + (get (index) (join TF SI + (reg h-fr index) + (reg h-fr (add index (const 1))) + (reg h-fr (add index (const 2))) + (reg h-fr (add index (const 3))))) + (set (index newval) + (sequence () + (set (reg h-fr index) (subword SI newval 0)) + (set (reg h-fr (add index (const 1))) (subword SI newval 1)) + (set (reg h-fr (add index (const 2))) (subword SI newval 2)) + (set (reg h-fr (add index (const 3))) (subword SI newval 3)))) +) + +; fp condition codes + +(dsh h-fcc0 "%fcc0" () (register (UINT 2))) +(dsh h-fcc1 "%fcc1" ((MACH64)) (register (UINT 2))) +(dsh h-fcc2 "%fcc2" ((MACH64)) (register (UINT 2))) +(dsh h-fcc3 "%fcc3" ((MACH64)) (register (UINT 2))) + +; sparc64 fpu control regs + +(dsh h-fsr-rd "fsr rounding direction" ((MACH64)) (register UQI)) +(dsh h-fsr-tem "fsr trap enable mask" ((MACH64)) (register UQI)) +(dsh h-fsr-ns "fsr nonstandard fp" ((MACH64)) (register BI)) +(dsh h-fsr-ver "fsr version" ((MACH64)) (register UQI)) +(dsh h-fsr-ftt "fsr fp trap type" ((MACH64)) (register UQI)) +(dsh h-fsr-qne "fsr queue not empty" ((MACH64)) (register BI)) +(dsh h-fsr-aexc "fsr accrued exception" ((MACH64)) (register UQI)) +(dsh h-fsr-cexc "fsr current exception" ((MACH64)) (register UQI)) +;(dsh h-fsr "floating point state" ((MACH64)) (register UDI)) + +(dsh h-fpsr-fef "fpsr enable fp" ((MACH64)) (register BI)) +(dsh h-fpsr-du "fpsr dirty upper" ((MACH64)) (register BI)) +(dsh h-fpsr-dl "fpsr dirty lower" ((MACH64)) (register BI)) + +(define-hardware + (name h-fpsr) + (comment "fp regs state") + (attrs VIRTUAL (MACH64)) + (type register UQI) + (get () (const 0)) ; FIXME + (set (newval) (set (raw-reg UQI h-fpsr) (const 0))) ; FIXME +) + +; Floating point operands. + +(define-operand + (name frs1s) + (comment "single precision floating point source register 1") + (type h-fr) + (index f-rs1) + (mode SF) +) +(define-operand + (name frs2s) + (comment "single precision floating point source register 2") + (type h-fr) + (index f-rs2) + (mode SF) +) +(define-operand + (name frds) + (comment "single precision floating point dest'n register") + (type h-fr) + (index f-rd) + (mode SF) +) + +(define-operand + (name frs1d) + (comment "double precision floating point source register 1") + (attrs (MACH32)) + (type h-frd) + (index f-rs1) + (mode DF) +) +(define-operand + (name frs2d) + (comment "double precision floating point source register 2") + (attrs (MACH32)) + (type h-frd) + (index f-rs2) + (mode DF) +) +(define-operand + (name frdd) + (comment "double precision floating point dest'n register") + (attrs (MACH32)) + (type h-frd) + (index f-rd) + (mode DF) +) + +(dnop frs1q "quad precision floating point source register 1" ((MACH32)) + h-frq f-rs1) +(dnop frs2q "quad precision floating point source register 2" ((MACH32)) + h-frq f-rs2) +(dnop frdq "quad precision floating point dest'n register" ((MACH32)) + h-frq f-rd) + +; Encoding/decoding of field for sparc64 requires extra effort. +; See v9 page 40: 5.1.4.1 Floating-Point Register Number Encoding. +(df f-frs1d-64 "rs1 field for sparc64 DF regs" ((MACH64)) 18 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(df f-frs2d-64 "rs2 field for sparc64 DF regs" ((MACH64)) 4 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(df f-frdd-64 "rd field for sparc64 DF regs" ((MACH64)) 29 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(dnop frs1d "double precision floating point source register 1" ((MACH64)) + h-frd f-frs1d-64) +(dnop frs2d "double precision floating point source register 2" ((MACH64)) + h-frd f-frs2d-64) +(dnop frdd "double precision floating point dest'n register" ((MACH64)) + h-frd f-frdd-64) + +; Encoding/decoding of field for sparc64 requires extra effort. +; See v9 page 40: 5.1.4.1 Floating-Point Register Number Encoding. +(df f-frs1q-64 "rs1 field for sparc64 TF regs" ((MACH64)) 18 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(df f-frs2q-64 "rs2 field for sparc64 TF regs" ((MACH64)) 4 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(df f-frdq-64 "rd field for sparc64 TF regs" ((MACH64)) 29 5 UINT + ((value pc) (or INT (srl value (const 5)) (and value (const #x1e)))) + ((value pc) (or INT (sll (and value (const 1)) (const 5)) + (and value (const #x1e)))) +) +(dnop frs1q "quad precision floating point source register 1" ((MACH64)) + h-frq f-frs1q-64) +(dnop frs2q "quad precision floating point source register 2" ((MACH64)) + h-frq f-frs2q-64) +(dnop frdq "quad precision floating point dest'n register" ((MACH64)) + h-frq f-frdq-64) + +(dnop fcc0 "%fcc0" () h-fcc0 f-nil) + +; Misc. support macros. +; FIXME: TRAP32 wip +; FIXME: sparc32/sparc64 differences +; FIXME: trap handling in general (c-call's used until more thought invested) + +; Check if fpu is present and enabled. + +(define-pmacro (check-fp-enabled) + ; FIXME: more things to check + (if (not fpu?) + (c-call VOID "@cpu@_hw_trap" pc (c-code INT "TRAP32_FP_DIS"))) +) + +; Return pointer to FPU. +; ??? wip. maybe move `snan?' to language proper? + +(define-pmacro (current-fpu) (c-call PTR "CGEN_CPU_FPU")) + +; Issue appropriate trap if x is an snan. + +(define-pmacro (check-sf-snan x) + (if (c-raw-call BI "cgen_sf_snan_p" (current-fpu) x) + (c-call VOID "@cpu@_hw_trap" pc (c-code INT "TRAP32_FP_DIS"))) ; FIXME +) + +(define-pmacro (check-df-snan x) + (if (c-raw-call BI "cgen_df_snan_p" (current-fpu) x) + (c-call VOID "@cpu@_hw_trap" pc (c-code INT "TRAP32_FP_DIS"))) ; FIXME +) + +; Floating point memory ops. + +; Note: the startup code uses a load to %f0 to see if an fpu is present. +; Other startup code tries to set the EF bit in the PSR. + +(define-pmacro (fp-ld-op name comment op3 mode dest) + (begin + (dnmi (.sym name "f-reg") comment () + (.str name " [$rs1],$" dest) + (emit (.sym name f-reg+reg) rs1 (rs2 0) dest)) + (dnmi (.sym name "f-reg+0") comment () + (.str name " [$rs1],$" dest) + (emit (.sym name f-reg+imm) rs1 (simm13 0) dest)) + (dni (.sym name "f-reg+reg") comment () + (.str name " [$rs1+$rs2],$" dest) + (+ OP_3 op3 dest rs1 (f-i 0) (f-res-asi 0) rs2) + (sequence () + (check-fp-enabled) + (set dest (mem mode (add WI rs1 rs2)))) + ()) + (dni (.sym name "f-reg+imm") comment () + (.str name " [$rs1+$simm13],$" dest) + (+ OP_3 op3 dest rs1 (f-i 1) simm13) + (sequence () + (check-fp-enabled) + (set dest (mem mode (add WI rs1 simm13)))) + ()) + (dnmi (.sym name "f-reg/asi") comment () + (.str name " [$rs1]$asi,$" dest) + (emit (.sym name f-reg+reg/asi) rs1 (rs2 0) asi dest)) + (dni (.sym name "f-reg+reg/asi") comment () + (.str name " [$rs1+$rs2]$asi,$" dest) + (+ OP_3 (.sym op3 A) dest rs1 (f-i 0) asi rs2) + (sequence () + (check-fp-enabled) + (set dest (mem mode (add WI rs1 rs2)))) + ()) + ) +) +(fp-ld-op ld "fp SF load" OP3_LDF SF frds) +(fp-ld-op ldd "fp DF load" OP3_LDDF DF frdd) + +(define-pmacro (fp-st-op name comment op3 mode src) + (begin + (dnmi (.sym name "f-reg") comment () + (.str name " $" src ",[$rs1]") + (emit (.sym name f-reg+reg) rs1 (rs2 0) src)) + (dnmi (.sym name "f-reg+0") comment () + (.str name " $" src ",[$rs1]") + (emit (.sym name f-reg+imm) rs1 (simm13 0) src)) + (dni (.sym name "f-reg+reg") comment () + (.str name " $" src ",[$rs1+$rs2]") + (+ OP_3 op3 src rs1 (f-i 0) (f-res-asi 0) rs2) + (sequence () + (check-fp-enabled) + (set (mem mode (add WI rs1 rs2)) src)) + ()) + (dni (.sym name "f-reg+imm") comment () + (.str name " $" src ",[$rs1+$simm13]") + (+ OP_3 op3 src rs1 (f-i 1) simm13) + (sequence () + (check-fp-enabled) + (set (mem mode (add WI rs1 simm13)) src)) + ()) + (dnmi (.sym name "f-reg/asi") comment () + (.str name " $" src ",[$rs1]$asi") + (emit (.sym name -reg+reg/asi) rs1 (rs2 0) asi src)) + (dni (.sym name "f-reg+reg/asi") comment () + (.str name " $" src ",[$rs1+$rs2]$asi") + (+ OP_3 (.sym op3 A) src rs1 (f-i 0) asi rs2) + (sequence () + (check-fp-enabled) + (set (mem mode (add WI rs1 rs2)) src)) + ()) + ) +) +(fp-st-op st "fp SF store" OP3_STF SF frds) +(fp-st-op std "fp DF store" OP3_STDF DF frdd) + +; SF mode arithmetic ops. + +(define-pmacro (sf-unary-op name comment op3 fpop1 fn) + (begin + (dni name comment () + (.str name " $frs1s,$frds") + (+ OP_2 op3 fpop1 frds frs1s (f-rs2 0)) + (sequence () + (check-fp-enabled) + (set frds (fn frs1s)) + ; ??? dest is modified if snan, assign to tmp first? + ; [grep for all check-*-snan's] + (check-sf-snan frds)) + ()) + ) +) + +(define-pmacro (sf-binary-op name comment op3 fpop1 fn) + (begin + (dni name comment () + (.str name " $frs1s,$frs2s,$frds") + (+ OP_2 op3 fpop1 frds frs1s frs2s) + (sequence () + (check-fp-enabled) + (set frds (fn frs1s frs2s)) + (check-sf-snan frds)) + ()) + ) +) + +(sf-unary-op fnegs "32 bit fp neg" OP3_FPOPS1 FPOPS1_FNEGS neg) +(sf-unary-op fabss "32 bit fp abs" OP3_FPOPS1 FPOPS1_FABSS abs) + +(sf-binary-op fadds "32 bit fp add" OP3_FPOPS1 FPOPS1_FADDS add) +(sf-binary-op fsubs "32 bit fp sub" OP3_FPOPS1 FPOPS1_FSUBS sub) +(sf-binary-op fmuls "32 bit fp mul" OP3_FPOPS1 FPOPS1_FMULS mul) +(sf-binary-op fdivs "32 bit fp div" OP3_FPOPS1 FPOPS1_FDIVS div) + +; ??? floating point compares are wip + +(dni fp-fcmps "32 bit compare" () + "fcmps $frs1s,$frs2s" + (+ OP_2 OP3_FPOPS2 FPOPS2_FCMPS (f-rd 0) frs1s frs2s) + (sequence () + (check-fp-enabled) + (set fcc0 (c-call UINT "SFCMP" frs1s frs2s))) + () +) + +(dni fp-fcmpse "32 bit compare, signal if any nans" () + "fcmpse $frs1s,$frs2s" + (+ OP_2 OP3_FPOPS2 FPOPS2_FCMPSE (f-rd 0) frs1s frs2s) + (sequence () + (check-fp-enabled) + (check-sf-snan frs1s) + (check-sf-snan frs2s) + (set fcc0 (c-call UINT "SFCMP" frs1s frs2s))) + () +) + +; DF mode arithmetic ops. + +(define-pmacro (df-unary-op name comment op3 fpop1 fn) + (begin + (dni name comment () + (.str name " $frs1d,$frdd") + (+ OP_2 op3 fpop1 frdd frs1d (f-rs2 0)) + (sequence () + (check-fp-enabled) + (set frdd (fn frs1d)) + (check-df-snan frdd)) + ()) + ) +) + +(define-pmacro (df-binary-op name comment op3 fpop1 fn) + (begin + (dni name comment () + (.str name " $frs1d,$frs2d,$frdd") + (+ OP_2 op3 fpop1 frdd frs1d frs2d) + (sequence () + (check-fp-enabled) + (set frdd (fn frs1d frs2d)) + (check-df-snan frdd)) + ()) + ) +) + +(df-unary-op fnegd "64 bit fp neg" OP3_FPOPS1 FPOPS1_FNEGD neg) +(df-unary-op fabsd "64 bit fp abs" OP3_FPOPS1 FPOPS1_FABSD abs) + +(df-binary-op faddd "64 bit fp add" OP3_FPOPS1 FPOPS1_FADDD add) +(df-binary-op fsubd "64 bit fp sub" OP3_FPOPS1 FPOPS1_FSUBD sub) +(df-binary-op fmuld "64 bit fp mul" OP3_FPOPS1 FPOPS1_FMULD mul) +(df-binary-op fdivd "64 bit fp div" OP3_FPOPS1 FPOPS1_FDIVD div) + +; ??? floating point compares are wip + +(dni fp-fcmpd "64 bit compare" () + "fcmpd $frs1d,$frs2d" + (+ OP_2 OP3_FPOPS2 FPOPS2_FCMPD (f-rd 0) frs1d frs2d) + (sequence () + (check-fp-enabled) + (set fcc0 (c-call UINT "DFCMP" frs1d frs2d))) + () +) + +(dni fp-fcmpde "64 bit compare, signal if any nans" () + "fcmpde $frs1d,$frs2d" + (+ OP_2 OP3_FPOPS2 FPOPS2_FCMPDE (f-rd 0) frs1d frs2d) + (sequence () + (check-fp-enabled) + (check-df-snan frs1d) + (check-df-snan frs2d) + (set fcc0 (c-call UINT "DFCMP" frs1d frs2d))) + () +) + +; Branches + +; CC is one of fcc0,fcc +(define-pmacro (ftest-u cc) (eq cc FCC_UN)) +(define-pmacro (ftest-g cc) (eq cc FCC_GT)) +(define-pmacro (ftest-ug cc) (orif (eq cc FCC_UN) (eq cc FCC_GT))) +(define-pmacro (ftest-l cc) (eq cc FCC_LT)) +(define-pmacro (ftest-ul cc) (orif (eq cc FCC_UN) (eq cc FCC_LT))) +(define-pmacro (ftest-lg cc) (orif (eq cc FCC_LT) (eq cc FCC_GT))) +(define-pmacro (ftest-ne cc) (ne cc FCC_EQ)) +(define-pmacro (ftest-e cc) (eq cc FCC_EQ)) +(define-pmacro (ftest-ue cc) (orif (eq cc FCC_UN) (eq cc FCC_EQ))) +(define-pmacro (ftest-ge cc) (orif (eq cc FCC_GT) (eq cc FCC_EQ))) +(define-pmacro (ftest-uge cc) (ne cc FCC_LT)) +(define-pmacro (ftest-le cc) (orif (eq cc FCC_LT) (eq cc FCC_EQ))) +(define-pmacro (ftest-ule cc) (ne cc FCC_GT)) +(define-pmacro (ftest-o cc) (ne cc FCC_UN)) + +(define-pmacro (fbfcc-branch bname comment cond test br-sem) + (begin + (dni bname (.str "fp branch " comment) (V9-DEPRECATED) + (.str bname "$a $disp22") + (+ OP_0 a cond OP2_FBFCC disp22) + (br-sem test fcc0) + ()) + ) +) +(fbfcc-branch fba "always" FCOND_A test-always uncond-br-sem) +(fbfcc-branch fbn "never" FCOND_N test-never uncond-br-sem) +(fbfcc-branch fbu "unordered" FCOND_U ftest-u cond-br-sem) +(fbfcc-branch fbg "greater" FCOND_G ftest-g cond-br-sem) +(fbfcc-branch fbug "unordered or greater" FCOND_UG ftest-ug cond-br-sem) +(fbfcc-branch fbl "less" FCOND_L ftest-l cond-br-sem) +(fbfcc-branch fbul "unordered or less" FCOND_UL ftest-ul cond-br-sem) +(fbfcc-branch fblg "less or greater" FCOND_LG ftest-lg cond-br-sem) +(fbfcc-branch fbne "not equal" FCOND_NE ftest-ne cond-br-sem) +(fbfcc-branch fbe "equal" FCOND_E ftest-e cond-br-sem) +(fbfcc-branch fbue "unordered or equal" FCOND_UE ftest-ue cond-br-sem) +(fbfcc-branch fbge "greater or equal" FCOND_GE ftest-ge cond-br-sem) +(fbfcc-branch fbuge "unordered or greater or equal" FCOND_UGE ftest-uge cond-br-sem) +(fbfcc-branch fble "less or equal" FCOND_LE ftest-le cond-br-sem) +(fbfcc-branch fbule "unordered or less or equal" FCOND_ULE ftest-ule cond-br-sem) +(fbfcc-branch fbo "ordered" FCOND_O ftest-o cond-br-sem) diff --git a/cgen/stamp-h.in b/cgen/stamp-h.in new file mode 100644 index 00000000000..9788f70238c --- /dev/null +++ b/cgen/stamp-h.in @@ -0,0 +1 @@ +timestamp diff --git a/cgen/thumb.cpu b/cgen/thumb.cpu new file mode 100644 index 00000000000..343a9cad03b --- /dev/null +++ b/cgen/thumb.cpu @@ -0,0 +1,842 @@ +; ARM/Thumb instructions. -*- Scheme -*- +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; This file is included by arm.cpu. + +; Hardware elements. + +(define-hardware + (name h-gr-t) + (comment "Thumb's general purpose registers") + (attrs (ISA thumb) VIRTUAL) ; ??? CACHE-ADDR should be doable + (type register WI (8)) + (indices keyword "" + ((r0 0) (r1 1) (r2 2) (r3 3) (r4 4) (r5 5) (r6 6) (r7 7))) + (get (regno) (reg h-gr regno)) + (set (regno newval) (set (reg h-gr regno) newval)) +) + +(define-hardware + (name h-lr-t) + (comment "Thumb's access to the LR register") + (attrs (ISA thumb) VIRTUAL) + (type register WI) + (get () (reg h-gr 14)) + (set (newval) (set (reg h-gr 14) newval)) +) + +(define-hardware + (name h-sp-t) + (comment "Thumb's access to the SP register") + (attrs (ISA thumb) VIRTUAL) + (type register WI) + (get () (reg h-gr 13)) + (set (newval) (set (reg h-gr 13) newval)) +) + +; Instruction fields. + +; define-normal-thumb-field +(define-pmacro (dntf name comment attrs start length) + (dnf name comment (.splice (.unsplice attrs) (ISA thumb)) start length) +) + +; Main opcode fields. +(dntf f-op3 "First 3 bits of opcode" () 15 3) +(dntf f-op4 "First 4 bits of opcode" () 15 4) +(dntf f-op5 "First 5 bits of opcode" () 15 5) +(dntf f-op6 "First 6 bits of opcode" () 15 6) +(dntf f-op8 "First 8 bits of opcode" () 15 8) + +; Other opcode like fields with special names. +(dntf f-h1 "h1 field in hireg insns" () 7 1) +(dntf f-h2 "h2 field in hireg insns" () 6 1) +(dntf f-l "load/store indicator" () 11 1) +(dntf f-b "byte/word indicator" () 10 1) +(dntf f-h "byte/halfword indicator" () 11 1) + +; Misc. remaining opcode fields (constant values but unnamed). +(dntf f-bit9 "bit 9" () 9 1) + +; Data fields. +(dntf f-offset5 "5 bit unsigned immediate" () 10 5) +(dntf f-rs "Rs (source reg)" () 5 3) +(dntf f-rd "Rd (dest reg)" () 2 3) +(dntf f-rn "Rn (2nd source reg in add/sub insns" () 8 3) +(dntf f-offset3 "3 bit unsigned immediate in add/sub insns" () 8 3) +(dntf f-bit10-rd "Rd (dest reg) at bit 10" () 10 3) +(dntf f-offset8 "8 bit unsigned immediate" () 7 8) +(dntf f-ro "Ro (offset register)" () 8 3) +(dntf f-rb "Rb (base register)" () 5 3) + +; Instruction operands. + +; define-normal-thumb-operand +(define-pmacro (dntop name comment attrs hw indx) + (dnop name comment (.splice (.unsplice attrs) (ISA thumb)) hw indx) +) + +(dntop sp "stack pointer" () h-sp-t f-nil) +(dntop lr "link register" () h-lr-t f-nil) + +(dntop rd "destination register" () h-gr-t f-rd) +(dntop rs "source register" () h-gr-t f-rs) +(dntop offset5 "5 bit unsigned immediate" () h-uint f-offset5) +(dntop rn "2nd source register" () h-gr-t f-rn) +(dntop offset3 "3 bit unsigned immediate" () h-uint f-offset3) +(dntop offset8 "8 bit unsigned immediate" () h-uint f-offset8) + +(dntop bit10-rd "rd in bits 10,9,8" () h-gr-t f-bit10-rd) + +(dntop ro "offset register" () h-gr-t f-ro) +(dntop rb "base register" () h-gr-t f-rb) + +; Instruction definitions. + +; Cover macro to dni to indicate these are all Thumb insns. +; dnti: define-normal-thumb-insn + +(define-pmacro (dnti xname xcomment xattrs xsyntax xformat xsemantics) + (define-insn + (name xname) + (comment xcomment) + (.splice attrs (.unsplice xattrs) (ISA thumb)) + (syntax xsyntax) + (format xformat) + (semantics xsemantics) + ) +) + +; Move shifted register insns. + +(dntf f-shift-op "Move shifted register opcode" () 12 2) + +(dnti lsl "logical shift left" + () + "lsl $rd,$rs,#$offset5" + (+ (f-op3 0) (f-shift-op 0) offset5 rs rd) + (sequence ((BI carry-out)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rs + SHIFT-TYPE-lsl offset5 cbit)) + (set rd (sll rs offset5)) + (set-logical-cc rd carry-out)) +) +(dnti lsr "logical shift right" + () + "lsr $rd,$rs,#$offset5" + (+ (f-op3 0) (f-shift-op 1) offset5 rs rd) + (sequence ((BI carry-out)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rs + SHIFT-TYPE-lsr offset5 cbit)) + (set rd (srl rs offset5)) + (set-logical-cc rd carry-out)) +) +(dnti asr "arithmetic shift right" + () + "asr $rd,$rs,#$offset5" + (+ (f-op3 0) (f-shift-op 2) offset5 rs rd) + (sequence ((BI carry-out)) + (set carry-out + (c-call BI "compute_carry_out_immshift" rs + SHIFT-TYPE-asr offset5 cbit)) + (set rd (sra rs offset5)) + (set-logical-cc rd carry-out)) +) + +; Add/subtract insns. + +(dntf f-i "immediate indicator in add/sub insns" () 10 1) + +(dntf f-addsub-op "Add/subtract opcode" () 9 1) + +(dnti add "add reg+reg" + () + "add $rd,$rs,$rn" + (+ (f-op5 3) (f-i 0) (f-addsub-op 0) rn rs rd) + (sequence () + (set-add-flags rs rn 0) + (set rd (add rs rn))) +) +(dnti addi "add reg+imm" + () + "add $rd,$rs,#$offset3" + (+ (f-op5 3) (f-i 1) (f-addsub-op 0) offset3 rs rd) + (sequence () + (set-add-flags rs offset3 0) + (set rd (add rs offset3))) +) +(dnti sub "sub reg+reg" + () + "sub $rd,$rs,$rn" + (+ (f-op5 3) (f-i 0) (f-addsub-op 1) rn rs rd) + (sequence () + (set-sub-flags rs rn 1) + (set rd (sub rs rn))) +) +(dnti subi "sub reg+imm" + () + "sub $rd,$rs,#$offset3" + (+ (f-op5 3) (f-i 1) (f-addsub-op 1) offset3 rs rd) + (sequence () + (set-sub-flags rs offset3 1) + (set rd (sub rs offset3))) +) + +; Move/compare/add/subtract immediate insns. + +(dntf f-mcasi-op "Move/compare/add/subtract immediate opcode" () 12 2) + +(dnti mov "move imm->reg" + () + "mov ${bit10-rd},#$offset8" + (+ (f-op3 1) (f-mcasi-op 0) bit10-rd offset8) + (sequence () + (set bit10-rd offset8) + (set-zn-flags bit10-rd)) +) +(dnti cmp "cmp reg,imm" + () + "cmp ${bit10-rd},#$offset8" + (+ (f-op3 1) (f-mcasi-op 1) bit10-rd offset8) + (set-sub-flags bit10-rd offset8 1) +) +(dnti addi8 "add 8 bit immediate" + () + "add ${bit10-rd},#$offset8" + (+ (f-op3 1) (f-mcasi-op 2) bit10-rd offset8) + (sequence () + (set-add-flags bit10-rd offset8 0) + (set bit10-rd (add bit10-rd offset8))) +) +(dnti subi8 "sub 8 bit immediate" + () + "sub ${bit10-rd},#$offset8" + (+ (f-op3 1) (f-mcasi-op 3) bit10-rd offset8) + (sequence () + (set-sub-flags bit10-rd offset8 1) + (set bit10-rd (sub bit10-rd offset8))) +) + +; ALU operations. + +(dntf f-alu-op "ALU opcode" () 9 4) + +(define-pmacro (alu-logical-op mnemonic comment alu-opcode sem-fn) + (dnti (.sym alu- mnemonic) comment + () + (.str mnemonic " $rd,$rs") + (+ (f-op6 #x10) (f-alu-op alu-opcode) rs rd) + (sequence () + (set rd (sem-fn rd rs)) + (set-zn-flags rd)) + ) +) + +(define-pmacro (alu-arith-op mnemonic comment alu-opcode sem-fn set-flags) + (dnti (.sym alu- mnemonic) comment + () + (.str mnemonic " $rd,$rs") + (+ (f-op6 #x10) (f-alu-op alu-opcode) rs rd) + (sequence ((SI result)) + (set result (sem-fn rd rs cbit)) + (set-flags rd rs cbit) + (set rd result)) + ) +) + +(define-pmacro (alu-shift-op mnemonic comment alu-opcode sem-fn shift-type) + (dnti (.sym alu- mnemonic) comment + () + (.str mnemonic " $rd,$rs") + (+ (f-op6 #x10) (f-alu-op alu-opcode) rs rd) + (sequence ((BI carry-out) (SI result)) + (set carry-out + (c-call BI "compute_carry_out_regshift" + rd shift-type rs cbit)) + (set result (sem-fn rd rs)) + (set rd result) + (set-logical-cc result carry-out)) + ) +) + +(alu-logical-op and "and" 0 and) +(alu-logical-op eor "xor" 1 xor) + +(alu-shift-op lsl "logical shift left" 2 sll SHIFT-TYPE-lsl) +(alu-shift-op lsr "logical shift right" 3 srl SHIFT-TYPE-lsr) +(alu-shift-op asr "arithmetic shift right" 4 sra SHIFT-TYPE-asr) +(alu-shift-op ror "rotate right" 7 ror SHIFT-TYPE-ror) + +(alu-arith-op adc "add with carry" 5 + (.pmacro (rd rs cbit) (addc rd rs cbit)) + (.pmacro (rd rs cbit) (set-add-flags rd rs cbit))) +(alu-arith-op sbc "subtract with carry (borrow)" 6 + (.pmacro (rd rs cbit) (subc rd rs (not cbit))) + (.pmacro (rd rs cbit) (set-sub-flags rd rs cbit))) + +(dnti alu-tst "test" + () + "tst $rd,$rs" + (+ (f-op6 #x10) (f-alu-op 8) rs rd) + (sequence ((SI x)) + (set x (and rd rs)) + (set-zn-flags x)) +) + +(alu-arith-op neg "negate" 9 + (.pmacro (rd rs cbit) (neg rs)) + (.pmacro (rd rs cbit) (set-sub-flags 0 rs 1))) + +(dnti alu-cmp "compare" + () + "cmp $rd,$rs" + (+ (f-op6 #x10) (f-alu-op 10) rs rd) + (set-sub-flags rd rs 1) +) +(dnti alu-cmn "compare negative" + () + "cmn $rd,$rs" + (+ (f-op6 #x10) (f-alu-op 11) rs rd) + (set-add-flags rd rs 0) +) + +(alu-logical-op orr "or" 12 or) + +; use alu-logical-op 'cus it sets the condition codes the way we want +(alu-logical-op mul "multiply" 13 mul) + +(alu-logical-op bic "bit clear" 14 (.pmacro (rd rs) (and rd (inv rs)))) + +(alu-logical-op mvn "invert" 15 (.pmacro (rd rs) (inv rs))) + +; Hi register operations. +; +; R15 and PC are treated as two distinct registers. It is assumed that the +; execution environment ensures R15 = PC+4. All reads are taken from R15. +; All writes are written to PC. + +(define-hardware + (name h-hiregs) + (comment "High registers (R8-R15)") + (attrs (ISA thumb) VIRTUAL) + (type register WI (8)) + (indices keyword "" + ((r8 0) (r9 1) (r10 2) (r11 3) (r12 4) (r13 5) (r14 6) (r15 7))) + ; ??? Accesses won't be as efficient as possible as +8 calculation will + ; get done at exec time (could be defered to extract phase), but that's an + ; optimization that can be generally useful in the extract phase. + (get (regno) (reg h-gr (add regno (const 8)))) + (set (regno newval) (set (reg h-gr (add regno (const 8))) newval)) +) + + +(dntf f-hireg-op "Hi register opcode" () 9 2) + +(dntop hs "high source register" () h-hiregs f-rs) +(dntop hd "high destination register" () h-hiregs f-rd) + +(define-pmacro (hireg-op mnemonic + lo-op-hi-comment + hi-op-lo-comment + hi1-op-hi2-comment + opcode + lo-dest-sem-fn + hi-dest-sem-fn) + (begin + (dnti (.sym mnemonic -rd-hs) + lo-op-hi-comment + () + (.str mnemonic " $rd,$hs") + (+ (f-op6 #x11) (f-hireg-op opcode) (f-h1 0) (f-h2 1) hs rd) + (lo-dest-sem-fn rd hs) + ) + (dnti (.sym mnemonic -hd-rs) + hi-op-lo-comment + () + (.str mnemonic " $hd,$rs") + (+ (f-op6 #x11) (f-hireg-op opcode) (f-h1 1) (f-h2 0) hd rs) + (hi-dest-sem-fn hd rs) + ) + (dnti (.sym mnemonic -hd-hs) + hi1-op-hi2-comment + () + (.str mnemonic " $hd,$hs") + (+ (f-op6 #x11) (f-hireg-op opcode) (f-h1 1) (f-h2 1) hd hs) + (hi-dest-sem-fn hd hs) + ) + ) +) + +(hireg-op add "lo = lo + hi" "hi = hi + lo" "hi = hi + hi2" 0 + (.pmacro (src1-dest src2) (set src1-dest (add src1-dest src2))) + (.pmacro (src1-dest src2) + (if (eq (regno src1-dest) 7) + (set pc (add src1-dest src2)) + (set src1-dest (add src1-dest src2)))) +) + +(hireg-op cmp "compare lo,hi" "compare hi,lo" "compare hi1,hi2" 1 + (.pmacro (src1 src2) (set-sub-flags src1 src2 1)) + (.pmacro (src1 src2) (set-sub-flags src1 src2 1)) +) + +(hireg-op mov "lo = hi" "hi = lo" "hi1 = hi2" 2 + (.pmacro (dest src) (set dest src)) + (.pmacro (dest src) + (if (eq (regno dest) 7) + (set pc src) + (set dest src))) +) + +(dnti bx-rs "bx on lo reg" + () + "bx $rs" + (+ (f-op6 #x11) (f-hireg-op 3) (f-h1 0) (f-h2 0) (f-rd 0) rs) + (sequence () + (set pc rs) + (if (not (and rs 1)) + (set (reg h-tbit) 0))) +) +(dnti bx-hs "bx on hi reg" + () + "bx $hs" + (+ (f-op6 #x11) (f-hireg-op 3) (f-h1 0) (f-h2 1) (f-rd 0) hs) + (sequence () + (set pc hs) + (if (not (and hs 1)) + (set (reg h-tbit) 0))) +) + +; PC relative load. + +(df f-word8 "10 bit unsigned offset, right shifted by 2" + ((ISA thumb)) + 7 8 UINT + ((value pc) (srl WI value (const 2))) + ((value pc) (sll WI value (const 2))) +) + +(dntop word8 "10 bit unsigned immediate" () h-uint f-word8) + +(dnti ldr-pc "pc relative load" + () + "ldr ${bit10-rd},[pc,#$word8]" + (+ (f-op5 9) bit10-rd word8) + (set bit10-rd + (mem WI (add (and (add pc (const 4)) (const WI -4)) word8))) +) + +; Load/store with register offset. + +(dnti str "store word" + () + "str $rd,[$rb,$ro]" + (+ (f-op4 5) (f-l 0) (f-b 0) (f-bit9 0) ro rb rd) + (set (mem WI (add rb ro)) rd) +) +(dnti strb "store byte" + () + "strb $rd,[$rb,$ro]" + (+ (f-op4 5) (f-l 0) (f-b 1) (f-bit9 0) ro rb rd) + (set (mem QI (add rb ro)) rd) +) +(dnti ldr "load word" + () + "ldr $rd,[$rb,$ro]" + (+ (f-op4 5) (f-l 1) (f-b 0) (f-bit9 0) ro rb rd) + (set rd (mem WI (add rb ro))) +) +(dnti ldrb "load zero extended byte" + () + "ldrb $rd,[$rb,$ro]" + (+ (f-op4 5) (f-l 1) (f-b 1) (f-bit9 0) ro rb rd) + (set rd (zext SI (mem QI (add rb ro)))) +) + +; Load/store sign-extended byte/halfword. + +(dntf f-s "signed/unsigned indicator" () 10 1) + +(dnti strh "store halfword" + () + "strh $rd,[$rb,$ro]" + (+ (f-op4 5) (f-h 0) (f-s 0) (f-bit9 1) ro rb rd) + (set (mem HI (add rb ro)) rd) +) +(dnti ldrh "load zero extended halfword" + () + "ldrh $rd,[$rb,$ro]" + (+ (f-op4 5) (f-h 1) (f-s 0) (f-bit9 1) ro rb rd) + (set rd (zext SI (mem HI (add rb ro)))) +) +(dnti ldsb "load sign extended byte" + () + "ldsb $rd,[$rb,$ro]" + (+ (f-op4 5) (f-h 0) (f-s 1) (f-bit9 1) ro rb rd) + (set rd (ext SI (mem QI (add rb ro)))) +) +(dnti ldsh "load sign extended halfword" + () + "ldsh $rd,[$rb,$ro]" + (+ (f-op4 5) (f-h 1) (f-s 1) (f-bit9 1) ro rb rd) + (set rd (ext SI (mem HI (add rb ro)))) +) + +; Load/store with immediate offset. + +(dntf f-b-imm "byte/word indicator in load/store with immediate offset insns" () 12 1) + +(df f-offset5-7 "offset5 field as 7 bit unsigned immediate" + ((ISA thumb)) + 10 5 UINT + ((value pc) (srl WI value (const 2))) + ((value pc) (sll WI value (const 2))) +) + +(dntop offset5-7 "offset5 as 7 bit unsigned immediate" () h-uint f-offset5-7) + +(dnti str-imm "store word with immediate offset" + () + "str $rd,[$rb,#${offset5-7}]" + (+ (f-op3 3) (f-b-imm 0) (f-l 0) offset5-7 rb rd) + (set (mem WI (add rb offset5-7)) rd) +) +(dnti ldr-imm "load word with immediate offset" + () + "ldr $rd,[$rb,#${offset5-7}]" + (+ (f-op3 3) (f-b-imm 0) (f-l 1) offset5-7 rb rd) + (set rd (mem WI (add rb offset5-7))) +) +(dnti strb-imm "store byte with immediate offset" + () + "strb $rd,[$rb,#$offset5]" + (+ (f-op3 3) (f-b-imm 1) (f-l 0) offset5 rb rd) + (set (mem QI (add rb offset5)) rd) +) +(dnti ldrb-imm "load zero extended byte with immediate offset" + () + "ldrb $rd,[$rb,#$offset5]" + (+ (f-op3 3) (f-b-imm 1) (f-l 1) offset5 rb rd) + (set rd (zext SI (mem QI (add rb offset5)))) +) + +; Load/store halfword with immediate offset. + +(df f-offset5-6 "offset5 field as 6 bit unsigned immediate" + ((ISA thumb)) + 10 5 UINT + ((value pc) (srl WI value (const 1))) + ((value pc) (sll WI value (const 1))) +) + +(dntop offset5-6 "offset5 as 7 bit unsigned immediate" () h-uint f-offset5-6) + +(dnti strh-imm "store halfword with immediate offset" + () + "strh $rd,[$rb,#${offset5-6}]" + (+ (f-op4 8) (f-l 0) offset5-6 rb rd) + (set (mem HI (add rb offset5-6)) rd) +) +(dnti ldrh-imm "load zero extended halfword with immediate offset" + () + "ldrh $rd,[$rb,#${offset5-6}]" + (+ (f-op4 8) (f-l 1) offset5-6 rb rd) + (set rd (zext WI (mem HI (add rb offset5-6)))) +) + +; SP-relative load/store + +(dnti str-sprel "store word, sp-relative" + () + "str ${bit10-rd},[sp,#$word8]" + (+ (f-op4 9) (f-l 0) bit10-rd word8) + (set (mem WI (add sp word8)) bit10-rd) +) +(dnti ldr-sprel "load word, sp-relative" + () + "ldr ${bit10-rd},[sp,#$word8]" + (+ (f-op4 9) (f-l 1) bit10-rd word8) + (set bit10-rd (mem WI (add sp word8))) +) + +; Load address + +(dntf f-sp "sp/pc indicator" () 11 1) + +(dnti lda-pc "load address from pc" + () + "add ${bit10-rd},pc,$word8" + (+ (f-op4 10) (f-sp 0) bit10-rd word8) + (set bit10-rd (add (and (add pc (const 4)) (const WI -4)) word8)) +) +(dnti lda-sp "load address from sp" + () + "add ${bit10-rd},sp,$word8" + (+ (f-op4 10) (f-sp 1) bit10-rd word8) + (set bit10-rd (add sp word8)) +) + +; Add offset to stack pointer. +; FIXME: Handling of sign+magnitude needs revisiting. +; If expressions are allowed here we can't assume "-" follows "#". + +(dntf f-addoff-s "s bit in add offset to sp insns" () 7 1) + +(df f-sword7 "7 bit magnitude, accompanies sign bit" + ((ISA thumb)) + 6 7 UINT + ((value pc) (srl WI value (const 2))) + ((value pc) (sll WI value (const 2))) +) + +(dntop sword7 "7 bit magnitude, accompanies sign bit" () h-uint f-sword7) + +(dnti add-sp "add offset to sp" + () + "add sp,#$sword7" + (+ (f-op8 #xb0) (f-addoff-s 0) sword7) + (set sp (add sp sword7)) +) +(dnti sub-sp "subtract offset from sp" + () + "add sp,#-$sword7" + (+ (f-op8 #xb0) (f-addoff-s 1) sword7) + (set sp (sub sp sword7)) +) + +; Push/pop registers. + +; FIXME: Might be better to use sequence temp as address reg. + +(define-pmacro (push-reg regno) + (if (and rlist (sll 1 regno)) + (sequence () + (set sp (sub sp 4)) + (set (mem WI sp) (reg WI h-gr-t regno)) + )) +) +(define-pmacro (pop-reg regno) + (if (and rlist (sll 1 regno)) + (sequence () + (set (reg WI h-gr-t regno) (mem WI sp)) + (set sp (add sp 4)) + )) +) + +(dntf f-pushpop-op "opcode bits 10,9 in push/pop insns" () 10 2) + +(dntf f-r "register indicator in push/pop insns" () 8 1) + +(dntf f-rlist "register list" () 7 8) + +; ??? Print/parse handler specs missing. Later. +(dntop rlist "register list" () h-uint f-rlist) +(dntop rlist-lr "register list with lr" () h-uint f-rlist) +(dntop rlist-pc "register list with pc" () h-uint f-rlist) + +(dnti push "push registers" + () + "push {$rlist}" + (+ (f-op4 11) (f-l 0) (f-pushpop-op 2) (f-r 0) rlist) + (.splice sequence () (.unsplice (.map push-reg (.iota 8 7 -1)))) +) +(dnti push-lr "push registers and lr" + () + "push {${rlist-lr}}" + (+ (f-op4 11) (f-l 0) (f-pushpop-op 2) (f-r 1) rlist) + (.splice sequence () + (set sp (sub sp 4)) + (set (mem WI sp) lr) + (.unsplice (.map push-reg (.iota 8 7 -1))) + ) +) + +(dnti pop "pop registers" + () + "pop {$rlist}" + (+ (f-op4 11) (f-l 1) (f-pushpop-op 2) (f-r 0) rlist) + (.splice sequence () (.unsplice (.map pop-reg (.iota 8)))) +) +(dnti pop-pc "pop registers and pc" + () + "pop {${rlist-pc}}" + (+ (f-op4 11) (f-l 1) (f-pushpop-op 2) (f-r 1) rlist) + (.splice sequence () + (.unsplice (.map pop-reg (.iota 8))) + (set pc (mem WI sp)) + (set sp (add sp 4)) + ) +) + +; Multiple load/store. + +; FIXME: Might be better to use sequence temp as address reg. + +(dntf f-bit10-rb "Rb at bit 10" () 10 3) + +(dntop bit10-rb "base reg at bit 10" () h-gr-t f-bit10-rb) + +(define-pmacro (save-reg-inc regno) + (if (and rlist (sll 1 regno)) + (sequence () + (set (mem WI bit10-rb) (reg WI h-gr-t regno)) + (set bit10-rb (add bit10-rb 4)) + )) +) +(define-pmacro (load-reg-inc regno) + (if (and rlist (sll 1 regno)) + (sequence () + (set (reg WI h-gr-t regno) (mem WI bit10-rb)) + (set bit10-rb (add bit10-rb 4)) + )) +) + +(dnti stmia "store multiple" + () + "stmia $rb!,{$rlist}" + (+ (f-op4 12) (f-l 0) bit10-rb rlist) + (.splice sequence () (.unsplice (.map save-reg-inc (.iota 8)))) +) +(dnti ldmia "load multiple" + () + "ldmia $rb!,{$rlist}" + (+ (f-op4 12) (f-l 1) bit10-rb rlist) + (.splice sequence () (.unsplice (.map load-reg-inc (.iota 8)))) +) + +; Conditional branches. + +(dntf f-cond "condition code spec" () 11 4) + +; The standard condition code tests. + +(define-normal-insn-enum cc-tests + "condition code tests" + () "" f-cond + ( + (CC_EQ 0) ; equal + (CC_NE 1) ; not equal + (CC_CS 2) ; carry set (unsigned greater or equal) + (CC_CC 3) ; carry clear (unsigned less than) + (CC_MI 4) ; minus (negative) + (CC_PL 5) ; positive or zero + (CC_VS 6) ; overflow set + (CC_VC 7) ; overflow clear + (CC_HI 8) ; higher (unsigned greater) + (CC_LS 9) ; less or same (unsigned less or equal) + (CC_GE 10) ; greater or equal + (CC_LT 11) ; less + (CC_GT 12) ; greater + (CC_LE 13) ; less or equal + ) +) + +(df f-soffset8 "8 bit pc relative branch address" + (PCREL-ADDR (ISA thumb)) + 7 8 INT + ((value pc) (sra WI (sub WI value (add WI pc (const 4))) (const 1))) + ((value pc) (add WI (sll WI value (const 1)) (add WI pc (const 4)))) +) + +(dntop soffset8 "8 bit pc relative branch address" () h-iaddr f-soffset8) + +(define-pmacro (cbranch bname comment cond test) + (dnti bname (.str "branch if " comment) + () + (.str bname " $soffset8") + (+ (f-op4 13) cond soffset8) + (if (test) + (set pc soffset8)) + ) +) +(cbranch beq "eq" CC_EQ test-eq) +(cbranch bne "ne" CC_NE test-ne) +(cbranch bcs "cs (ltu)" CC_CS test-cs) +(cbranch bcc "cc (geu)" CC_CC test-cc) +(cbranch bmi "mi (negative)" CC_MI test-mi) +(cbranch bpl "pl (positive or zero)" CC_PL test-pl) +(cbranch bvs "vs (overflow set)" CC_VS test-vs) +(cbranch bvc "vc (overflow clear)" CC_VC test-vc) +(cbranch bhi "hi (gtu)" CC_HI test-hi) +(cbranch bls "ls (leu)" CC_LS test-ls) +(cbranch bge "ge" CC_GE test-ge) +(cbranch blt "lt" CC_LT test-lt) +(cbranch bgt "gt" CC_GT test-gt) +(cbranch ble "le" CC_LE test-le) + +; Software interrupt. + +(dntf f-value8 "8 bit value for swi" () 7 8) + +(dntop value8 "8 bit value for swi" () h-uint f-value8) + +(dnti swi "software interrupt" + () + "swi $value8" + (+ (f-op8 #xdf) value8) + ; FIXME: for now + (set pc (c-call WI "thumb_swi" pc value8)) +) + +; Unconditional branch. + +(df f-offset11 "11 bit pc relative branch address" + (PCREL-ADDR (ISA thumb)) + 10 11 INT + ((value pc) (sra WI (sub value (add pc (const 4))) (const 1))) + ((value pc) (add WI (sll value (const 1)) (add pc (const 4)))) +) + +(dntop offset11 "11 bit pc relative branch address" () h-iaddr f-offset11) + +(dnti b "unconditional branch" + () + "b $offset11" + (+ (f-op5 #x1c) offset11) + (set pc offset11) +) + +; Long branch with link. +; Two instructions that make up a subroutine call. +; FIXME: Assembler access is via one insn - macro-insn? +; Left for later, as is all assembly considerations. + +(dntf f-lbwl-h "long branch with link `h' field" () 11 1) + +; This one is signed. +(define-ifield + (name f-lbwl-hi) + (comment "long branch with link offset, high part") + (attrs (ISA thumb)) + (mode INT) + (start 10) + (length 11) +) +(dntop lbwl-hi "long branch with link offset, high part" () + h-sint f-lbwl-hi) + +; This one is unsigned. +(dntf f-lbwl-lo "long branch with link offset, low part" () 10 11) +(dntop lbwl-lo "long branch with link offset, low part" () + h-uint f-lbwl-lo) + +(dnti bl-hi "branch link, high offset" + () + "bl-hi ${lbwl-hi}" + (+ (f-op4 15) (f-lbwl-h 0) lbwl-hi) + (set lr (add (add pc 4) (sll lbwl-hi 12))) +) + +(dnti bl-lo "branch link, low offset" + () + "bl-lo ${lbwl-lo}" + (+ (f-op4 15) (f-lbwl-h 1) lbwl-lo) + (sequence ((WI cur-pc)) + (set cur-pc pc) + (set pc (add lr (sll lbwl-lo 1))) + (set lr (or (add cur-pc 2) 1))) +) diff --git a/cgen/types.scm b/cgen/types.scm new file mode 100644 index 00000000000..dec4142e5af --- /dev/null +++ b/cgen/types.scm @@ -0,0 +1,278 @@ +; Type system. +; This provides the low level classes for describing data, except for +; the actual type (confusingly enough) which is described in mode.scm. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Array type. +; DIMENSIONS has a suitable initial value so (new <scalar>) to works. + +(define <array> (class-make '<array> nil '(mode (dimensions . ())) nil)) + +; Return number of elements in array. + +(method-make! + <array> 'get-num-elms + (lambda (self) + (apply * (elm-get self 'dimensions))) +) + +; Return mode of the array. + +(method-make! <array> 'get-mode (lambda (self) (elm-get self 'mode))) + +; Return the rank of the array (number of dimensions). + +(method-make! <array> 'get-rank (lambda (self) (length (elm-get self 'dimensions))) +) + +; Return shape of array + +(method-make! <array> 'get-shape (lambda (self) (elm-get self 'dimensions)) +) + +; Return #t if X is an array. + +(define (array? x) (class-instance? <array> x)) + +; Scalar type. + +(define <scalar> (class-make '<scalar> '(<array>) nil nil)) + +(method-make-make! <scalar> '(mode)) + +; Return #t if X is a scalar. + +(define (scalar? x) (and (array? x) (= (send x 'get-rank) 0))) + +; Return number of bits in an element of TYPE. + +(define (type-bits type) + (mode:bits (send type 'get-mode)) +) + +; Integers. +; These are like scalars but are specified in bits. +; BITS is the size in bits. +; ATTRS contains !UNSIGNED [or nothing] or UNSIGNED. +; +; A mode is needed so we know how big a field is needed to record the value. +; It might be more appropriate to use a host mode though. +; +; FIXME: Need to separate rank from type. scalar/array are not types. +; +;(define <integer> (class-make '<integer> nil '(attrs bits) nil)) +; +;(method-make! <integer> 'get-atlist (lambda (self) (elm-get self 'attrs))) +; +;(method-make! +; <integer> 'get-mode +; (lambda (self) +; (mode-find (elm-get self 'bits) +; (if (has-attr? self 'UNSIGNED) 'UINT 'INT)) +; ) +;) +; +; FIXME: Quick hack. Revisit. +; +;(method-make! <integer> 'get-rank (lambda (self) 0)) + +; Structures. +; FIXME: Unfinished. + +(define <struct> (class-make '<struct> nil '(members) nil)) + +; Parse a type spec. +; TYPE-SPEC is: (mode [(dimensions ...)]) +; or: ((mode bits) [(dimensions ...)]) + +(define (parse-type errtxt type-spec) + ; Preliminary error checking. + (if (and (list? (car type-spec)) + (not (= (length (car type-spec)) 2))) + (parse-error errtxt "invalid type spec" type-spec)) + + ; Pick out the arguments. + (let ((mode (if (list? (car type-spec)) (caar type-spec) (car type-spec))) + (bits (if (list? (car type-spec)) (cadar type-spec) #f)) + (dims (if (> (length type-spec) 1) (cadr type-spec) nil))) + + ; FIXME: Need more error checking here. + ; Validate the mode and bits. + (let ((mode-obj + (case mode + ((INT) + (if (integer? bits) + (mode-make-int bits) + (parse-error errtxt "invalid number of bits" bits))) + ((UINT) + (if (integer? bits) + (mode-make-uint bits) + (parse-error errtxt "invalid number of bits" bits))) + ((BI QI HI SI DI WI UQI UHI USI UDI UWI SF DF XF TF) + (let ((x (parse-mode-name mode errtxt))) + (if (and bits (not (= bits (mode:bits x)))) + (parse-error errtxt "wrong number of bits for mode" bits)) + x)) + (else (parse-error errtxt "unknown/unsupported mode" mode))))) + + ; Validate the dimension spec. + (if (or (not (list? dims)) + (not (all-true? (map integer? dims)))) + (parse-error errtxt "invalid dimension spec" dims)) + + ; All done, create the <array> object. + ; ??? Special casing scalars is a concession for apps that think + ; scalars aren't arrays. Not sure it should stay. + (if (null? dims) + (make <scalar> mode-obj) + (make <array> mode-obj dims)))) +) + +; Bit ranges. +; ??? Perhaps this should live in a different source file, but for now +; it's here. +; +; Endianness is not recorded with the bitrange. +; Values are operated on a "word" at a time. +; This is to handle bi-endian systems: we don't want two copies of +; every bitrange. +; +; Instruction word sizes are based on the "base insn length" which is the +; number of bytes the cpu first looks at to decode an insn. In cases where +; the total length is longer than the base insn length, the word length +; for the rest of the insn is the base insn length replicated as many times +; as necessary. The trailing part [last few bytes] of the insn may not fill +; the entire word, in which case the numbering is adjusted for it. +; ??? Might need to have an insn-base-length and an insn-word-length. +; +; Instructions that have words of one endianness and sub-words of a different +; endianness are handled at a higher level. +; +; Bit numbering examples: +; [each byte is represented MSB to LSB, low address to high address] +; +; lsb0? = #f +; insn-word-length = 2 +; endian = little +; | 8 ... 15 | 0 ... 7 | 24 ... 31 | 16 ... 23 | 40 ... 47 | 32 ... 39 | +; +; lsb0? = #t +; insn-word-length = 2 +; endian = little +; [note that this is the little endian canonical form +; - word length is irrelevant] +; | 7 ... 0 | 15 ... 8 | 23 ... 16 | 31 ... 24 | 39 ... 32 | 47 ... 40 | +; +; lsb0? = #f +; insn-word-length = 2 +; endian = big +; [note that this is the big endian canonical form +; - word length is irrelevant] +; | 0 ... 7 | 8 ... 15 | 16 ... 23 | 24 ... 31 | 32 ... 39 | 40 ... 47 | +; +; lsb0? = #t +; insn-word-length = 2 +; endian = big +; | 15 ... 8 | 7 ... 0 | 31 ... 24 | 23 ... 16 | 47 ... 40 | 39 ... 32 | +; +; While there are no current examples, the intent is to not preclude +; situations where each "word" in an insn isn't the same size. For example a +; 48 bit insn with a 16 bit opcode and a 32 bit immediate value might [but not +; necessarily] consist of one 16 bit "word" and one 32 bit "word". +; Bitranges support this situation, however none of the rest of the code does. +; +; Examples: +; +; lsb0? = #f +; insn-word-length = 2, 4 +; endian = little +; | 8 ... 15 | 0 ... 7 | 40 ... 47 | 32 ... 39 | 24 ... 31 | 16 ... 23 | +; +; lsb0? = #t +; insn-word-length = 2, 4 +; endian = little +; | 7 ... 0 | 15 ... 8 | 23 ... 16 | 31 ... 24 | 39 ... 32 | 47 ... 40 | +; +; lsb0? = #f +; insn-word-length = 2, 4 +; endian = big +; | 0 ... 7 | 8 ... 15 | 16 ... 23 | 24 ... 31 | 32 ... 39 | 40 ... 47 | +; +; lsb0? = #t +; insn-word-length = 2, 4 +; endian = big +; | 15 ... 8 | 7 ... 0 | 47 ... 40 | 39 ... 32 | 31 ... 24 | 23 ... 16 | + +(define <bitrange> + (class-make '<bitrange> + nil + '( + ; offset in bits from the start of the insn of the word + ; in which the value resides [must be divisible by 8] + ; [this allows the bitrange to be independent of the lengths + ; of words preceding this one] + word-offset + ; starting bit number within the word + ; [externally, = word-offset + start] + start + ; number of bits in the value + length + ; length of word in which the value resides + word-length + ; lsb = bit number 0? + lsb0? + ) + nil) +) + +; Accessor fns. + +(define-getters <bitrange> bitrange + (word-offset start length word-length lsb0?) +) + +(define-setters <bitrange> bitrange + ; lsb0? left out on purpose: not sure changing it should be allowed + (word-offset start length word-length) +) + +; Return a boolean indicating if two bitranges overlap. + +(define (bitrange-overlap? start1 length1 start2 length2 lsb0?) + ; ??? lsb0? + (let ((end1 (+ start1 length1)) + (end2 (+ start2 length2))) + (not (or (<= end1 start2) + (>= start1 end2)))) +) + +; Return a boolean indicating if BITPOS is beyond bitrange START,LEN. +; ??? This needs more thought. + +(define (bitpos-beyond? bitpos start length word-length lsb0?) + (>= bitpos (+ start length)) +) + +; Return the offset of the word after <bitrange> br. + +(define (bitrange-next-word br) + (let ((word-offset (bitrange-word-offset br)) + (start (bitrange-start br)) + (length (bitrange-length br)) + (word-length (bitrange-word-length br)) + (lsb0? (bitrange-lsb0? br))) + ; ??? revisit + (+ word-offset word-length)) +) + +; Initialize/finalize support. + +(define (types-init!) + *UNSPECIFIED* +) + +(define (types-finish!) + *UNSPECIFIED* +) diff --git a/cgen/utils-cgen.scm b/cgen/utils-cgen.scm new file mode 100644 index 00000000000..5d3f24cb76d --- /dev/null +++ b/cgen/utils-cgen.scm @@ -0,0 +1,654 @@ +; CGEN Utilities. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. +; +; This file contains utilities specific to cgen. +; Generic utilities should go in utils.scm. + +; True if text of sanitize markers are to be emitted. +; This is a debugging tool only, though it could have use in sanitized trees. +(define include-sanitize-marker? #t) + +; Utility to display command line invocation for debugging purposes. + +(define (display-argv argv) + (let ((cep (current-error-port))) + (display "cgen -s " cep) + (for-each (lambda (arg) + ; Output double-quotes if string has a space for better + ; correspondence to how to specify string to shell. + (if (string-index arg #\space) + (write arg cep) + (display arg cep)) + (display " " cep)) + argv) + (newline cep)) +) + +; COS utilities. +; Perhaps these should be provided with cos (cgen-object-system), but for +; now they live here. + +; Define the getter for a list of elements of a class. + +(defmacro define-getters (class class-prefix elm-names) + (cons 'begin + (map (lambda (elm-name) + (if (pair? elm-name) + `(define ,(symbol-append class-prefix '- (cdr elm-name)) + (elm-make-getter ,class (quote ,(car elm-name)))) + `(define ,(symbol-append class-prefix '- elm-name) + (elm-make-getter ,class (quote ,elm-name))))) + elm-names)) +) + +; Define the setter for a list of elements of a class. + +(defmacro define-setters (class class-prefix elm-names) + (cons 'begin + (map (lambda (elm-name) + (if (pair? elm-name) + `(define ,(symbol-append class-prefix '-set- (cdr elm-name) '!) + (elm-make-setter ,class (quote ,(car elm-name)))) + `(define ,(symbol-append class-prefix '-set- elm-name '!) + (elm-make-setter ,class (quote ,elm-name))))) + elm-names)) +) + +; Make an object, specifying values for particular elements. +; ??? Eventually move to cos.scm/cos.c. + +(define (vmake class . args) + (let ((obj (new class))) + (let ((unrecognized (send obj 'vmake! args))) + (if (null? unrecognized) + obj + (error "vmake: unknown options:" unrecognized)))) +) + +; Each named entry in the description file typically has these three members: +; name, comment attrs. + +(define <ident> (class-make '<ident> () '(name comment attrs) ())) + +(method-make! <ident> 'get-name (lambda (self) (elm-get self 'name))) +(method-make! <ident> 'get-comment (lambda (self) (elm-get self 'comment))) +(method-make! <ident> 'get-atlist (lambda (self) (elm-get self 'attrs))) + +(method-make! <ident> 'set-name! + (lambda (self newval) (elm-set! self 'name newval))) +(method-make! <ident> 'set-comment! + (lambda (self newval) (elm-set! self 'comment newval))) +(method-make! <ident> 'set-atlist! + (lambda (self newval) (elm-set! self 'attrs newval))) + +; All objects defined in the .cpu file have these elements. +; Where in the class hierarchy they're recorded depends on the object. +; Additionally most objects have `name', `comment' and `attrs' elements. + +(define (obj:name obj) (send obj 'get-name)) +(define (obj-set-name! obj name) (send obj 'set-name! name)) +(define (obj:comment obj) (send obj 'get-comment)) + +; Utility to add standard access methods for name, comment, attrs. +; ??? Old. Using <ident> baseclass now. + +(define (add-ident-methods! class) + (method-make! class 'get-name (lambda (self) (elm-get self 'name))) + (method-make! class 'set-name! (lambda (self name) (elm-set! self 'name name))) + + (method-make! class 'get-comment (lambda (self) (elm-get self 'comment))) + (method-make! class 'set-comment! (lambda (self comment) (elm-set! self 'comment comment))) + + (method-make! class 'get-atlist (lambda (self) (elm-get self 'attrs))) + (method-make! class 'set-atlist! (lambda (self attrs) (elm-set! self 'attrs attrs))) + + *UNSPECIFIED* +) + +; Parsing utilities + +; Parsing context, used to give better error messages. + +(define <context> + (class-make '<context> nil + '( + ; Name of file containing object being processed. + (file . #f) + ; Line number in the file. + (lineno . #f) + ; Error message prefix + (prefix . "") + ) + nil) +) + +; Accessors. + +(define-getters <context> context (file lineno prefix)) + +; Create a <context> object that is just a prefix. + +(define (context-make-prefix prefix) + (make <context> #f #f prefix) +) + +; Create a <context> object for the reader. +; This sets file,lineno from (current-input-port). + +(define (context-make-reader prefix) + (make <context> + (or (port-filename (current-input-port)) + "<input>") + (port-line (current-input-port)) + prefix) +) + +; Call this to issue an error message. +; CONTEXT is a <context> object or #f if there is none. +; ARG is the value that had the error if there is one. + +(define (context-error context errmsg . arg) + (cond ((and context (context-file context)) + (let ((msg (string-append + (context-file context) ":" + (number->string (context-lineno context)) ": " + (context-prefix context) ": " + errmsg ": "))) + (apply error (cons msg arg)))) + (context (let ((msg (string-append (context-prefix context) ": " + errmsg ": "))) + (apply error (cons msg arg)))) + (else (apply error (cons (string-append errmsg ": ") arg)))) +) + +; Parse an object name. +; NAME is either a symbol or a list of symbols which are concatenated +; together. Each element can in turn be a list of symbols, and so on. +; This supports symbol concatenation in the description file without having +; to using string-append or some such. +; FIXME: Isn't the plan to move ERRTXT to the 1st arg? + +(define (parse-name name errtxt) + (cond ((list? name) + (string->symbol (string-map (lambda (elm) (parse-name elm errtxt)) name))) + ((symbol? name) name) + ((string? name) (string->symbol name)) + (else (parse-error errtxt "improper name" name))) +) + +; Parse an object comment. +; COMMENT is either a string or a list of strings, each element of which may +; in turn be a list of strings. +; FIXME: Isn't the plan to move ERRTXT to the 1st arg? + +(define (parse-comment comment errtxt) + (cond ((list? comment) + (string-map (lambda (elm) (parse-comment elm errtxt)) comment)) + ((or (string? comment) (symbol? comment)) + comment) + (else (parse-error errtxt "improper comment" comment))) +) + +; Parse a symbol. + +(define (parse-symbol context value) + (if (and (not (symbol? value)) (not (string? value))) + (parse-error context "not a symbol" value)) + value +) + +; Parse a string. + +(define (parse-string context value) + (if (and (not (symbol? value)) (not (string? value))) + (parse-error context "not a string" value)) + value +) + +; Parse a number. +; VALID-VALUES is a list of numbers and (min . max) pairs. + +(define (parse-number errtxt value . valid-values) + (if (not (number? value)) + (parse-error errtxt "not a number" value)) + (if (any-true? (map (lambda (test) + (if (pair? test) + (and (>= value (car test)) + (<= value (cdr test))) + (= value test))) + valid-values)) + value + (parse-error errtxt "invalid number" value valid-values)) +) + +; Parse a boolean value + +(define (parse-boolean context value) + (if (boolean? value) + value + (parse-error context "not a boolean (#f/#t)" value)) +) + +; Parse a list of handlers. +; Each entry is (symbol "string"). +; These map function to a handler for it. +; The meaning is up to the application but generally the handler is a +; C/C++ function name. +; ALLOWED is a list valid values for the symbol or #f if anything is allowed. +; The result is handlers unchanged. + +(define (parse-handlers context allowed handlers) + (if (not (list? handlers)) + (parse-error context "bad handler spec" handlers)) + (for-each (lambda (arg) + (if (not (list-elements-ok? arg (list symbol? string?))) + (parse-error context "bad handler spec" arg)) + (if (and allowed (not (memq (car arg) allowed))) + (parse-error context "unknown handler type" (car arg)))) + handlers) + handlers +) + +; Return a boolean indicating if X is a keyword. +; This also handles symbols named :foo because Guile doesn't stablely support +; :keywords (how does one enable :keywords? read-options doesn't appear to +; work). + +(define (keyword-list? x) + (and (list? x) + (not (null? x)) + (or (keyword? (car x)) + (and (symbol? (car x)) + (char=? (string-ref (car x) 0) #\:)))) +) + +; Convert a list like (#:key1 val1 #:key2 val2 ...) to +; ((#:key1 val1) (#:key2 val2) ...). +; Missing values are specified with an empty list. +; This also supports (:sym1 val1 ...) because Guile doesn't stablely support +; :keywords (#:keywords work, but #:foo shouldn't appear in the description +; language). + +(define (keyword-list->arg-list kl) + ; Scan KL backwards, building up each element as we go. + (let loop ((result nil) (current nil) (rkl (reverse kl))) + (cond ((null? rkl) + result) + ((keyword? (car rkl)) + (loop (acons (keyword->symbol (car rkl)) current result) + nil + (cdr rkl))) + ((and (symbol? (car rkl)) + (char=? (string-ref (car rkl) 0) #\:)) + (loop (acons (string->symbol + (substring (car rkl) 1 (string-length (car rkl)))) + current result) + nil + (cdr rkl))) + (else + (loop result + (cons (car rkl) current) + (cdr rkl))))) +) + +; Signal an error if the argument name is not a symbol. +; This is done by each of the argument validation routines so the caller +; doesn't need to make two calls. + +(define (arg-list-validate-name errtxt arg-spec) + (if (null? arg-spec) + (parse-error errtxt "empty argument spec")) + (if (not (symbol? (car arg-spec))) + (parse-error errtxt "argument name not a symbol" arg-spec)) + *UNSPECIFIED* +) + +; Signal a parse error if an argument was specified with a value. +; ARG-SPEC is (name value). + +(define (arg-list-check-no-args errtxt arg-spec) + (arg-list-validate-name errtxt arg-spec) + (if (not (null? (cdr arg-spec))) + (parse-error errtxt (string-append (car arg-spec) + " takes zero arguments"))) + *UNSPECIFIED* +) + +; Validate and return a symbol argument. +; ARG-SPEC is (name value). + +(define (arg-list-symbol-arg errtxt arg-spec) + (arg-list-validate-name errtxt arg-spec) + (if (or (!= (length (cdr arg-spec)) 1) + (not (symbol? (cadr arg-spec)))) + (parse-error errtxt (string-append (car arg-spec) + ": argument not a symbol"))) + (cadr arg-spec) +) + +; Sanitization + +; Sanitization is handled via attributes. Anything that must be sanitized +; has a `sanitize' attribute with the value being the keyword to sanitize on. +; Ideally most, if not all, of the guts of the generated sanitization is here. + +; Utility to simplify expression in .cpu file. +; Usage: (sanitize keyword entry-type entry-name1 [entry-name2 ...]) +; Enum attribute `(sanitize keyword)' is added to the entry. +; It's written this way so Hobbit can handle it. + +(define (sanitize keyword entry-type . entry-names) + (for-each (lambda (entry-name) + (let ((entry #f)) + (case entry-type + ((attr) (set! entry (current-attr-lookup entry-name))) + ((enum) (set! entry (current-enum-lookup entry-name))) + ((isa) (set! entry (current-isa-lookup entry-name))) + ((cpu) (set! entry (current-cpu-lookup entry-name))) + ((mach) (set! entry (current-mach-lookup entry-name))) + ((model) (set! entry (current-model-lookup entry-name))) + ((ifield) (set! entry (current-ifld-lookup entry-name))) + ((hardware) (set! entry (current-hw-lookup entry-name))) + ((operand) (set! entry (current-op-lookup entry-name))) + ((insn) (set! entry (current-insn-lookup entry-name))) + ((macro-insn) (set! entry (current-minsn-lookup entry-name))) + (else (parse-error "sanitize" "unknown entry type" entry-type))) + + ; ENTRY is #f in the case where the element was discarded + ; because its mach wasn't selected. But in the case where + ; we're keeping everything, ensure ENTRY is not #f to + ; catch spelling errors. + + (if entry + + (begin + (obj-cons-attr! entry (enum-attr-make 'sanitize keyword)) + ; Propagate the sanitize attribute to class members + ; as necessary. + (case entry-type + ((hardware) + (if (hw-indices entry) + (obj-cons-attr! (hw-indices entry) + (enum-attr-make 'sanitize + keyword))) + (if (hw-values entry) + (obj-cons-attr! (hw-values entry) + (enum-attr-make 'sanitize + keyword)))) + )) + + (if (and (eq? APPLICATION 'OPCODES) (keep-all?)) + (parse-error "sanitize" + (string-append "unknown " entry-type) + entry-name))))) + entry-names) + + #f ; caller eval's our result, so return a no-op +) + +; Return TEXT sanitized with KEYWORD. +; TEXT must exist on a line (or lines) by itself. +; i.e. it is assumed that it begins at column 1 and ends with a newline. +; If KEYWORD is #f, no sanitization is generated. + +(define (gen-sanitize keyword text) + (cond ((null? text) "") + ((pair? text) ; pair? -> cheap list? + (if (and keyword include-sanitize-marker?) + (string-list + ; split string to avoid removal + "/* start-" + "sanitize-" keyword " */\n" + text + "/* end-" + "sanitize-" keyword " */\n") + text)) + (else + (if (= (string-length text) 0) + "" + (if (and keyword include-sanitize-marker?) + (string-append + ; split string to avoid removal + "/* start-" + "sanitize-" keyword " */\n" + text + "/* end-" + "sanitize-" keyword " */\n") + text)))) +) + +; Return TEXT sanitized with OBJ's sanitization, if it has any. +; OBJ may be #f. + +(define (gen-obj-sanitize obj text) + (if obj + (let ((san (obj-attr-value obj 'sanitize))) + (gen-sanitize (if (or (not san) (eq? san 'none)) #f san) + text)) + (gen-sanitize #f text)) +) + +; Cover procs to handle generation of object declarations and definitions. +; All object output should be routed through gen-decl and gen-defn. + +; Send the gen-decl message to OBJ, and sanitize the output if necessary. + +(define (gen-decl obj) + (logit 3 "Generating decl for " + (cond ((method-present? obj 'get-name) (send obj 'get-name)) + ((elm-present? obj 'name) (elm-get obj 'name)) + (else "unknown")) + " ...\n") + (cond ((and (method-present? obj 'gen-decl) (not (has-attr? obj 'META))) + (gen-obj-sanitize obj (send obj 'gen-decl))) + (else "")) +) + +; Send the gen-defn message to OBJ, and sanitize the output if necessary. + +(define (gen-defn obj) + (logit 3 "Generating defn for " + (cond ((method-present? obj 'get-name) (send obj 'get-name)) + ((elm-present? obj 'name) (elm-xget obj 'name)) + (else "unknown")) + " ...\n") + (cond ((and (method-present? obj 'gen-defn) (not (has-attr? obj 'META))) + (gen-obj-sanitize obj (send obj 'gen-defn))) + (else "")) +) + +; Attributes + +; Return C code to declare an enum of attributes ATTRS. +; PREFIX is one of "cgen_ifld", "cgen_hw", "cgen_operand", "cgen_insn". +; ATTRS is an alist of attribute values. The value is unimportant except that +; it is used to determine bool/non-bool. +; Non-bools need to be separated from bools as they're each recorded +; differently. Non-bools are recorded in an int for each. All bools are +; combined into one int to save space. +; ??? We assume there is at least one bool. + +(define (gen-attr-enum-decl prefix attrs) + (string-append + (gen-enum-decl (string-append prefix "_attr") + (string-append prefix " attrs") + (string-append prefix "_") + (attr-list-enum-list attrs)) + "/* Number of non-boolean elements in " prefix "_attr. */\n" + "#define " (string-upcase prefix) "_NBOOL_ATTRS " + "(" (string-upcase prefix) "_END_NBOOLS - " + (string-upcase prefix) "_START_NBOOLS - 1)\n" + "\n") +) + +; Return name of symbol ATTR-NAME. +; PREFIX is the prefix arg to gen-attr-enum-decl. + +(define (gen-attr-name prefix attr-name) + (string-upcase (gen-c-symbol (string-append prefix "_" attr-name))) +) + +; Normal gen-mask argument to gen-bool-attrs. +; Returns "(1<< PREFIX_NAME)" where PREFIX is from atlist-prefix and +; NAME is the name of the attribute. +; ??? This used to return PREFIX_NAME-CGEN_ATTR_BOOL_OFFSET. +; The tradeoff is simplicity vs perceived maximum number of boolean attributes +; needed. In the end the maximum number needn't be fixed, and the simplicity +; of the current way is good. + +(define (gen-attr-mask prefix name) + (string-append "(1<<" (gen-attr-name prefix name) ")") +) + +; Return C expression of bitmasks of boolean attributes in ATTRS. +; ATTRS is an <attr-list> object, it need not be pre-sorted. +; GEN-MASK is a procedure that returns the C code of the mask. + +(define (gen-bool-attrs attrs gen-mask) + (let loop ((result "0") + (alist (attr-remove-meta-attrs-alist + (attr-nub (atlist-attrs attrs))))) + (cond ((null? alist) result) + ((and (boolean? (cdar alist)) (cdar alist)) + (loop (string-append result + ; `|' is used here instead of `+' so we don't + ; have to care about duplicates. + "|" (gen-mask (atlist-prefix attrs) + (caar alist))) + (cdr alist))) + (else (loop result (cdr alist))))) +) + +; Return the C definition of OBJ's attributes. +; TYPE is one of 'ifld, 'hw, 'operand, 'insn. +; [Other objects have attributes but these are the only ones we currently +; emit definitions for.] +; OBJ is any object that supports the 'get-atlist message. +; ALL-ATTRS is an ordered alist of all attributes. +; "ordered" means all the non-boolean attributes are at the front and +; duplicate entries have been removed. +; GEN-MASK is the gen-mask arg to gen-bool-attrs. + +(define (gen-obj-attr-defn type obj all-attrs num-non-bools gen-mask) + (let* ((attrs (obj-atlist obj)) + (non-bools (attr-non-bool-attrs (atlist-attrs attrs))) + (all-non-bools (list-take num-non-bools all-attrs))) + (string-append + "{ " + (gen-bool-attrs attrs gen-mask) + ", {" + ; For the boolean case, we can (currently) get away with only specifying + ; the attributes that are used since they all fit in one int and the + ; default is currently always #f (and won't be changed without good + ; reason). In the non-boolean case order is important since each value + ; has a specific spot in an array, all of them must be specified. + (if (null? all-non-bools) + " 0" + (string-drop1 ; drop the leading "," + (string-map (lambda (attr) + (let ((val (or (assq-ref non-bools (obj:name attr)) + (attr-default attr)))) + ; FIXME: Are we missing attr-prefix here? + (string-append ", " + (send attr 'gen-value-for-defn val)))) + all-non-bools))) + " } }" + )) +) + +; Return a boolean indicating if ATLIST indicates a CTI insn. + +(define (atlist-cti? atlist) + (or (atlist-has-attr? atlist 'UNCOND-CTI) + (atlist-has-attr? atlist 'COND-CTI)) +) + +; Misc. gen-* procs + +; Return name of obj as a C symbol. + +(define (gen-sym obj) (gen-c-symbol (obj:name obj))) + +; Return the name of the selected cpu family. +; An error is signalled if more than one has been selected. + +(define (gen-cpu-name) + ; FIXME: error checking + (gen-sym (current-cpu)) +) + +; Return HAVE_CPU_<CPU>. + +(define (gen-have-cpu cpu) + (string-append "HAVE_CPU_" + (string-upcase (gen-sym cpu))) +) + +; Return the bfd mach name for MACH. + +(define (gen-mach-bfd-name mach) + (string-append "bfd_mach_" (gen-c-symbol (mach-bfd-name mach))) +) + +; Return definition of C macro to get the value of SYM. + +(define (gen-get-macro sym index-args expr) + (string-append + "#define GET_" (string-upcase sym) "(" index-args ") " expr "\n") +) + +; Return definition of C macro to set the value of SYM. + +(define (gen-set-macro sym index-args lvalue) + (string-append + "#define SET_" (string-upcase sym) + "(" index-args + (if (equal? index-args "") "" ", ") + "x) (" lvalue " = (x))\n") +) + +; Return definition of C macro to set the value of SYM, version 2. +; EXPR is one or more C statements *without* proper \newline handling, +; we prepend \ to each line. + +(define (gen-set-macro2 sym index-args newval-arg expr) + (string-append + "#define SET_" (string-upcase sym) + "(" index-args + (if (equal? index-args "") "" ", ") + newval-arg ") \\\n" + "do { \\\n" + (backslash "\n" expr) + ";} while (0)\n") +) + +; Return C code to fetch a value from instruction memory. +; PC-VAR is the C expression containing the address of the start of the +; instruction. +; ??? Aligned/unaligned support? + +(define (gen-ifetch pc-var bitoffset bitsize) + (string-append "GETIMEM" + (case bitsize + ((8) "UQI") + ((16) "UHI") + ((32) "USI") + (else (error "bad bitsize argument to gen-ifetch" bitsize))) + " (current_cpu, " + pc-var " + " (number->string (quotient bitoffset 8)) + ")") +) + +; Called before loading the .cpu file to initialize. + +(define (utils-init!) + (reader-add-command! 'sanitize + "\ +Mark an entry as being sanitized. +" + nil '(keyword entry-type . entry-names) sanitize) + + *UNSPECIFIED* +) diff --git a/cgen/utils-gen.scm b/cgen/utils-gen.scm new file mode 100644 index 00000000000..b96c0efe959 --- /dev/null +++ b/cgen/utils-gen.scm @@ -0,0 +1,506 @@ +; Application independent utilities for C/C++ code generation. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; Attributes. + +(define (attr-bool-gen-decl attr) "") + +(define (attr-bool-gen-defn attr) "") + +(define (attr-int-gen-decl attr) "") + +(define (attr-int-gen-defn attr) "") + +(define (attr-gen-decl attr) + (gen-enum-decl (symbol-append (obj:name attr) '-attr) + (obj:comment attr) + (string-append (obj:name attr) "_") + (attr-values attr)) +) + +(define (attr-gen-defn attr) + (string-append + "static const CGEN_ATTR_ENTRY " + (gen-sym attr) "_attr" + "[] =\n{\n" + (string-map (lambda (elm) + (let* ((san (and (pair? elm) (pair? (cdr elm)) + (attr-value (cddr elm) 'sanitize #f)))) + (gen-sanitize + (if (and san (not (eq? san 'none))) + san + #f) + (string-append " { " + "\"" + (gen-c-symbol (car elm)) + "\", " + (string-upcase (gen-sym attr)) + "_" + (string-upcase (gen-c-symbol (car elm))) + " },\n")))) + (attr-values attr)) + " { 0, 0 }\n" + "};\n\n") +) + +(method-make! <boolean-attribute> 'gen-decl attr-bool-gen-decl) +(method-make! <bitset-attribute> 'gen-decl attr-gen-decl) +(method-make! <integer-attribute> 'gen-decl attr-int-gen-decl) +(method-make! <enum-attribute> 'gen-decl attr-gen-decl) + +(method-make! <boolean-attribute> 'gen-defn attr-bool-gen-defn) +(method-make! <bitset-attribute> 'gen-defn attr-gen-defn) +(method-make! <integer-attribute> 'gen-defn attr-int-gen-defn) +(method-make! <enum-attribute> 'gen-defn attr-gen-defn) + +; Ifield extraction utilities. + +; Return the C data type to use to hold an extracted and decoded +; <ifield> from an insn. Usually this is just an int, but for register +; numbers or large unsigned immediates, an unsigned int may be preferable. +; Then there's floats (??? which aren't handled yet). + +(define (gen-ifld-type f) + (mode:c-type (ifld-decode-mode f)) +) + +; Return C declaration of variable(s) to hold <ifield> F. +; MACRO? is #t if the result is part of a macro. + +(define (gen-ifld-extract-decl f indent macro?) + (string-append indent (gen-ifld-type f) " " (gen-sym f) ";" + (if macro? " \\\n" "\n")) +) + +; Return C code to extract a field from the base part of an insn. +; +; TOTAL-LENGTH is the total length of the value in VAL. +; BASE-VALUE is a C expression (string) containing the base part of the insn. + +(define (-gen-ifld-extract-base f total-length base-value) + (let ((extraction + (string-append "EXTRACT_" + (if (current-arch-insn-lsb0?) "LSB0_" "MSB0_") + (case (mode:class (ifld-mode f)) + ((INT) "INT") + ((UINT) "UINT") + (else (error "unsupported mode class" + (mode:class (ifld-mode f))))) + " (" + base-value ", " + (number->string total-length) ", " + ; ??? Is passing total-length right here? + (number->string (ifld-start f total-length)) ", " + (number->string (ifld-length f)) + ")")) + (decode (ifld-decode f))) + ; If the field doesn't have a special decode expression, + ; just return the raw extracted value. Otherwise, emit + ; the expression. + (if (not decode) + extraction + ; cadr: fetches expression to be evaluated + ; caar: fetches symbol in arglist + ; cadar: fetches `pc' symbol in arglist + (rtl-c VOID (cadr decode) + (list (list (caar decode) 'UINT extraction) + (list (cadar decode) 'IAI "pc")) + #:rtl-cover-fns? #f #:ifield-var? #t))) +) + +; Subroutine of -gen-ifld-extract-beyond to extract the relevant value +; from WORD-NAME and move it into place. + +(define (-gen-extract-word word-name word-start word-length start length + unsigned? lsb0?) + ; ??? lsb0? + (let ((word-end (+ word-start word-length)) + (end (+ start length))) + (string-append "(" + "EXTRACT_" + (if (current-arch-insn-lsb0?) "LSB0" "MSB0") + (if (and (not unsigned?) + ; Only want sign extension for word with sign bit. + (bitrange-overlap? start 1 word-start word-length + lsb0?)) + "_INT (" + "_UINT (") + word-name + ", " + (number->string word-length) + ", " + (number->string (if (< start word-start) + 0 + (- start word-start))) + ", " + (number->string (if (< end word-end) + (- word-end end) + word-length)) + ") << " + (number->string (if (> end word-end) + (- end word-end) + 0)) + ")")) +) + +; Return C code to extract a field that extends beyond the base insn. +; +; Things get tricky in the non-integral-insn case (no kidding). +; This case includes every architecture with at least one insn larger +; than 32 bits, and all architectures where insns smaller than 32 bits +; can't be interpreted as an int. +; ??? And maybe other architectures not considered yet. +; We want to handle these reasonably fast as this includes architectures like +; the ARC and I960 where 99% of the insns are 32 bits, with a few insns that +; take a 32 bit immediate. It would be a real shame to unnecessarily slow down +; handling of 99% of the instruction set just for a few insns. Fortunately +; for these chips base-insn includes these insns, so things fall out naturally. +; +; BASE-LENGTH is base-insn-bitsize. +; TOTAL-LENGTH is the total length of the insn. +; VAR-LIST is a list of variables containing the insn. +; Each element in VAR-LIST is (name start length). +; The contents of the insn are in several variables: insn, word_[123...], +; where `insn' contains the "base insn" and `word_N' is a set of variables +; recording the rest of the insn, 32 bits at a time (with the last one +; containing whatever is left over). + +(define (-gen-ifld-extract-beyond f base-length total-length var-list) + ; First compute the list of variables that contains pieces of the + ; desired value. + (let ((start (+ (ifld-start f total-length) (ifld-word-offset f))) + (length (ifld-length f)) + ;(word-start (ifld-word-offset f)) + ;(word-length (ifld-word-length f)) + ; extraction code + (extraction #f) + ; extra processing to perform on extracted value + (decode (ifld-decode f)) + (lsb0? (current-arch-insn-lsb0?))) + ; Find which vars are needed and move the value into place. + (let loop ((var-list var-list) (result (list ")"))) + (if (null? var-list) + (set! extraction (apply string-append (cons "(0" result))) + (let ((var-name (caar var-list)) + (var-start (cadar var-list)) + (var-length (caddar var-list))) + (if (bitrange-overlap? start length + var-start var-length + lsb0?) + (loop (cdr var-list) + (cons "|" + (cons (-gen-extract-word var-name + var-start + var-length + start length + (eq? (mode:class (ifld-mode f)) + 'UINT) + lsb0?) + result))) + (loop (cdr var-list) result))))) + ; If the field doesn't have a special decode expression, just return the + ; raw extracted value. Otherwise, emit the expression. + (if (not decode) + extraction + ; cadr: fetches expression to be evaluated + ; caar: fetches symbol in arglist + ; cadar: fetches `pc' symbol in arglist + (rtl-c VOID (cadr decode) + (list (list (caar decode) 'UINT extraction) + (list (cadar decode) 'IAI "pc")) + #:rtl-cover-fns? #f #:ifield-var? #t))) +) + +; Return C code to extract <ifield> F. + +(define (gen-ifld-extract f indent base-length total-length base-value var-list macro?) + (string-append + indent + (gen-sym f) + " = " + (if (ifld-beyond-base? f base-length total-length) + (-gen-ifld-extract-beyond f base-length total-length var-list) + (-gen-ifld-extract-base f (min base-length total-length) base-value)) + ";" + (if macro? " \\\n" "\n") + ) +) + +; Return C code to extract a <multi-ifield> from an insn. +; This must have the same signature as gen-ifld-extract as both can be +; made methods in application code. + +(define (gen-multi-ifld-extract f indent base-length total-length base-value var-list macro?) + ; The subfields must have already been extracted. + (let* ((extract (rtl-c VOID (multi-ifld-extract f) nil + #:rtl-cover-fns? #f #:ifield-var? #t)) + (decode-proc (ifld-decode f)) + (decode (if decode-proc + (rtl-c VOID (cadr decode-proc) + (list (list (caar decode-proc) 'UINT extract) + (list (cadar decode-proc) 'IAI "pc")) + #:rtl-cover-fns? #f #:ifield-var? #t) + extract))) + (if macro? + (backslash "\n" decode) + decode)) +) + +; Return C symbol of variable containing the extracted field value +; in the extraction code. E.g. f_rd = EXTRACT_UINT (insn, ...). + +(define (gen-extracted-ifld-value f) + (gen-sym f) +) + +; Subroutine of gen-extract-ifields to compute arguments for -extract-chunk +; to extract values beyond the base insn. +; This is also used by gen-define-ifields to know how many vars are needed. +; +; The result is a list of (offset . length) pairs. +; +; ??? Here's a case where explicitly defined instruction formats can +; help - without them we can only use heuristics (which must evolve). +; At least all the details are tucked away here. + +(define (-extract-chunk-specs base-length total-length alignment) + (let ((chunk-length + (case alignment + ; For the aligned and forced case split the insn up into base-insn + ; sized chunks. For the unaligned case, use a chunk-length of 32. + ; 32 was chosen because the values are extracted into portable ints. + ((aligned forced) (min base-length 32)) + ((unaligned) 32) + (else (error "unknown alignment" alignment))))) + (let loop ((start base-length) + (remaining (- total-length base-length)) + (result nil)) + (if (<= remaining 0) + (reverse! result) + (loop (+ start chunk-length) + (- remaining chunk-length) + (cons (cons start (min chunk-length remaining)) + result))))) +) + +; Subroutine of gen-define-ifmt-ifields and gen-extract-ifmt-ifields to +; insert the subfields of any multi-ifields present into IFLDS. +; Subfields are inserted before their corresponding multi-ifield as they +; are initialized in order. + +(define (-extract-insert-subfields iflds) + (let loop ((result nil) (iflds iflds)) + (cond ((null? iflds) + (reverse! result)) + ((multi-ifield? (car iflds)) + (loop (cons (car iflds) + ; There's no real need to reverse the subfields here + ; other than to keep them in order. + (append (reverse (multi-ifld-subfields (car iflds))) + result)) + (cdr iflds))) + (else + (loop (cons (car iflds) result) (cdr iflds))))) +) + +; Return C code to define local vars to contain IFIELDS. +; All insns using the result have the same TOTAL-LENGTH (in bits). +; INDENT is a string prepended to each line. +; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended +; to each line). + +(define (gen-define-ifields ifields total-length indent macro?) + (let* ((base-length (state-base-insn-bitsize)) + (chunk-specs (-extract-chunk-specs base-length total-length + (current-arch-default-alignment)))) + (string-list + (string-list-map (lambda (f) + (gen-ifld-extract-decl f indent macro?)) + ifields) + ; Define enough ints to hold the trailing part of the insn, + ; N bits at a time. + ; ??? This could be more intelligent of course. Later. + ; ??? Making these global to us would allow filling them during + ; decoding. + (if (> total-length base-length) + (string-list + indent + "/* Contents of trailing part of insn. */" + (if macro? " \\\n" "\n") + (string-list-map (lambda (chunk-num) + (string-list indent + "UINT word_" + (number->string chunk-num) + (if macro? "; \\\n" ";\n"))) + (iota 1 (length chunk-specs)))) + ""))) +) + +; Return C code to define local vars to contain IFIELDS of <iformat> IFMT. +; INDENT is a string prepended to each line. +; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended +; to each line). +; USE-MACRO? is #t if instead of generating the fields, we return the macro +; that does that. + +(define (gen-define-ifmt-ifields ifmt indent macro? use-macro?) + (let ((macro-name (string-append + "EXTRACT_" (string-upcase (gen-sym ifmt)) + "_VARS")) + (ifields (-extract-insert-subfields (ifmt-ifields ifmt)))) + (if use-macro? + (string-list indent macro-name + " /*" + (string-list-map (lambda (fld) + (string-append " " (obj:name fld))) + ifields) + " */\n") + (let ((indent (if macro? (string-append indent " ") indent))) + (string-list + (if macro? + (string-list "#define " macro-name " \\\n") + (string-list indent "/* Instruction fields. */\n")) + (gen-define-ifields ifields (ifmt-length ifmt) indent macro?) + indent "unsigned int length;" + ; The last line doesn't have a trailing '\\'. + "\n" + )))) +) + +; Subroutine of gen-extract-ifields to fetch one value into VAR-NAME. + +(define (-extract-chunk offset bits var-name macro?) + (string-append + " " + var-name + " = " + (gen-ifetch "pc" offset bits) + ";" + (if macro? " \\\n" "\n")) +) + +; Subroutine of gen-extract-ifields to compute the var-list arg to +; gen-ifld-extract-beyond. +; The result is a list of `(name start length)' elements describing the +; variables holding the parts of the insn. +; CHUNK-SPECS is a list of (offset . length) pairs. + +(define (-gen-extract-beyond-var-list base-length var-prefix chunk-specs lsb0?) + ; ??? lsb0? support ok? + (cons (list "insn" 0 base-length) + (map (lambda (chunk-num chunk-spec) + (list (string-append var-prefix (number->string chunk-num)) + (car chunk-spec) + (cdr chunk-spec))) + (iota 1 (length chunk-specs)) + chunk-specs)) +) + +; Return C code to extract IFIELDS. +; All insns using the result have the same TOTAL-LENGTH (in bits). +; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended +; to each line). +; +; Here is where we handle integral-insn vs non-integeral-insn architectures. +; +; Examples of architectures that can be handled as integral-insns are: +; sparc, m32r, mips, etc. +; +; Examples of architectures that can't be handled as integral insns are: +; arc, i960, fr30, i386, m68k. +; [i386,m68k are only mentioned for completeness. cgen ports of these +; would be great, but more thought is needed first] +; +; C variable `insn' is assumed to contain the base part of the insn +; (max base-insn-bitsize insn-bitsize). In the m32r case insn-bitsize +; can be less than base-insn-bitsize. +; +; ??? Need to see how well gcc optimizes this. +; +; ??? Another way to do this is to put this code in an inline function that +; gets passed pointers to each ifield variable. GCC is smart enough to +; produce optimal code for this, but other compilers may not have inlining +; or the indirection removal. I think the slowdown for a non-scache simulator +; would be phenomenal and while one can say "too bad, use gcc", I'm defering +; doing this for now. + +(define (gen-extract-ifields ifields total-length indent macro?) + (let* ((base-length (state-base-insn-bitsize)) + (chunk-specs (-extract-chunk-specs base-length total-length + (current-arch-default-alignment)))) + (string-list + ; If the insn has a trailing part, fetch it. + ; ??? Could have more intelligence here. Later. + (if (> total-length base-length) + (let () + (string-list-map (lambda (chunk-spec chunk-num) + (-extract-chunk (car chunk-spec) + (cdr chunk-spec) + (string-append + "word_" + (number->string chunk-num)) + macro?)) + chunk-specs + (iota 1 (length chunk-specs)))) + "") + (string-list-map + (lambda (f) + ; Dispatching on a method works better, as would a generic fn. + ; ??? Written this way to pass through Hobbit, doesn't handle + ; ((if foo a b) (arg1 arg2)). + (if (multi-ifield? f) + (gen-multi-ifld-extract + f indent base-length total-length "insn" + (-gen-extract-beyond-var-list base-length "word_" + chunk-specs + (current-arch-insn-lsb0?)) + macro?) + (gen-ifld-extract + f indent base-length total-length "insn" + (-gen-extract-beyond-var-list base-length "word_" + chunk-specs + (current-arch-insn-lsb0?)) + macro?))) + ifields) + )) +) + +; Return C code to extract the fields of <iformat> IFMT. +; MACRO? is #t if the code is part of a macro (and thus '\\' must be appended +; to each line). +; USE-MACRO? is #t if instead of generating the fields, we return the macro +; that does that. + +(define (gen-extract-ifmt-ifields ifmt indent macro? use-macro?) + (let ((macro-name (string-append + "EXTRACT_" (string-upcase (gen-sym ifmt)) + "_CODE")) + (ifields (-extract-insert-subfields (ifmt-ifields ifmt)))) + (if use-macro? + (string-list indent macro-name "\n") + (let ((indent (if macro? (string-append indent " ") indent))) + (string-list + (if macro? + (string-list "#define " macro-name " \\\n") + "") + indent "length = " + (number->string (bits->bytes (ifmt-length ifmt))) + ";" + (if macro? " \\\n" "\n") + (gen-extract-ifields ifields (ifmt-length ifmt) indent macro?) + ; The last line doesn't have a trailing '\\'. + "\n" + )))) +) + +; Instruction format utilities. + +(define (gen-sfmt-enum-decl sfmt-list) + (gen-enum-decl "@cpu@_sfmt_type" + "semantic formats in cpu family @cpu@" + "@CPU@_" + (map (lambda (sfmt) (cons (obj:name sfmt) nil)) + sfmt-list)) +) diff --git a/cgen/utils-sim.scm b/cgen/utils-sim.scm new file mode 100644 index 00000000000..e0951adb07a --- /dev/null +++ b/cgen/utils-sim.scm @@ -0,0 +1,955 @@ +; Generic simulator application utilities. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; The cache-addr? method. +; Return #t if the hardware element's address is stored in the scache buffer. +; This saves doing the index calculation during semantic processing. + +(method-make! + <hardware-base> 'cache-addr? + (lambda (self) + (and (with-scache?) + (has-attr? self 'CACHE-ADDR))) +) + +(define (hw-cache-addr? hw) (send hw 'cache-addr?)) + +; The needed-iflds method. +; Return list of ifields needed during semantic execution by hardware element +; SELF referenced by <operand> OP in <sformat> SFMT. + +(method-make! + <hardware-base> 'needed-iflds + (lambda (self op sfmt) + (list (op-ifield op))) +) + +(method-make! + <hw-register> 'needed-iflds + (lambda (self op sfmt) + (list (op-ifield op))) +; Instead of the following, we now arrange to store the ifield in the +; argbuf, even for CACHE-ADDR operands. This way, the ifield values +; (register numbers, etc.) remain available during semantics tracing. +; (if (hw-cache-addr? self) +; nil +; (list (op-ifield op)))) +) + +; For addresses this is none because we make our own copy of the ifield +; [because we want to use a special type]. + +(method-make! + <hw-address> 'needed-iflds + (lambda (self op sfmt) + nil) +) + +(define (hw-needed-iflds hw op sfmt) (send hw 'needed-iflds op sfmt)) + +; Return a list of ifields of <operand> OP that must be recorded in ARGBUF +; for <sformat> SFMT. +; ??? At the moment there can only be at most one, but callers must not +; assume this. + +(define (op-needed-iflds op sfmt) + (let ((indx (op:index op))) + (if (and (eq? (hw-index:type indx) 'ifield) + (not (= (ifld-length (hw-index:value indx)) 0))) + (hw-needed-iflds (op:type op) op sfmt) + nil)) +) + +; Operand extraction (ARGBUF) support code. +; +; Any operand that uses a non-empty ifield needs extraction support. +; Normally we just record the ifield's value. However, in cases where +; hardware elements have CACHE-ADDR specified or where the mode of the +; hardware index isn't compatible with the mode of the decoded ifield +; (this can happen for pc-relative instruction address), we need to record +; something else. + +; Return a boolean indicating if <operand> OP needs any extraction processing. + +(define (op-extract? op) + (let* ((indx (op:index op)) + (extract? + (if (derived-operand? op) + (any-true? (map op-extract? (derived-args op))) + (and (eq? (hw-index:type indx) 'ifield) + (not (= (ifld-length (hw-index:value indx)) 0)))))) + (logit 4 "op-extract? op=" (obj:name op) " =>" extract? "\n") + extract?) +) + +; Return a list of operands that need special extraction processing. +; SFMT is an <sformat> object. + +(define (sfmt-extracted-operands sfmt) + (let ((in-ops (sfmt-in-ops sfmt)) + (out-ops (sfmt-out-ops sfmt))) + (let ((ops (append (find op-extract? in-ops) + (find op-extract? out-ops)))) + (nub ops obj:name))) +) + +; Return a list of ifields that are needed by the semantic code. +; SFMT is an <sformat> object. +; ??? This redoes a lot of the calculation that sfmt-extracted-operands does. + +(define (sfmt-needed-iflds sfmt) + (let ((in-ops (sfmt-in-ops sfmt)) + (out-ops (sfmt-out-ops sfmt))) + (let ((ops (append (find op-extract? in-ops) + (find op-extract? out-ops)))) + (nub (apply append (map (lambda (op) + (op-needed-iflds op sfmt)) + ops)) + obj:name))) +) + +; Sformat argument buffer. +; +; This contains the details needed to create an argument buffer `fields' union +; entry for the containing sformats. + +(define <sformat-argbuf> + (class-make '<sformat-argbuf> + '(<ident>) + ; From <ident>: + ; - NAME is derived from one of the containing sformats. + '( + ; List of structure elements. + ; Each element is ("var name" "C type" bitsize). + ; The list is sorted by decreasing size, then C type, + ; then var name. + elms + ) + nil) +) + +(define-getters <sformat-argbuf> sbuf (sfmts elms)) + +; Subroutine of -sfmt-contents to return an ifield element. +; The result is ("var-name" "C-type" bitsize). + +(define (-sfmt-ifld-elm f sfmt) + (let ((real-mode (mode-real-mode (ifld-decode-mode f)))) + (list (gen-sym f) + (mode:c-type real-mode) + (mode:bits real-mode))) +) + +; sbuf-elm method. +; The result is ("var-name" "C-type" approx-bitsize) or #f if unneeded. +; For the default case we use the ifield as is, which is computed elsewhere. + +(method-make! + <hardware-base> 'sbuf-elm + (lambda (self op ifmt) + #f) +) + +(method-make! + <hw-register> 'sbuf-elm + (lambda (self op ifmt) + (if (hw-cache-addr? self) + (list (gen-sym (op:index op)) + (string-append (gen-type self) "*") + ; Use 64 bits for size. Doesn't really matter, just put them + ; near the front. + 64) + #f)) +) + +; We want to use ADDR/IADDR in ARGBUF for addresses + +(method-make! + <hw-address> 'sbuf-elm + (lambda (self op ifmt) + (list (gen-sym (op:index op)) + "ADDR" + ; Use 64 bits for size. Doesn't really matter, just put them + ; near the front. + 64)) +) + +(method-make! + <hw-iaddress> 'sbuf-elm + (lambda (self op ifmt) + (list (gen-sym (op:index op)) + "IADDR" + ; Use 64 bits for size. Doesn't really matter, just put them + ; near the front. + 64)) +) + +; Subroutine of -sfmt-contents to return an operand element. +; These are in addition (or instead of) the actual ifields. +; This is also used to compute definitions of local vars needed in the +; !with-scache case. +; The result is ("var-name" "C-type" approx-bitsize) or #f if unneeded. + +(define (sfmt-op-sbuf-elm op sfmt) + (send (op:type op) 'sbuf-elm op sfmt) +) + +; Subroutine of compute-sformat-bufs! to compute list of structure elements +; needed by <sformat> SFMT. +; The result is +; (SFMT ("var-name1" "C-type1" size1) ("var-name2" "C-type2" size2) ...) +; and is sorted by decreasing size, then C type, then variable name +; (as <sformat-argbuf> wants it). + +(define (-sfmt-contents sfmt) + (let ((needed-iflds (sfmt-needed-iflds sfmt)) + (extracted-ops (sfmt-extracted-operands sfmt)) + (in-ops (sfmt-in-ops sfmt)) + (out-ops (sfmt-out-ops sfmt)) + (sort-elms (lambda (a b) + ; Sort by descending size, then ascending C type, then + ; ascending name. + (cond ((> (caddr a) (caddr b)) + #t) + ((= (caddr a) (caddr b)) + (cond ((string<? (cadr a) (cadr b)) + #t) + ((string=? (cadr a) (cadr b)) + (string<? (car a) (car b))) + (else + #f))) + (else + #f)))) + ) + (cons sfmt + (sort + ; Compute list of all things we need to record at extraction time. + (find (lambda (x) + ; Discard #f entries, they indicate "unneeded". + x) + (append + (map (lambda (f) + (-sfmt-ifld-elm f sfmt)) + needed-iflds) + (map (lambda (op) + (sfmt-op-sbuf-elm op sfmt)) + extracted-ops) + (cond ((with-any-profile?) + (append + ; Profiling support. ??? This stuff is in flux. + (map (lambda (op) + (sfmt-op-profile-elm op sfmt #f)) + (find op-profilable? in-ops)) + (map (lambda (op) + (sfmt-op-profile-elm op sfmt #t)) + (find op-profilable? out-ops)))) + (else + (append))))) + sort-elms))) +) + +; Return #t if ELM-LIST is a subset of SBUF. +; SBUF is an <sformat-argbuf> object. + +(define (-sbuf-subset? elm-list sbuf) + ; We take advantage of the fact that elements in each are already sorted. + ; FIXME: Can speed up. + (let loop ((elm-list elm-list) (sbuf-elm-list (sbuf-elms sbuf))) + (cond ((null? elm-list) + #t) + ((null? sbuf-elm-list) + #f) + ((equal? (car elm-list) (car sbuf-elm-list)) + (loop (cdr elm-list) (cdr sbuf-elm-list))) + (else + (loop elm-list (cdr sbuf-elm-list))))) +) + +; Subroutine of compute-sformat-bufs!. +; Lookup ELM-LIST in SBUF-LIST. A match is found if ELM-LIST +; is a subset of one in SBUF-LIST. +; Return the containing <sformat-argbuf> object if found, otherwise return #f. +; SBUF-LIST is a list of <sformat-argbuf> objects. +; ELM-LIST is (elm1 elm2 ...). + +(define (-sbuf-lookup elm-list sbuf-list) + (let loop ((sbuf-list sbuf-list)) + (cond ((null? sbuf-list) + #f) + ((-sbuf-subset? elm-list (car sbuf-list)) + (car sbuf-list)) + (else + (loop (cdr sbuf-list))))) +) + +; Compute and record the set of <sformat-argbuf> objects needed for SFMT-LIST, +; a list of all sformats. +; The result is the computed list of <sformat-argbuf> objects. +; +; This is used to further reduce the number of entries in the argument buffer's +; `fields' union. Some sformats have structs with the same contents or one is +; a subset of another's, thus there is no need to distinguish them as far as +; the struct is concerned (there may be other reasons to distinguish them of +; course). +; The consequence of this is fewer semantic fragments created in with-sem-frags +; pbb engines. + +(define (compute-sformat-argbufs! sfmt-list) + (logit 1 "Computing sformat argument buffers ...\n") + + (let ((sfmt-contents + ; Sort by descending length. This helps building the result: while + ; iterating over each element, its sbuf is either a subset of a + ; previous entry or requires a new entry. + (sort (map -sfmt-contents sfmt-list) + (lambda (a b) + (> (length a) (length b))))) + ; Build an <sformat-argbuf> object. + (build-sbuf (lambda (sfmt-data) + (make <sformat-argbuf> + (obj:name (car sfmt-data)) + "" + atlist-empty + (cdr sfmt-data)))) + ) + ; Start off with the first sfmt. + ; Also build an empty sbuf. Which sbuf to use for an empty argument list + ; is rather arbitrary. Rather than pick one, keep the empty sbuf unto + ; itself. + (let ((nub-sbufs (list (build-sbuf (car sfmt-contents)))) + (empty-sbuf (make <sformat-argbuf> + 'fmt-empty "no operands" atlist-empty + nil)) + ) + (sfmt-set-sbuf! (caar sfmt-contents) (car nub-sbufs)) + + ; Now loop over the remaining sfmts. + (let loop ((sfmt-contents (cdr sfmt-contents))) + (if (not (null? sfmt-contents)) + (let ((sfmt-data (car sfmt-contents))) + (if (null? (cdr sfmt-data)) + (sfmt-set-sbuf! (car sfmt-data) empty-sbuf) + (let ((sbuf (-sbuf-lookup (cdr sfmt-data) nub-sbufs))) + (if (not sbuf) + (begin + (set! sbuf (build-sbuf sfmt-data)) + (set! nub-sbufs (cons sbuf nub-sbufs)))) + (sfmt-set-sbuf! (car sfmt-data) sbuf))) + (loop (cdr sfmt-contents))))) + + ; Done. + ; Note that the result will be sorted by ascending number of elements + ; (because the search list was sorted by descending length and the result + ; is built up in reverse order of that). + ; Not that it matters, but that's kinda nice. + (cons empty-sbuf nub-sbufs))) +) + +; Profiling support. + +; By default hardware elements are not profilable. + +(method-make! <hardware-base> 'profilable? (lambda (self) #f)) + +(method-make! + <hw-register> 'profilable? + (lambda (self) (has-attr? self 'PROFILE)) +) + +; Return boolean indicating if HW is profilable. + +(define (hw-profilable? hw) (send hw 'profilable?)) + +; Return a boolean indicating if OP is profilable. + +(define (op-profilable? op) + (hw-profilable? (op:type op)) +) + +; sbuf-profile-data method. +; Return a list of C type and size to use in an sformat's argument buffer. + +(method-make! + <hardware-base> 'sbuf-profile-data + (lambda (self) + (error "sbuf-profile-elm not supported for this hw type")) +) + +(method-make! + <hw-register> 'sbuf-profile-data + (lambda (self) + ; Don't unnecessarily bloat size of argument buffer. + (if (<= (hw-num-elms self) 255) + (list "unsigned char" 8) + (list "unsigned short" 16))) +) + +; sbuf-profile-elm method. +; Return the ARGBUF member needed for profiling SELF in <sformat> SFMT. +; The result is (var-name "C-type" approx-bitsize) or #f if unneeded. + +(method-make! + <operand> 'sbuf-profile-elm + (lambda (self sfmt out?) + (if (hw-scalar? (op:type self)) + #f + (cons (string-append (if out? "out_" "in_") + (gen-sym self)) + (send (op:type self) 'sbuf-profile-data)))) +) + +; Subroutine of -sfmt-contents to return an operand's profile element. +; The result is (var-name "C-type" approx-bitsize) or #f if unneeded. + +(define (sfmt-op-profile-elm op sfmt out?) + (send op 'sbuf-profile-elm sfmt out?) +) + +; ARGBUF accessor support. + +; Define and undefine C macros to tuck away details of instruction format used +; in the extraction and semantic code. Instruction format names can +; change frequently and this can result in unnecessarily large diffs from one +; generated version of the file to the next. Secondly, tucking away details of +; the extracted argument structure from the extraction code is a good thing. + +; Name of macro to access fields in ARGBUF. +(define c-argbuf-macro "FLD") + +(define (gen-define-argbuf-macro sfmt) + (string-append "#define " c-argbuf-macro "(f) " + "abuf->fields." + (gen-sym (sfmt-sbuf sfmt)) + ".f\n") +) + +(define (gen-undef-argbuf-macro sfmt) + (string-append "#undef " c-argbuf-macro "\n") +) + +; For old code. Delete in time. +(define gen-define-field-macro gen-define-argbuf-macro) +(define gen-undef-field-macro gen-undef-argbuf-macro) + +; Return a C reference to an ARGBUF field value. + +(define (gen-argbuf-ref name) + (string-append c-argbuf-macro " (" name ")") +) + +; Return name of ARGBUF member for extracted <field> F. + +(define (gen-ifld-argbuf-name f) + (gen-sym f) +) + +; Return the C reference to a cached ifield. + +(define (gen-ifld-argbuf-ref f) + (gen-argbuf-ref (gen-ifld-argbuf-name f)) +) + +; Return name of ARGBUF member holding processed from of extracted +; ifield value for <hw-index> index. + +(define (gen-hw-index-argbuf-name index) + (gen-sym index) +) + +; Return C reference to a processed <hw-index> in ARGBUF. + +(define (gen-hw-index-argbuf-ref index) + (gen-argbuf-ref (gen-hw-index-argbuf-name index)) +) + +; Decode support. + +; Main procedure call tree: +; cgen-decode.{c,cxx} +; -gen-decode-fn +; gen-decoder [our entry point] +; decode-build-table +; -gen-decoder-switch +; -gen-decoder-switch +; +; decode-build-table is called to construct a tree of "table-guts" elements +; (??? Need better name obviously), +; and then gen-decoder is recursively called on each of these elements. + +; Return C/C++ code that fetches the desired decode bits from C value VAL. +; SIZE is the size in bits of val (the MSB is 1 << (size - 1)) which we +; treat as bitnum 0. +; BITNUMS must be monotonically increasing. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; FIXME: START may not be handled right in words beyond first. +; +; e.g. (-gen-decode-bits '(0 1 2 3 8 9 10 11) 0 16 "insn" #f) +; --> "(((insn >> 8) & 0xf0) | ((insn >> 4) & 0xf))" +; FIXME: The generated code has some inefficiencies in edge cases. Later. + +(define (-gen-decode-bits bitnums start size val lsb0?) + + ; Compute a list of lists of three numbers: + ; (first bitnum in group, position in result (0=LSB), bits in result) + + (let ((groups + ; POS = starting bit position of current group. + ; COUNT = number of bits in group. + ; Work from least to most significant bit so reverse bitnums. + (let loop ((result nil) (pos 0) (count 0) (bitnums (reverse bitnums))) + ;(display (list result pos count bitnums)) (newline) + (if (null? bitnums) + result + (if (or (= (length bitnums) 1) + ; Are numbers not next to each other? + (not (= (- (car bitnums) (if lsb0? -1 1)) + (cadr bitnums)))) + (loop (cons (list (car bitnums) pos (+ 1 count)) + result) + (+ pos count 1) 0 + (cdr bitnums)) + (loop result + pos (+ 1 count) + (cdr bitnums))))))) + (string-append + "(" + (string-drop 3 + (string-map + (lambda (group) + (let* ((first (car group)) + (pos (cadr group)) + (bits (caddr group)) + ; Difference between where value is and where + ; it needs to be. + ; FIXME: Need to handle left (-ve) shift. + (shift (- (if lsb0? + (- first bits -1) + (- (+ start size) (+ first bits))) + pos))) + (string-append + " | ((" val " >> " (number->string shift) + ") & (" + (number->string (- (integer-expt 2 bits) 1)) + " << " (number->string pos) "))"))) + groups)) + ")")) +) + +; Convert decoder table into C code. + +; Return code for one insn entry. +; REST is the remaining entries. + +(define (-gen-decode-insn-entry entry rest indent) + (assert (eq? 'insn (dtable-entry-type entry))) + (logit 3 "Generating decode insn entry for " (obj:name (dtable-entry-value entry)) " ...\n") + + (let ((insn (dtable-entry-value entry))) + + (cond + + ; Leave invalids to the default case. + ((eq? (obj:name insn) 'x-invalid) + "") + + ; If same contents as next case, fall through. + ; FIXME: Can reduce more by sorting cases. Much later. + ((and (not (null? rest)) + ; Ensure both insns. + (eq? 'insn (dtable-entry-type (car rest))) + ; Ensure same insn. + (eq? (obj:name insn) + (obj:name (dtable-entry-value (car rest))))) + (string-append indent " case " + (number->string (dtable-entry-index entry)) + " : /* fall through */\n")) + + (else + (string-append indent " case " + (number->string (dtable-entry-index entry)) + " : itype = " + (gen-cpu-insn-enum (current-cpu) insn) + "; " + (if (with-scache?) + (string-append "goto " + "extract_" + (gen-sym (insn-sfmt insn)) + ";\n") + "goto done;\n"))))) +) + +; Subroutine of -decode-expr-ifield-tracking. +; Return a list of all possible values for ifield IFLD-NAME. +; FIXME: Quick-n-dirty implementation. Should use bit arrays. + +(define (-decode-expr-ifield-values ifld-name) + (let* ((ifld (current-ifld-lookup ifld-name)) + (bits (ifld-length ifld))) + (if (mode-unsigned? (ifld-mode ifld)) + (iota (logsll 1 bits)) + (iota (- (logsll 1 (- bits 1))) (logsll 1 bits)))) +) + +; Subroutine of -decode-expr-ifield-tracking,-decode-expr-ifield-mark-used. +; Create the search key for tracking table lookup. + +(define (-decode-expr-ifield-tracking-key insn ifld-name) + (symbol-append (obj:name (insn-ifmt insn)) '-x- ifld-name) +) + +; Subroutine of -gen-decode-expr-entry. +; Return a table to track used ifield values. +; The table is an associative list of (key . value-list). +; KEY is "iformat-name-x-ifield-name". +; VALUE-LIST is a list of the unused values. + +(define (-decode-expr-ifield-tracking expr-list) + (let ((table1 + (apply append + (map (lambda (entry) + (map (lambda (ifld-name) + (cons (exprtable-entry-insn entry) + (cons ifld-name + (-decode-expr-ifield-values ifld-name)))) + (exprtable-entry-iflds entry))) + expr-list)))) + ; TABLE1 is a list of (insn ifld-name value1 value2 ...). + (nub (map (lambda (elm) + (cons + (-decode-expr-ifield-tracking-key (car elm) (cadr elm)) + (cddr elm))) + table1) + car)) +) + +; Subroutine of -decode-expr-ifield-mark-used!. +; Return list of values completely used for ifield IFLD-NAME in EXPR. +; "completely used" here means the value won't appear elsewhere. +; e.g. in (andif (eq f-rd 15) (eq f-rx 14)) we don't know what happens +; for the (ne f-rx 14) case. + +(define (-decode-expr-ifield-values-used ifld-name expr) + (case (rtx-name expr) + ((eq) + (if (and (rtx-kind? 'ifield (rtx-cmp-op-arg expr 0)) + (rtx-constant? (rtx-cmp-op-arg expr 1))) + (list (rtx-constant-value (rtx-cmp-op-arg expr 1))) + nil)) + ((member) + (if (rtx-kind? 'ifield (rtx-member-value expr)) + (rtx-member-set expr) + nil)) + ; FIXME: more needed + (else nil)) +) + +; Subroutine of -gen-decode-expr-entry. +; Mark ifield values used by EXPR-ENTRY in TRACKING-TABLE. + +(define (-decode-expr-ifield-mark-used! tracking-table expr-entry) + (let ((insn (exprtable-entry-insn expr-entry)) + (expr (exprtable-entry-expr expr-entry)) + (ifld-names (exprtable-entry-iflds expr-entry))) + (for-each (lambda (ifld-name) + (let ((table-entry + (assq (-decode-expr-ifield-tracking-key insn ifld-name) + tracking-table)) + (used (-decode-expr-ifield-values-used ifld-name expr))) + (for-each (lambda (value) + (delq! value table-entry)) + used) + )) + ifld-names)) + *UNSPECIFIED* +) + +; Subroutine of -gen-decode-expr-entry. +; Return code to set `itype' and branch to the extraction phase. + +(define (-gen-decode-expr-set-itype indent insn-enum fmt-name) + (string-append + indent + "{ itype = " + insn-enum + "; " + (if (with-scache?) + (string-append "goto " + "extract_" + fmt-name + ";") + "goto done;") + " }\n" + ) +) + +; Generate code to decode the expression table in ENTRY. +; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones. + +(define (-gen-decode-expr-entry entry indent invalid-insn) + (assert (eq? 'expr (dtable-entry-type entry))) + (logit 3 "Generating decode expr entry for " (exprtable-name (dtable-entry-value entry)) " ...\n") + + (let ((expr-list (exprtable-insns (dtable-entry-value entry)))) + (string-list + indent " case " + (number->string (dtable-entry-index entry)) + " :\n" + + (let ((iflds-tracking (-decode-expr-ifield-tracking expr-list)) + (indent (string-append indent " "))) + + (let loop ((expr-list expr-list) (code nil)) + + (if (null? expr-list) + + ; All done. If we used up all field values we don't need to + ; "fall through" and select the invalid insn marker. + + (if (all-true? (map null? (map cdr iflds-tracking))) + code + (append! code + (list + (-gen-decode-expr-set-itype + indent + (gen-cpu-insn-enum (current-cpu) invalid-insn) + "sfmt_empty")))) + + ; Not all done, process next expr. + + (let ((insn (exprtable-entry-insn (car expr-list))) + (expr (exprtable-entry-expr (car expr-list))) + (ifld-names (exprtable-entry-iflds (car expr-list)))) + + ; Mark of those ifield values we use first. + ; If there are none left afterwards, we can unconditionally + ; choose this insn. + (-decode-expr-ifield-mark-used! iflds-tracking (car expr-list)) + + (let ((next-code + ; If this is the last expression, and it uses up all + ; remaining ifield values, there's no need to perform any + ; test. + (if (and (null? (cdr expr-list)) + (all-true? (map null? (map cdr iflds-tracking)))) + + ; Need this in a list for a later append!. + (string-list + (-gen-decode-expr-set-itype + indent + (gen-cpu-insn-enum (current-cpu) insn) + (gen-sym (insn-sfmt insn)))) + + ; We don't use up all ifield values, so emit a test. + (let ((iflds (map current-ifld-lookup ifld-names))) + (string-list + indent "{\n" + (gen-define-ifields iflds + (insn-length insn) + (string-append indent " ") + #f) + (gen-extract-ifields iflds + (insn-length insn) + (string-append indent " ") + #f) + indent " if (" + (rtl-c 'BI expr nil #:ifield-var? #t) + ")\n" + (-gen-decode-expr-set-itype + (string-append indent " ") + (gen-cpu-insn-enum (current-cpu) insn) + (gen-sym (insn-sfmt insn))) + indent "}\n"))))) + + (loop (cdr expr-list) + (append! code next-code))))))) + )) +) + +; Generate code to decode TABLE. +; REST is the remaining entries. +; SWITCH-NUM, STARTBIT, DECODE-BITSIZE, INDENT, LSB0?, INVALID-INSN are same +; as for -gen-decoder-switch. + +(define (-gen-decode-table-entry table rest switch-num startbit decode-bitsize indent lsb0? invalid-insn) + (assert (eq? 'table (dtable-entry-type table))) + (logit 3 "Generating decode table entry for case " (dtable-entry-index table) " ...\n") + + (string-list + indent " case " + (number->string (dtable-entry-index table)) + " :" + ; If table is same as next, just emit a "fall through" to cut down on + ; generated code. + (if (and (not (null? rest)) + ; Ensure both tables. + (eq? 'table (dtable-entry-type (car rest))) + ; Ensure same table. + (eqv? (subdtable-key (dtable-entry-value table)) + (subdtable-key (dtable-entry-value (car rest))))) + " /* fall through */\n" + (string-list + "\n" + (-gen-decoder-switch switch-num + startbit + decode-bitsize + (subdtable-table (dtable-entry-value table)) + (string-append indent " ") + lsb0? + invalid-insn)))) +) + +; Subroutine of -decode-sort-entries. +; Return a boolean indicating if A,B are equivalent entries. + +(define (-decode-equiv-entries? a b) + (let ((a-type (dtable-entry-type a)) + (b-type (dtable-entry-type b))) + (if (eq? a-type b-type) + (case a-type + ((insn) + (let ((a-name (obj:name (dtable-entry-value a))) + (b-name (obj:name (dtable-entry-value b)))) + (eq? a-name b-name))) + ((expr) + ; Ignore expr entries for now. + #f) + ((table) + (let ((a-name (subdtable-key (dtable-entry-value a))) + (b-name (subdtable-key (dtable-entry-value b)))) + (eq? a-name b-name)))) + ; A and B are not the same type. + #f)) +) + +; Subroutine of -gen-decoder-switch, sort ENTRIES according to desired +; print order (maximizes amount of fall-throughs, but maintains numerical +; order as much as possible). +; ??? This is an O(n^2) algorithm. An O(n Log(n)) algorithm can be done +; but it seemed more complicated than necessary for now. + +(define (-decode-sort-entries entries) + (let ((find-equiv! + ; Return list of entries in non-empty list L that have the same decode + ; entry as the first entry. Entries found are marked with #f so + ; they're not processed again. + (lambda (l) + ; Start off the result with the first entry, then see if the + ; remaining ones match it. + (let ((first (car l))) + (let loop ((l (cdr l)) (result (cons first nil))) + (if (null? l) + (reverse! result) + (if (and (car l) (-decode-equiv-entries? first (car l))) + (let ((lval (car l))) + (set-car! l #f) + (loop (cdr l) (cons lval result))) + (loop (cdr l) result))))))) + ) + (let loop ((entries (list-copy entries)) (result nil)) + (if (null? entries) + (apply append (reverse! result)) + (if (car entries) + (loop (cdr entries) + (cons (find-equiv! entries) + result)) + (loop (cdr entries) result))))) +) + +; Generate switch statement to decode TABLE-GUTS. +; SWITCH-NUM is for compatibility with the computed goto decoder and +; isn't used. +; STARTBIT is the bit offset of the instruction value that C variable `insn' +; holds (note that this is independent of LSB0?). +; DECODE-BITSIZE is the number of bits of the insn that `insn' holds. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones. + +(define (-gen-decoder-switch switch-num startbit decode-bitsize table-guts indent lsb0? invalid-insn) + ; For entries that are a single insn, we're done, otherwise recurse. + + (string-list + indent "{\n" + ; Are we at the next word? + (if (not (= startbit (dtable-guts-startbit table-guts))) + (begin + (set! startbit (dtable-guts-startbit table-guts)) + (set! decode-bitsize (dtable-guts-bitsize table-guts)) + ; FIXME: Bits may get fetched again during extraction. + (string-append indent " unsigned int val;\n" + indent " /* Must fetch more bits. */\n" + indent " insn = " + (gen-ifetch "pc" startbit decode-bitsize) + ";\n" + indent " val = ")) + (string-append indent " unsigned int val = ")) + (-gen-decode-bits (dtable-guts-bitnums table-guts) + (dtable-guts-startbit table-guts) + (dtable-guts-bitsize table-guts) "insn" lsb0?) + ";\n" + indent " switch (val)\n" + indent " {\n" + + ; The code is more readable, and icache use is improved, if we collapse + ; common code into one case and use "fall throughs" for all but the last of + ; a set of common cases. + ; FIXME: We currently rely on -gen-decode-foo-entry to recognize the fall + ; through. We should take care of it ourselves. + + (let loop ((entries (-decode-sort-entries (dtable-guts-entries table-guts))) + (result nil)) + (if (null? entries) + (reverse! result) + (loop + (cdr entries) + (cons (case (dtable-entry-type (car entries)) + ((insn) + (-gen-decode-insn-entry (car entries) (cdr entries) indent)) + ((expr) + (-gen-decode-expr-entry (car entries) indent invalid-insn)) + ((table) + (-gen-decode-table-entry (car entries) (cdr entries) + switch-num startbit decode-bitsize + indent lsb0? invalid-insn)) + ) + result)))) + + ; ??? Can delete if all cases are present. + indent " default : itype = " + (gen-cpu-insn-enum (current-cpu) invalid-insn) + ";" + (if (with-scache?) + " goto extract_sfmt_empty;\n" + " goto done;\n") + indent " }\n" + indent "}\n" + ) +) + +; Decoder generation entry point. +; Generate code to decode INSN-LIST. +; BITNUMS is the set of bits to initially key off of. +; DECODE-BITSIZE is the number of bits of the instruction that `insn' holds. +; LSB0? is non-#f if bit number 0 is the least significant bit. +; INVALID-INSN is the <insn> object of the pseudo insn to handle invalid ones. + +(define (gen-decoder insn-list bitnums decode-bitsize indent lsb0? invalid-insn) + (logit 3 "Building decode tree.\n" + "bitnums = " (stringize bitnums " ") "\n" + "decode-bitsize = " (number->string decode-bitsize) "\n" + "lsb0? = " (if lsb0? "#t" "#f") "\n" + ) + + ; First build a table that decodes the instruction set. + + (let ((table-guts (decode-build-table insn-list bitnums + decode-bitsize lsb0? + invalid-insn))) + + ; Now print it out. + + (-gen-decoder-switch "0" 0 decode-bitsize table-guts indent lsb0? + invalid-insn) + ) +) diff --git a/cgen/utils.scm b/cgen/utils.scm new file mode 100644 index 00000000000..84e871e6e05 --- /dev/null +++ b/cgen/utils.scm @@ -0,0 +1,1268 @@ +; Generic Utilities. +; Copyright (C) 2000 Red Hat, Inc. +; This file is part of CGEN. +; See file COPYING.CGEN for details. + +; These utilities are neither object nor cgen centric. +; They're generic, non application-specific utilities. +; There are a few exceptions, keep them to a minimum. +; +; Conventions: +; - the prefix "gen-" comes from cgen's convention that procs that return C +; code, and only those procs, are prefixed with "gen-" + +(define nil '()) + +; Hobbit support code; for when not using hobbit. +; FIXME: eliminate this stuff ASAP. + +(defmacro /fastcall-make (proc) proc) + +(defmacro fastcall4 (proc arg1 arg2 arg3 arg4) + (list proc arg1 arg2 arg3 arg4) +) + +(defmacro fastcall5 (proc arg1 arg2 arg3 arg4 arg5) + (list proc arg1 arg2 arg3 arg4 arg5) +) + +(defmacro fastcall6 (proc arg1 arg2 arg3 arg4 arg5 arg6) + (list proc arg1 arg2 arg3 arg4 arg5 arg6) +) + +(defmacro fastcall7 (proc arg1 arg2 arg3 arg4 arg5 arg6 arg7) + (list proc arg1 arg2 arg3 arg4 arg5 arg6 arg7) +) + +; ??? value doesn't matter too much here, just check if portable +; Name was `UNSPECIFIED' but that conflicts with hobbit. +(define *UNSPECIFIED* (if #f 1)) + +; Define as global to avoid multiple copies in hobbit generated code. +(define assert-fail-msg "assertion failure:") + +(defmacro assert (expr) + `(if (not ,expr) + (error assert-fail-msg ',expr)) +) + +(define verbose-level 0) + +(define (verbose-inc!) + (set! verbose-level (+ verbose-level 1)) +) + +(define (verbose? level) (>= verbose-level level)) + +; Print to stderr, takes an arbitrary number of strings, possibly nested. + +(define message + (lambda args + (for-each (lambda (str) + (if (pair? str) + (apply message str) + (display str (current-error-port)))) + args)) +) + +; Print a message if the verbosity level calls for it. +; This is a macro as a bit of cpu may be spent computing args, +; and we only want to spend it if the result will be printed. +; Macro's can't be used in hobbit-compiled code, so instead there use: +; (if (verbose? level) (message ...)). + +(defmacro logit (level . args) + `(if (>= verbose-level ,level) (message ,@args)) +) + +; Return a string of N spaces. + +(define (spaces n) (make-string n #\space)) + +; Write N spaces to PORT, or the current output port if elided. + +(define (write-spaces n . port) + (let ((port (if (null? port) (current-output-port) (car port)))) + (write (spaces n) port)) +) + +; Often used idiom. + +(define (string-map fn . args) (apply string-append (apply map (cons fn args)))) + +; Collect a flat list of returned sublists from the lambda fn applied over args. + +(define (collect fn . args) (apply append (apply map (cons fn args)))) + + +; Map over value entries in an alist. +; 'twould be nice if this were a primitive. + +(define (amap fn args) + (map fn (map cdr args)) +) + +; Like map but accept a proper or improper list. +; An improper list is (a b c . d). +; FN must be a proc of one argument. + +(define (map1-improper fn l) + (let ((result nil)) + (let loop ((last #f) (l l)) + (cond ((null? l) + result) + ((pair? l) + (if last + (begin + (set-cdr! last (cons (fn (car l)) nil)) + (loop (cdr last) (cdr l))) + (begin + (set! result (cons (fn (car l)) nil)) + (loop result (cdr l))))) + (else + (if last + (begin + (set-cdr! last (fn l)) + result) + (fn l)))))) +) + +; Turn STR into a proper C symbol. +; We assume STR has no leading digits. +; All invalid characters are turned into '_'. +; FIXME: Turn trailing "?" into "_p". + +(define (gen-c-symbol str) + (if (not (or (string? str) (symbol? str))) + (error "gen-c-symbol: not symbol or string:" str)) + (map-over-string (lambda (c) (if (id-char? c) c #\_)) str) +) + +; Turn STR into a proper file name, which is defined to be the same +; as gen-c-symbol except use -'s instead of _'s. + +(define (gen-file-name str) + (if (not (or (string? str) (symbol? str))) + (error "gen-file-name: not symbol or string:" str)) + (map-over-string (lambda (c) (if (id-char? c) c #\-)) str) +) + +; Turn STR into lowercase. + +(define (string-downcase str) + (map-over-string (lambda (c) (char-downcase c)) str) +) + +; Turn STR into uppercase. + +(define (string-upcase str) + (map-over-string (lambda (c) (char-upcase c)) str) +) + +; Drop N chars from string S. +; If N is negative, drop chars from the end. +; It is ok to drop more characters than are in the string, the result is "". + +(define (string-drop n s) + (cond ((>= n (string-length s)) "") + ((< n 0) (substring s 0 (+ (string-length s) n))) + (else (substring s n (string-length s)))) +) + +; Drop the leading char from string S (assumed to have at least 1 char). + +(define (string-drop1 s) + (string-drop 1 s) +) + +; Return the leading N chars from string STR. +; This has APL semantics: +; N > length: FILLER chars are appended +; N < 0: take from the end of the string and prepend FILLER if necessary + +(define (string-take-with-filler n str filler) + (let ((len (string-length str))) + (if (< n 0) + (let ((n (- n))) + (string-append (if (> n len) + (make-string (- n len) filler) + "") + (substring str (max 0 (- len n)) len))) + (string-append (substring str 0 (min len n)) + (if (> n len) + (make-string (- n len) filler) + "")))) +) + +(define (string-take n str) + (string-take-with-filler n str #\space) +) + +; Return the leading char from string S (assumed to have at least 1 char). + +(define (string-take1 s) + (substring s 0 1) +) + +; Return the index of char C in string S or #f if not found. + +(define (string-index s c) + (let loop ((i 0)) + (cond ((= i (string-length s)) #f) + ((char=? c (string-ref s i)) i) + (else (loop (1+ i))))) +) + +; Cut string S into a list of strings using delimiter DELIM (a character). + +(define (string-cut s delim) + (let loop ((start 0) + (end 0) + (length (string-length s)) + (result nil)) + (cond ((= end length) + (if (> end start) + (reverse! (cons (substring s start end) result)) + (reverse! result))) + ((char=? (string-ref s end) delim) + (loop (1+ end) (1+ end) length (cons (substring s start end) result))) + (else (loop start (1+ end) length result)))) +) + +; Convert a list of elements to a string, inserting DELIM (a string) +; between elements. +; L can also be a string or a number. + +(define (stringize l delim) + (cond ((string? l) l) + ((number? l) (number->string l)) + ((symbol? l) (symbol->string l)) + ((list? l) + (string-drop + (string-length delim) + (string-map (lambda (elm) + (string-append delim + (stringize elm delim))) + l))) + (else (error "stringize: can't handle:" l))) +) + +; Output routines. + +; Extension to the current-output-port. +; Only valid inside string-write. + +(define -current-print-state #f) + +; Create a print-state object. +; This is written in portable Scheme so we don't use COS objects, etc. + +(define (make-print-state) + (vector 'print-state 0) +) + +; print-state accessors. + +(define (pstate-indent pstate) (vector-ref pstate 1)) +(define (pstate-set-indent! pstate indent) (vector-set! pstate 1 indent)) + +; Special print commands (embedded in args). + +(define (pstate-cmd? x) (and (vector? x) (eq? (vector-ref x 0) 'pstate))) + +;(define /endl (vector 'pstate '/endl)) ; ??? needed? +(define /indent (vector 'pstate '/indent)) +(define (/indent-set n) (vector 'pstate '/indent-set n)) +(define (/indent-add n) (vector 'pstate '/indent-add n)) + +; Process a pstate command. + +(define (pstate-cmd-do pstate cmd) + (assert (pstate-cmd? cmd)) + (case (vector-ref cmd 1) + ((/endl) + "\n") + ((/indent) + (let ((indent (pstate-indent pstate))) + (string-append (make-string (quotient indent 8) #\tab) + (make-string (remainder indent 8) #\space)))) + ((/indent-set) + (pstate-set-indent! pstate (vector-ref cmd 2)) + "") + ((/indent-add) + (pstate-set-indent! pstate (+ (pstate-indent pstate) + (vector-ref cmd 2))) + "") + (else + (error "unknown pstate command" (vector-ref cmd 1)))) +) + +; Write STRINGS to current-output-port. +; STRINGS is a list of things to write. Supported types are strings, symbols, +; lists, procedures. Lists are printed by applying string-write recursively. +; Procedures are thunks that return the string to write. +; +; The result is the empty string. This is for debugging where this +; procedure is modified to return its args, rather than write them out. + +(define string-write + (lambda strings + (let ((pstate (make-print-state))) + (set! -current-print-state pstate) + (for-each (lambda (elm) (-string-write pstate elm)) + strings) + (set! -current-print-state #f) + "")) +) + +; Subroutine of string-write and string-write-map. + +(define (-string-write pstate expr) + (cond ((string? expr) (display expr)) ; not write, we want raw text + ((symbol? expr) (display expr)) + ((procedure? expr) (-string-write pstate (expr))) + ((pstate-cmd? expr) (display (pstate-cmd-do pstate expr))) + ((list? expr) (for-each (lambda (x) (-string-write pstate x)) expr)) + (else (error "string-write: bad arg:" expr))) + *UNSPECIFIED* +) + +; Combination of string-map and string-write. + +(define (string-write-map proc arglist) + (let ((pstate -current-print-state)) + (for-each (lambda (arg) (-string-write pstate (proc arg))) + arglist)) + "" +) + +; Build up an argument for string-write. + +(define string-list list) +(define string-list-map map) + +; Subroutine of string-list->string. Does same thing -string-write does. + +(define (-string-list-flatten pstate strlist) + (cond ((string? strlist) strlist) + ((symbol? strlist) strlist) + ((procedure? strlist) (-string-list-flatten pstate (strlist))) + ((pstate-cmd? strlist) (pstate-cmd-do pstate strlist)) + ((list? strlist) (apply string-append + (map (lambda (str) + (-string-list-flatten pstate str)) + strlist))) + (else (error "string-list->string: bad arg:" strlist))) +) + +; Flatten out a string list. + +(define (string-list->string strlist) + (-string-list-flatten (make-print-state) strlist) +) + +; Prefix CHARS, a string of characters, with backslash in STR. +; STR is either a string or list of strings (to any depth). +; ??? Quick-n-dirty implementation. + +(define (backslash chars str) + (if (string? str) + ; quick check for any work to do + (if (any-true? (map (lambda (c) + (string-index str c)) + (string->list chars))) + (let loop ((result "") (str str)) + (if (= (string-length str) 0) + result + (loop (string-append result + (if (string-index chars (string-ref str 0)) + "\\" + "") + (substring str 0 1)) + (substring str 1 (string-length str))))) + str) + ; must be a list + (if (null? str) + nil + (cons (backslash chars (car str)) + (backslash chars (cdr str))))) +) + +; Return a boolean indicating if S is bound to a value. +;(define old-symbol-bound? symbol-bound?) +;(define (symbol-bound? s) (old-symbol-bound? #f s)) + +; Return a boolean indicating if S is a symbol and is bound to a value. + +(define (bound-symbol? s) + (and (symbol? s) + (or (symbol-bound? #f s) + ;(module-bound? cgen-module s) + )) +) + +; Return X. + +(define (identity x) x) + +; Test whether X is a `form' (non-empty list). +; ??? Is `form' the right word to use here? +; One can argue we should also test for a valid car. If so, it's the +; name that's wrong not the code (because the code is what I want). + +(define (form? x) (and (not (null? x)) (list? x))) + +; Return the number of arguments to ARG-SPEC, a valid argument list +; of `lambda'. +; The result is a pair: number of fixed arguments, varargs indicator (#f/#t). + +(define (num-args arg-spec) + (if (symbol? arg-spec) + '(0 . #t) + (let loop ((count 0) (arg-spec arg-spec)) + (cond ((null? arg-spec) (cons count #f)) + ((null? (cdr arg-spec)) (cons (+ count 1) #f)) + ((pair? (cdr arg-spec)) (loop (+ count 1) (cdr arg-spec))) + (else (cons (+ count 1) #t))))) +) + +; Return a boolean indicating if N args is ok to pass to a proc with +; an argument specification of ARG-SPEC (a valid argument list of `lambda'). + +(define (num-args-ok? n arg-spec) + (let ((processed-spec (num-args arg-spec))) + (and + ; Ensure enough fixed arguments. + (>= n (car processed-spec)) + ; If more args than fixed args, ensure varargs. + (or (= n (car processed-spec)) + (cdr processed-spec)))) +) + +; Take N elements from list L. +; If N is negative, take elements from the end. +; If N is larger than the length, the extra elements are NIL. +; FIXME: incomplete +; FIXME: list-tail has args reversed (we should conform) + +(define (list-take n l) + (let ((len (length l))) + (if (< n 0) + (list-tail l (+ len n)) + (let loop ((result nil) (l l) (i 0)) + (if (= i n) + (reverse! result) + (loop (cons (car l) result) (cdr l) (+ i 1)))))) +) + +; Drop N elements from list L. +; FIXME: list-tail has args reversed (we should conform) + +(define (list-drop n l) + (let loop ((n n) (l l)) + (if (> n 0) + (loop (- n 1) (cdr l)) + l)) +) + +; Drop N elements from the end of L. +; FIXME: list-tail has args reversed (we should conform) + +(define (list-tail-drop n l) + (reverse! (list-drop n (reverse l))) +) + +; APL's +\ operation on a vector of numbers. + +(define (plus-scan l) + (letrec ((-plus-scan (lambda (l result) + (if (null? l) + result + (-plus-scan (cdr l) + (cons (if (null? result) + (car l) + (+ (car l) (car result))) + result)))))) + (reverse! (-plus-scan l nil))) +) + +; Remove duplicate elements from sorted list L. +; Currently supported elements are symbols (a b c) and lists ((a) (b) (c)). + +(define (remove-duplicates l) + (let loop ((l l) (result nil)) + (cond ((null? l) (reverse! result)) + ((null? result) (loop (cdr l) (cons (car l) result))) + ((equal? (car l) (car result)) (loop (cdr l) result)) + (else (loop (cdr l) (cons (car l) result))) + ) + ) +) + +; Return a boolean indicating if each element of list satisfies its +; corresponding predicates. The length of L must be equal to the length +; of PREDS. + +(define (list-elements-ok? l preds) + (and (list? l) + (= (length l) (length preds)) + (all-true? (map (lambda (pred elm) (pred elm)) preds l))) +) + +; Remove duplicates from unsorted list L. +; KEY-GENERATOR is a lambda that takes a list element as input and returns +; an equal? key to use to determine duplicates. +; The first instance in a set of duplicates is always used. +; This is not intended to be applied to large lists with an expected large +; result (where sorting the list first would be faster), though one could +; add such support later. + +(define (nub l key-generator) + (let loop ((l l) (keys (map key-generator l)) (result nil)) + (if (null? l) + (reverse! (map cdr result)) + (if (assv (car keys) result) + (loop (cdr l) (cdr keys) result) + (loop (cdr l) (cdr keys) (acons (car keys) (car l) + result))))) +) + +; Return a boolean indicating if list L1 is a subset of L2. +; Uses memq. + +(define (subset? l1 l2) + (let loop ((l1 l1)) + (if (null? l1) + #t + (if (memq (car l1) l2) + (loop (cdr l1)) + #f))) +) + +; Return intersection of two lists. + +(define (intersection l1 l2) + (cond ((null? l1) l1) + ((null? l2) l2) + ((memq (car l1) l2) (cons (car l1) (intersection (cdr l1) l2))) + (else (intersection (cdr l1) l2))) +) + +; Return a count of the number of elements of list L1 that are in list L2. +; Uses memq. + +(define (count-common l1 l2) + (let loop ((result 0) (l1 l1)) + (if (null? l1) + result + (if (memq (car l1) l2) + (loop (+ result 1) (cdr l1)) + (loop result (cdr l1))))) +) + +; Remove duplicate elements from sorted alist L. +; L must be sorted by name. + +(define (alist-nub l) + (let loop ((l l) (result nil)) + (cond ((null? l) (reverse! result)) + ((null? result) (loop (cdr l) (cons (car l) result))) + ((eq? (caar l) (caar result)) (loop (cdr l) result)) + (else (loop (cdr l) (cons (car l) result))) + ) + ) +) + +; Return a copy of alist L. + +(define (alist-copy l) + ; (map cons (map car l) (map cdr l)) ; simple way + ; presumably more efficient way (less cons cells created) + (map (lambda (elm) + (cons (car elm) (cdr elm))) + l) +) + +; Return the order in which to select elements of L sorted by SORT-FN. +; The result is origin 0. + +(define (sort-grade l sort-fn) + (let ((sorted (sort (map cons (iota (length l)) l) + (lambda (a b) (sort-fn (cdr a) (cdr b)))))) + (map car sorted)) +) + +; Return ALIST sorted on the name in ascending order. + +(define (alist-sort alist) + (sort alist + (lambda (a b) + (string<? (symbol->string (car a)) + (symbol->string (car b))))) +) + +; Return a boolean indicating if C is a leading id char. +; '@' is treated as an id-char as it's used to delimit something that +; sed will alter. + +(define (leading-id-char? c) + (or (char-alphabetic? c) + (char=? c #\_) + (char=? c #\@)) +) + +; Return a boolean indicating if C is an id char. +; '@' is treated as an id-char as it's used to delimit something that +; sed will alter. + +(define (id-char? c) + (or (leading-id-char? c) + (char-numeric? c)) +) + +; Return the length of the identifier that begins S. +; Identifiers are any of letter, digit, _, @. +; The first character must not be a digit. +; ??? The convention is to use "-" between cgen symbols, not "_". +; Try to handle "-" here as well. + +(define (id-len s) + (if (leading-id-char? (string-ref s 0)) + (let ((len (string-length s))) + (let loop ((n 0)) + (if (and (< n len) + (id-char? (string-ref s n))) + (loop (1+ n)) + n))) + 0) +) + +; Return number of characters in STRING until DELIMITER. +; Returns #f if DELIMITER not present. +; FIXME: Doesn't yet support \-prefixed delimiter (doesn't terminate scan). + +(define (chars-until-delimiter string delimiter) + (let loop ((str string) (result 0)) + (cond ((= (string-length str) 0) + #f) + ((char=? (string-ref str 0) delimiter) + result) + (else (loop (string-drop1 str) (1+ result))))) +) + +; Apply FN to each char of STR. + +(define (map-over-string fn str) + (do ((tmp (string-copy (if (symbol? str) (symbol->string str) str))) + (i (- (string-length str) 1) (- i 1))) + ((< i 0) tmp) + (string-set! tmp i (fn (string-ref tmp i))) + ) +) + +; Return a range. +; It must be distinguishable from a list of numbers. + +(define (minmax min max) (cons min max)) + +; Move VALUE of LENGTH bits to position START in a word of SIZE bits. +; LSB0? is non-#f if bit numbering goes LSB->MSB. +; Otherwise it goes MSB->LSB. +; START-LSB? is non-#f if START denotes the least significant bit. +; Otherwise START denotes the most significant bit. +; N is assumed to fit in the field. + +(define (word-value start length size lsb0? start-lsb? value) + (if lsb0? + (if start-lsb? + (logsll value start) + (logsll value (+ (- start length) 1))) + (if start-lsb? + (logsll value (- size start 1)) + (logsll value (- size (+ start length))))) +) + +; Return a bit mask of LENGTH bits in a word of SIZE bits starting at START. +; LSB0? is non-#f if bit numbering goes LSB->MSB. +; Otherwise it goes MSB->LSB. +; START-LSB? is non-#f if START denotes the least significant bit. +; Otherwise START denotes the most significant bit. + +(define (word-mask start length size lsb0? start-lsb?) + (if lsb0? + (if start-lsb? + (logsll (mask length) start) + (logsll (mask length) (+ (- start length) 1))) + (if start-lsb? + (logsll (mask length) (- size start 1)) + (logsll (mask length) (- size (+ start length))))) +) + +; Extract LENGTH bits at bit number START in a word of SIZE bits from VALUE. +; LSB0? is non-#f if bit numbering goes LSB->MSB. +; Otherwise it goes MSB->LSB. +; START-LSB? is non-#f if START denotes the least significant bit. +; Otherwise START denotes the most significant bit. +; +; ??? bit-extract takes a big-number argument but still uses logand +; which doesn't so we don't use it + +(define (word-extract start length size lsb0? start-lsb? value) + (if lsb0? + (if start-lsb? + (remainder (logslr value start) (integer-expt 2 length)) + (remainder (logslr value (+ (- start length) 1)) (integer-expt 2 length))) + (if start-lsb? + (remainder (logslr value (- size start 1)) (integer-expt 2 length)) + (remainder (logslr value (- size (+ start length))) (integer-expt 2 length)))) +) + +; Return a bit mask of size SIZE beginning at the LSB. + +(define (mask size) + (- (logsll 1 size) 1) +) + +; Split VAL into pieces of bit size LENGTHS. +; e.g. (split-bits '(8 2) 997) -> (229 3) +; There are as many elements in the result as there are in LENGTHS. +; Note that this can result in a loss of information. + +(define (split-bits lengths val) + (letrec ((split1 + (lambda (lengths val result) + (if (null? lengths) + result + (split1 (cdr lengths) + (quotient val (integer-expt 2 (car lengths))) + (cons (remainder val (integer-expt 2 (car lengths))) + result)))))) + (reverse! (split1 lengths val nil))) +) + +; Generalized version of split-bits. +; e.g. (split-value '(10 10 10) 1234) -> (4 3 2 1) ; ??? -> (1 2 3 4) ? +; (split-value '(10 10) 1234) -> (4 3) +; There are as many elements in the result as there are in BASES. +; Note that this can result in a loss of information. + +(define (split-value bases val) + (letrec ((split1 + (lambda (bases val result) + (if (null? bases) + result + (split1 (cdr bases) + (quotient val (car bases)) + (cons (remainder val (car bases)) + result)))))) + (reverse! (split1 bases val nil))) +) + +; Convert bits to bytes. + +(define (bits->bytes bits) (quotient (+ 7 bits) 8)) + +; Convert bytes to bits. + +(define (bytes->bits bytes) (* bytes 8)) + +; Return a list of integers. +; ARGS is either a list of one integer (N) meaning return a list from 0 to N-1, +; or a list of two integers (START N) meaning return a list from START to +; START+N-1. +; FIXME: change to (iota n . start). + +(define (iota . args) + (case (length args) + ((1) (let loop ((n (car args)) (z nil)) + (if (<= n 0) z (loop (1- n) (cons (1- n) z))))) + ((2) (let ((start (car args))) + (let loop ((n (cadr args)) (z nil)) + (if (<= n 0) z (loop (1- n) (cons (+ start (1- n)) z)))))) + (else (error "iota: wrong number of arguments:" args))) +) + +; Return a list of the first N powers of 2. + +(define (powers-of-2 n) + (cond ((= n 0) nil) + (else (cons (integer-expt 2 (1- n)) (powers-of-2 (1- n)))) + ) + ; Another way: (map (lambda (n) (ash 1 n)) (iota n)) +) + +; I'm tired of writing (not (= foo bar)). + +(define (!= a b) (not (= a b))) + +; Return #t if BIT-NUM (which is starting from LSB), is set in the binary +; representation of non-negative integer N. + +(define (bit-set? n bit-num) + ; ??? Quick hack to work around missing bignum support. + ;(= 1 (cg-logand (logslr n bit-num) 1)) + (if (>= n #x20000000) + (if (>= bit-num 16) + (logbit? (- bit-num 16) (logslr n 16)) + (logbit? bit-num (remainder n 65536))) + (logbit? bit-num n)) +) + +; Return #t if each element of bools is #t. Since Scheme considers any +; non-#f value as #t we do too. +; (all-true? ()) is #t since that is the identity element. + +(define (all-true? bools) + (cond ((null? bools) #t) + ((car bools) (all-true? (cdr bools))) + (else #f)) +) + +; Return #t if any element of BOOLS is #t. +; If BOOLS is empty, return #f. + +(define (any-true? bools) + (cond ((null? bools) #f) + ((car bools) #t) + (else (any-true? (cdr bools)))) +) + +; Return count of true values. + +(define (count-true flags) + (let loop ((result 0) (flags flags)) + (if (null? flags) + result + (loop (+ result (if (car flags) 1 0)) + (cdr flags)))) +) + +; Return count of all ones in BITS. + +(define (count-bits bits) + (let loop ((result 0) (bits bits)) + (if (= bits 0) + result + (loop (+ result (remainder bits 2)) (quotient bits 2)))) +) + +; Convert bits in N #f/#t. +; LENGTH is the length of N in bits. + +(define (bits->bools n length) + (do ((result (make-list length #f)) + (i 0 (+ i 1))) + ((= i length) (reverse! result)) + (list-set! result i (if (bit-set? n i) #t #f)) + ) +) + +; Print a C integer. + +(define (gen-integer val) + (cond ((and (<= #x-80000000 val) (> #x80000000 val)) + (number->string val)) + ((and (<= #x80000000 val) (>= #xffffffff val)) + ; ??? GCC complains if not affixed with "U" but that's not k&r. + ;(string-append (number->string val) "U")) + (string-append "0x" (number->string val 16))) + (else (error "Number too large for gen-integer:" val))) +) + +; Return higher/lower part of double word integer. + +(define (high-part val) + (logslr val 32) +) +(define (low-part val) + (remainder val #x100000000) +) + +; Logical operations. + +(define (logslr val shift) (ash val (- shift))) +(define logsll ash) ; (logsll val shift) (ash val shift)) +; logand, logior, logxor defined by guile so we don't need to +; (define (logand a b) ...) +; (define (logxor a b) ...) +; (define (logior a b) ...) +; +; On the other hand they didn't support bignums, so the cgen-binary +; defines cg-log* that does. These are just a quick hack that only +; handle what currently needs handling. + +(define (cg-logand a b) + (if (or (>= a #x20000000) + (>= b #x20000000)) + (+ (logsll (logand (logslr a 16) (logslr b 16)) 16) + (logand (remainder a 65536) (remainder b 65536))) + (logand a b)) +) + +(define (cg-logxor a b) + (if (or (>= a #x20000000) + (>= b #x20000000)) + (+ (logsll (logxor (logslr a 16) (logslr b 16)) 16) + (logxor (remainder a 65536) (remainder b 65536))) + (logxor a b)) +) + +; Return list of bit values for the 1's in X. + +(define (bit-vals x) + (let loop ((result nil) (mask 65536)) + (cond ((= mask 0) result) + ((> (logand x mask) 0) (loop (cons mask result) (logslr mask 1))) + (else (loop result (logslr mask 1))))) +) + +; Return bit representation of N in LEN bits. +; e.g. (bit-rep 6 3) -> (1 1 0) + +(define (bit-rep n len) + (cond ((= len 0) nil) + ((> (logand n (logsll 1 (- len 1))) 0) + (cons 1 (bit-rep n (- len 1)))) + (else (cons 0 (bit-rep n (- len 1)))))) + +; Return list of all bit values from 0 to N. +; e.g. (bit-patterns 3) -> ((0 0 0) (0 0 1) (0 1 0) ... (1 1 1)) + +(define (bit-patterns len) + (map (lambda (x) (bit-rep x len)) (iota (logsll 1 len))) +) + +; Compute the list of all indices from bits missing in MASK. +; e.g. (missing-bit-indices #xff00 #xffff) -> (0 1 2 3 ... 255) +; +; Hobbit emits two functions named `missing_bit_indices_fn31' for this. +;(define (missing-bit-indices mask full-mask) +; (let* ((bitvals (bit-vals (logxor mask full-mask))) +; (selectors (bit-patterns (length bitvals)))) +; (map (lambda (sel) (apply + (map * sel bitvals))) selectors)) +;) +; So it's rewritten to this ... + +(define (missing-bit-indices mask full-mask) + (let* ((bitvals (bit-vals (logxor mask full-mask))) + (selectors (bit-patterns (length bitvals))) + (map-star (lambda (sel) (map * sel bitvals))) + (compute-indices (lambda (sel) (apply + (map-star sel))))) + (map compute-indices selectors)) +) + +; Convert a list of numbers to a string, separated by SEP. +; The result is prefixed by SEP too. + +(define (numbers->string nums sep) + (string-map (lambda (elm) (string-append sep (number->string elm))) nums) +) + +; Convert a number to a hex string. + +(define (number->hex num) + (number->string num 16) +) + +; Given a list of numbers NUMS, generate text to pass them as arguments to a +; C function. We assume they're not the first argument and thus have a +; leading comma. + +(define (gen-int-args nums) + (numbers->string nums ", ") +) + +; Given a C expression or a list of C expressions, return a comma separated +; list of them. +; In the case of more than 0 elements the leading ", " is present so that +; there is no edge case in the case of 0 elements when the caller is appending +; the result to an initial set of arguments (the number of commas equals the +; number of elements). The caller is responsible for dropping the leading +; ", " if necessary. Note that `string-drop' can handle the case where more +; characters are dropped than are present. + +(define (gen-c-args exprs) + (cond ((null? exprs) "") + ((pair? exprs) (string-map (lambda (elm) (string-append ", " elm)) + exprs)) + ((equal? exprs "") "") + (else (string-append ", " exprs))) +) + +; Return a list of N macro argument names. + +(define (macro-args n) + (map (lambda (i) (string-append "a" (number->string i))) + (map 1+ (iota n))) +) + +; Return C code for N macro argument names. +; (gen-macro-args 4) -> ", a1, a2, a3, a4" + +(define (gen-macro-args n) + (gen-c-args (macro-args n)) +) + +; Return a string to reference an array. +; INDICES is either a (possibly empty) list of indices or a single index. +; The values can either be numbers or strings (/symbols). + +(define (gen-array-ref indices) + (let ((gen-index (lambda (idx) + (string-append "[" + (cond ((number? idx) (number->string idx)) + (else idx)) + "]")))) + (cond ((null? indices) "") + ((pair? indices) ; list of indices? + (string-map gen-index indices)) + (else (gen-index indices)))) +) + +; Return list element N or #f if list L is too short. + +(define (list-maybe-ref l n) + (if (> (length l) n) + (list-ref l n) + #f) +) + +; Return list of index numbers of elements in list L that satisfy PRED. +; I is usually 0. + +(define (find-index i pred l) + (define (find1 i pred l result) + (cond ((null? l) result) + ((pred (car l)) (find1 (+ 1 i) pred (cdr l) (cons i result))) + (else (find1 (+ 1 i) pred (cdr l) result)))) + (reverse! (find1 i pred l nil)) +) + +; Return list of elements of L that satisfy PRED. + +(define (find pred l) + (define (find1 pred l result) + (cond ((null? l) result) + ((pred (car l)) (find1 pred (cdr l) (cons (car l) result))) + (else (find1 pred (cdr l) result)))) + (reverse! (find1 pred l nil)) +) + +; Return first element of L that satisfies PRED or #f if there is none. + +(define (find-first pred l) + (cond ((null? l) #f) + ((pred (car l)) (car l)) + (else (find-first pred (cdr l)))) +) + +; Return list of FN applied to elements of L that satisfy PRED. + +(define (find-apply fn pred l) + (cond ((null? l) nil) + ((pred (car l)) (cons (fn (car l)) (find-apply fn pred (cdr l)))) + (else (find-apply fn pred (cdr l)))) +) + +; Given a list of lists L such that the first element in each list names the +; entry, look up symbol S in that and return its index. If not found, +; return #f. +; Eg: (lookup 'element2 '((element1 1) (element2 2))) +; Granted, linear searching isn't efficient. If it ever becomes a problem we +; can do something about it then. +; I is added to the result. + +(define (lookup-index s l i) + (cond ((null? l) #f) + ((eqv? s (caar l)) i) + (else (lookup-index s (cdr l) (1+ i)))) +) + +; Return the index of element ELM in list L or #f if not found. +; If found, I is added to the result. +; (Yes, in one sense I is present to simplify the implementation. Sue me.) + +(define (element-lookup-index elm l i) + (cond ((null? l) #f) + ((equal? elm (car l)) i) + (else (element-lookup-index elm (cdr l) (1+ i)))) +) + +; Return #t if ELM is in ELM-LIST. + +(define (element? elm elm-list) + (->bool (member elm elm-list)) +) + +; Return the set of all possible combinations of elements in list L +; according to the following rules: +; - each element of L is either an atom (non-list) or a list +; - each list element is (recursively) interpreted as a set of choices +; - the result is a list of all possible combinations of elements +; +; Example: (list-expand '(a b (1 2 (3 4)) c (5 6))) +; --> ((a b 1 c d 5) +; (a b 1 c d 6) +; (a b 2 c d 5) +; (a b 2 c d 6) +; (a b 3 c d 5) +; (a b 3 c d 6) +; (a b 4 c d 5) +; (a b 4 c d 6)) + +(define (list-expand l) + #f ; ??? wip +) + +; Given X, a number or symbol, reduce it to a constant if possible. +; Numbers always reduce to themselves. +; Symbols are reduced to a number if they're defined as such, +; or to an enum constant if one exists; otherwise X is returned unchanged. +; Requires: symbol-bound? enum-lookup-val + +(define (reduce x) + (if (number? x) + x + ; A symbol bound to a number? + (if (and (symbol? x) (symbol-bound? #f x) (number? (eval x))) + (eval x) + ; An enum value that has a known numeric value? + (let ((e (enum-lookup-val x))) + (if (number? (car e)) + (car e) + ; Otherwise return X unchanged. + x)))) +) + +; If OBJ has a dump method call it, otherwise return OBJ untouched. + +(define (dump obj) + (if (method-present? obj 'dump) + (send obj 'dump) + obj) +) + +; Copyright messages. + +; Pair of header,trailer parts of copyright. + +(define copyright-fsf + (cons "\ +THIS FILE IS MACHINE GENERATED WITH CGEN. + +Copyright (C) 1996, 1997, 1998, 1999 Free Software Foundation, Inc. +" + "\ +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2, or (at your option) +any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License along +with this program; if not, write to the Free Software Foundation, Inc., +59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +" +)) + +; Pair of header,trailer parts of copyright. + +(define copyright-cygnus + (cons "\ +THIS FILE IS MACHINE GENERATED WITH CGEN. + +Copyright (C) 2000 Red Hat, Inc. +" + "\ +")) + +; Set this to one of copyright-fsf, copyright-cygnus. + +(define CURRENT-COPYRIGHT copyright-fsf) + +; Packages. + +(define package-gnu-binutils-gdb "\ +This file is part of the GNU Binutils and/or GDB, the GNU debugger. +") + +(define package-gnu-simulators "\ +This file is part of the GNU Simulators. +") + +(define package-cygnus-simulators "\ +This file is part of the Cygnus Simulators. +") + +; Return COPYRIGHT, with FILE-DESC as the first line +; and PACKAGE as the name of the package which the file belongs in. +; COPYRIGHT is a pair of (header . trailer). + +(define (gen-copyright file-desc copyright package) + (string-append "/* " file-desc "\n\n" + (car copyright) + "\n" package "\n" + (cdr copyright) + "\n*/\n\n") +) + +; File operations. + +; Delete FILE, handling the case where it doesn't exist. + +(define (delete-file-noerr file) + ; This could also use file-exists?, but it's nice to have a few examples + ; of how to use `catch' lying around. + (catch 'system-error (lambda () (delete-file file)) + (lambda args #f)) +) + +; Create FILE, point current-output-port to it, and call WRITE-FN. +; FILE is always overwritten. +; GEN-FN either writes output to stdout or returns the text to write, +; the last thing we do is write the text returned by WRITE-FN to FILE. + +(define (file-write file write-fn) + (delete-file-noerr file) + (let ((left-over-text (with-output-to-file file write-fn))) + (let ((port (open-file file "a"))) + (display left-over-text port) + (close-port port)) + #t) +) + +; Return the size in bytes of FILE. + +(define (file-size file) + (let ((stat (%stat file))) + (if stat + (vector-ref (%stat file) 7) + -1)) +) + +; Time operations. + +; Return the current time. +; The result is a black box understood only by time-elapsed. + +(define (time-current) (gettimeofday)) + +; Return the elapsed time in milliseconds since START. + +(define (time-elapsed start) + (let ((now (gettimeofday))) + (+ (* (- (car now) (car start)) 1000) + (quotient (- (cdr now) (cdr start)) 1000))) +) + +; Run PROC and return the number of milliseconds it took to execute it N times. + +(define (time-proc n proc) + (let ((now (time-current))) + (do ((i 0 (+ i 1))) ((= i n) (time-elapsed now)) + (proc))) +) |