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