From 37ed41563c52eb1776bfb458b83efcacbe7423a6 Mon Sep 17 00:00:00 2001 From: Ben Elliston Date: Fri, 8 Dec 2000 22:34:20 +0000 Subject: [PATCH] 2000-12-08 Ben Elliston * 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. --- ChangeLog | 9 + cgen-sid.scm | 92 +++ dev.scm | 15 + sid-cpu.scm | 1266 ++++++++++++++++++++++++++++++ sid-decode.scm | 774 +++++++++++++++++++ sid-model.scm | 362 +++++++++ sid.scm | 2021 ++++++++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 4539 insertions(+) create mode 100644 cgen-sid.scm create mode 100644 sid-cpu.scm create mode 100644 sid-decode.scm create mode 100644 sid-model.scm create mode 100644 sid.scm diff --git a/ChangeLog b/ChangeLog index 7028df7..17c5784 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2000-12-08 Ben Elliston + + * 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 * sim-decode.scm (-gen-extract-case): Do not emit a definition for diff --git a/cgen-sid.scm b/cgen-sid.scm new file mode 100644 index 0000000..70c9b6a --- /dev/null +++ b/cgen-sid.scm @@ -0,0 +1,92 @@ +; 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 " + (lambda (arg) (file-write arg cgen-desc.h))) + (list '-C "file" "generate cpu.h in " + (lambda (arg) (file-write arg cgen-cpu.h))) + (list '-E "file" "generate defs.h in " + (lambda (arg) (file-write arg cgen-defs.h))) + (list '-T "file" "generate decode.h in " + (lambda (arg) (file-write arg cgen-decode.h))) + (list '-D "file" "generate decode.cxx in " + (lambda (arg) (file-write arg cgen-decode.cxx))) + (list '-W "file" "generate write.cxx in " + (lambda (arg) (file-write arg cgen-write.cxx))) + (list '-S "file" "generate semantics.cxx in " + (lambda (arg) (file-write arg cgen-semantics.cxx))) + (list '-X "file" "generate sem-switch.cxx in " + (lambda (arg) (file-write arg cgen-sem-switch.cxx))) + (list '-M "file" "generate model.cxx in " + (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)) diff --git a/dev.scm b/dev.scm index c473aa1..c2b9b3f 100644 --- a/dev.scm +++ b/dev.scm @@ -9,6 +9,7 @@ ; (use-c) ; (load-opc) ; (load-sim) +; (load-sid) ; (cload #:arch arch #:machs "mach-list" #:isas "isa-list" #:options "options") ; First load fixup.scm to coerce guile into something we've been using. @@ -106,6 +107,16 @@ (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") @@ -171,6 +182,10 @@ sim test options: [none yet] \n") +(display "\ +sid options: +[wip] +\n") ; If ~/.cgenrc exists, load it. diff --git a/sid-cpu.scm b/sid-cpu.scm new file mode 100644 index 0000000..83acc06 --- /dev/null +++ b/sid-cpu.scm @@ -0,0 +1,1266 @@ +; 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 -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" + ) +) + +; ********** +; 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.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" + ) +) + +; ********** +; 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 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 -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" + ) +) + +; ************** +; 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 +; 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 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 -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 + ) +) + +; ****************** +; 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 -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 + ) +) + +; ******************* +; 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 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 SFMT is +; conditionally written to. + +(define (-any-cond-written? sfmt) + (any-true? (map op:cond? (sfmt-out-ops sfmt))) +) + +; 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" + ) +) + +; 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 "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 "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 "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)))) + ) +) + +; 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) + ) +) diff --git a/sid-decode.scm b/sid-decode.scm new file mode 100644 index 0000000..0c89055 --- /dev/null +++ b/sid-decode.scm @@ -0,0 +1,774 @@ +; 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" + ) +) + +; 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" + ) +) + + +; 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 +; 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); +}; + +") +) + +; 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 to reduce the quantity of structures +; created (this helps semantic-fragment pbb engines). + +; Return C code to record F for the semantic handler +; in a local variable rather than an ARGBUF struct. + +(define (-gen-record-argbuf-ifld f sfmt) + (string-append " " (gen-ifld-argbuf-ref f) + " = " (gen-extracted-ifld-value f) ";\n") +) + +; Return three of arguments to TRACE: +; string argument to fprintf, character indicating type of third arg, value. +; The type is one of: x. + +(define (-gen-trace-argbuf-ifld f sfmt) + (string-append + ; FIXME: Add method to return fprintf format string. + ", \"" (gen-sym f) " 0x%x\"" + ", 'x'" + ", " (gen-extracted-ifld-value f)) +) + +; Instruction field extraction support cont'd. +; Hardware support. + +; gen-extract method. +; For the default case we use the ifield as is, which is output elsewhere. + +(method-make! + 'gen-extract + (lambda (self op sfmt local?) + "") +) + +; gen-trace-extract method. +; Return appropriate arguments for TRACE_EXTRACT. + +(method-make! + 'gen-trace-extract + (lambda (self op sfmt) + "") +) + +; Extract the necessary fields into ARGBUF. + +(method-make! + '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! + '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! + '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! + 'gen-trace-extract + (lambda (self op sfmt) + (string-append + ; FIXME: Add method to return fprintf format string. + ", \"" (gen-sym op) " 0x%x\"" + ", 'x'" + ", " (gen-extracted-ifld-value (op-ifield op)))) +) + +; Instruction field extraction support cont'd. +; Operand support. + +; Return C code to record the field for the semantic handler. +; In the case of a register, this is usually the address of the register's +; value (if CACHE-ADDR). +; LOCAL? indicates whether to record the value in a local variable or in +; the ARGBUF struct. +; ??? Later allow target to provide an `extract' expression. + +(define (-gen-op-extract op sfmt local?) + (send (op:type op) 'gen-extract op sfmt local?) +) + +; Return three of arguments to TRACE_EXTRACT: +; string argument to fprintf, character indicating type of third arg, value. +; The type is one of: x. + +(define (-gen-op-trace-extract op sfmt) + (send (op:type op) 'gen-trace-extract op sfmt) +) + +; Return C code to define local vars to hold processed ifield data for +; 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 SFMT. +; This is used when !with-scache. +; Assignment of the extracted ifields is handled elsewhere. + +(define (gen-sfmt-op-argbuf-assigns sfmt) + (let ((operands (sfmt-extracted-operands sfmt))) + (string-list-map (lambda (op) + (-gen-op-extract op sfmt #t)) + operands)) +) + +; Instruction field extraction support cont'd. +; Emit extraction section of decode function. + +; Return C code to record insn field data for 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 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)) +) + + +; 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 + ))) +) + +; 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" + ) +) + +; 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?))) + ) +) diff --git a/sid-model.scm b/sid-model.scm new file mode 100644 index 0000000..e90bcf3 --- /dev/null +++ b/sid-model.scm @@ -0,0 +1,362 @@ +; 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" + ) +) + +; 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))) + ) +) + +; Generate timing table entry for function unit U while executing INSN. +; U is a 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)) +) + +; 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 + ) +) diff --git a/sid.scm b/sid.scm new file mode 100644 index 0000000..b33c8cb --- /dev/null +++ b/sid.scm @@ -0,0 +1,2021 @@ +; 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)) +) + +; Cover functions for various methods. + +; Return the C type of something. This isn't always a mode. + +(define (gen-type self) (send self 'gen-type)) + +; Return the C type of an index's value or #f if not needed (scalar). + +(define (gen-index-type op sfmt) + (let ((index-mode (send op 'get-index-mode))) + (if index-mode + (mode:c-type index-mode) + #f)) +) + +; Misc. utilities. + +; Return reference to hardware element SYM. +; ISAS is a list of 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)) +) + +; 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))) + " }")) +) + +; Instruction field support code. + +; Return a object of the value of an ifield. + +(define (-cxmake-ifld-val mode f) + (if (with-scache?) + ; ??? Perhaps a better way would be to defer evaluating the src of a + ; set until the method processing the dest. + (cx:make-with-atlist mode (gen-ifld-argbuf-ref f) + (atlist-make "" (bool-attr-make 'CACHED #t))) + (cx:make mode (gen-extracted-ifld-value f))) +) + +; Type system. + +; Methods: +; gen-type - return C code representing the type +; gen-sym-decl - generate decl using the provided symbol +; gen-sym-get-macro - generate GET macro for accessing CPU elements +; gen-sym-set-macro - generate SET macro for accessing CPU elements + +; Scalar type + +(method-make! + 'gen-type + (lambda (self) (mode:c-type (elm-get self 'mode))) +) + +(method-make! + 'gen-sym-decl + (lambda (self sym comment) + (string-append + " /* " comment " */\n" + " " (send self 'gen-type) " " + (gen-c-symbol sym) ";\n")) +) + +(method-make! 'gen-ref (lambda (self sym index estate) sym)) + +; Array type + +(method-make! + 'gen-type + (lambda (self) (mode:c-type (elm-get self 'mode))) +) + +(method-make! + '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! + '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! +; 'gen-type +; (lambda (self) +; (mode:c-type (mode-find (elm-get self 'bits) +; (if (has-attr? self 'UNSIGNED) +; 'UINT 'INT))) +; ) +;) +; +;(method-make! 'gen-sym-decl (lambda (self sym comment) "")) +;(method-make! 'gen-sym-get-macro (lambda (self sym comment) "")) +;(method-make! 'gen-sym-set-macro (lambda (self sym comment) "")) + +; Hardware descriptions support code. +; +; Various operations are required for each h/w object to support the various +; things the simulator will want to do with it. +; +; Methods: +; gen-decl +; gen-write - Same as gen-read except done on output operands +; cxmake-get - Return a 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! + 'gen-decl + (lambda (self) + (send self 'gen-sym-decl (obj:name self) (obj:comment self))) +) + +(method-make-virtual! 'gen-sym-decl (lambda (self sym comment) "")) + +; Return a C reference to a hardware object. + +(method-make! 'gen-ref (lambda (self sym index estate) sym)) + +; Each hardware type must provide its own gen-write method. + +(method-make! + '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! + 'gen-type + (lambda (self) (error "gen-type not overridden:" self)) +) + +(method-make! 'gen-profile-decl (lambda (self) "")) + +; Default gen-record-profile method. + +(method-make! + 'gen-record-profile + (lambda (self index sfmt estate) + "") ; nothing to do +) + +; Default cxmake-get method. +; Return a object of the value of SELF. +; ESTATE is the current rtl evaluator state. +; INDEX is a object. It must be an ifield. +; SELECTOR is a hardware selector RTX. + +(method-make! + '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))) +) + +; PC support + +; 'gen-set-quiet helper for PC values. +; NEWVAL is a 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! '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 . +; 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! + '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! + '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"))) +) + +; Registers. + +; Forward these methods onto TYPE. +(method-make-virtual-forward! 'type '(gen-type gen-sym-decl)) +(method-make-forward! '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! + '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 . +; OP is the . +; ACCESS-MACRO is the runtime C macro to use to fetch indices computed +; during semantic evaluation. +; FIXME: May need mode of OP. + +(method-make! + '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! + 'gen-profile-decl + (lambda (self) + (string-append + " /* " (obj:comment self) " */\n" + " unsigned long " (gen-c-symbol (obj:name self)) ";\n")) +) + +(method-make! + '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 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! 'cxmake-get -hw-cxmake-get) + +; raw-reg: support +; ??? raw-reg: support is wip + +(method-make! + '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! 'gen-set-quiet -hw-gen-set-quiet) + +; raw-reg: support +; ??? wip + +(method-make! + '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") +) + +; Memory support. + +(method-make! + '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! + '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! 'type '(gen-type)) +(method-make-virtual! 'gen-sym-decl (lambda (self sym comment) "")) +(method-make! 'gen-sym-get-macro (lambda (self sym comment) "")) +(method-make! '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! + '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! + 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (let ((index (send index 'get-write-index self sfmt op access-macro))) + (string-append " " + (send self 'gen-set-quiet estate mode index + hw-selector-default + (cx:make DFLT (string-append access-macro " (" + (gen-sym op) + ")")))))) +) + +; Immediates, addresses. + +; Forward these methods onto TYPE. +(method-make-virtual-forward! 'type '(gen-type gen-sym-decl)) +(method-make-forward! 'type '(gen-sym-get-macro + gen-sym-set-macro)) + +(method-make! + 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (error "gen-write of shouldn't happen")) +) + +; FIXME. +(method-make-virtual! 'gen-type (lambda (self) "ADDR")) +(method-make-virtual! 'gen-sym-decl (lambda (self sym comment) "")) +(method-make! 'gen-sym-get-macro (lambda (self sym comment) "")) +(method-make! 'gen-sym-set-macro (lambda (self sym comment) "")) + +; Return a 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! + '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! + 'gen-write + (lambda (self estate index mode sfmt op access-macro) + (error "gen-write of shouldn't happen")) +) + +; FIXME: revisit. +(method-make-virtual! 'gen-type (lambda (self) "IADDR")) + +; Return a object of the value of SELF. +; ESTATE is the current rtl evaluator state. +; INDEX is a 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! + 'cxmake-get + (lambda (self estate mode index selector) + (if (not (eq? 'ifield (hw-index:type index))) + (error "not an ifield hw-index" index)) + (if (with-scache?) + ; ??? Perhaps a better way would be to defer evaluating the src of a + ; set until the method processing the dest. + (cx:make-with-atlist mode (gen-hw-index-argbuf-ref index) + (atlist-make "" (bool-attr-make 'CACHED #t))) + (cx:make mode (gen-hw-index-argbuf-name index)))) +) + +; Hardware index support code. + +; Return the index to use by the gen-write method. +; In the cases where this is needed (the index isn't known until insn +; execution time), the index is computed along with the value to be stored, +; so this is easy. + +(method-make! + '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 '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 object of the value of a hardware index. + +(method-make! + 'cxmake-get + (lambda (self estate mode) + (let ((mode (if (mode:eq? 'DFLT mode) (elm-get self 'mode) mode))) + ; If MODE is VOID, abort. + (if (mode:eq? 'VOID mode) + (error "hw-index:cxmake-get: result needs a mode" self)) + (cx:make (if (mode:host? mode) + ; FIXME: Temporary hack to generate same code as before. + (let ((xmode (object-copy-top mode))) + (obj-cons-attr! xmode (bool-attr-make 'FORCE-C #t)) + xmode) + mode) + (-gen-hw-index self estate)))) +) + +; Hardware selector support code. + +; Generate C code for SEL. + +(define (-gen-hw-selector sel) + (rtl-c++ 'INT sel nil) +) + +; Instruction operand support code. + +; Methods: +; gen-type - Return C type to use to hold operand's value. +; gen-read - Record an operand's value prior to parallely executing +; several instructions. Not used if gen-write used. +; gen-write - Write back an operand's value after parallely executing +; several instructions. Not used if gen-read used. +; cxmake-get - Return C code to fetch the value of an operand. +; gen-set-quiet - Return C code to set the value of an operand. +; gen-set-trace - Return C code to set the value of an operand, and print +; a result trace message. ??? Ideally this will go away when +; trace record support is complete. + +; Return the C type of an operand. +; Generally we forward things on to TYPE, but for the actual type we need to +; use the get-mode method. + +;(method-make-forward! 'type '(gen-type)) +(method-make! + '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! + '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! + '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! +; 'gen-set-quiet +; (lambda (self estate mode index selector newval) +; (-op-gen-set-quiet self estate mode index selector newval))) +;(method-make! +; '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! + '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 object. + +(method-make! + '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 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! + '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 " 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_ (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_ (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 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! + '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 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! + '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") +) + +; Operand profiling and parallel execution support. + +(method-make! + '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-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! + '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! + '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")) +) + +; 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 - 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" + ) +) + +; Function units. + +(method-make! '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! + '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! + '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))) +) + +; Mode support. + +; Generate a table of mode data. +; For now all we need is the names. + +(define (gen-mode-defs) + (string-append + "const char *mode_names[] = {\n" + (string-map (lambda (m) + (string-append " \"" (string-upcase (obj:name m)) "\",\n")) + ; We don't treat aliases as being different from the real + ; mode here, so ignore them. + (mode-list-non-alias-values)) + "};\n\n" + ) +) + +; Insn profiling support. + +; Generate declarations for local variables needed for modelling code. + +(method-make! + '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! + '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))) + )) +) + +; 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 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* +) + +; .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* +) -- 2.43.5