* dev.scm (load-sid): New function.
* cgen-sid.scm: New file.
* sid-cpu.scm: Likeiwse.
* sid-decode.scm: Likewise.
* sid-model.scm: Likewise.
* sid.scm: Likewise.
+2000-12-08 Ben Elliston <bje@redhat.com>
+
+ * dev.scm (load-sid): New function.
+ * cgen-sid.scm: New file.
+ * sid-cpu.scm: Likeiwse.
+ * sid-decode.scm: Likewise.
+ * sid-model.scm: Likewise.
+ * sid.scm: Likewise.
+
2000-12-07 Ben Elliston <bje@redhat.com>
* sim-decode.scm (-gen-extract-case): Do not emit a definition for
--- /dev/null
+; Simulator generator entry point.
+; This is invoked to build: desc.h, cpu.h, defs.h, decode.h, decode.cxx,
+; semantics.cxx, sem-switch.cxx.
+; 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 "/sid.scm"))
+ (load (string-append srcdir "/sid-cpu.scm"))
+ (load (string-append srcdir "/sid-model.scm"))
+ (load (string-append srcdir "/sid-decode.scm"))
+)
+
+(define sim-arguments
+ (list
+ (list '-H "file" "generate desc.h in <file>"
+ (lambda (arg) (file-write arg cgen-desc.h)))
+ (list '-C "file" "generate cpu.h in <file>"
+ (lambda (arg) (file-write arg cgen-cpu.h)))
+ (list '-E "file" "generate defs.h in <file>"
+ (lambda (arg) (file-write arg cgen-defs.h)))
+ (list '-T "file" "generate decode.h in <file>"
+ (lambda (arg) (file-write arg cgen-decode.h)))
+ (list '-D "file" "generate decode.cxx in <file>"
+ (lambda (arg) (file-write arg cgen-decode.cxx)))
+ (list '-W "file" "generate write.cxx in <file>"
+ (lambda (arg) (file-write arg cgen-write.cxx)))
+ (list '-S "file" "generate semantics.cxx in <file>"
+ (lambda (arg) (file-write arg cgen-semantics.cxx)))
+ (list '-X "file" "generate sem-switch.cxx in <file>"
+ (lambda (arg) (file-write arg cgen-sem-switch.cxx)))
+ (list '-M "file" "generate model.cxx in <file>"
+ (lambda (arg) (file-write arg cgen-model.cxx)))
+ )
+)
+
+; 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))
; (use-c)
; (load-opc)
; (load-sim)
+; (load-sid)
; (cload #:arch arch #:machs "mach-list" #:isas "isa-list" #:options "options")
\f
; First load fixup.scm to coerce guile into something we've been using.
(set! APPLICATION 'GAS-TEST)
)
+(define (load-sid)
+ (load "read")
+ (load "utils-sim")
+ (load "sid")
+ (load "sid-cpu")
+ (load "sid-model")
+ (load "sid-decode")
+ (set! verbose-level 3)
+ (set! APPLICATION 'SIMULATOR)
+)
(define (load-sim)
(load "read")
[none yet]
\n")
+(display "\
+sid options:
+[wip]
+\n")
; If ~/.cgenrc exists, load it.
--- /dev/null
+; CPU family related simulator generator, excluding decoding and model support.
+; Copyright (C) 2000 Red Hat, Inc.
+; This file is part of CGEN.
+
+; ***********
+; cgen-desc.h
+
+; Declare the attributes.
+
+(define (-gen-attr-decls)
+ (string-list
+ "// Insn attribute indices.\n\n"
+ (gen-attr-enum-decl "cgen_insn" (current-insn-attr-list))
+ "// Attributes.\n\n"
+ (string-list-map gen-decl (current-attr-list))
+ )
+)
+
+; Generate class to hold an instruction's attributes.
+
+(define (-gen-insn-attr-decls)
+ (let ((attrs (current-insn-attr-list)))
+ (string-append
+ "// Insn attributes.\n\n"
+ ; FIXME: maybe make class, but that'll require a constructor. Later.
+ "struct @arch@_insn_attr {\n"
+ " unsigned int bools;\n"
+ (string-map (lambda (attr)
+ (if (bool-attr? attr)
+ ""
+ (string-append " "
+ (gen-attr-type attr)
+ " "
+ (string-downcase (gen-sym attr))
+ ";\n")))
+ attrs)
+ ;"public:\n"
+ (string-map (lambda (attr)
+ (string-append
+ " inline "
+ (gen-attr-type attr)
+ " get_" (string-downcase (gen-sym attr)) "_attr"
+ " () { return "
+ (if (bool-attr? attr)
+ (string-append "(bools & "
+ (gen-attr-mask "cgen_insn" (obj:name attr))
+ ") != 0")
+ (string-downcase (gen-sym attr)))
+ "; }\n"))
+ attrs)
+
+ "};\n\n"
+ ))
+)
+
+; Generate <cpu>-desc.h.
+
+(define (cgen-desc.h)
+ (logit 1 "Generating " (gen-cpu-name) " desc.h ...\n")
+
+ (string-write
+ (gen-copyright "Misc. entries in the @arch@ description file."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+#ifndef DESC_@ARCH@_H
+#define DESC_@ARCH@_H
+
+namespace @arch@ {
+\n"
+
+ "// Enums.\n\n"
+ (lambda () (string-map gen-decl (current-enum-list)))
+
+ -gen-attr-decls
+ -gen-insn-attr-decls
+
+ "
+} // end @arch@ namespace
+
+#endif /* DESC_@ARCH@_H */\n"
+ )
+)
+\f
+; **********
+; cgen-cpu.h
+
+; Print out file containing elements to add to cpu class.
+
+; Get/set fns for hardware element HW.
+
+(define (-gen-reg-access-defns hw)
+ (let ((scalar? (hw-scalar? hw))
+ (name (obj:name hw))
+ (getter (hw-getter hw))
+ (setter (hw-setter hw))
+ (isas (bitset-attr->list (obj-attr-value hw 'ISA)))
+ (type (gen-type hw)))
+ (let ((get-code (if getter
+ (let ((mode (hw-mode hw))
+ (args (car getter))
+ (expr (cadr getter)))
+ (string-append
+ "return "
+ (rtl-c++ mode expr
+ (if scalar?
+ nil
+ (list (list (car args) 'UINT "regno")))
+ #:rtl-cover-fns? #t)
+ ";"))
+ (string-append
+ "return this->hardware."
+ (gen-c-symbol name)
+ (if scalar? "" "[regno]")
+ ";")))
+ (set-code (if setter
+ (let ((args (car setter))
+ (expr (cadr setter)))
+ (rtl-c++
+ VOID ; not `mode', sets have mode VOID
+ expr
+ (if scalar?
+ (list (list (car args) (hw-mode hw) "newval"))
+ (list (list (car args) 'UINT "regno")
+ (list (cadr args) (hw-mode hw) "newval")))
+ #:rtl-cover-fns? #t))
+ (string-append
+ "this->hardware."
+ (gen-c-symbol name)
+ (if scalar? "" "[regno]")
+ " = newval;"))))
+ (string-append
+ " inline " type " "
+ (gen-reg-get-fun-name hw)
+ " ("
+ (if scalar? "" "UINT regno")
+ ") const"
+ " { " get-code " }"
+ "\n"
+ " inline void "
+ (gen-reg-set-fun-name hw)
+ " ("
+ (if scalar? "" "UINT regno, ")
+ type " newval)"
+ " { " set-code " }"
+ "\n\n")))
+)
+
+; 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)))
+)
+
+; Subroutine of -gen-hardware-types to generate the struct containing
+; hardware elements of one isa.
+
+(define (-gen-hardware-struct prefix hw-list)
+ (if (null? hw-list)
+ ; If struct is empty, leave it out to simplify generated code.
+ ""
+ (string-list
+ (if prefix
+ (string-append " // Hardware elements for " prefix ".\n")
+ " // Hardware elements.\n")
+ " struct {\n"
+ (string-list-map gen-decl hw-list)
+ " } "
+ (if prefix
+ (string-append prefix "_")
+ "")
+ "hardware;\n\n"
+ ))
+)
+
+; 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\n"
+ (if (with-multiple-isa?)
+ (let ((keep-isas (current-keep-isa-name-list))
+ (candidates (find hw-need-storage? (current-hw-list))))
+ (string-list
+ ; First emit a struct that contains all the common elements.
+ ; A common element is one supported by more than isa.
+ (-gen-hardware-struct #f
+ (find (lambda (hw)
+ (> (count-common
+ keep-isas
+ (bitset-attr->list
+ (obj-attr-value hw 'ISA)))
+ 1))
+ candidates))
+ ; Now emit structs for each isa. These contain entries for elements
+ ; supported by exactly one isa.
+ (string-list-map (lambda (isa)
+ (-gen-hardware-struct
+ isa
+ (find (lambda (hw)
+ (= (count-common
+ keep-isas
+ (bitset-attr->list
+ (obj-attr-value hw 'ISA)))
+ 1))
+ candidates)))
+ keep-isas)
+ ))
+ (-gen-hardware-struct #f (find hw-need-storage? (current-hw-list))))
+ )
+)
+
+; Generate <cpu>-cpu.h
+
+(define (cgen-cpu.h)
+ (logit 1 "Generating " (gen-cpu-name) " cpu.h ...\n")
+ (assert-keep-one)
+
+ ; Turn parallel execution support on if cpu needs it.
+ (set-with-parallel?! (state-parallel-exec?))
+
+ ; Initialize rtl->c generation.
+ (rtl-c-config! #:rtl-cover-fns? #t)
+
+ (string-write
+ (gen-copyright "CPU class elements for @cpu@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+// This file is included in the middle of the cpu class struct.
+
+public:
+\n"
+
+ -gen-hardware-types
+
+ " // C++ register access function templates\n"
+ "#define current_cpu this\n\n"
+ (lambda ()
+ (string-list-map -gen-reg-access-defns
+ (find register? (current-hw-list))))
+ "#undef current_cpu\n\n"
+ )
+)
+\f
+; **********
+; cgen-defs.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). */\n"
+ "#define @CPU@_MAX_LIW_INSNS " (number->string (cpu-liw-insns (current-cpu))) "\n\n"
+ "/* Maximum number of instructions that can be executed in parallel. */\n"
+ "#define @CPU@_MAX_PARALLEL_INSNS " (number->string (cpu-parallel-insns (current-cpu))) "\n"
+ "\n"
+; (gen-enum-decl '@prefix@_virtual
+; "@prefix@ 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)))
+ )
+)
+
+; 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"
+ (string-map (lambda (var)
+ (string-append " "
+ (mode:c-type (mode:lookup (cadr var)))
+ " "
+ (gen-c-symbol (car var))
+ ";\n"))
+ (model:state model)))
+ "} "
+ (if (null? (model:state model)) "BLANK" "@CPU@") "_MODEL_DATA;\n\n"
+ ))
+ (current-model-list))
+ "
+typedef int (@CPU@_MODEL_FN) (struct @cpu@_cpu*, void*);
+
+typedef struct {
+ /* This is an integer that identifies this insn.
+ How this works is up to the target. */
+ int num;
+
+ /* Function to handle insn-specific profiling. */
+ @CPU@_MODEL_FN *model_fn;
+
+ /* Array of function units used by this insn. */
+ UNIT units[MAX_UNITS];
+} @CPU@_INSN_TIMING;"
+ )
+)
+
+; 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"
+ (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 @prefix@_parexec {
+ union {\n"
+ (string-map gen-parallel-exec-elm (current-sfmt-list))
+ "\
+ } operands;
+ /* For conditionally written operands, bitmask of which ones were. */
+ unsigned written;
+};\n\n"
+ )
+)
+
+; Generate the TRACE_RECORD struct definition.
+
+(define (-gen-trace-record-type)
+ (string-list
+ "\
+/* Collection of various things for the trace handler to use. */
+
+typedef struct @prefix@_trace_record {
+ PCADDR pc;
+ /* FIXME:wip */
+} @CPU@_TRACE_RECORD;
+\n"
+ )
+)
+
+; Generate <cpu>-defs.h
+
+(define (cgen-defs.h)
+ (logit 1 "Generating " (gen-cpu-name) " defs.h ...\n")
+ (assert-keep-one)
+
+ ; Turn parallel execution support on if cpu needs it.
+ (set-with-parallel?! (state-parallel-exec?))
+
+ ; Initialize rtl->c generation.
+ (rtl-c-config! #:rtl-cover-fns? #t)
+
+ (string-write
+ (gen-copyright "CPU family header for @cpu@ / @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+#ifndef DEFS_@PREFIX@_H
+#define DEFS_@PREFIX@_H
+
+namespace @cpu@ {
+\n"
+
+ (if (with-parallel?)
+ gen-parallel-exec-type
+ "")
+
+ "\
+} // end @cpu@ namespace
+
+#endif /* DEFS_@PREFIX@_H */\n"
+ )
+)
+\f
+; **************
+; cgen-write.cxx
+
+; 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.
+
+; 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-fns to generate a writer function for <sformat> SFMT.
+
+(define (-gen-write-fn sfmt)
+ (logit 2 "Processing write function for \"" (obj:name sfmt) "\" ...\n")
+ (string-list
+ "\nsem_status\n"
+ (-gen-write-fn-name sfmt) " (@cpu@_cpu* current_cpu, @prefix@_scache* sem, @prefix@_parexec* par_exec)\n"
+ "{\n"
+ (if (with-scache?)
+ (gen-define-field-macro sfmt)
+ "")
+ (gen-define-parallel-operand-macro sfmt)
+ " @prefix@_scache* abuf = sem;\n"
+ " unsigned written = abuf->written;\n"
+ " PCADDR pc = abuf->addr;\n"
+ " PCADDR npc = 0; // dummy value for branches\n"
+ " sem_status status = SEM_STATUS_NORMAL; // ditto\n"
+ "\n"
+ (-gen-write-args sfmt)
+ "\n"
+ " return status;\n"
+ (gen-undef-parallel-operand-macro sfmt)
+ (if (with-scache?)
+ (gen-undef-field-macro sfmt)
+ "")
+ "}\n\n")
+)
+
+(define (-gen-write-fns)
+ (logit 2 "Processing writer functions ...\n")
+ (string-write-map (lambda (sfmt) (-gen-write-fn sfmt))
+ (current-sfmt-list))
+)
+
+
+; Generate <cpu>-write.cxx.
+
+(define (cgen-write.cxx)
+ (logit 1 "Generating " (gen-cpu-name) " write.cxx ...\n")
+ (assert-keep-one)
+
+ (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) ".")
+ copyright-cygnus package-cygnus-simulators)
+ "\
+
+#include \"@cpu@.h\"
+using namespace @cpu@;
+
+"
+ -gen-write-fns
+ )
+)
+\f
+; ******************
+; cgen-semantics.cxx
+
+; 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-c-code
+ (if (insn-compiled-semantics insn)
+ (rtl-c++-parsed VOID (insn-compiled-semantics insn) nil
+ #:rtl-cover-fns? #t
+ #:owner insn)
+ (rtl-c++ VOID (insn-semantics insn) nil
+ #:rtl-cover-fns? #t
+ #:owner insn)))
+ )
+ sem-c-code)
+)
+
+; 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 ((cti? (insn-cti? insn))
+ (insn-len (insn-length-bytes insn)))
+ (string-list
+ "// ********** " (obj:name insn) ": " (insn-syntax insn) "\n\n"
+ (if (with-parallel?)
+ "void\n"
+ "sem_status\n")
+ "@prefix@_sem_" (gen-sym insn)
+ (if (with-parallel?)
+ " (@cpu@_cpu* current_cpu, @prefix@_scache* sem, @prefix@_parexec* par_exec)\n"
+ " (@cpu@_cpu* current_cpu, @prefix@_scache* sem)\n")
+ "{\n"
+ (gen-define-field-macro (insn-sfmt insn))
+ (if (with-parallel?)
+ (gen-define-parallel-operand-macro (insn-sfmt insn))
+ "")
+ " sem_status status = SEM_STATUS_NORMAL;\n"
+ " @prefix@_scache* abuf = sem;\n"
+ ; Unconditionally written operands are not recorded here.
+ (if (or (with-profile?) (with-parallel-write?))
+ " unsigned 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.
+ " PCADDR pc = abuf->addr;\n"
+ " PCADDR npc = 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 (or (with-profile?) (with-parallel-write?))
+ (if (-any-cond-written? (insn-sfmt insn))
+ " abuf->written = written;\n"
+ "")
+ "")
+ (if cti?
+ " current_cpu->done_cti_insn (npc, status);\n"
+ " current_cpu->done_insn (npc, status);\n")
+ (if (with-parallel?)
+ ""
+ " return status;\n")
+ (if (with-parallel?)
+ (gen-undef-parallel-operand-macro (insn-sfmt insn))
+ "")
+ (gen-undef-field-macro (insn-sfmt insn))
+ "}\n\n"
+ ))
+)
+
+(define (-gen-all-semantic-fns)
+ (logit 2 "Processing semantics ...\n")
+ (let ((insns (scache-engine-insns)))
+ (if (with-scache?)
+ (string-write-map -gen-scache-semantic-fn insns)
+ (error "must specify `with-scache'")))
+)
+
+; Generate <cpu>-sem.cxx.
+; Each instruction is implemented in its own function.
+
+(define (cgen-semantics.cxx)
+ (logit 1 "Generating " (gen-cpu-name) " semantics.cxx ...\n")
+ (assert-keep-one)
+
+ (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)
+
+ ; Indicate we're currently not generating a pbb engine.
+ (set-current-pbb-engine?! #f)
+
+ (string-write
+ (gen-copyright "Simulator instruction semantics for @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+
+#include \"@cpu@.h\"
+
+using namespace @cpu@; // FIXME: namespace organization still wip
+
+#define GET_ATTR(name) GET_ATTR_##name ()
+
+\n"
+
+ -gen-all-semantic-fns
+ )
+)
+\f
+; *******************
+; cgen-sem-switch.cxx
+;
+; The semantic switch engine has two flavors: one case per insn, and one
+; case per "frag" (where each insn is split into one or more fragments).
+
+; 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)))
+)
+\f
+; One case per insn version.
+
+; 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.
+ "\
+// ********** " (insn-syntax insn) "
+
+ CASE (INSN_" (if parallel? "PAR_" "") (string-upcase (gen-sym insn)) "):
+ {
+ @prefix@_scache* abuf = vpc;\n"
+ (if (with-scache?)
+ (gen-define-field-macro (insn-sfmt insn))
+ "")
+ (if parallel?
+ (gen-define-parallel-operand-macro (insn-sfmt insn))
+ "")
+ ; Unconditionally written operands are not recorded here.
+ (if (or (with-profile?) (with-parallel-write?))
+ " unsigned 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.
+ " PCADDR pc = abuf->addr;\n"
+ (if (and cti? (not parallel?))
+ (string-append " PCADDR npc;\n"
+ " branch_status br_status = BRANCH_UNTAKEN;\n")
+ "")
+ (string-list " vpc = vpc + 1;\n")
+ ; Emit setup-semantics code for real insns.
+ (if (and (insn-real? insn)
+ (isa-setup-semantics (current-isa)))
+ (string-append
+ " "
+ (rtl-c++ VOID (isa-setup-semantics (current-isa)) nil
+ #:rtl-cover-fns? #t
+ #:owner 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 (or (with-profile?) (with-parallel-write?))
+ (if (-any-cond-written? (insn-sfmt insn))
+ " abuf->written = written;\n"
+ "")
+ "")
+ (if (and cti? (not parallel?))
+ (string-append " pbb_br_npc = npc;\n"
+ " pbb_br_status = br_status;\n")
+ "")
+ (if parallel?
+ (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.
+ (set-with-parallel?! #f)
+ (string-write-map (lambda (insn) (-gen-sem-case insn #f))
+ (non-multi-insns (non-alias-insns (current-insn-list))))
+)
+
+; 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.
+ (set-with-parallel?! #t)
+ (string-write-map (lambda (insn)
+ (string-list (-gen-sem-case insn #t)
+ (-gen-write-case (insn-sfmt insn) insn)))
+ (parallel-insns (current-insn-list)))
+)
+
+; Return computed-goto engine.
+
+(define (-gen-sem-switch-engine)
+ (string-write
+ "\
+void
+@cpu@_cpu::@prefix@_pbb_run ()
+{
+ @cpu@_cpu* current_cpu = this;
+ @prefix@_scache* vpc;
+ // These two are used to pass data from cti insns to the cti-chain insn.
+ PCADDR pbb_br_npc;
+ branch_status pbb_br_status;
+
+#ifdef __GNUC__
+{
+ static const struct sem_labels
+ {
+ enum @prefix@_insn_type insn;
+ void *label;
+ }
+ labels[] =
+ {\n"
+
+ (lambda ()
+ (string-write-map (lambda (insn)
+ (string-append " { "
+ "@PREFIX@_INSN_"
+ (string-upcase (gen-sym insn))
+ ", && case_INSN_"
+ (string-upcase (gen-sym insn))
+ " },\n"))
+ (non-multi-insns (non-alias-insns (current-insn-list)))))
+
+ (if (state-parallel-exec?)
+ (lambda ()
+ (string-write-map (lambda (insn)
+ (string-append " { "
+ "@PREFIX@_INSN_PAR_"
+ (string-upcase (gen-sym insn))
+ ", && case_INSN_PAR_"
+ (string-upcase (gen-sym insn))
+ " },\n"
+ " { "
+ "@PREFIX@_INSN_WRITE_"
+ (string-upcase (gen-sym insn))
+ ", && case_INSN_WRITE_"
+ (string-upcase (gen-sym insn))
+ " },\n"))
+ (parallel-insns (current-insn-list))))
+ "")
+
+ " { (@prefix@_insn_type) 0, 0 }
+ };
+
+ if (! @prefix@_idesc::idesc_table_initialized_p)
+ {
+ for (int i=0; labels[i].label != 0; i++)
+ @prefix@_idesc::idesc_table[labels[i].insn].cgoto.label = labels[i].label;
+
+ // confirm that table is all filled up
+ for (int i=0; i<@PREFIX@_INSN_MAX; i++)
+ assert (@prefix@_idesc::idesc_table[i].cgoto.label != 0);
+
+ // Initialize the compiler virtual insn.
+ current_cpu->@prefix@_engine.compile_begin_insn (current_cpu);
+
+ @prefix@_idesc::idesc_table_initialized_p = true;
+ }
+}
+#endif
+
+#ifdef __GNUC__
+#define CASE(X) case_##X
+// Branch to next handler without going around main loop.
+#define NEXT(vpc) goto * vpc->execute.cgoto.label;
+// Break out of threaded interpreter and return to \"main loop\".
+#define BREAK(vpc) goto end_switch
+#else
+#define CASE(X) case @PREFIX@_##X
+#define NEXT(vpc) goto restart
+#define BREAK(vpc) break
+#endif
+
+ // Get next insn to execute.
+ vpc = current_cpu->@prefix@_engine.get_next_vpc (current_cpu->h_pc_get ());
+
+restart:
+#ifdef __GNUC__
+ goto * vpc->execute.cgoto.label;
+#else
+ switch (vpc->idesc->sem_index)
+#endif
+
+ {
+"
+
+ -gen-sem-switch
+
+ (if (state-parallel-exec?)
+ -gen-parallel-sem-switch
+ "")
+
+"
+#ifdef __GNUC__
+ end_switch: ;
+#else
+ default: abort();
+#endif
+ }
+
+ // Save vpc for next time.
+ current_cpu->@prefix@_engine.set_next_vpc (vpc);
+}
+\n"
+ )
+)
+\f
+; Semantic frag version.
+
+; Return declaration of frag enum.
+
+(define (-gen-sfrag-enum-decl frag-list)
+ (gen-enum-decl "@prefix@_frag_type"
+ "semantic fragments in cpu family @prefix@"
+ "@PREFIX@_FRAG_"
+ (append '((list-end))
+ (map (lambda (i)
+ (cons (obj:name i)
+ (cons '-
+ (atlist-attrs (obj-atlist i)))))
+ frag-list)
+ '((max))))
+)
+
+; Return header file decls for semantic frag threaded engine.
+
+(define (-gen-sfrag-engine-decls)
+ (string-write
+ "namespace @cpu@ {\n\n"
+
+ ; FIXME: vector->list
+ (-gen-sfrag-enum-decl (vector->list (sim-sfrag-frag-table)))
+
+ "\
+struct @prefix@_insn_frag {
+ @PREFIX@_INSN_TYPE itype;
+ // 4: header+middle+trailer+delimiter
+ @PREFIX@_FRAG_TYPE ftype[4];
+};
+
+struct @prefix@_pbb_label {
+ @PREFIX@_FRAG_TYPE frag;
+ void *label;
+};
+
+} // end @cpu@ namespace
+\n")
+)
+
+; Return C code to perform the semantics of FRAG.
+; LOCALS is a list of sequence locals made global to all frags.
+; Each element is (symbol <mode> "c-var-name").
+
+(define (-gen-sfrag-code frag locals)
+ ; Indicate generating code for FRAG.
+ ; Use the compiled form if available.
+ ; The case when they're not available is for virtual insns.
+ (let ((sem (sfrag-compiled-semantics frag))
+ ; If the frag has one owner, use it. Otherwise indicate the owner is
+ ; unknown. In cases where the owner is needed by the semantics, the
+ ; frag should have only one owner.
+ (owner (if (= (length (sfrag-users frag)) 1)
+ (car (sfrag-users frag))
+ #f))
+ )
+ (if sem
+ (rtl-c++-parsed VOID sem locals
+ #:rtl-cover-fns? #t
+ #:owner owner)
+ (rtl-c++ VOID (sfrag-semantics frag) locals
+ #:rtl-cover-fns? #t
+ #:owner owner)))
+)
+
+; Generate a switch case to perform FRAG.
+; LOCALS is a list of sequence locals made global to all frags.
+; Each element is (symbol <mode> "c-var-name").
+
+(define (-gen-sfrag-case frag locals)
+ (set! -with-profile? -with-profile-sw?)
+ (let ((cti? (sfmt-cti? (sfrag-sfmt frag)))
+ (parallel? (sfrag-parallel? frag)))
+ (logit 2 "Processing "
+ (if parallel? "parallel " "")
+ "semantic switch case for \"" (obj:name frag) "\" ...\n")
+ (string-list
+ ; FRAG_ is prepended here and not elsewhere to avoid name collisions
+ ; with symbols like AND, etc.
+ "\
+// ********** "
+ (if (= (length (sfrag-users frag)) 1)
+ "used only by:"
+ "used by:")
+ (string-drop1
+ (string-map (lambda (user)
+ (string-append ", " (obj:name user)))
+ (sfrag-users frag)))
+ "
+
+ CASE (FRAG_" (string-upcase (gen-sym frag)) "):
+ {\n"
+ (if (sfrag-header? frag)
+ (string-append " abuf = vpc;\n"
+ " vpc = vpc + 1;\n")
+ "")
+ (gen-define-field-macro (sfrag-sfmt frag))
+ (if parallel?
+ (gen-define-parallel-operand-macro (sfrag-sfmt frag))
+ "")
+ ; Unconditionally written operands are not recorded here.
+ (if (or (with-profile?) (with-parallel-write?))
+ " unsigned 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.
+ " PCADDR pc = abuf->addr;\n"
+ (if (and cti?
+ (not parallel?)
+ (sfrag-header? frag))
+ (string-append ; " npc = 0;\n" ??? needed?
+ " br_status = BRANCH_UNTAKEN;\n")
+ "")
+ ; Emit setup-semantics code for headers of real insns.
+ (if (and (sfrag-header? frag)
+ (not (obj-has-attr? frag 'VIRTUAL))
+ (isa-setup-semantics (current-isa)))
+ (string-append
+ " "
+ (rtl-c++ VOID (isa-setup-semantics (current-isa)) nil
+ #:rtl-cover-fns? #t
+ #:owner #f))
+ "")
+ "\n"
+ (-gen-sfrag-code frag locals)
+ "\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 (or (with-profile?) (with-parallel-write?))
+ (if (-any-cond-written? (sfrag-sfmt frag))
+ " abuf->written = written;\n"
+ "")
+ "")
+ (if (and cti?
+ (not parallel?)
+ (sfrag-trailer? frag))
+ (string-append " pbb_br_npc = npc;\n"
+ " pbb_br_status = br_status;\n")
+ "")
+ (if parallel?
+ (gen-undef-parallel-operand-macro (sfrag-sfmt frag))
+ "")
+ (gen-undef-field-macro (sfrag-sfmt frag))
+ " }\n"
+ (if (sfrag-trailer? frag)
+ " NEXT_INSN (vpc, fragpc);\n"
+ " NEXT_FRAG (fragpc);\n")
+ "\n"
+ ))
+)
+
+; Convert locals from form computed by sem-find-common-frags to that needed by
+; -gen-sfrag-engine-code (and ultimately rtl-c++).
+
+(define (-frag-convert-c-locals locals)
+ (map (lambda (local)
+ (list (car local) (mode:lookup (cadr local))
+ (gen-c-symbol (car local))))
+ locals)
+)
+
+; Return definition of insn frag usage table.
+
+(define (-gen-sfrag-engine-frag-table insn-list frag-table frag-usage)
+ (string-write
+ "\
+// Table of frags used by each insn.
+
+const @prefix@_insn_frag @prefix@_frag_usage[] = {\n"
+
+ (lambda ()
+ (for-each (lambda (insn frag-nums)
+ (string-write " { "
+ "@PREFIX@_INSN_"
+ (string-upcase (gen-sym insn))
+ (string-map (lambda (frag-num)
+ (string-append ", @PREFIX@_FRAG_"
+ (string-upcase (gen-sym (vector-ref frag-table frag-num)))))
+ frag-nums)
+ ", @PREFIX@_FRAG_LIST_END },\n"))
+ insn-list frag-usage)
+ "")
+
+ "\
+ { @PREFIX@_INSN_MAX }
+};
+\n"
+ )
+)
+
+; Return sfrag computed-goto engine.
+; LOCALS is a list of sequence locals made global to all frags.
+; Each element is (symbol <mode> "c-var-name").
+
+(define (-gen-sfrag-engine-fn frag-table locals)
+ (string-write
+ "\
+void
+@cpu@_cpu::@prefix@_pbb_run ()
+{
+ @cpu@_cpu* current_cpu = this;
+ @prefix@_scache* vpc;
+ @prefix@_scache* abuf;
+#ifdef __GNUC__
+ void** fragpc;
+#else
+ ARM_FRAG_TYPE* fragpc;
+#endif
+
+#ifdef __GNUC__
+{
+ static const @prefix@_pbb_label labels[] =
+ {
+ { @PREFIX@_FRAG_LIST_END, 0 },
+"
+
+ (lambda ()
+ (string-write-map (lambda (frag)
+ (string-append " { "
+ "@PREFIX@_FRAG_"
+ (string-upcase (gen-sym frag))
+ ", && case_FRAG_"
+ (string-upcase (gen-sym frag))
+ " },\n"))
+ ; FIXME: vector->list
+ (vector->list frag-table)))
+
+ "\
+ { @PREFIX@_FRAG_MAX, 0 }
+ };
+
+ if (! @prefix@_idesc::idesc_table_initialized_p)
+ {
+ // Several tables are in play here:
+ // idesc table: const table of misc things for each insn
+ // frag usage table: const set of frags used by each insn
+ // frag label table: same as frag usage table, but contains labels
+ // selected insn frag table: table of pointers to either the frag usage
+ // table (if !gnuc) or frag label table (if gnuc) for the currently
+ // selected ISA. Insns not in the ISA are redirected to the `invalid'
+ // insn handler. FIXME: This one isn't implemented yet.
+
+ // Allocate frag label table and point idesc table entries at it.
+ // FIXME: Temporary hack, to be redone.
+ static void** frag_label_table;
+ frag_label_table = new (void*) [@PREFIX@_INSN_MAX * 4];
+ memset (frag_label_table, 0, sizeof (void*) * @PREFIX@_INSN_MAX * 4);
+ int i;
+ void** v;
+ for (i = 0, v = frag_label_table; i < @PREFIX@_INSN_MAX; ++i)
+ {
+ @prefix@_idesc::idesc_table[@prefix@_frag_usage[i].itype].cgoto.frags = v;
+ for (int j = 0; @prefix@_frag_usage[i].ftype[j] != @PREFIX@_FRAG_LIST_END; ++j)
+ *v++ = labels[@prefix@_frag_usage[i].ftype[j]].label;
+ }
+
+ // Record frags used by each insn.
+ //for (int i = 0; @prefix@_frag_usage[i].itype != @PREFIX@_INSN_MAX; ++i)
+ // @prefix@_idesc::idesc_table[@prefix@_frag_usage[i].itype].frags = & @prefix@_frag_usage[i];
+
+ // Initialize the compiler virtual insn.
+ // FIXME: Also needed if !gnuc.
+ current_cpu->@prefix@_engine.compile_begin_insn (current_cpu);
+
+ @prefix@_idesc::idesc_table_initialized_p = true;
+ }
+}
+#endif
+
+#ifdef __GNUC__
+#define CASE(X) case_##X
+// Branch to next handler without going around main loop.
+#define NEXT_INSN(vpc, fragpc) fragpc = vpc->execute.cgoto.frags; goto * *fragpc
+#define NEXT_FRAG(fragpc) ++fragpc; goto * *fragpc
+// Break out of threaded interpreter and return to \"main loop\".
+#define BREAK(vpc) goto end_switch
+#else
+#define CASE(X) case @PREFIX@_##X
+#define NEXT_INSN(vpc, fragpc) fragpc = vpc->idesc->frags; goto restart
+#define NEXT_FRAG(fragpc) ++fragpc; goto restart
+#define BREAK(vpc) break
+#endif
+
+ // Get next insn to execute.
+ vpc = current_cpu->@prefix@_engine.get_next_vpc (current_cpu->h_pc_get ());
+
+ {
+ // These two are used to pass data from cti insns to the cti-chain insn.
+ PCADDR pbb_br_npc;
+ branch_status pbb_br_status;
+ // These two are used to build up values of the previous two.
+ PCADDR npc;
+ branch_status br_status;
+ // Top level locals moved here so they're usable by multiple fragments.
+"
+
+ (lambda ()
+ (string-write-map (lambda (local)
+ (string-append " "
+ (mode:c-type (cadr local))
+ " "
+ (caddr local)
+ ";\n"))
+ locals))
+
+ "\
+
+restart:
+#ifdef __GNUC__
+ fragpc = vpc->execute.cgoto.frags;
+ goto * *fragpc;
+#else
+ fragpc = vpc->idesc->frags;
+ switch (*fragpc)
+#endif
+
+ {
+
+"
+
+ (lambda ()
+ ; Turn parallel execution support off.
+ ; ??? Still needed?
+ (set-with-parallel?! #f)
+ (string-write-map (lambda (frag)
+ (-gen-sfrag-case frag locals))
+ ; FIXME: vector->list
+ (vector->list frag-table)))
+
+ "
+#ifdef __GNUC__
+ end_switch: ;
+#else
+ default: abort ();
+#endif
+ }
+ }
+
+ // Save vpc for next time.
+ current_cpu->@prefix@_engine.set_next_vpc (vpc);
+}
+\n")
+)
+
+(define (-gen-sfrag-engine)
+ (string-write
+ (lambda ()
+ (-gen-sfrag-engine-frag-table (sim-sfrag-insn-list)
+ (sim-sfrag-frag-table)
+ (sim-sfrag-usage-table)))
+ (lambda ()
+ (-gen-sfrag-engine-fn (sim-sfrag-frag-table)
+ (-frag-convert-c-locals (sim-sfrag-locals-list))))
+ )
+)
+\f
+; Generate sem-switch.cxx.
+
+(define (cgen-sem-switch.cxx)
+ (logit 1 "Generating " (gen-cpu-name) " sem-switch.cxx ...\n")
+
+ (sim-analyze-insns!)
+ (if (with-sem-frags?)
+ (sim-sfrag-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)
+
+ ; Indicate we're currently generating a pbb engine.
+ (set-current-pbb-engine?! #t)
+
+ (string-write
+ (gen-copyright "Simulator instruction semantics for @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+
+#include \"@cpu@.h\"
+
+using namespace @cpu@; // FIXME: namespace organization still wip
+
+#define GET_ATTR(name) GET_ATTR_##name ()
+
+\n"
+
+ (if (with-sem-frags?)
+ -gen-sfrag-engine-decls
+ "")
+
+ (if (with-sem-frags?)
+ -gen-sfrag-engine
+ -gen-sem-switch-engine)
+ )
+)
--- /dev/null
+; Decoder generation.
+; Copyright (C) 2000 Red Hat, Inc.
+; This file is part of CGEN.
+
+; 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")
+
+ (let* ((all-attrs (current-insn-attr-list)))
+
+ (string-write
+ "
+// The instruction descriptor array.
+\n"
+
+ (if (with-pbb?)
+ "\
+// Have label pointers been initialized?
+// XXX: Note that this is also needed by when semantics are implemented as
+// functions to handle machine variants.
+bool @prefix@_idesc::idesc_table_initialized_p = false;\n\n"
+ "")
+
+ "\
+@prefix@_idesc @prefix@_idesc::idesc_table[@PREFIX@_INSN_MAX] =
+{\n"
+
+ (string-map
+ (lambda (insn)
+ (let ((name (gen-sym insn))
+ (sfmt (insn-sfmt insn))
+ (pbb? (obj-has-attr? insn 'PBB))
+ (virtual? (obj-has-attr? insn 'VIRTUAL)))
+ (string-append
+ " { "
+ (if (with-pbb?)
+ "0, "
+ "")
+ (if (with-scache?)
+ (if pbb?
+ "0, "
+ (string-append (-gen-sem-fn-name insn) ", "))
+ "")
+ (if (with-parallel?)
+ (string-append (-gen-write-fn-name sfmt) ", ")
+ "")
+ "\"" (string-upcase name) "\", "
+ (gen-cpu-insn-enum (current-cpu) insn)
+ ", "
+ (gen-obj-attr-sid-defn 'insn insn all-attrs)
+ " },\n")))
+ insn-list)
+
+ "\n};\n\n"
+ ))
+)
+
+; Return a function that lookups up virtual insns.
+
+(define (-gen-virtual-insn-finder)
+ (string-list
+ "\
+// Given a canonical virtual insn id, return the target specific one.
+
+@prefix@_insn_type
+@prefix@_idesc::lookup_virtual (virtual_insn_type vit)
+{
+ switch (vit)
+ {
+ case VIRTUAL_INSN_INVALID: return @PREFIX@_INSN_X_INVALID;
+"
+
+ (if (with-pbb?)
+ "\
+ case VIRTUAL_INSN_BEGIN: return @PREFIX@_INSN_X_BEGIN;
+ case VIRTUAL_INSN_CHAIN: return @PREFIX@_INSN_X_CHAIN;
+ case VIRTUAL_INSN_CTI_CHAIN: return @PREFIX@_INSN_X_CTI_CHAIN;
+ case VIRTUAL_INSN_BEFORE: return @PREFIX@_INSN_X_BEFORE;
+ case VIRTUAL_INSN_AFTER: return @PREFIX@_INSN_X_AFTER;
+"
+ "")
+ (if (and (with-pbb?)
+ (state-conditional-exec?))
+ "\
+ case VIRTUAL_INSN_COND: return @PREFIX@_INSN_X_COND;
+"
+ ; Unused, but may still be requested. Just return X_INVALID.
+ "\
+ case VIRTUAL_INSN_COND: return @PREFIX@_INSN_X_INVALID;
+")
+ "\
+ }
+ abort ();
+}\n\n"
+ )
+)
+\f
+; Return enum name of format FMT.
+
+(define (-gen-fmt-enum fmt)
+ (string-upcase (gen-sym fmt))
+)
+
+; Return names of semantic fns for INSN.
+; ??? Make global, call from gen-semantic-fn, blah blah blah.
+
+(define (-gen-sem-fn-name insn)
+ (string-append "@prefix@_sem_" (gen-sym insn))
+)
+
+; Return decls of each semantic fn.
+
+(define (-gen-sem-fn-decls)
+ (string-write
+ "// Decls of each semantic fn.\n\n"
+ "using @cpu@::@prefix@_sem_fn;\n"
+ (string-list-map (lambda (insn)
+ (string-list "extern @prefix@_sem_fn "
+ (-gen-sem-fn-name insn)
+ ";\n"))
+ (scache-engine-insns))
+ "\n"
+ )
+)
+
+
+;; and the same for writeback functions
+
+(define (-gen-write-fn-name sfmt)
+ (string-append "@prefix@_write_" (gen-sym sfmt))
+)
+
+
+(define (-gen-write-fn-decls)
+ (string-write
+ "// Decls of each writeback fn.\n\n"
+ "using @cpu@::@prefix@_write_fn;\n"
+ (string-list-map (lambda (sfmt)
+ (string-list "extern @prefix@_write_fn "
+ (-gen-write-fn-name sfmt)
+ ";\n"))
+ (current-sfmt-list))
+ "\n"
+ )
+)
+
+\f
+; idesc, argbuf, and scache types
+
+; Generate decls for the insn descriptor table type IDESC.
+
+(define (-gen-idesc-decls)
+ (string-append
+ "
+// Forward decls.
+struct @cpu@_cpu;
+struct @prefix@_scache;
+"
+ (if (with-parallel?)
+ "struct @prefix@_parexec;\n" "")
+ (if (with-parallel?)
+ "typedef void (@prefix@_sem_fn) (@cpu@_cpu* cpu, @prefix@_scache* sem, @prefix@_parexec* par_exec);"
+ "typedef sem_status (@prefix@_sem_fn) (@cpu@_cpu* cpu, @prefix@_scache* sem);")
+ "\n"
+ (if (with-parallel?)
+ "typedef sem_status (@prefix@_write_fn) (@cpu@_cpu* cpu, @prefix@_scache* sem, @prefix@_parexec* par_exec);"
+ "")
+ "\n"
+"
+// Instruction descriptor.
+
+struct @prefix@_idesc {
+\n"
+
+ (if (with-pbb?)
+ "\
+ // computed-goto label pointer (pbb engine)
+ // FIXME: frag case to be redone (should instead point to usage table).
+ cgoto_label cgoto;\n\n"
+ "")
+
+ (if (with-scache?)
+ "\
+ // scache engine executor for this insn
+ @prefix@_sem_fn* execute;\n\n"
+ "")
+
+ (if (with-parallel?)
+ "\
+ // scache write executor for this insn
+ @prefix@_write_fn* writeback;\n\n"
+ "")
+
+ "\
+ const char* insn_name;
+ enum @prefix@_insn_type sem_index;
+ @arch@_insn_attr attrs;
+
+ // idesc table: indexed by sem_index
+ static @prefix@_idesc idesc_table[];
+"
+
+ (if (with-pbb?)
+ "\
+
+ // semantic label pointers filled_in?
+ static bool idesc_table_initialized_p;\n"
+ "")
+
+ "\
+
+ static @prefix@_insn_type lookup_virtual (virtual_insn_type vit);
+};
+
+")
+)
+
+; 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-scache-decls to generate the union of extracted ifields.
+
+(define (-gen-argbuf-fields-union)
+ (string-list
+ "\
+// Instruction argument buffer.
+
+union @prefix@_sem_fields {\n"
+ (string-list-map -gen-argbuf-elm (current-sbuf-list))
+ "\
+ // This one is for chain/cti-chain virtual insns.
+ struct {
+ // Number of insns in pbb.
+ unsigned insn_count;
+ // This is used by chain insns and by untaken conditional branches.
+ @prefix@_scache* next;
+ @prefix@_scache* branch_target;
+ } chain;
+ // This one is for `before' virtual insns.
+ struct {
+ // The cache entry of the real insn.
+ @prefix@_scache* insn;
+ } before;
+};\n\n"
+ )
+)
+
+(define (-gen-scache-decls)
+ (string-list
+ (-gen-argbuf-fields-union)
+ "\
+// Simulator instruction cache.
+
+struct @prefix@_scache {
+ // executor
+ union {
+ cgoto_label cgoto;
+ @prefix@_sem_fn* fn;
+ } execute;
+\n"
+
+ (if (state-conditional-exec?)
+ "\
+ // condition
+ UINT cond;
+\n"
+ "")
+
+ "\
+ // PC of this instruction.
+ PCADDR addr;
+
+ // instruction class
+ @prefix@_idesc* idesc;
+
+ // argument buffer
+ @prefix@_sem_fields fields;
+
+ // writeback flags
+ // Only used if profiling or parallel execution support enabled during
+ // file generation.
+ unsigned written;
+
+ // decode given instruction
+ void decode (@cpu@_cpu* current_cpu, PCADDR pc, @prefix@_insn_word base_insn, @prefix@_insn_word entire_insn);
+};
+
+")
+)
+\f
+; 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))
+)
+\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 (hw-isas self) (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))))
+)
+\f
+; 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)))
+ (logit 3 "sfmt = " (obj:name sfmt) " operands=" (string-map obj:name operands))
+ (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))
+)
+\f
+; 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)
+ " if (current_cpu->trace_extract_p)\n"
+ " {\n"
+ " current_cpu->trace_stream \n"
+ " << \"0x\" << hex << pc << dec << \" (" (gen-sym sfmt) ")\\t\"\n"
+ ; NB: The following is not necessary any more, as the ifield list
+ ; is a subset of the operand list.
+ ; (string-list-map (lambda (f)
+ ; (string-list
+ ; " << \" " (gen-sym f) ":0x\" << hex << " (gen-sym f) " << dec\n"))
+ ; iflds)
+ (string-list-map (lambda (ifld)
+ (string-list
+ " << \" " (gen-extracted-ifld-value ifld) ":0x\" << hex << "
+ ; Add (SI) or (USI) cast for byte-wide data, to prevent C++ iostreams
+ ; from printing byte as plain raw char.
+ (cond ((not ifld) "")
+ ((mode:eq? 'QI (ifld-decode-mode ifld)) "(SI) ")
+ ((mode:eq? 'UQI (ifld-decode-mode ifld)) "(USI) ")
+ (else ""))
+ (gen-extracted-ifld-value ifld)
+ " << dec\n"))
+ iflds)
+ " << endl;\n"
+ " }\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-fn sfmt)
+ (logit 2 "Processing extractor for \"" (sfmt-key sfmt) "\" ...\n")
+ (string-list
+ "void
+@prefix@_extract_" (gen-sym sfmt) " (@prefix@_scache* abuf, @cpu@_cpu* current_cpu, PCADDR pc, @prefix@_insn_word base_insn, @prefix@_insn_word entire_insn)"
+ "{\n"
+ " @prefix@_insn_word 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) ??? not supported yet
+ (gen-undef-field-macro sfmt)
+ "}\n\n"
+ )
+)
+
+; For each format, return its extraction function.
+
+(define (-define-all-extractor-fns)
+ (logit 2 "Processing extractor fn bodies ...\n")
+ (string-list-map -gen-extract-fn (current-sfmt-list))
+)
+
+(define (-declare-all-extractor-fns)
+ (logit 2 "Processing extractor fn declarations ...\n")
+ (string-map (lambda (sfmt)
+ (string-append "
+static void
+@prefix@_extract_" (gen-sym sfmt) " (@prefix@_scache* abuf, @cpu@_cpu* current_cpu, PCADDR pc, @prefix@_insn_word base_insn, @prefix@_insn_word entire_insn);"))
+ (current-sfmt-list))
+)
+
+\f
+; 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?)
+ (assert (with-scache?))
+
+ ; Compute the initial DECODE-BITSIZE as the minimum of all insn lengths.
+ ; The caller of @prefix@_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)
+ #t)))
+
+ (string-write
+ "
+// Declare extractor functions
+"
+ -declare-all-extractor-fns
+
+ "
+
+// Fetch & decode instruction
+void
+@prefix@_scache::decode (@cpu@_cpu* current_cpu, PCADDR pc, @prefix@_insn_word base_insn, @prefix@_insn_word entire_insn)
+{
+ /* Result of decoder. */
+ @PREFIX@_INSN_TYPE itype;
+
+ {
+ @prefix@_insn_word insn = base_insn;
+\n"
+ decode-code
+ "
+ }
+
+ /* The instruction has been decoded and fields extracted. */
+ done:
+"
+ (if (state-conditional-exec?)
+ (let ((cond-ifld (current-ifld-lookup (car (isa-condition (current-isa))))))
+ (string-append
+ " {\n"
+ (gen-ifld-extract-decl cond-ifld " " #f)
+ (gen-ifld-extract cond-ifld " "
+ (state-base-insn-bitsize)
+ (state-base-insn-bitsize)
+ "base_insn" nil #f)
+ " this->cond = " (gen-sym cond-ifld) ";\n"
+ " }\n"))
+ "")
+
+ "
+ this->addr = pc;
+ // FIXME: To be redone (to handle ISA variants).
+ this->idesc = & @prefix@_idesc::idesc_table[itype];
+ // ??? record semantic handler?
+ assert(this->idesc->sem_index == itype);
+}
+
+"
+
+ -define-all-extractor-fns
+ )))
+)
+\f
+; 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 @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+#ifndef @PREFIX@_DECODE_H
+#define @PREFIX@_DECODE_H
+
+namespace @cpu@ {
+
+using namespace cgen;
+using namespace @arch@;
+
+typedef UINT @prefix@_insn_word;
+
+"
+ (lambda () (gen-cpu-insn-enum-decl (current-cpu)
+ (non-multi-insns (non-alias-insns (current-insn-list)))))
+ -gen-idesc-decls
+ -gen-scache-decls
+
+ "\
+} // end @cpu@ namespace
+\n"
+
+ ; ??? The semantic functions could go in the cpu's namespace.
+ ; There's no pressing need for it though.
+ (if (with-scache?)
+ -gen-sem-fn-decls
+ "")
+
+ (if (with-parallel?)
+ -gen-write-fn-decls
+ "")
+
+ "\
+#endif /* @PREFIX@_DECODE_H */\n"
+ )
+)
+\f
+; Entry point. Generate decode.cxx.
+
+(define (cgen-decode.cxx)
+ (logit 1 "Generating " (gen-cpu-name) " decode.cxx ...\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 @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+
+#include \"@cpu@.h\"
+
+using namespace @cpu@; // FIXME: namespace organization still wip
+\n"
+
+ (lambda () (-gen-decode-insn-globals (non-multi-insns (non-alias-insns (current-insn-list)))))
+ -gen-virtual-insn-finder
+ (lambda () (-gen-decode-fn (non-multi-insns (real-insns (current-insn-list)))
+ (state-decode-assist)
+ (current-arch-insn-lsb0?)))
+ )
+)
--- /dev/null
+; 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 (@cpu@_cpu),
+#if WITH_SCACHE
+ sizeof (SCACHE)
+#else
+ 0
+#endif
+};\n\n"
+ )
+)
+\f
+; 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 @prefix@_model_mark_get_"
+ (gen-sym hw) " (@cpu@_cpu *"
+ (if (hw-scalar? hw)
+ ""
+ ", int") ; FIXME: get index type
+ ");\n"
+ "extern void @prefix@_model_mark_set_"
+ (gen-sym hw) " (@cpu@_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 "@prefix@_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)
+ " (@cpu@_cpu *, const struct @prefix@_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 @prefix@_model_insn_before (@cpu@_cpu *, int /*first_p*/);\n"
+ "extern void @prefix@_model_insn_after (@cpu@_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")
+ (let ((sfmt (insn-sfmt insn)))
+ (string-list
+ "static int\n"
+ (-gen-model-insn-fn-name model insn)
+ " (@cpu@_cpu *current_cpu, @prefix@_scache *sem_arg)\n"
+ "{\n"
+ (if (with-scache?)
+ (gen-define-field-macro sfmt)
+ "")
+ " const @prefix@_argbuf * UNUSED abuf = sem_arg->argbuf;\n"
+ " const @prefix@_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
+ " PCADDR UNUSED pc = current_cpu->hardware.h_pc;\n"
+ " @prefix@_insn_word insn = abuf->insn;\n"
+ (gen-define-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f)
+ (gen-sfmt-argvars-defns sfmt)
+ (gen-extract-ifields (sfmt-iflds sfmt) (sfmt-length sfmt) " " #f)
+ (gen-sfmt-argvars-assigns sfmt)))
+ ; 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 sfmt)
+ "")
+ "}\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))
+ (non-multi-insns (real-insns (current-insn-list)))))
+ (current-model-list)))
+ )
+)
+\f
+; 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 @PREFIX@_INSN_TIMING " (gen-sym model) "_timing[] = {\n"
+ (lambda () (string-write-map (lambda (insn) (-gen-insn-timing model insn))
+ (non-multi-insns (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 (@cpu@_cpu *cpu)
+{
+ cpu->model_data = new @PREFIX@_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)
+ ""
+)
+
+; 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 (@cpu@_cpu *cpu)
+{
+ @prefix@_init_idesc_table (cpu);
+}
+
+const MACH " (gen-sym mach) "_mach =
+{
+ \"" (obj:name mach) "\", "
+ "\"" (mach-bfd-name mach) "\",
+ " (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
+};
+
+")))
+
+ (current-mach-list))
+)
+\f
+; Top level file generators.
+
+; Generate model.cxx
+
+(define (cgen-model.cxx)
+ (logit 1 "Generating " (gen-cpu-name) " model.cxx ...\n")
+ (assert-keep-one)
+
+ ; Turn parallel execution support on if cpu needs it.
+ (set-with-parallel?! (state-parallel-exec?))
+
+ (string-write
+ (gen-copyright "Simulator model support for @prefix@."
+ copyright-cygnus package-cygnus-simulators)
+ "\
+
+#include \"@arch@-main.h\"
+
+using namespace @cpu@; // FIXME: namespace organization still wip
+
+/* 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
+ )
+)
--- /dev/null
+; 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)
+
+; Misc. state info.
+
+; Currently supported options:
+; with-scache
+; generate code to use the scache engine
+; with-pbb
+; generate code to use the pbb engine
+; with-sem-frags
+; generate semantic fragment engine (requires with-pbb)
+; with-profile fn|sw
+; generate code to do profiling in the semantic function
+; code (fn) or in the semantic switch (sw)
+; with-multiple-isa
+; enable multiple-isa support (e.g. arm+thumb)
+; ??? wip.
+; 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?))
+
+; #t if multiple isa support is enabled
+(define -with-multiple-isa? #f)
+(define (with-multiple-isa?) -with-multiple-isa?)
+
+; #t if semantics are generated as pbb computed-goto engine
+(define -with-pbb? #f)
+(define (with-pbb?) -with-pbb?)
+
+; #t if the semantic fragment engine is to be used.
+; This involves combining common fragments of each insn into one.
+(define -with-sem-frags? #f)
+(define (with-sem-frags?) -with-sem-frags?)
+
+; 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-pbb? #f)
+ (set! -with-sem-frags? #f)
+ (set! -with-profile-fn? #f)
+ (set! -with-profile-sw? #f)
+ (set! -with-multiple-isa? #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-pbb) (set! -with-pbb? #t))
+ ((with-sem-frags) (set! -with-sem-frags? #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-multiple-isa) (set! -with-multiple-isa? #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 we're currently generating a pbb engine.
+(define -current-pbb-engine? #f)
+(define (current-pbb-engine?) -current-pbb-engine?)
+(define (set-current-pbb-engine?! flag) (set! -current-pbb-engine? flag))
+
+; #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))
+)
+\f
+; 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))
+)
+\f
+; Misc. utilities.
+
+; Return reference to hardware element SYM.
+; ISAS is a list of <isa> objects.
+; The idea is that in multiple isa architectures (e.g. arm) the elements
+; common to all isas are kept in one class and the elements specific to each
+; isa are kept in separate classes.
+
+(define (gen-cpu-ref isas sym)
+ (if (and (with-multiple-isa?)
+ (= (length isas) 1))
+ (string-append "current_cpu->@cpu@_hardware." sym)
+ (string-append "current_cpu->hardware." sym))
+)
+\f
+; Attribute support.
+
+; Return the C++ type to use to hold a value for attribute ATTR.
+
+(define (gen-attr-type attr)
+ (case (attr-kind attr)
+ ((boolean) "int")
+ ((bitset) "unsigned int")
+ ((integer) "int")
+ ((enum) (string-append "enum " (string-downcase (gen-sym attr)) "_attr"))
+ )
+)
+
+; 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 "current_cpu->GETIMEM"
+ (case bitsize
+ ((8) "UQI")
+ ((16) "UHI")
+ ((32) "USI")
+ (else (error "bad bitsize argument to gen-ifetch" bitsize)))
+ " (pc, "
+ pc-var " + " (number->string (quotient bitoffset 8))
+ ")")
+)
+
+; Return definition of an object's attributes.
+; This is like gen-obj-attr-defn, except split for sid.
+; TYPE is one of 'ifld, 'hw, 'operand, 'insn.
+; [Only 'insn is currently needed.]
+; 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.
+
+(define (gen-obj-attr-sid-defn type obj all-attrs)
+ (let* ((attrs (obj-atlist obj))
+ (non-bools (attr-non-bool-attrs (atlist-attrs attrs)))
+ (all-non-bools (list-take (attr-count-non-bools all-attrs) all-attrs))
+ )
+ (string-append
+ "{ "
+ (gen-bool-attrs attrs gen-attr-mask)
+ ","
+ (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)))
+ " }"))
+)
+\f
+; 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)))
+)
+\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-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")
+ )
+)
+
+; 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) ""))
+\f
+; 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-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)))
+)
+\f
+; 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))
+ ((current-pbb-engine?)
+ (string-append "npc = " (cx:c newval) ";"
+ (if (obj-has-attr? newval 'CACHED)
+ " br_status = BRANCH_CACHEABLE;"
+ " br_status = BRANCH_UNCACHEABLE;")
+ (if (assq #:delay (estate-modifiers estate))
+ (string-append " current_cpu->delay_slot_p = true;"
+ " current_cpu->delayed_branch_address = npc;\n")
+ "\n")
+ ))
+ ((assq #:delay (estate-modifiers estate))
+ (string-append "current_cpu->delayed_branch (" (cx:c newval) ", npc, status);\n"))
+ (else
+ (string-append "current_cpu->branch (" (cx:c newval) ", npc, status);\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 VOID (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"
+ (if (current-pbb-engine?)
+ (string-append " vpc = current_cpu->skip (vpc);\n")
+ (string-append " npc = current_cpu->skip (pc);\n"))
+ "}\n")))
+)
+\f
+; 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)
+ ; For array registers, we need to store away the index.
+ (if (hw-scalar? (op:type op))
+ #f
+ UINT))
+)
+
+; 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 VOID (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)
+ ;(send index 'gen-extracted-field-value)
+ )
+)
+
+; Utilities to generate register accesses via cover functions.
+
+(define (-hw-gen-fun-get reg estate mode index)
+ (let ((scalar? (hw-scalar? reg))
+ (c-index (-gen-hw-index index estate)))
+ (string-append "current_cpu->"
+ (gen-reg-get-fun-name reg)
+ " ("
+ (if scalar? "" (string-drop 2 (gen-c-args c-index)))
+ ")"))
+)
+
+(define (-hw-gen-fun-set reg estate mode index newval)
+ (let ((scalar? (hw-scalar? reg))
+ (c-index (-gen-hw-index index estate)))
+ (string-append "current_cpu->"
+ (gen-reg-set-fun-name reg)
+ " ("
+ (if scalar? "" (string-append (string-drop 2 (gen-c-args c-index)) ", "))
+ (cx:c newval)
+ ");\n"))
+)
+
+; 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)))
+ ; 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 ((or (hw-getter hw)
+ (obj-has-attr? hw 'FUN-GET))
+ (-hw-gen-fun-get hw estate mode 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 (hw-isas hw)
+ (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 (hw-isas self)
+ (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)
+ (cond ((or (hw-setter hw)
+ (obj-has-attr? hw 'FUN-SET))
+ (-hw-gen-fun-set hw estate mode index newval))
+ ((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 (hw-isas hw)
+ (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 (hw-isas self)
+ (send self 'gen-ref
+ (gen-sym self) index estate))
+ " = " (cx:c newval) ";\n"))
+)
+
+; Return method name of access function.
+; Common elements have no prefix.
+; Elements specific to a particular isa are prefixed with @prefix@_.
+
+(define (gen-reg-get-fun-name hw)
+ (string-append (if (and (with-multiple-isa?)
+ (= (length (hw-isas hw)) 1))
+ (string-append (gen-sym (car (hw-isas hw))) "_")
+ "")
+ (gen-sym hw)
+ "_get")
+)
+
+(define (gen-reg-set-fun-name hw)
+ (string-append (if (and (with-multiple-isa?)
+ (= (length (hw-isas hw)) 1))
+ (string-append (gen-sym (car (hw-isas hw))) "_")
+ "")
+ (gen-sym hw)
+ "_set")
+)
+\f
+; 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 "current_cpu->GETMEM" (obj:name mode)
+ (if default-selector? "" "ASI")
+ " ("
+ "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 "current_cpu->SETMEM" (obj:name mode)
+ (if default-selector? "" "ASI")
+ " ("
+ "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)
+ ")"))))))
+)
+\f
+; 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))))
+)
+\f
+; 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 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))))
+)
+\f
+; Hardware selector support code.
+
+; Generate C code for SEL.
+
+(define (-gen-hw-selector sel)
+ (rtl-c++ 'INT sel nil)
+)
+\f
+; 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 default mode, 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 object is marked with the RAW attribute, access the hardware
+ ; object directly.
+ (logit 4 "<operand> cxmake-get self=" (obj:name self) " mode=" (obj:name mode)
+ " index=" (obj:name index) " selector=" selector "\n")
+ (cond ((obj-has-attr? self 'RAW)
+ (send (op:type self) 'cxmake-get-raw estate mode index selector))
+ ; 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.
+ ((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-expr mode expr
+ (if (= (length args) 0)
+ nil
+ (list (list (car args) 'UINT index)))
+ #:rtl-cover-fns? #t
+ #:output-language (estate-output-language estate))))
+ (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)
+)
+
+(define (-op-gen-set-quiet-parallel op estate mode index selector 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"
+ ; Dispatch to setter code if appropriate
+ " "
+ (if (op:setter op)
+ (let ((args (car (op:setter op)))
+ (expr (cadr (op:setter op))))
+ (rtl-c 'VOID expr
+ (if (= (length args) 0)
+ (list (list 'newval mode "opval"))
+ (list (list (car args) 'UINT index)
+ (list 'newval mode "opval")))
+ #:rtl-cover-fns? #t
+ #:output-language (estate-output-language estate)))
+ ;else
+ (send (op:type op) 'gen-set-quiet estate mode index selector
+ (cx:make-with-atlist mode "opval" (cx:atlist newval))))
+ (if (and (with-profile?)
+ (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'.
+ (if (current-pbb-engine?)
+ ""
+ (string-append
+ " if (current_cpu->trace_result_p)\n"
+ " current_cpu->trace_stream << "
+ (send op 'gen-pretty-name mode)
+ (if (send op 'get-index-mode)
+ (string-append
+ " << '['"
+ " << "
+ ; print memory addresses in hex
+ (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
+ " \"0x\" << hex << (UDI) "
+ "")
+ (-gen-hw-index index estate)
+ (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
+ " << dec"
+ "")
+ " << ']'")
+ "")
+ " << \":=0x\" << hex << "
+ ; Add (SI) or (USI) cast for byte-wide data, to prevent C++ iostreams
+ ; from printing byte as plain raw char.
+ (if (mode:eq? 'QI mode)
+ "(SI) "
+ (if (mode:eq? 'UQI mode)
+ "(USI) "
+ ""))
+ "opval << dec << \" \";\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 (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'.
+ " if (current_cpu->trace_result_p)\n"
+ " current_cpu->trace_stream << "
+ (send op 'gen-pretty-name mode)
+ (if (send op 'get-index-mode)
+ (string-append
+ " << '['"
+ " << "
+ ; print memory addresses in hex
+ (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
+ " \"0x\" << hex << (UDI) "
+ "")
+ (-gen-hw-index index estate)
+ (if (string=? (send op 'gen-pretty-name mode) "\"memory\"")
+ " << dec"
+ "")
+ " << ']'")
+ "")
+ " << \":=0x\" << hex << "
+ ;; Add (SI) or (USI) cast for byte-wide data, to prevent C++ iostreams
+ ;; from printing byte as plain raw char.
+ (if (mode:eq? 'QI mode)
+ "(SI) "
+ (if (mode:eq? 'UQI mode)
+ "(USI) "
+ ""))
+ "opval << dec << \" \";\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))))
+ (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))))
+ (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")
+)
+\f
+; 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 (vmake <rtl-c-eval-state>
+ #:rtl-cover-fns? #t
+ #:output-language "c++")))
+ (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 " "
+ "@prefix@_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"))
+)
+\f
+; CPU, mach, model support.
+
+; Return the declaration of the cpu/insn enum.
+
+(define (gen-cpu-insn-enum-decl cpu insn-list)
+ (gen-enum-decl "@prefix@_insn_type"
+ "instructions in cpu family @prefix@"
+ "@PREFIX@_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)
+ '((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-append "@PREFIX@_INSN_" (string-upcase (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))))
+ (non-multi-insns (real-insns (current-insn-list)))))))
+ ")\n\n"
+ )
+)
+\f
+; 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-append
+ " {\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-append
+ (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, abuf->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)))
+)
+\f
+; 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"
+ )
+)
+\f
+; 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-append
+ (let ((timing (assq-ref (insn-timing self) (obj:name model))))
+ (if timing
+ (string-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)))
+ ))
+)
+\f
+; Instruction support.
+
+; Return list of all instructions to use for scache engine.
+; This is all real insns plus the `invalid' and `cond' virtual insns.
+; It does not include the pbb virtual insns.
+
+(define (scache-engine-insns)
+ (non-multi-insns (non-alias-pbb-insns (current-insn-list)))
+)
+
+; Return list of all instructions to use for pbb engine.
+; This is all real insns plus the `invalid' and `cond' virtual insns.
+
+(define (pbb-engine-insns)
+ (non-multi-insns (real-insns (current-insn-list)))
+)
+
+; Create the virtual insns.
+
+(define (-create-virtual-insns! isa)
+ (let ((isa-name (obj:name isa))
+ (context "virtual insns"))
+
+ (current-insn-add!
+ (insn-read context
+ '(name x-invalid)
+ '(comment "invalid insn handler")
+ `(attrs VIRTUAL (ISA ,isa-name))
+ '(syntax "--invalid--")
+ '(semantics (c-code VOID "\
+ {
+ current_cpu->invalid_insn (pc);
+ assert (0);
+ /* NOTREACHED */
+ }
+"))
+ ))
+
+ (if (with-pbb?)
+ (begin
+ (current-insn-add!
+ (insn-read context
+ '(name x-begin)
+ '(comment "pbb begin handler")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--begin--")
+ '(semantics (c-code VOID "\
+ {
+ vpc = current_cpu->@prefix@_pbb_begin (current_cpu->h_pc_get ());
+ }
+"))
+ ))
+
+ (current-insn-add!
+ (insn-read context
+ '(name x-chain)
+ '(comment "pbb chain handler")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--chain--")
+ '(semantics (c-code VOID "\
+ {
+ vpc = current_cpu->@prefix@_engine.pbb_chain (current_cpu, abuf);
+ // If we don't have to give up control, don't.
+ // Note that we may overrun step_insn_count since we do the test at the
+ // end of the block. This is defined to be ok.
+ if (current_cpu->stop_after_insns_p (abuf->fields.chain.insn_count))
+ BREAK (vpc);
+ }
+"))
+ ))
+
+ (current-insn-add!
+ (insn-read context
+ '(name x-cti-chain)
+ '(comment "pbb cti-chain handler")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--cti-chain--")
+ '(semantics (c-code VOID "\
+ {
+ vpc = current_cpu->@prefix@_engine.pbb_cti_chain (current_cpu, abuf, pbb_br_status, pbb_br_npc);
+ // If we don't have to give up control, don't.
+ // Note that we may overrun step_insn_count since we do the test at the
+ // end of the block. This is defined to be ok.
+ if (current_cpu->stop_after_insns_p (abuf->fields.chain.insn_count))
+ BREAK (vpc);
+ }
+"))
+ ))
+
+ (current-insn-add!
+ (insn-read context
+ '(name x-before)
+ '(comment "pbb before handler")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--before--")
+ '(semantics (c-code VOID "\
+ {
+ current_cpu->@prefix@_engine.pbb_before (current_cpu, abuf);
+ }
+"))
+ ))
+
+ (current-insn-add!
+ (insn-read context
+ '(name x-after)
+ '(comment "pbb after handler")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--after--")
+ '(semantics (c-code VOID "\
+ {
+ current_cpu->@prefix@_engine.pbb_after (current_cpu, abuf);
+ }
+"))
+ ))
+
+ ))
+
+ ; If entire instruction set is conditionally executed, create a virtual
+ ; insn to handle that.
+ (if (and (with-pbb?)
+ (isa-conditional-exec? isa))
+ (current-insn-add!
+ (insn-read context
+ '(name x-cond)
+ '(syntax "conditional exec test")
+ `(attrs VIRTUAL PBB (ISA ,isa-name))
+ '(syntax "--cond--")
+ (list 'semantics (list 'c-code 'VOID
+ (string-append "\
+ {
+ // Assume branch not taken.
+ pbb_br_status = BRANCH_UNTAKEN;
+ UINT cond_code = abuf->cond;
+ BI exec_p = "
+ (rtl-c++ DFLT (cadr (isa-condition isa)) '((cond-code UINT "cond_code"))
+ #:rtl-cover-fns? #t)
+ ";
+ if (! exec_p)
+ ++vpc;
+ }
+")))
+ )))
+ )
+)
+
+; Return a boolean indicating if INSN should be split.
+
+(define (-decode-split-insn? insn isa)
+ (let loop ((split-specs (isa-decode-splits isa)))
+ (cond ((null? split-specs)
+ #f)
+ ((let ((f-name (decode-split-name (car split-specs))))
+ (and (insn-has-ifield? insn f-name)
+ (let ((constraint
+ (decode-split-constraint (car split-specs))))
+ (or (not constraint)
+ (rtl-eval -FIXME-unfinished-)))))
+ #t)
+ (else (loop (cdr split-specs)))))
+)
+
+; Subroutine of -decode-split-insn-1.
+; Build the ifield-assertion for ifield F-NAME.
+; VALUE is either a number or a non-empty list of numbers.
+
+(define (-decode-split-build-assertion f-name value)
+ (if (number? value)
+ (rtx-make 'eq 'INT (rtx-make 'ifield f-name) (rtx-make 'const 'INT value))
+ (rtx-make 'member (rtx-make 'ifield f-name)
+ (apply rtx-make (cons 'number-list (cons 'INT value)))))
+)
+
+; Subroutine of -decode-split-insn.
+; Specialize INSN according to <decode-split> dspec.
+
+(define (-decode-split-insn-1 insn dspec)
+ (let ((f-name (decode-split-name dspec))
+ (values (decode-split-values dspec)))
+ (let ((result (map object-copy-top (make-list (length values) insn))))
+ (for-each (lambda (insn-copy value)
+ (obj-set-name! insn-copy
+ (symbol-append (obj:name insn-copy)
+ '-
+ (car value)))
+ (obj-cons-attr! insn-copy (bool-attr-make 'DECODE-SPLIT #t))
+ (let ((existing-assertion (insn-ifield-assertion insn-copy))
+ (split-assertion
+ (-decode-split-build-assertion f-name (cadr value))))
+ (insn-set-ifield-assertion!
+ insn-copy
+ (if existing-assertion
+ (rtx-make 'andif split-assertion existing-assertion)
+ split-assertion)))
+ )
+ result values)
+ result))
+)
+
+; Split INSN.
+; The result is a list of the split copies of INSN.
+
+(define (-decode-split-insn insn isa)
+ (logit 3 "Splitting " (obj:name insn) " ...\n")
+ (let loop ((splits (isa-decode-splits isa)) (result nil))
+ (cond ((null? splits)
+ result)
+ ; FIXME: check constraint
+ ((insn-has-ifield? insn (decode-split-name (car splits)))
+ ; At each iteration, split the result of the previous.
+ (loop (cdr splits)
+ (if (null? result)
+ (-decode-split-insn-1 insn (car splits))
+ (apply append
+ (map (lambda (insn)
+ (-decode-split-insn-1 insn (car splits)))
+ result)))))
+ (else
+ (loop (cdr splits) result))))
+)
+
+; Create copies of insns to be split.
+; ??? better phrase needed? Possible confusion with gcc's define-split.
+; The original insns are then marked as aliases so the simulator ignores them.
+
+(define (-fill-sim-insn-list!)
+ (let ((isa (current-isa)))
+
+ (if (not (null? (isa-decode-splits isa)))
+
+ (begin
+ (logit 1 "Splitting instructions ...\n")
+ ; FIXME: We shouldn't need to know the innards of how insn lists
+ ; are recorded.
+ (let loop ((insns (current-raw-insn-list)))
+ (if (null? insns)
+ #f ; done
+ (let ((insn (insn-list-car insns)))
+ (if (and (insn-real? insn)
+ (insn-semantics insn)
+ (-decode-split-insn? insn isa))
+ (begin
+ (for-each (lambda (new-insn)
+ ; Splice new insns next to original.
+ ; Keeps things tidy and generated code
+ ; easier to read for human viewer.
+ (let ((new-list (insn-list-splice! insns new-insn)))
+ ; Assign insns separately. Paranoia,
+ ; insn-list-splice! modifies the list.
+ (set! insns new-list))
+ )
+ (-decode-split-insn insn isa))
+ (obj-cons-attr! insn (bool-attr-make 'ALIAS #t))))
+ (loop (cdr insns)))))
+ (logit 1 "Done splitting.\n"))
+ ))
+
+ *UNSPECIFIED*
+)
+\f
+; .cpu file loading support
+
+; Only run sim-analyze-insns! once.
+(define -sim-insns-analyzed? #f)
+
+; List of computed sformat argument buffers.
+(define -sim-sformat-argbuf-list #f)
+(define (current-sbuf-list) -sim-sformat-argbuf-list)
+
+; Called before the .cpu file has been read in.
+
+(define (sim-init!)
+ (set! -sim-insns-analyzed? #f)
+ (set! -sim-sformat-argbuf-list #f)
+ (if (with-sem-frags?)
+ (sim-sfrag-init!))
+ *UNSPECIFIED*
+)
+
+; Called after the .cpu file has been read in.
+
+(define (sim-finish!)
+ ; Specify FUN-GET/SET in the .sim file to cause all hardware references to
+ ; go through methods, thus allowing the programmer to override them.
+ (define-attr '(for hardware) '(type boolean) '(name FUN-GET)
+ '(comment "read hardware elements via cover functions/methods"))
+ (define-attr '(for hardware) '(type boolean) '(name FUN-SET)
+ '(comment "write hardware elements via cover functions/methods"))
+
+ ; If there is a .sim file, load it.
+ (let ((sim-file (string-append srcdir "/" (current-arch-name) ".sim")))
+ (if (file-exists? sim-file)
+ (begin
+ (display (string-append "Loading sim file " sim-file " ...\n"))
+ (reader-read-file! sim-file))))
+
+ ; If we're building files for an isa, create the virtual insns.
+ (if (not (keep-isa-multiple?))
+ (-create-virtual-insns! (current-isa)))
+
+ *UNSPECIFIED*
+)
+
+; Called after file is read in and global error checks are done
+; to initialize tables.
+
+(define (sim-analyze!)
+ *UNSPECIFIED*
+)
+
+; Scan insns, copying them to the simulator insn list, splitting the
+; requested insns, then analyze the semantics and compute 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
+ (-fill-sim-insn-list!)
+
+ (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-argbuf-list
+ (compute-sformat-argbufs! (current-sfmt-list)))
+
+ (set! -sim-insns-analyzed? #t)
+ ))
+
+ ; Do our own error checking.
+ (assert (current-insn-lookup 'x-invalid))
+
+ *UNSPECIFIED*
+)
OSDN Git Service
