cgen/opcodes.scm

   1 ; General cpu info generator support.
   2 ; Copyright (C) 2000, 2002, 2005, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4
   5 ; Global state variables.
   6
   7 ; Specify which application.
   8 (set! APPLICATION 'OPCODES)
   9
  10 ; Records the -OPC arg which specifies the path to the .opc file.
  11 (define /opc-file-path #f)
  12 (define (opc-file-path)
  13   (if /opc-file-path
  14       /opc-file-path
  15       (error ".opc file unspecified, missing -OPC argument"))
  16 )
  17 (define (set-opc-file-path! path)
  18   (set! /opc-file-path path)
  19 )
  20
  21 ; Return #t if the -OPC parameter was specified.
  22
  23 (define (opc-file-provided?)
  24   (and /opc-file-path #t)
  25 )
  26
  27 ; Boolean indicating if we're to build the operand instance table.
  28 ; The default is no, since only the m32r uses it at present.
  29 ; ??? Simulator tracing support could use it.
  30 ; ??? Might be lazily built at runtime by parsing the semantic code
  31 ; (which would be recorded in the insn table).
  32 ; FIXME: Referenced outside this file in opc-opinst.scm.
  33 (define /opcodes-build-operand-instance-table? #f)
  34
  35 ; String containing copyright text.
  36 (define CURRENT-COPYRIGHT #f)
  37
  38 ; String containing text defining the package we're generating code for.
  39 (define CURRENT-PACKAGE #f)
  40
  41 ; Initialize the options.
  42
  43 (define (option-init!)
  44   (set! /opcodes-build-operand-instance-table? #f)
  45   (set! CURRENT-COPYRIGHT copyright-fsf)
  46   (set! CURRENT-PACKAGE package-gnu-binutils-gdb)
  47   *UNSPECIFIED*
  48 )
  49
  50 ; Handle an option passed in from the command line.
  51
  52 (define (option-set! name value)
  53   (case name
  54     ((opinst) (set! /opcodes-build-operand-instance-table? #t))
  55     ((copyright) (cond ((equal?  value '("fsf"))
  56                         (set! CURRENT-COPYRIGHT copyright-fsf))
  57                        ((equal? value '("redhat"))
  58                         (set! CURRENT-COPYRIGHT copyright-red-hat))
  59                        (else (error "invalid copyright value" value))))
  60     ((package) (cond ((equal?  value '("binutils"))
  61                       (set! CURRENT-PACKAGE package-gnu-binutils-gdb))
  62                      ((equal?  value '("gnusim"))
  63                       (set! CURRENT-PACKAGE package-gnu-simulators))
  64                      ((equal? value '("cygsim"))
  65                       (set! CURRENT-PACKAGE package-red-hat-simulators))
  66                      (else (error "invalid package value" value))))
  67     (else (error "unknown option" name))
  68     )
  69   *UNSPECIFIED*
  70 )
  71 \f
  72 ; Instruction fields support code.
  73
  74 ; Default type of variable to use to hold ifield value.
  75
  76 (define (gen-ifield-default-type)
  77   ; FIXME: Use long for now.
  78   "long"
  79 )
  80
  81 ; Given field F, return a C definition of a variable big enough to hold
  82 ; its value.
  83
  84 (define (gen-ifield-value-decl f)
  85   (gen-obj-sanitize f (string-append "  "
  86                                      (gen-ifield-default-type)
  87                                      " " (gen-sym f) ";\n"))
  88 )
  89
  90 ; Return name of function to call to insert the value of <ifield> F
  91 ; into an insn.
  92
  93 (define (ifld-insert-fn-name f)
  94   "insert_normal"
  95 )
  96
  97 ; Return name of function to call to extract the value of <ifield> F
  98 ; into an insn.
  99
 100 (define (ifld-extract-fn-name f)
 101   "extract_normal"
 102 )
 103
 104 ; Default routine to emit C code to insert a field in an insn.
 105
 106 (method-make!
 107  <ifield> 'gen-insert
 108  (lambda (self operand)
 109    (let* ((encode (elm-get self 'encode))
 110           (need-extra? encode) ; use to also handle operand's `insert' field
 111           (varname (gen-operand-result-var self)))
 112      (string-append
 113       (if need-extra?
 114           (string-append "      {\n"
 115                          "        "
 116                          (gen-ifield-default-type)
 117                          " value = " varname ";\n")
 118           "")
 119       (if encode
 120           (string-append "        value = "
 121                          ;; NOTE: ENCODE is either, e.g.,
 122                          ;; ((value pc) (sra DI value 1))
 123                          ;; or
 124                          ;; (((<mode> value) (<mode> pc)) (sra DI value 1))
 125                          (let ((expr (cadr encode))
 126                                (value (if (symbol? (caar encode)) (caar encode) (cadr (caar encode))))
 127                                (pc (if (symbol? (cadar encode)) (cadar encode) (cadr (cadar encode)))))
 128                            (rtl-c DFLT expr
 129                                   (list (list value (obj:name (ifld-encode-mode self)) "value")
 130                                         (list pc 'IAI "pc"))))
 131                          ";\n")
 132           "")
 133       (if need-extra?
 134           "  "
 135           "")
 136       "      errmsg = "
 137       (ifld-insert-fn-name self)
 138       " (cd, "
 139       (if need-extra?
 140           "value"
 141           varname)
 142       ", "
 143       ; We explicitly pass the attributes here rather than look them up
 144       ; to give the code more optimization opportunities.
 145       ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
 146       ; pass a pointer to the recorded attributes instead.
 147       (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
 148                           (atlist-cons (bool-attr-make 'SIGNED #t)
 149                                        (obj-atlist self))
 150                           (obj-atlist self))
 151                       gen-attr-mask)
 152       ", " (number->string (ifld-word-offset self))
 153       ", " (number->string (ifld-start self))
 154       ", " (number->string (ifld-length self))
 155       ", " (number->string (ifld-word-length self))
 156       ", total_length"
 157       ", buffer"
 158       ");\n"
 159       (if need-extra?
 160           "      }\n"
 161           "")
 162       )))
 163 )
 164
 165 ; Default routine to emit C code to extract a field from an insn.
 166
 167 (method-make!
 168  <ifield> 'gen-extract
 169  (lambda (self operand)
 170    (let* ((decode (elm-get self 'decode))
 171           (need-extra? decode) ; use to also handle operand's `extract' field
 172           (varname (gen-operand-result-var self)))
 173      (string-append
 174       (if need-extra?
 175           (string-append "      {\n        "
 176                          (gen-ifield-default-type)
 177                          " value;\n  ")
 178           "")
 179       "      length = "
 180       (ifld-extract-fn-name self)
 181       " (cd, ex_info, insn_value, "
 182       ; We explicitly pass the attributes here rather than look them up
 183       ; to give the code more optimization opportunities.
 184       ; ??? Maybe when fields are recorded in opc.c, stop doing this, and
 185       ; pass a pointer to the recorded attributes instead.
 186       (gen-bool-attrs (if (eq? (mode:class (ifld-mode self)) 'INT)
 187                           (atlist-cons (bool-attr-make 'SIGNED #t)
 188                                        (obj-atlist self))
 189                           (obj-atlist self))
 190                       gen-attr-mask)
 191       ", " (number->string (ifld-word-offset self))
 192       ", " (number->string (ifld-start self))
 193       ", " (number->string (ifld-length self))
 194       ", " (number->string (ifld-word-length self))
 195       ", total_length"
 196       ", pc"
 197       ", & "
 198       (if need-extra?
 199           "value"
 200           varname)
 201       ");\n"
 202       (if decode
 203           (string-append "        value = "
 204                          ;; NOTE: DECODE is either, e.g.,
 205                          ;; ((value pc) (sll DI value 1))
 206                          ;; or
 207                          ;; (((<mode> value) (<mode> pc)) (sll DI value 1))
 208                          (let ((expr (cadr decode))
 209                                (value (if (symbol? (caar decode)) (caar decode) (cadr (caar decode))))
 210                                (pc (if (symbol? (cadar decode)) (cadar decode) (cadr (cadar decode)))))
 211                            (rtl-c DFLT expr
 212                                   (list (list value (obj:name (ifld-decode-mode self)) "value")
 213                                         (list pc 'IAI "pc"))))
 214                          ";\n")
 215           "")
 216       (if need-extra?
 217           (string-append "        " varname " = value;\n"
 218                          "      }\n")
 219           "")
 220       )))
 221 )
 222
 223 ; gen-insert of multi-ifields
 224
 225 (method-make!
 226  <multi-ifield> 'gen-insert
 227  (lambda (self operand)
 228    (let* ((varname (gen-operand-result-var self))
 229           (encode (elm-get self 'encode))
 230           (need-extra? encode))
 231      (string-list
 232       "      {\n"
 233       (if need-extra?
 234           (string-append "        " varname " = "
 235                          (let ((expr (cadr encode))
 236                                (value (caar encode))
 237                                (pc (cadar encode)))
 238                            (rtl-c DFLT expr
 239                                   (list (list value (obj:name (ifld-encode-mode self)) varname)
 240                                         (list pc 'IAI "pc"))))
 241                          ";\n")
 242           "")
 243       (let ((expr (elm-get self 'insert)))
 244         (rtl-c VOID expr nil))
 245       (string-list-map (lambda (subfld)
 246                          (string-list
 247                           "  "
 248                           (send subfld 'gen-insert operand)
 249                           "        if (errmsg)\n"
 250                           "          break;\n"))
 251                        (elm-get self 'subfields))
 252       "      }\n"
 253       )))
 254 )
 255
 256 ; gen-insert of derived-operands
 257
 258 (method-make!
 259  <derived-operand> 'gen-insert
 260  (lambda (self operand)
 261    "      abort();\n")
 262 )
 263
 264 ; gen-extract of multi-ifields
 265
 266 (method-make!
 267  <multi-ifield> 'gen-extract
 268  (lambda (self operand)
 269    (let* ((varname (gen-operand-result-var self))
 270           (decode (elm-get self 'decode))
 271           (need-extra? decode))
 272      (string-list
 273       "      {\n"
 274       (string-list-map (lambda (subfld)
 275                          (string-list
 276                           "  "
 277                           (send subfld 'gen-extract operand)
 278                           "        if (length <= 0) break;\n"
 279                           ))
 280                        (elm-get self 'subfields))
 281       (let ((expr (elm-get self 'extract)))
 282         (rtl-c VOID expr nil))
 283       (if need-extra?
 284           (string-append "        " varname " = "
 285                          (let ((expr (cadr decode))
 286                                (value (caar decode))
 287                                (pc (cadar decode)))
 288                            (rtl-c DFLT expr
 289                                   (list (list value (obj:name (ifld-decode-mode self)) varname)
 290                                         (list pc 'IAI "pc"))))
 291                          ";\n")
 292           "")
 293       "      }\n"
 294       )))
 295 )
 296
 297
 298 (method-make!
 299  <derived-operand> 'gen-extract
 300  (lambda (self operand)
 301    "      abort();\n")
 302 )
 303
 304 ;(method-make!
 305 ; <derived-operand> 'gen-extract
 306 ; (lambda (self operand)
 307 ;   (string-list
 308 ;    "      {\n"
 309 ;    (string-list-map (lambda (subop)
 310 ;                      (string-list
 311 ;                       "  " (send subop 'gen-extract operand)
 312 ;                       "        if (length <= 0)\n"
 313 ;                       "          break;\n"))
 314 ;                    (elm-get self 'args))
 315 ;    "      }\n"
 316 ;    ))
 317 ;)
 318
 319 \f
 320 ; Hardware index support code.
 321
 322 (method-make!
 323  <hw-index> 'gen-insert
 324  (lambda (self operand)
 325    (case (hw-index:type self)
 326      ((ifield)
 327       (send (hw-index:value self) 'gen-insert operand))
 328      (else
 329       "")))
 330 )
 331
 332 (method-make!
 333  <hw-index> 'gen-extract
 334  (lambda (self operand)
 335    (case (hw-index:type self)
 336      ((ifield)
 337       (send (hw-index:value self) 'gen-extract operand))
 338      (else
 339       ""))))
 340 \f
 341 ; HW-ASM is the base class for supporting hardware elements in the opcode table
 342 ; (aka assembler/disassembler).
 343
 344 ; Utility to return C code to parse a number of <mode> MODE for an operand.
 345 ; RESULT-VAR-NAME is a string containing the variable to store the
 346 ; parsed number in.
 347 ; PARSE-FN is the name of the function to call or #f to use the default.
 348 ; OP-ENUM is the enum of the operand.
 349
 350 (define (/gen-parse-number mode parse-fn op-enum result-var-name)
 351   (string-append
 352    "      errmsg = "
 353    ; Use operand's special parse function if there is one, otherwise compute
 354    ; the function's name from the mode.
 355    (or parse-fn
 356        (case (obj:name mode)
 357          ((QI HI SI INT) "cgen_parse_signed_integer")
 358          ((BI UQI UHI USI UINT) "cgen_parse_unsigned_integer")
 359          (else (error "unsupported (as yet) mode for parsing"
 360                       (obj:name mode)))))
 361    " (cd, strp, "
 362    op-enum
 363    ", "
 364    ; This is to pacify gcc 4.x which will complain about
 365    ; incorrect signed-ness of pointers passed to functions.
 366    (case (obj:name mode)
 367          ((QI HI SI INT) "(long *)")
 368          ((BI UQI UHI USI UINT) "(unsigned long *)")
 369    )
 370    " (& " result-var-name
 371    "));\n"
 372    )
 373 )
 374
 375 ; Utility to return C code to parse an address.
 376 ; RESULT-VAR-NAME is a string containing the variable to store the
 377 ; parsed number in.
 378 ; PARSE-FN is the name of the function to call or #f to use the default.
 379 ; OP-ENUM is the enum of the operand.
 380
 381 (define (/gen-parse-address parse-fn op-enum result-var-name)
 382   (string-append
 383    "      {\n"
 384    "        bfd_vma value = 0;\n"
 385    "        errmsg = "
 386    ; Use operand's special parse function if there is one.
 387    (or parse-fn
 388        "cgen_parse_address")
 389    " (cd, strp, "
 390    op-enum
 391    ", 0, " ; opinfo arg
 392    "NULL, " ; result_type arg (FIXME)
 393    " & value);\n"
 394    "        " result-var-name " = value;\n"
 395    "      }\n"
 396    )
 397 )
 398
 399 ; Return C code to parse an expression.
 400
 401 (method-make!
 402  <hw-asm> 'gen-parse
 403  (lambda (self operand)
 404    (let ((mode (elm-get self 'mode))
 405          (result-var
 406           (case (hw-index:type (op:index operand))
 407             ((ifield) (gen-operand-result-var (op-ifield operand)))
 408             (else "junk"))))
 409      (if (address? (op:type operand))
 410          (/gen-parse-address (send operand 'gen-function-name 'parse)
 411                              (op-enum operand)
 412                              result-var)
 413          (/gen-parse-number mode (send operand 'gen-function-name 'parse)
 414                             (op-enum operand)
 415                             result-var))))
 416 )
 417
 418 ; Default method to emit C code to print a hardware element.
 419
 420 (method-make!
 421  <hw-asm> 'gen-print
 422  (lambda (self operand)
 423    (let ((value
 424           (case (hw-index:type (op:index operand))
 425             ((ifield) (gen-operand-result-var (op-ifield operand)))
 426             (else "0"))))
 427      (string-append
 428       "      "
 429       (or (send operand 'gen-function-name 'print)
 430           (and (address? (op:type operand))
 431                "print_address")
 432           "print_normal")
 433 ;    (or (send operand 'gen-function-name 'print)
 434 ;       (case (obj:name (elm-get self 'mode))
 435 ;         ((QI HI SI INT) "print_signed")
 436 ;         ((BI UQI UHI USI UINT) "print_unsigned")
 437 ;         (else (error "unsupported (as yet) mode for printing"
 438 ;                      (obj:name (elm-get self 'mode))))))
 439       " (cd, info, "
 440       value
 441       ", "
 442       ; We explicitly pass the attributes here rather than look them up
 443       ; to give the code more optimization opportunities.
 444       (gen-bool-attrs (if (eq? (mode:class (elm-get self 'mode)) 'INT)
 445                           (atlist-cons (bool-attr-make 'SIGNED #t)
 446                                        (obj-atlist operand))
 447                           (obj-atlist operand))
 448                       gen-attr-mask)
 449       ;(gen-bool-attrs (obj-atlist operand) gen-attr-mask)
 450       ", pc, length"
 451       ");\n"
 452       )))
 453 )
 454 \f
 455 ; Keyword support.
 456
 457 ; Return C code to parse a keyword.
 458
 459 (method-make!
 460  <keyword> 'gen-parse
 461  (lambda (self operand)
 462    (let ((result-var
 463           (case (hw-index:type (op:index operand))
 464             ((ifield) (gen-operand-result-var (op-ifield operand)))
 465             (else "junk"))))
 466      (string-append
 467       "      errmsg = "
 468       (or (send operand 'gen-function-name 'parse)
 469           "cgen_parse_keyword")
 470       " (cd, strp, "
 471       (send self 'gen-ref) ", "
 472       ;(op-enum operand) ", "
 473       "& " result-var
 474       ");\n"
 475       )))
 476 )
 477
 478 ; Return C code to print a keyword.
 479
 480 (method-make!
 481  <keyword> 'gen-print
 482  (lambda (self operand)
 483    (let ((value
 484           (case (hw-index:type (op:index operand))
 485             ((ifield) (gen-operand-result-var (op-ifield operand)))
 486             (else "0"))))
 487      (string-append
 488       "      "
 489       (or (send operand 'gen-function-name 'print)
 490           "print_keyword")
 491       " (cd, "
 492       "info" ; The disassemble_info argument to print_insn.
 493       ", "
 494       (send self 'gen-ref)
 495       ", " value
 496       ", "
 497       ; We explicitly pass the attributes here rather than look them up
 498       ; to give the code more optimization opportunities.
 499       (gen-bool-attrs (obj-atlist operand) gen-attr-mask)
 500       ");\n"
 501       )))
 502 )
 503 \f
 504 ; Hardware support.
 505
 506 ; For registers, use the indices field.  Ignore values.
 507 ; ??? Not that that will always be the case.
 508
 509 (method-make-forward! <hw-register> 'indices '(gen-parse gen-print))
 510
 511 ; No such support for memory yet.
 512
 513 (method-make!
 514  <hw-memory> 'gen-parse
 515  (lambda (self operand)
 516    (error "gen-parse of memory not supported yet"))
 517 )
 518
 519 (method-make!
 520  <hw-memory> 'gen-print
 521  (lambda (self operand)
 522    (error "gen-print of memory not supported yet"))
 523 )
 524
 525 ; For immediates, use the values field.  Ignore indices.
 526 ; ??? Not that that will always be the case.
 527
 528 (method-make-forward! <hw-immediate> 'values '(gen-parse gen-print))
 529
 530 ; For addresses, use the values field.  Ignore indices.
 531
 532 (method-make-forward! <hw-address> 'values '(gen-parse gen-print))
 533 \f
 534 ; Generate the C code for dealing with operands.
 535 ; This code is inserted into cgen-{ibld,asm,dis}.in above the insn routines
 536 ; so that it can be inlined if desired.  ??? Actually this isn't always the
 537 ; case but this is minutiae to be dealt with much later.
 538
 539 ; Generate the guts of a C switch to handle an operation for all operands.
 540 ; WHAT is one of fget/fset/parse/insert/extract/print.
 541 ;
 542 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
 543 ; operations from similar ones in other contexts.  ??? I'd prefer to come
 544 ; up with better names for fget/fset but I haven't come up with anything
 545 ; satisfactory yet.
 546
 547 (define (gen-switch what)
 548   (string-list-map
 549    (lambda (ops)
 550      ; OPS is a list of operands with the same name that for whatever reason
 551      ; were defined separately.
 552      (logit 3 (string/symbol-append
 553                "Processing " (obj:str-name (car ops)) " " what " ...\n"))
 554      (if (= (length ops) 1)
 555          (gen-obj-sanitize
 556           (car ops)
 557           (string-list
 558            "    case @ARCH@_OPERAND_"
 559            (string-upcase (gen-sym (car ops)))
 560            " :\n"
 561            (send (car ops) (symbol-append 'gen- what) (car ops))
 562            "      break;\n"))
 563          (string-list
 564           ; FIXME: operand name doesn't get sanitized.
 565           "    case @ARCH@_OPERAND_"
 566           (string-upcase (gen-sym (car ops)))
 567           " :\n"
 568           ; There's more than one operand defined with this name, so we
 569           ; have to distinguish them.
 570           ; FIXME: Unfinished.
 571           (string-list-map (lambda (op)
 572                              (gen-obj-sanitize
 573                               op
 574                               (string-list
 575                                (send op (symbol-append 'gen- what) op)
 576                                )))
 577                            ops)
 578           "      break;\n"
 579           )))
 580    (op-sort (find (lambda (op) (and (not (has-attr? op 'SEM-ONLY))
 581                                     (not (anyof-operand? op))
 582                                     (not (derived-operand? op))))
 583                   (current-op-list))))
 584 )
 585 \f
 586 ; Operand support.
 587
 588 ; Return the function name to use for WHAT or #f if there isn't a special one.
 589 ; WHAT is one of fget/fset/parse/insert/extract/print.
 590
 591 (method-make!
 592  <operand> 'gen-function-name
 593  (lambda (self what)
 594    (let ((handlers (elm-get self 'handlers)))
 595      (let ((fn (assq-ref handlers what)))
 596        (and fn (string-append (symbol->string what) "_" (car fn))))))
 597 )
 598
 599 ; Interface fns.
 600 ; The default is to forward the request onto TYPE.
 601 ; OP is a copy of SELF so the method we forward to sees it.
 602 ; There is one case in the fget/fset/parse/insert/extract/print
 603 ; switches for each operand.
 604 ; These are invoked via gen-switch.
 605
 606 ; Emit C code to get an operand value from the fields struct.
 607 ; Operand values are stored in a struct "indexed" by field name.
 608 ;
 609 ; The "f" prefix (e.g. set -> fset) is for "field" to distinguish the
 610 ; operations from similar ones in other contexts.  ??? I'd prefer to come
 611 ; up with better names for fget/fset but I haven't come up with anything
 612 ; satisfactory yet.
 613
 614 (method-make!
 615  <operand> 'gen-fget
 616  (lambda (self operand)
 617    (case (hw-index:type (op:index self))
 618      ((ifield)
 619       (string-append "      value = "
 620                      (gen-operand-result-var (op-ifield self))
 621                      ";\n"))
 622      (else
 623       "      value = 0;\n")))
 624 )
 625
 626 (method-make!
 627  <derived-operand> 'gen-fget
 628  (lambda (self operand)
 629    "      abort();\n") ; should never be called
 630 )
 631
 632 ; Emit C code to save an operand value in the fields struct.
 633
 634 (method-make!
 635  <operand> 'gen-fset
 636  (lambda (self operand)
 637    (case (hw-index:type (op:index self))
 638      ((ifield)
 639       (string-append "      "
 640                      (gen-operand-result-var (op-ifield self))
 641                      " = value;\n"))
 642      (else
 643       ""))) ; ignore
 644 )
 645
 646 (method-make!
 647  <derived-operand> 'gen-fset
 648  (lambda (self operand)
 649    "      abort();\n") ; should never be called
 650 )
 651
 652 ; Need to call op:type to resolve the hardware reference.
 653 ;(method-make-forward! <operand> 'type '(gen-parse gen-print))
 654
 655 (method-make!
 656  <operand> 'gen-parse
 657  (lambda (self operand)
 658    (send (op:type self) 'gen-parse operand))
 659 )
 660
 661 (method-make!
 662  <derived-operand> 'gen-parse
 663  (lambda (self operand)
 664    "      abort();\n") ; should never be called
 665 )
 666
 667 (method-make!
 668  <operand> 'gen-print
 669  (lambda (self operand)
 670    (send (op:type self) 'gen-print operand))
 671 )
 672
 673 (method-make!
 674  <derived-operand> 'gen-print
 675  (lambda (self operand)
 676    "      abort();\n") ; should never be called
 677 )
 678
 679 (method-make-forward! <operand> 'index '(gen-insert gen-extract))
 680 ; But: <derived-operand> has its own gen-insert / gen-extract.
 681
 682 ; Return the value of PC.
 683 ; Used by insert/extract fields.
 684
 685 (method-make!
 686  <pc> 'cxmake-get
 687  (lambda (self estate mode index selector)
 688    (cx:make IAI "pc"))
 689 )
 690 \f
 691 ; Opcodes init,finish,analyzer support.
 692
 693 ; Initialize any opcodes specific things before loading the .cpu file.
 694
 695 (define (opcodes-init!)
 696   (desc-init!)
 697   (mode-set-biggest-word-bitsizes!)
 698   *UNSPECIFIED*
 699 )
 700
 701 ; Finish any opcodes specific things after loading the .cpu file.
 702 ; This is separate from analyze-data! as cpu-load performs some
 703 ; consistency checks in between.
 704
 705 (define (opcodes-finish!)
 706   (desc-finish!)
 707   *UNSPECIFIED*
 708 )
 709
 710 ; Compute various needed globals and assign any computed fields of
 711 ; the various objects.  This is the standard routine that is called after
 712 ; a .cpu file is loaded.
 713
 714 (define (opcodes-analyze!)
 715   (desc-analyze!)
 716
 717   ; Initialize the rtl->c translator.
 718   (rtl-c-config!)
 719
 720   ; Only include semantic operands when computing the format tables if we're
 721   ; generating operand instance tables.
 722   ; ??? Actually, may always be able to exclude the semantic operands.
 723   ; Still need to traverse the semantics to derive machine computed attributes.
 724   (arch-analyze-insns! CURRENT-ARCH
 725                        #t ; include aliases
 726                        /opcodes-build-operand-instance-table?)
 727
 728   *UNSPECIFIED*
 729 )
 730 \f
 731 ; Extra target specific code generation.
 732
 733 ; Pick out a section from the .opc file.
 734 ; The section is delimited with:
 735 ; /* -- name ... */
 736 ; ...
 737 ; /* -- ... */
 738 ;
 739 ; FIXME: This is a pretty involved bit of code.  'twould be nice to split
 740 ; it up into manageable chunks.
 741
 742 (define (read-cpu.opc opc-file delim)
 743   (let ((file opc-file)
 744         (start-delim (string-append "/* -- " delim))
 745         (end-delim "/* -- "))
 746     (if (file-exists? file)
 747         (let ((port (open-file file "r"))
 748               ; Extra amount is added to SIZE so substring's to fetch possible
 749               ; delim won't fail, even at end of file
 750               (size (+ (file-size file) (string-length start-delim))))
 751           (if port
 752               (let ((result (make-string size #\space)))
 753                 (let loop ((start -1) (line 0) (index 0))
 754                   (let ((char (read-char port)))
 755                     (if (not (eof-object? char))
 756                         (string-set! result index char))
 757                     (cond ((eof-object? char)
 758                            (begin
 759                              (close-port port)
 760                              ; End of file, did we find the text?
 761                              (if (=? start -1)
 762                                  ""
 763                                  (substring result start index))))
 764                           ((char=? char #\newline)
 765                            ; Check for start delim or end delim?
 766                            (if (=? start -1)
 767                                (if (string=? (substring result line
 768                                                         (+ (string-length start-delim)
 769                                                            line))
 770                                              start-delim)
 771                                    (loop line (+ index 1) (+ index 1))
 772                                    (loop -1 (+ index 1) (+ index 1)))
 773                                (if (string=? (substring result line
 774                                                         (+ (string-length end-delim)
 775                                                            line))
 776                                              end-delim)
 777                                    (begin
 778                                      (close-port port)
 779                                      (substring result start (+ index 1)))
 780                                    (loop start (+ index 1) (+ index 1)))))
 781                           (else
 782                            (loop start line (+ index 1)))))))
 783                 (error "Unable to open:" file)))
 784         "" ; file doesn't exist
 785         ))
 786 )
 787
 788 (define (gen-extra-cpu.h opc-file arch)
 789   (logit 2 "Generating extra cpu.h stuff from " arch ".opc ...\n")
 790   (read-cpu.opc opc-file "cpu.h")
 791 )
 792 (define (gen-extra-cpu.c opc-file arch)
 793   (logit 2 "Generating extra cpu.c stuff from " arch ".opc ...\n")
 794   (read-cpu.opc opc-file "cpu.c")
 795 )
 796 (define (gen-extra-opc.h opc-file arch)
 797   (logit 2 "Generating extra opc.h stuff from " arch ".opc ...\n")
 798   (read-cpu.opc opc-file "opc.h")
 799 )
 800 (define (gen-extra-opc.c opc-file arch)
 801   (logit 2 "Generating extra opc.c stuff from " arch ".opc ...\n")
 802   (read-cpu.opc opc-file "opc.c")
 803 )
 804 (define (gen-extra-asm.c opc-file arch)
 805   (logit 2 "Generating extra asm.c stuff from " arch ".opc ...\n")
 806   (read-cpu.opc opc-file "asm.c")
 807 )
 808 (define (gen-extra-dis.c opc-file arch)
 809   (logit 2 "Generating extra dis.c stuff from " arch ".opc ...\n")
 810   (read-cpu.opc opc-file "dis.c")
 811 )
 812 (define (gen-extra-ibld.h opc-file arch)
 813   (logit 2 "Generating extra ibld.h stuff from " arch ".opc ...\n")
 814   (read-cpu.opc opc-file "ibld.h")
 815 )
 816 (define (gen-extra-ibld.c opc-file arch)
 817   (logit 2 "Generating extra ibld.c stuff from " arch ".opc ...\n")
 818   (read-cpu.opc opc-file "ibld.c")
 819 )
 820 \f
 821 ; For debugging.
 822
 823 (define (cgen-all)
 824   (string-write
 825    cgen-desc.h
 826    cgen-desc.c
 827    cgen-opinst.c
 828    cgen-opc.h
 829    cgen-opc.c
 830    cgen-ibld.h
 831    cgen-ibld.in
 832    cgen-asm.in
 833    cgen-dis.in
 834    )
 835 )