cgen/mach.scm

   1 ; CPU architecture description.
   2 ; Copyright (C) 2000, 2003, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; Top level class that records everything about a cpu.
   7 ; FIXME: Rename this to something else and rename <arch-data> to <arch>
   8 ; for consistency with other classes (define-foo -> <foo> object).
   9
  10 (define <arch>
  11   (class-make '<arch>
  12               nil
  13               '(
  14                 ; An object of type <arch-data>.
  15                 data
  16
  17                 ;; ??? All should really be assumed to be a black-box table.
  18                 (attr-list . (() . ()))
  19                 (enum-list . ())
  20                 (kw-list . ())
  21                 (isa-list . ())
  22                 (cpu-list . ())
  23                 (mach-list . ())
  24                 (model-list . ())
  25                 (ifld-table . ())
  26                 (hw-list . ())
  27                 (op-table . ())
  28                 (ifmt-list . ())
  29                 (sfmt-list . ())
  30                 (insn-table . ())
  31                 (minsn-table . ())
  32                 (subr-list . ())
  33
  34                 (insn-extract . #f) ; FIXME: wip (and move elsewhere)
  35                 (insn-execute . #f) ; FIXME: wip (and move elsewhere)
  36
  37                 ; standard values derived from the input data
  38                 derived
  39
  40                 ; #t if multi-insns have been instantiated
  41                 (multi-insns-instantiated? . #f)
  42                 ; #t if instructions have been analyzed
  43                 (insns-analyzed? . #f)
  44                 ; #t if semantics were included in the analysis
  45                 (semantics-analyzed? . #f)
  46                 ; #t if alias insns were included in the analysis
  47                 (aliases-analyzed? . #f)
  48
  49                 ; ordinal of next object that needs one
  50                 (next-ordinal . 0)
  51                 )
  52               nil)
  53 )
  54
  55 ; Accessors.
  56 ; Each getter is arch-foo.
  57 ; Each setter is arch-set-foo!.
  58
  59 (define-getters <arch> arch
  60   (data
  61    attr-list enum-list kw-list
  62    isa-list cpu-list mach-list model-list
  63    ifld-table hw-list op-table ifmt-list sfmt-list
  64    insn-table minsn-table subr-list
  65    derived
  66    multi-insns-instantiated?
  67    insns-analyzed? semantics-analyzed? aliases-analyzed?
  68    next-ordinal
  69    )
  70 )
  71
  72 (define-setters <arch> arch
  73   (data
  74    attr-list enum-list kw-list
  75    isa-list cpu-list mach-list model-list
  76    ifld-table hw-list op-table ifmt-list sfmt-list
  77    insn-table minsn-table subr-list
  78    derived
  79    multi-insns-instantiated?
  80    insns-analyzed? semantics-analyzed? aliases-analyzed?
  81    next-ordinal
  82    )
  83 )
  84
  85 ; For elements recorded as a table, return a sorted list.
  86 ; ??? All elements should really be assumed to be a black-box table.
  87
  88 (define (arch-ifld-list arch)
  89   (/ident-object-table->list (arch-ifld-table arch))
  90 )
  91
  92 (define (arch-op-list arch)
  93   (/ident-object-table->list (arch-op-table arch))
  94 )
  95
  96 (define (arch-insn-list arch)
  97   (/ident-object-table->list (arch-insn-table arch))
  98 )
  99
 100 (define (arch-minsn-list arch)
 101   (/ident-object-table->list (arch-minsn-table arch))
 102 )
 103
 104 ;; Get the next ordinal and increment it for the next time.
 105
 106 (define (/get-next-ordinal! arch)
 107   (let ((ordinal (arch-next-ordinal arch)))
 108     (arch-set-next-ordinal! arch (+ ordinal 1))
 109     ordinal)
 110 )
 111
 112 ;; FIXME: temp hack for current-ifld-lookup, current-op-lookup.
 113 ;; Return the element of list L with the lowest ordinal.
 114
 115 (define (/get-lowest-ordinal l)
 116   (let ((lowest-obj #f)
 117         (lowest-ord (/get-next-ordinal! CURRENT-ARCH)))
 118     (for-each (lambda (elm)
 119                 (if (< (obj-ordinal elm) lowest-ord)
 120                     (begin
 121                       (set! lowest-obj elm)
 122                       (set! lowest-ord (obj-ordinal elm)))))
 123               l)
 124     lowest-obj)
 125 )
 126
 127 ;; Table of <source-ident> objects with two access styles:
 128 ;; hash lookup, ordered list.
 129 ;; The main table is the hash table, the list is lazily created and cached.
 130 ;; The table is recorded as (hash-table . list).
 131 ;; The list is #f if it needs to be computed.
 132 ;; Each entry in the hash table is a list, multiple objects can have the same
 133 ;; key (e.g. insns from different isas can have the same name).
 134 ;;
 135 ;; This relies on the ordinal element of <source-ident> objects to build the
 136 ;; ordered list.
 137
 138 (define (/make-ident-object-table hash-size)
 139   (cons (make-hash-table hash-size) #f)
 140 )
 141
 142 ;; Return ordered list.
 143 ;;
 144 ;; To allow splicing in new objects we recognize two kinds of ordinal numbers:
 145 ;; integer and (integer . integer) where the latter is a pair of
 146 ;; major-ordinal-number and minor-ordinal-number.
 147
 148 (define (/ident-object-table->list iot)
 149   (if (cdr iot)
 150       (cdr iot)
 151       (let ((unsorted (hash-fold (lambda (key value prior)
 152                                    ;; NOTE: {value} usually contains just
 153                                    ;; one element.
 154                                    (append value prior))
 155                                  '()
 156                                  (car iot))))
 157         (set-cdr! iot
 158                   (sort unsorted (lambda (a b)
 159                                    ;; Ordinals are either an integer or
 160                                    ;; (major . minor).
 161                                    (let ((oa (obj-ordinal a))
 162                                          (ob (obj-ordinal b)))
 163                                      ;; Quick test for common case.
 164                                      (if (and (number? oa) (number? ob))
 165                                          (< oa ob)
 166                                          (let ((maj-a (if (pair? oa) (car oa) oa))
 167                                                (maj-b (if (pair? ob) (car ob) ob))
 168                                                (min-a (if (pair? oa) (cdr oa) 0))
 169                                                (min-b (if (pair? ob) (cdr ob) 0)))
 170                                            (cond ((< maj-a maj-b) #t)
 171                                                  ((= maj-a maj-b) (< min-a min-b))
 172                                                  (else #f))))))))
 173         (cdr iot)))
 174 )
 175
 176 ;; Add an entry to an ident-object-table.
 177
 178 (define (/ident-object-table-add! arch iot key object)
 179   ;; Give OBJECT an ordinal if it doesn't have one already.
 180   (if (not (obj-ordinal object))
 181       (obj-set-ordinal! object (/get-next-ordinal! arch)))
 182
 183   ;; Remember: Elements in the hash table are lists of objects, this is because
 184   ;; multiple objects can have the same key if they come from different isas.
 185   (let ((elm (hashq-ref (car iot) key)))
 186     (if elm
 187         (hashq-set! (car iot) key (cons object elm))
 188         (hashq-set! (car iot) key (cons object nil))))
 189
 190   ;; Need to recompute the sorted list.
 191   (set-cdr! iot #f)
 192
 193   *UNSPECIFIED*
 194 )
 195
 196 ;; Look up KEY in an ident-object-table.
 197
 198 (define (/ident-object-table-lookup iot key)
 199   (hashq-ref iot key)
 200 )
 201
 202 ; Class for recording things specified in `define-arch'.
 203 ; This simplifies define-arch as the global arch object CURRENT-ARCH
 204 ; must exist before loading the .cpu file.
 205
 206 (define <arch-data>
 207   (class-make '<arch-data>
 208               '(<ident>)
 209               '(
 210                 ; Default alignment of memory operations.
 211                 ; One of aligned, unaligned, forced.
 212                 default-alignment
 213
 214                 ; Orientation of insn bit numbering (#f->msb=0, #t->lsb=0).
 215                 insn-lsb0?
 216
 217                 ; List of all machs.
 218                 ; Each element is pair of (mach-name . sanitize-key)
 219                 ; where sanitize-key is #f if there is none.
 220                 ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah
 221                 machs
 222
 223                 ; List of all isas (instruction set architecture).
 224                 ; Each element is a pair of (isa-name . sanitize-key)
 225                 ; where sanitize-key is #f if there is none.
 226                 ; There is usually just one.  ARM has two (arm, thumb).
 227                 ; blah blah blah ... ooohhh, evil sanitize key, blah blah blah
 228                 isas
 229
 230                 ; ??? Defaults for other things should be here.
 231                 )
 232               nil)
 233 )
 234
 235 (define-getters <arch-data> adata
 236   (default-alignment insn-lsb0? machs isas)
 237 )
 238 \f
 239 ; Add, list, lookup accessors for <arch>.
 240 ;
 241 ; For the lookup routines, the result is the object or #f if not found.
 242 ; For some, if X is already an object, return that.
 243
 244 (define (current-arch-name) (obj:name (arch-data CURRENT-ARCH)))
 245
 246 (define (current-arch-comment) (obj:comment (arch-data CURRENT-ARCH)))
 247
 248 (define (current-arch-atlist) (obj-atlist (arch-data CURRENT-ARCH)))
 249
 250 (define (current-arch-default-alignment)
 251   (adata-default-alignment (arch-data CURRENT-ARCH)))
 252
 253 (define (current-arch-insn-lsb0?)
 254   (adata-insn-lsb0? (arch-data CURRENT-ARCH)))
 255
 256 (define (current-arch-mach-name-list)
 257   (map car (adata-machs (arch-data CURRENT-ARCH)))
 258 )
 259
 260 (define (current-arch-isa-name-list)
 261   (map car (adata-isas (arch-data CURRENT-ARCH)))
 262 )
 263
 264 ; Attributes.
 265 ; Recorded as a pair of lists.
 266 ; The car is a list of <attribute> objects.
 267 ; The cdr is an associative list of (name . <attribute>) elements, for lookup.
 268 ; Could use a hash table except that there currently aren't that many.
 269
 270 (define (current-attr-list) (car (arch-attr-list CURRENT-ARCH)))
 271
 272 (define (current-attr-add! a)
 273   ; NOTE: While putting this test in define-attr feels better, having it here
 274   ; is more robust, internal calls get checked too.  Thus it's here.
 275   ; Ditto for all the other such tests in this file.
 276   (if (current-attr-lookup (obj:name a))
 277       (parse-error (make-current-context "define-attr")
 278                    "attribute already defined" (obj:name a)))
 279   (let ((adata (arch-attr-list CURRENT-ARCH)))
 280     ; Build list in normal order so we don't have to reverse it at the end
 281     ; (since our format is non-trivial).
 282     (if (null? (car adata))
 283         (arch-set-attr-list! CURRENT-ARCH
 284                              (cons (cons a nil)
 285                                    (acons (obj:name a) a nil)))
 286         (begin
 287           (append! (car adata) (cons a nil))
 288           (append! (cdr adata) (acons (obj:name a) a nil)))))
 289   *UNSPECIFIED*
 290 )
 291
 292 (define (current-attr-lookup attr-name)
 293   (assq-ref (cdr (arch-attr-list CURRENT-ARCH)) attr-name)
 294 )
 295
 296 ; Enums.
 297
 298 (define (current-enum-list) (arch-enum-list CURRENT-ARCH))
 299
 300 (define (current-enum-add! e)
 301   (if (current-enum-lookup (obj:name e))
 302       (parse-error (make-current-context "define-enum")
 303                    "enum already defined" (obj:name e)))
 304   (arch-set-enum-list! CURRENT-ARCH (cons e (arch-enum-list CURRENT-ARCH)))
 305   *UNSPECIFIED*
 306 )
 307
 308 (define (current-enum-lookup enum-name)
 309   (object-assq enum-name (current-enum-list))
 310 )
 311
 312 ; Keywords.
 313
 314 (define (current-kw-list) (arch-kw-list CURRENT-ARCH))
 315
 316 (define (current-kw-add! kw)
 317   (if (current-kw-lookup (obj:name kw))
 318       (parse-error (make-current-context "define-keyword")
 319                    "keyword already defined" (obj:name kw)))
 320   (arch-set-kw-list! CURRENT-ARCH (cons kw (arch-kw-list CURRENT-ARCH)))
 321   *UNSPECIFIED*
 322 )
 323
 324 (define (current-kw-lookup kw-name)
 325   (object-assq kw-name (current-kw-list))
 326 )
 327
 328 ; Instruction sets.
 329
 330 (define (current-isa-list) (arch-isa-list CURRENT-ARCH))
 331
 332 (define (current-isa-add! i)
 333   (if (current-isa-lookup (obj:name i))
 334       (parse-error (make-current-context "define-isa")
 335                    "isa already defined" (obj:name i)))
 336   (arch-set-isa-list! CURRENT-ARCH (cons i (arch-isa-list CURRENT-ARCH)))
 337   *UNSPECIFIED*
 338 )
 339
 340 (define (current-isa-lookup isa-name)
 341   (object-assq isa-name (current-isa-list))
 342 )
 343
 344 ;; Given a list of objects OBJ-LIST, return those objects that are from the
 345 ;; ISA(s) in ISA-NAME-LIST.
 346 ;; ISA-NAME-LIST may be (all) or #f (which also means (all)).
 347
 348 (define (obj-filter-by-isa obj-list isa-name-list)
 349   (if (or (eq? isa-name-list #f)
 350           (memq 'all isa-name-list))
 351       obj-list
 352       (find (lambda (obj)
 353               (let ((obj-isas (obj-attr-value obj 'ISA)))
 354                 (non-null-intersection? obj-isas isa-name-list)))
 355             obj-list))
 356 )
 357
 358 ; Cpu families.
 359
 360 (define (current-cpu-list) (arch-cpu-list CURRENT-ARCH))
 361
 362 (define (current-cpu-add! c)
 363   (if (current-cpu-lookup (obj:name c))
 364       (parse-error (make-current-context "define-cpu")
 365                    "cpu already defined" (obj:name c)))
 366   (arch-set-cpu-list! CURRENT-ARCH (cons c (arch-cpu-list CURRENT-ARCH)))
 367   *UNSPECIFIED*
 368 )
 369
 370 (define (current-cpu-lookup cpu-name)
 371   (object-assq cpu-name (current-cpu-list))
 372 )
 373
 374 ; Machines.
 375
 376 (define (current-mach-list) (arch-mach-list CURRENT-ARCH))
 377
 378 (define (current-mach-add! m)
 379   (if (current-mach-lookup (obj:name m))
 380       (parse-error (make-current-context "define-mach")
 381                    "mach already defined" (obj:name m)))
 382   (arch-set-mach-list! CURRENT-ARCH (cons m (arch-mach-list CURRENT-ARCH)))
 383   *UNSPECIFIED*
 384 )
 385
 386 (define (current-mach-lookup mach-name)
 387   (object-assq mach-name (current-mach-list))
 388 )
 389
 390 ; Models.
 391
 392 (define (current-model-list) (arch-model-list CURRENT-ARCH))
 393
 394 (define (current-model-add! m)
 395   (if (current-model-lookup (obj:name m))
 396       (parse-error (make-current-context "define-model")
 397                    "model already defined" (obj:name m)))
 398   (arch-set-model-list! CURRENT-ARCH (cons m (arch-model-list CURRENT-ARCH)))
 399   *UNSPECIFIED*
 400 )
 401
 402 (define (current-model-lookup model-name)
 403   (object-assq model-name (current-model-list))
 404 )
 405
 406 ;; Hardware elements.
 407 ;;
 408 ;; NOTE: Hardware elements must be uniquely named across all machs and isas.
 409
 410 (define (current-hw-list) (arch-hw-list CURRENT-ARCH))
 411
 412 (define (current-hw-add! hw)
 413   (if (current-hw-lookup (obj:name hw))
 414       (parse-error (make-current-context "define-hardware")
 415                    "hardware already defined" (obj:name hw)))
 416   (arch-set-hw-list! CURRENT-ARCH (cons hw (arch-hw-list CURRENT-ARCH)))
 417   *UNSPECIFIED*
 418 )
 419
 420 (define (current-hw-lookup hw)
 421   (if (object? hw)
 422       hw
 423       ; This doesn't use object-assq on purpose.  Hardware objects handle
 424       ; get-name specially.
 425       (find-first (lambda (hw-obj) (eq? (send hw-obj 'get-name) hw))
 426                   (current-hw-list)))
 427 )
 428
 429 ;; Instruction fields.
 430 ;;
 431 ;; NOTE: Instruction fields must be uniquely named across all machs,
 432 ;; but isas may share ifields with the same name.
 433
 434 (define (current-ifld-list)
 435   (/ident-object-table->list (arch-ifld-table CURRENT-ARCH))
 436 )
 437
 438 (define (current-ifld-add! f)
 439   (if (/ifld-already-defined? f)
 440       (parse-error (make-obj-context f "define-ifield")
 441                    "ifield already defined" (obj:name f)))
 442   (/ident-object-table-add! CURRENT-ARCH (arch-ifld-table CURRENT-ARCH)
 443                             (obj:name f) f)
 444   *UNSPECIFIED*
 445 )
 446
 447 ;; Look up ifield X in the current architecture.
 448 ;; Returns the <ifield> object or #f if not found.
 449 ;; If there is an ambiguity (i.e. the ifield is in multiple ISAs and
 450 ;; MAYBE-ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
 451 ;;
 452 ;; If X is an <ifield> object, just return it.
 453 ;; This is to handle ???
 454 ;; Otherwise X is the name of the ifield to look up.
 455 ;; If MAYBE-ISA-NAME-LIST is provided, the car is a list of ISAs to look in.
 456 ;; If the specified isa list is #f, look in all ISAs.
 457
 458 (define (current-ifld-lookup x . maybe-isa-name-list)
 459   (if (ifield? x)
 460       x
 461       (let ((f-list (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
 462                                                 x)))
 463         (if f-list
 464             (let* ((isas (if (not (null? maybe-isa-name-list)) (car maybe-isa-name-list) #f))
 465                    (filtered-f-list (obj-filter-by-isa f-list isas)))
 466               (case (length filtered-f-list)
 467                 ((0) (error "Ifield not in specified ISA:" x))
 468                 ((1) (car filtered-f-list))
 469                 (else (error "Ambiguous ifield lookup:" x))))
 470             #f)))
 471 )
 472
 473 ; Return a boolean indicating if <ifield> F is currently defined.
 474 ; This is slightly complicated because multiple isas can have different
 475 ; ifields with the same name.
 476
 477 (define (/ifld-already-defined? f)
 478   (let ((iflds (/ident-object-table-lookup (car (arch-ifld-table CURRENT-ARCH))
 479                                            (obj:name f))))
 480     ; We've got all the ifields with the same name,
 481     ; now see if any have the same ISA as F.
 482     (if iflds
 483         (let ((result #f)
 484               (f-isas (obj-isa-list f)))
 485           (for-each (lambda (ff)
 486                       (if (non-null-intersection? f-isas (obj-isa-list ff))
 487                           (set! result #t)))
 488                     iflds)
 489           result)
 490         #f))
 491 )
 492
 493 ;; Operands.
 494 ;;
 495 ;; NOTE: Operands must be uniquely named across all machs,
 496 ;; but isas may share operands with the same name.
 497
 498 (define (current-op-list)
 499   (/ident-object-table->list (arch-op-table CURRENT-ARCH))
 500 )
 501
 502 (define (current-op-add! op)
 503   (if (/op-already-defined? op)
 504       (parse-error (make-obj-context op "define-operand")
 505                    "operand already defined" (obj:name op)))
 506   (/ident-object-table-add! CURRENT-ARCH (arch-op-table CURRENT-ARCH)
 507                             (obj:name op) op)
 508   *UNSPECIFIED*
 509 )
 510
 511 ;; Look up operand NAME in the current architecture.
 512 ;; Returns the <operand> object or #f if not found.
 513 ;; If there is an ambiguity (i.e. the operand is in multiple ISAs and
 514 ;; MAYBE-ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
 515 ;;
 516 ;; If MAYBE-ISA-NAME-LIST is provided, the car is a list of ISAs to look in.
 517 ;; If the specified isa list is #f, look in all ISAs.
 518
 519 (define (current-op-lookup name . maybe-isa-name-list)
 520   (let ((op-list (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
 521                                              name)))
 522     (if op-list
 523         (let* ((isas (if (not (null? maybe-isa-name-list)) (car maybe-isa-name-list) #f))
 524                (filtered-o-list (obj-filter-by-isa op-list isas)))
 525           (case (length filtered-o-list)
 526             ((0) (error "Operand not in specified ISA:" name))
 527             ((1) (car filtered-o-list))
 528             (else (error "Ambiguous operand lookup:" name))))
 529         #f))
 530 )
 531
 532 ; Return a boolean indicating if <operand> OP is currently defined.
 533 ; This is slightly complicated because multiple isas can have different
 534 ; operands with the same name.
 535
 536 (define (/op-already-defined? op)
 537   (let ((ops (/ident-object-table-lookup (car (arch-op-table CURRENT-ARCH))
 538                                          (obj:name op))))
 539     ; We've got all the operands with the same name,
 540     ; now see if any have the same ISA as OP.
 541     (if ops
 542         (let ((result #f)
 543               (op-isas (obj-isa-list op)))
 544           (for-each (lambda (o)
 545                       (if (non-null-intersection? op-isas (obj-isa-list o))
 546                           (set! result #t)))
 547                     ops)
 548           result)
 549         #f))
 550 )
 551
 552 ; Instruction field formats.
 553
 554 (define (current-ifmt-list) (arch-ifmt-list CURRENT-ARCH))
 555
 556 ; Semantic formats (akin to ifmt's, except includes semantics to distinguish
 557 ; insns).
 558
 559 (define (current-sfmt-list) (arch-sfmt-list CURRENT-ARCH))
 560
 561 ;; Instructions.
 562 ;;
 563 ;; NOTE: Instructions must be uniquely named across all machs,
 564 ;; but isas may share instructions with the same name.
 565
 566 (define (current-insn-list)
 567   (/ident-object-table->list (arch-insn-table CURRENT-ARCH))
 568 )
 569
 570 (define (current-insn-add! i)
 571   (if (/insn-already-defined? i)
 572       (parse-error (make-obj-context i "define-insn")
 573                    "insn already defined" (obj:name i)))
 574   (/ident-object-table-add! CURRENT-ARCH (arch-insn-table CURRENT-ARCH)
 575                             (obj:name i) i)
 576   *UNSPECIFIED*
 577 )
 578
 579 ;; Look up insn NAME in the current architecture.
 580 ;; Returns the <insn> object or #f if not found.
 581 ;; If there is an ambiguity (i.e. the insn is in multiple ISAs and
 582 ;; ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
 583 ;; If the specified isa list is #f, look in all ISAs.
 584
 585 (define (current-insn-lookup name isa-name-list)
 586   (let ((i-list (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
 587                                             name)))
 588     (if i-list
 589         (let ((filtered-i-list (obj-filter-by-isa i-list isa-name-list)))
 590           (case (length filtered-i-list)
 591             ((0) (error "Insn not in specified ISA:" name))
 592             ((1) (car filtered-i-list))
 593             (else (error "Ambiguous insn lookup:" name))))
 594         #f))
 595 )
 596
 597 ; Return a boolean indicating if <insn> INSN is currently defined.
 598 ; This is slightly complicated because multiple isas can have different
 599 ; insns with the same name.
 600
 601 (define (/insn-already-defined? insn)
 602   (let ((insns (/ident-object-table-lookup (car (arch-insn-table CURRENT-ARCH))
 603                                            (obj:name insn))))
 604     ; We've got all the insns with the same name,
 605     ; now see if any have the same ISA as INSN.
 606     (if insns
 607         (let ((result #f)
 608               (insn-isas (obj-isa-list insn)))
 609           (for-each (lambda (i)
 610                       (if (non-null-intersection? insn-isas (obj-isa-list i))
 611                           (set! result #t)))
 612                     insns)
 613           result)
 614         #f))
 615 )
 616
 617 ;; Macro instructions.
 618 ;;
 619 ;; NOTE: Instructions must be uniquely named across all machs,
 620 ;; but isas may share instructions with the same name.
 621
 622 (define (current-minsn-list)
 623   (/ident-object-table->list (arch-minsn-table CURRENT-ARCH))
 624 )
 625
 626 (define (current-minsn-add! m)
 627   (if (/minsn-already-defined? m)
 628       (parse-error (make-obj-context m "define-minsn")
 629                    "macro-insn already defined" (obj:name m)))
 630   (/ident-object-table-add! CURRENT-ARCH (arch-minsn-table CURRENT-ARCH)
 631                             (obj:name m) m)
 632   *UNSPECIFIED*
 633 )
 634
 635 ;; Look up minsn NAME in the current architecture.
 636 ;; Returns the <macro-insn> object or #f if not found.
 637 ;; If there is an ambiguity (i.e. the minsn is in multiple ISAs and
 638 ;; ISA-NAME-LIST doesn't disambiguate the choice) an error is signalled.
 639 ;; If the specified isa list is #f, look in all ISAs.
 640
 641 (define (current-minsn-lookup name isa-name-list)
 642   (let ((m-list (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
 643                                             name)))
 644     (if m-list
 645         (let ((filtered-m-list (obj-filter-by-isa m-list isa-name-list)))
 646           (case (length filtered-m-list)
 647             ((0) (error "Macro-insn not in specified ISA:" name))
 648             ((1) (car filtered-m-list))
 649             (else (error "Ambiguous macro-insn lookup:" name))))
 650         #f))
 651 )
 652
 653 ; Return a boolean indicating if <macro-insn> MINSN is currently defined.
 654 ; This is slightly complicated because multiple isas can have different
 655 ; macro-insns with the same name.
 656
 657 (define (/minsn-already-defined? m)
 658   (let ((minsns (/ident-object-table-lookup (car (arch-minsn-table CURRENT-ARCH))
 659                                             (obj:name m))))
 660     ; We've got all the macro-insns with the same name,
 661     ; now see if any have the same ISA as M.
 662     (if minsns
 663         (let ((result #f)
 664               (m-isas (obj-isa-list m)))
 665           (for-each (lambda (mm)
 666                       (if (non-null-intersection? m-isas (obj-isa-list mm))
 667                           (set! result #t)))
 668                     minsns)
 669           result)
 670         #f))
 671 )
 672
 673 ; rtx subroutines.
 674
 675 (define (current-subr-list) (map cdr (arch-subr-list CURRENT-ARCH)))
 676
 677 (define (current-subr-add! s)
 678   (if (current-subr-lookup (obj:name s))
 679       (parse-error (make-current-context "define-subr")
 680                    "subroutine already defined" (obj:name s)))
 681   (arch-set-subr-list! CURRENT-ARCH
 682                        (acons (obj:name s) s (arch-subr-list CURRENT-ARCH)))
 683   *UNSPECIFIED*
 684 )
 685
 686 (define (current-subr-lookup name)
 687   (assq-ref (arch-subr-list CURRENT-ARCH) name)
 688 )
 689 \f
 690 ; Arch parsing support.
 691
 692 ; Parse an alignment spec.
 693
 694 (define (/arch-parse-alignment context alignment)
 695   (if (memq alignment '(aligned unaligned forced))
 696       alignment
 697       (parse-error context "invalid alignment" alignment))
 698 )
 699
 700 ; Parse an arch mach spec.
 701 ; The value is a list of mach names or (mach-name sanitize-key) elements.
 702 ; The result is a list of (mach-name . sanitize-key) elements.
 703
 704 (define (/arch-parse-machs context machs)
 705   (for-each (lambda (m)
 706               (if (or (symbol? m)
 707                       (and (list? m) (= (length m) 2)
 708                            (symbol? (car m)) (symbol? (cadr m))))
 709                   #t ; ok
 710                   (parse-error context "bad arch mach spec" m)))
 711             machs)
 712   (map (lambda (m)
 713          (if (symbol? m)
 714              (cons m #f)
 715              (cons (car m) (cadr m))))
 716        machs)
 717 )
 718
 719 ; Parse an arch isa spec.
 720 ; The value is a list of isa names or (isa-name sanitize-key) elements.
 721 ; The result is a list of (isa-name . sanitize-key) elements.
 722
 723 (define (/arch-parse-isas context isas)
 724   (for-each (lambda (m)
 725               (if (or (symbol? m)
 726                       (and (list? m) (= (length m) 2)
 727                            (symbol? (car m)) (symbol? (cadr m))))
 728                   #t ; ok
 729                   (parse-error context "bad arch isa spec" m)))
 730             isas)
 731   (map (lambda (m)
 732          (if (symbol? m)
 733              (cons m #f)
 734              (cons (car m) (cadr m))))
 735        isas)
 736 )
 737
 738 ; Parse an architecture description
 739 ; This is the main routine for building an arch object from a cpu
 740 ; description in the .cpu file.
 741 ; All arguments are in raw (non-evaluated) form.
 742
 743 (define (/arch-parse context name comment attrs
 744                      default-alignment insn-lsb0?
 745                      machs isas)
 746   (logit 2 "Processing arch " name " ...\n")
 747   (make <arch-data>
 748     (parse-name context name)
 749     (parse-comment context comment)
 750     (atlist-parse context attrs "arch")
 751     (/arch-parse-alignment context default-alignment)
 752     (parse-boolean context insn-lsb0?)
 753     (/arch-parse-machs context machs)
 754     (/arch-parse-isas context isas))
 755 )
 756
 757 ; Read an architecture description.
 758 ; This is the main routine for analyzing an arch description in the .cpu file.
 759 ; ARG-LIST is an associative list of field name and field value.
 760 ; parse-arch is invoked to create the `arch' object.
 761
 762 (define /arch-read
 763   (lambda arg-list
 764     (let ((context "arch-read")
 765           ; <arch-data> object members and default values
 766           (name "unknown")
 767           (comment "")
 768           (attrs nil)
 769           (default-alignment 'aligned)
 770           (insn-lsb0? #f)
 771           (machs #f)
 772           (isas #f)
 773           )
 774       ; Loop over each element in ARG-LIST, recording what's found.
 775       (let loop ((arg-list arg-list))
 776         (if (null? arg-list)
 777             nil
 778             (let ((arg (car arg-list))
 779                   (elm-name (caar arg-list)))
 780               (case elm-name
 781                 ((name) (set! name (cadr arg)))
 782                 ((comment) (set! comment (cadr arg)))
 783                 ((attrs) (set! attrs (cdr arg)))
 784                 ((default-alignment) (set! default-alignment (cadr arg)))
 785                 ((insn-lsb0?) (set! insn-lsb0? (cadr arg)))
 786                 ((machs) (set! machs (cdr arg)))
 787                 ((isas) (set! isas (cdr arg)))
 788                 (else (parse-error context "invalid arch arg" arg)))
 789               (loop (cdr arg-list)))))
 790       ; Ensure required fields are present.
 791       (if (not machs)
 792           (parse-error context "missing machs spec"))
 793       (if (not isas)
 794           (parse-error context "missing isas spec"))
 795       ; Now that we've identified the elements, build the object.
 796       (/arch-parse context name comment attrs default-alignment insn-lsb0?
 797                    machs isas)
 798       )
 799     )
 800 )
 801
 802 ; Define an arch object, name/value pair list version.
 803
 804 (define define-arch
 805   (lambda arg-list
 806     (let ((a (apply /arch-read arg-list)))
 807       (arch-set-data! CURRENT-ARCH a)
 808       (def-mach-attr! (adata-machs a))
 809       (keep-mach-validate!)
 810       (def-isa-attr! (adata-isas a))
 811       (keep-isa-validate!)
 812       ; Install the builtin objects now that we have an arch, and now that
 813       ; attributes MACH and ISA exist.
 814       (reader-install-builtin!)
 815       a))
 816 )
 817 \f
 818 ; Mach/isa processing.
 819
 820 ; Create the MACH attribute.
 821 ; MACHS is the canonicalized machs spec to define-arch: (name . sanitize-key).
 822
 823 (define (def-mach-attr! machs)
 824   (let ((mach-enums (append
 825                      '((base))
 826                      (map (lambda (mach)
 827                             (cons (car mach)
 828                                   (cons '-
 829                                         (if (cdr mach)
 830                                             (list (cons 'sanitize (cdr mach)))
 831                                             nil))))
 832                           machs)
 833                      '((max)))))
 834     (define-attr '(type bitset) '(name MACH)
 835       '(comment "machine type selection")
 836       '(default base) (cons 'values mach-enums))
 837     )
 838
 839   *UNSPECIFIED*
 840 )
 841
 842 ; Return #t if MACH is supported by OBJ.
 843 ; This is done by looking for the MACH attribute in OBJ.
 844 ; By definition, objects that support the default (base) mach support
 845 ; all machs.
 846
 847 (define (mach-supports? mach obj)
 848   (let ((machs (obj-attr-value obj 'MACH))
 849         (name (obj:name mach)))
 850     (or (memq name machs)
 851         (memq 'base machs)))
 852         ;(let ((deflt (attr-lookup-default 'MACH obj)))
 853         ;  (any-true? (map (lambda (m) (memq m deflt)) machs)))))
 854 )
 855
 856 ; Create the ISA attribute.
 857 ; ISAS is the canonicalized isas spec to define-arch: (name . sanitize-key).
 858 ; ISAS is a list of isa names.
 859
 860 (define (def-isa-attr! isas)
 861   (let ((isa-enums (append
 862                     (map (lambda (isa)
 863                            (cons (car isa)
 864                                  (cons '-
 865                                        (if (cdr isa)
 866                                            (list (cons 'sanitize (cdr isa)))
 867                                            nil))))
 868                          isas)
 869                     '((max)))))
 870     (define-attr '(type bitset) '(name ISA)
 871       '(comment "instruction set selection")
 872       ; If there's only one isa, don't (yet) pollute the tables with a value
 873       ; for it.
 874       (if (= (length isas) 1)
 875           '(for)
 876           '(for ifield operand insn hardware))
 877       (cons 'default (list (caar isa-enums)))
 878       (cons 'values isa-enums))
 879     )
 880
 881   *UNSPECIFIED*
 882 )
 883
 884 ; Return the bitset attr value for all isas.
 885
 886 (define (all-isas-attr-value)
 887   (current-arch-isa-name-list)
 888 )
 889
 890 ; Return an ISA attribute of all isas.
 891 ; This is useful for things like f-nil which exist across all isas.
 892
 893 (define (all-isas-attr)
 894   (bitset-attr-make 'ISA (all-isas-attr-value))
 895 )
 896
 897 ; Return list of ISA names specified by attribute object ATLIST.
 898
 899 (define (attr-isa-list atlist)
 900   (atlist-attr-value atlist 'ISA #f)
 901 )
 902
 903 ; Return list of ISA names specified by OBJ.
 904
 905 (define (obj-isa-list obj)
 906   (obj-attr-value obj 'ISA)
 907 )
 908
 909 ; Return #t if <isa> ISA is supported by OBJ.
 910 ; This is done by looking for the ISA attribute in OBJ.
 911
 912 (define (isa-supports? isa obj)
 913   (let ((isas (obj-isa-list obj))
 914         (name (obj:name isa)))
 915     (->bool (memq name isas)))
 916 )
 917 \f
 918 ; The fetch/decode/execute process.
 919 ; "extract" is a fancy word for fetch/decode.
 920 ; FIXME: wip, not currently used.
 921 ; FIXME: move to inside define-isa, and maybe elsewhere.
 922 ;
 923 ;(defmacro
 924 ;  define-extract (code)
 925 ;  ;(arch-set-insn-extract! CURRENT-ARCH code)
 926 ;  *UNSPECIFIED*
 927 ;)
 928 ;
 929 ;(defmacro
 930 ;  define-execute (code)
 931 ;  ;(arch-set-insn-execute! CURRENT-ARCH code)
 932 ;  *UNSPECIFIED*
 933 ;)
 934 \f
 935 ; ISA specification.
 936 ; Each architecture is generally one isa, but in the case of ARM (and a few
 937 ; others) there is more than one.
 938 ;
 939 ; ??? "ISA" has a very well defined meaning, and our usage of it one might
 940 ; want to quibble over.  A better name would be welcome.
 941
 942 ; Associated with an instruction set is its framing.
 943 ; This refers to how instructions are laid out at the liw level (where several
 944 ; insns are framed together and executed sequentially or in parallel).
 945 ; ??? If one defines the term "format" as being how an individual instruction
 946 ; is laid out then formatting can be thought of as being different from
 947 ; framing.  However, it's possible for a particular ISA to intertwine the two.
 948 ; Thus this will need to evolve.
 949 ; ??? Not used yet, wip.
 950
 951 (define <iframe> ; pronounced I-frame
 952   (class-make '<iframe> '(<ident>)
 953               '(
 954                 ; list of <itype> objects that make up the frame
 955                 insns
 956
 957                 ; assembler syntax
 958                 syntax
 959
 960                 ; list of (length value) elements that make up the format
 961                 ; Length is in bits.  Value is either a number or a $number
 962                 ; symbol refering to the insn specified in `insns'.
 963                 value
 964
 965                 ; Initial bitnumbers to decode insns by.
 966                 ; ??? At present the rest of the decoding is determined
 967                 ; algorithmically.  May wish to give the user more control
 968                 ; [like psim].
 969                 decode-assist
 970
 971                 ; rtl that executes instructions in `value'
 972                 ; Fields specified in `value' can be used here.
 973                 action
 974                 )
 975               nil)
 976 )
 977
 978 ; Accessors.
 979
 980 (define-getters <iframe> iframe (insns syntax value decode-assist action))
 981
 982 ; Instruction types, recorded in <iframe>.
 983 ; ??? Not used yet, wip.
 984
 985 (define <itype>
 986   (class-make '<itype> '(<ident>)
 987               '(
 988                 ; length in bits, or initial part if variable length (wip)
 989                 length
 990
 991                 ; constraint specifying which insns are included
 992                 constraint
 993
 994                 ; Initial bitnumbers to decode insns by.
 995                 ; ??? At present the rest of the decoding is determined
 996                 ; algorithmically.  May wish to give the user more control
 997                 ; [like psim].
 998                 decode-assist
 999                 )
1000               nil)
1001 )
1002
1003 ; Accessors.
1004
1005 (define-getters <itype> itype (length constraint decode-assist))
1006
1007 ; Simulator instruction decode splitting.
1008 ; FIXME: Should live in simulator specific code.  Requires class handling
1009 ; cleanup first.
1010 ;
1011 ; Instructions can be split by particular values for an ifield.
1012 ; The ARM port uses this to split insns into those that set the pc and
1013 ; those that don't.
1014
1015 (define <decode-split>
1016   (class-make '<decode-split> '()
1017               '(
1018                 ; Name of ifield to split on.
1019                 name
1020
1021                 ; Constraint.  Only insns satifying this constraint are
1022                 ; split.  #f if no constraint.
1023                 constraint
1024
1025                 ; List of ifield splits.
1026                 ; Each element is one of (name value) or (name (values)).
1027                 values
1028                 )
1029               nil
1030               )
1031 )
1032
1033 ; Accessors.
1034
1035 (define-getters <decode-split> decode-split (name constraint values))
1036
1037 ; Parse a decode-split spec.
1038 ; SPEC is (ifield-name constraint value-list).
1039 ; CONSTRAINT is an rtl expression.  Only insns satifying the constraint
1040 ; are split.
1041 ; Each element of VALUE-LIST is one of (name value) or (name (values)).
1042 ; FIXME: All possible values must be specified.  Need an `else' clause.
1043 ; Ranges would also be useful.
1044
1045 (define (/isa-parse-decode-split context spec)
1046   (if (!= (length spec) 3)
1047       (parse-error context "decode-split spec is (ifield-name constraint value-list)" spec))
1048
1049   (let ((name (parse-name (car spec) context))
1050         (constraint (cadr spec))
1051         (value-list (caddr spec)))
1052
1053     ; FIXME: more error checking.
1054
1055     (make <decode-split>
1056       name
1057       (if (null? constraint) #f constraint)
1058       value-list))
1059 )
1060
1061 ; Parse a list of decode-split specs.
1062
1063 (define (/isa-parse-decode-splits context spec-list)
1064   (map (lambda (spec)
1065          (/isa-parse-decode-split context spec))
1066        spec-list)
1067 )
1068
1069 ; Top level class to describe an isa.
1070
1071 (define <isa>
1072   (class-make '<isa> '(<ident>)
1073               '(
1074                 ; Default length to record in ifields.
1075                 ; This is used in calculations involving bit numbers.
1076                 default-insn-word-bitsize
1077
1078                 ; Length of an unknown instruction.  Used by disassembly
1079                 ; and by the simulator's invalid insn handler.
1080                 default-insn-bitsize
1081
1082                 ; Number of bytes of insn that can be initially fetched.
1083                 ; In non-LIW isas this would be the length of the smallest
1084                 ; insn.  For LIW isas it depends - only one LIW isa is
1085                 ; currently supported (m32r).
1086                 base-insn-bitsize
1087
1088                 ; Initial bitnumbers to decode insns by.
1089                 ; ??? At present the rest of the decoding is determined
1090                 ; algorithmically.  May wish to give the user more control
1091                 ; [like psim].
1092                 decode-assist
1093
1094                 ; Number of instructions that can be fetched at a time
1095                 ; [e.g. 2 on m32r].
1096                 liw-insns
1097
1098                 ; Maximum number of instructions the cpu can execute in
1099                 ; parallel.
1100                 ; FIXME: Rename to max-parallel-insns.
1101                 parallel-insns
1102
1103                 ; List of <iframe> objects.
1104                 ;frames
1105
1106                 ; Condition tested before execution of any instruction or
1107                 ; #f if there is none.  For architectures like ARM, ARC.
1108                 ; If specified it is a pair of
1109                 ; (condition-field-name . rtl-for-condition)
1110                 (condition . #f)
1111
1112                 ; Code to execute after CONDITION and prior to SEMANTICS.
1113                 ; This is rtl in source form or #f if there is none.
1114                 ; This is generally unused.  It is used on the ARM to set
1115                 ; R15 to the correct value.
1116                 ; The reason it's not specified with SEMANTICS is that it is
1117                 ; believed some applications won't need/want this.
1118                 ; ??? It is a bit of a hack though, as it is used to aid
1119                 ; implementation of apps (e.g. simulator).  Arguably something
1120                 ; that doesn't belong here.  Maybe as more architectures are
1121                 ; ported that have the PC as a general register, a better way
1122                 ; to do this will arise.
1123                 (setup-semantics . #f)
1124
1125                 ; list of simulator instruction splits
1126                 ; FIXME: should live in simulator file (needs class cleanup).
1127                 (decode-splits . ())
1128
1129                 ; ??? More may need to migrate here.
1130                 )
1131               nil)
1132 )
1133
1134 ; Accessors.
1135
1136 (define-getters <isa> isa
1137   (base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1138    decode-assist liw-insns parallel-insns condition
1139    setup-semantics decode-splits)
1140 )
1141
1142 (define-setters <isa> isa
1143   (decode-splits)
1144 )
1145
1146 (define (isa-enum isa) (string-append "ISA_" (string-upcase (gen-sym isa))))
1147
1148 ; Return minimum/maximum size in bits of all insns in the isa.
1149
1150 (define (isa-min-insn-bitsize isa)
1151   ; add `65535' in case list is nil (avoids crash)
1152   ; [a language with infinite precision can't have min-reduce-iota-0 :-)]
1153   (apply min (cons 65535
1154                    (map insn-length (find (lambda (insn)
1155                                             (and (not (has-attr? insn 'ALIAS))
1156                                                  (isa-supports? isa insn)))
1157                                           (non-multi-insns (current-insn-list))))))
1158 )
1159
1160 (define (isa-max-insn-bitsize isa)
1161   ; add `0' in case list is nil (avoids crash)
1162   ; [a language with infinite precision can't have max-reduce-iota-0 :-)]
1163   (apply max (cons 0
1164                    (map insn-length (find (lambda (insn)
1165                                             (and (not (has-attr? insn 'ALIAS))
1166                                                  (isa-supports? isa insn)))
1167                                           (non-multi-insns (current-insn-list))))))
1168 )
1169
1170 ; Return a boolean indicating if instructions in ISA can be kept in a
1171 ; portable int.
1172
1173 (define (isa-integral-insn? isa)
1174   (<= (isa-max-insn-bitsize isa) 32)
1175 )
1176
1177 ;; Parse an isa decode-assist spec.
1178
1179 (define (/isa-parse-decode-assist context spec)
1180   (if (not (all-true? (map non-negative-integer? spec)))
1181       (parse-error context
1182                    "spec must consist of non-negative-integers"
1183                    spec))
1184   (if (not (= (length spec) (length (nub spec identity))))
1185       (parse-error context
1186                    "duplicate elements"
1187                    spec))
1188   spec
1189 )
1190
1191 ; Parse an isa condition spec.
1192 ; `condition' here refers to the condition performed by architectures like
1193 ; ARM and ARC before each insn.
1194
1195 (define (/isa-parse-condition context spec)
1196   (if (null? spec)
1197       #f
1198       (begin
1199         (if (or (!= (length spec) 2)
1200                 (not (symbol? (car spec)))
1201                 (not (form? (cadr spec))))
1202             (parse-error context
1203                          "condition spec not `(ifield-name rtl-code)'" spec))
1204         spec))
1205 )
1206
1207 ; Parse a setup-semantics spec.
1208
1209 (define (/isa-parse-setup-semantics context spec)
1210   (if (not (null? spec))
1211       spec
1212       #f)
1213 )
1214
1215 ; Parse an isa spec.
1216 ; The result is the <isa> object.
1217 ; All arguments are in raw (non-evaluated) form.
1218
1219 (define (/isa-parse context name comment attrs
1220                     base-insn-bitsize default-insn-bitsize default-insn-word-bitsize
1221                     decode-assist liw-insns parallel-insns condition
1222                     setup-semantics decode-splits)
1223   (logit 2 "Processing isa " name " ...\n")
1224
1225   ;; Pick out name first to augment the error context.
1226   (let* ((name (parse-name context name))
1227          (context (context-append-name context name)))
1228
1229     (if (not (memq name (current-arch-isa-name-list)))
1230         (parse-error context "isa name is not present in `define-arch'" name))
1231
1232     ; Isa's are always kept - we need them to validate later uses, even if
1233     ; the then resulting object won't be kept.  All isas are also needed to
1234     ; compute a proper value for the isas-cache member of <hardware-base>
1235     ; for builtin objects.
1236     (make <isa>
1237       name
1238       (parse-comment context comment)
1239       (atlist-parse context attrs "isa")
1240       (parse-number (context-append context
1241                                     ": default-insn-word-bitsize")
1242                     default-insn-word-bitsize '(8 . 128))
1243       (parse-number (context-append context
1244                                     ": default-insn-bitsize")
1245                     default-insn-bitsize '(8 . 128))
1246       (parse-number (context-append context
1247                                     ": base-insn-bitsize")
1248                     base-insn-bitsize '(8 . 128))
1249       (/isa-parse-decode-assist (context-append context
1250                                                 ": decode-assist")
1251                                 decode-assist)
1252       liw-insns
1253       parallel-insns
1254       (/isa-parse-condition context condition)
1255       (/isa-parse-setup-semantics context setup-semantics)
1256       (/isa-parse-decode-splits context decode-splits)
1257       ))
1258 )
1259
1260 ; Read an isa entry.
1261 ; ARG-LIST is an associative list of field name and field value.
1262
1263 (define (/isa-read context . arg-list)
1264   (let (
1265         (name #f)
1266         (attrs nil)
1267         (comment "")
1268         (base-insn-bitsize #f)
1269         (default-insn-bitsize #f)
1270         (default-insn-word-bitsize #f)
1271         (decode-assist nil)
1272         (liw-insns 1)
1273         ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1274         ;; in the `case' expression below because there is a local var
1275         ;; of the same name ("__1" gets appended to the symbol name).
1276         (parallel-insns- 1)
1277         (condition nil)
1278         (setup-semantics nil)
1279         (decode-splits nil)
1280         )
1281
1282     (let loop ((arg-list arg-list))
1283       (if (null? arg-list)
1284           nil
1285           (let ((arg (car arg-list))
1286                 (elm-name (caar arg-list)))
1287             (case elm-name
1288               ((name) (set! name (cadr arg)))
1289               ((comment) (set! comment (cadr arg)))
1290               ((attrs) (set! attrs (cdr arg)))
1291               ((default-insn-word-bitsize)
1292                (set! default-insn-word-bitsize (cadr arg)))
1293               ((default-insn-bitsize) (set! default-insn-bitsize (cadr arg)))
1294               ((base-insn-bitsize) (set! base-insn-bitsize (cadr arg)))
1295               ((decode-assist) (set! decode-assist (cadr arg)))
1296               ((liw-insns) (set! liw-insns (cadr arg)))
1297               ((parallel-insns) (set! parallel-insns- (cadr arg)))
1298               ((condition) (set! condition (cdr arg)))
1299               ((setup-semantics) (set! setup-semantics (cadr arg)))
1300               ((decode-splits) (set! decode-splits (cdr arg)))
1301               ((insn-types) #t) ; ignore for now
1302               ((frame) #t) ; ignore for now
1303               (else (parse-error context "invalid isa arg" arg)))
1304             (loop (cdr arg-list)))))
1305
1306     ;; Now that we've identified the elements, build the object.
1307     (/isa-parse context name comment attrs
1308                 base-insn-bitsize
1309                 (if default-insn-word-bitsize
1310                     default-insn-word-bitsize
1311                     base-insn-bitsize)
1312                 (if default-insn-bitsize
1313                     default-insn-bitsize
1314                     base-insn-bitsize)
1315                 decode-assist liw-insns parallel-insns- condition
1316                 setup-semantics decode-splits))
1317 )
1318
1319 ; Define a <isa> object, name/value pair list version.
1320
1321 (define define-isa
1322   (lambda arg-list
1323     (let ((i (apply /isa-read (cons (make-current-context "define-isa")
1324                                     arg-list))))
1325       (if i
1326           (current-isa-add! i))
1327       i))
1328 )
1329
1330 ; Subroutine of modify-isa to process one add-decode-split spec.
1331
1332 (define (/isa-add-decode-split! context isa spec)
1333   (let ((decode-split (/isa-parse-decode-split context spec)))
1334     (isa-set-decode-splits! (cons decode-split (isa-decode-splits isa)))
1335     *UNSPECIFIED*)
1336 )
1337
1338 ; Main routine for modifying existing isa definitions
1339
1340 (define modify-isa
1341   (lambda arg-list
1342     (let ((context (make-current-context "modify-isa"))
1343           (isa-spec (assq 'name arg-list)))
1344       (if (not isa-spec)
1345           (parse-error context "isa name not specified"))
1346
1347       (let ((isa (current-isa-lookup (arg-list-symbol-arg context isa-spec))))
1348         (if (not isa)
1349             (parse-error context "undefined isa" isa-spec))
1350
1351         (let loop ((args arg-list))
1352           (if (null? args)
1353               #f ; done
1354               (let ((arg-spec (car args)))
1355                 (case (car arg-spec)
1356                   ((name) #f) ; ignore, already processed
1357                   ((add-decode-split)
1358                    (/isa-add-decode-split! context isa (cdr arg-spec)))
1359                   (else
1360                    (parse-error context "invalid/unsupported option" (car arg-spec))))
1361                 (loop (cdr args)))))))
1362
1363     *UNSPECIFIED*)
1364 )
1365
1366 ; Return boolean indicating if ISA supports parallel execution.
1367
1368 (define (isa-parallel-exec? isa) (> (isa-parallel-insns isa) 1))
1369
1370 ; Return a boolean indicating if ISA supports conditional execution
1371 ; of all instructions.
1372
1373 (define (isa-conditional-exec? isa) (->bool (isa-condition isa)))
1374 \f
1375 ; The `<cpu>' object collects together various details about a particular
1376 ; subset of the architecture (e.g. perhaps all 32 bit variants of the sparc
1377 ; architecture).
1378 ; This is called a "cpu-family".
1379 ; ??? May be renamed to <family> (both internally and in the .cpu file).
1380 ; ??? Another way to do this would be to discard the family notion and allow
1381 ; machs to inherit from other machs, as well as use isas to distinguish
1382 ; sufficiently dissimilar machs.  This would remove a fuzzy illspecified
1383 ; notion with a concrete one.
1384 ; ??? Maybe a better way to organize sparc32 vs sparc64 is via an isa.
1385
1386 (define <cpu>
1387   (class-make '<cpu>
1388               '(<ident>)
1389               '(
1390                 ; one of big/little/either/#f.
1391                 ; If #f, then {insn,data,float}-endian are used.
1392                 ; Otherwise they're ignored.
1393                 endian
1394
1395                 ; one of big/little/either.
1396                 insn-endian
1397
1398                 ; one of big/little/either/big-words/little-words.
1399                 ; If big-words then each word is little-endian.
1400                 ; If little-words then each word is big-endian.
1401                 data-endian
1402
1403                 ; one of big/little/either/big-words/little-words.
1404                 float-endian
1405
1406                 ; number of bits in a word.
1407                 word-bitsize
1408
1409                 ; number of bits in a chunk of an instruction word, for
1410                 ; endianness conversion purposes; 0 = no chunking
1411                 insn-chunk-bitsize
1412
1413                 ; Transformation to use in generated files should one be
1414                 ; needed.  At present the only supported value is a string
1415                 ; which is the file suffix.
1416                 ; ??? A dubious element of the description language, but given
1417                 ; the quantity of generated files, some machine generated
1418                 ; headers may need to #include other machine generated headers
1419                 ; (e.g. cpuall.h).
1420                 file-transform
1421
1422                 ; Allow a cpu family to override the isa parallel-insns spec.
1423                 ; ??? Concession to the m32r port which can go away, in time.
1424                 parallel-insns
1425
1426                 ; Computed: maximum number of insns which may pass before there
1427                 ; an insn writes back its output operands.
1428                 max-delay
1429
1430                 )
1431               nil)
1432 )
1433
1434 ; Accessors.
1435
1436 (define-getters <cpu> cpu (word-bitsize insn-chunk-bitsize file-transform parallel-insns max-delay))
1437 (define-setters <cpu> cpu (max-delay))
1438
1439 ; Return endianness of instructions.
1440
1441 (define (cpu-insn-endian cpu)
1442   (let ((endian (elm-xget cpu 'endian)))
1443     (if endian
1444         endian
1445         (elm-xget cpu 'insn-endian)))
1446 )
1447
1448 ; Return endianness of data.
1449
1450 (define (cpu-data-endian cpu)
1451   (let ((endian (elm-xget cpu 'endian)))
1452     (if endian
1453         endian
1454         (elm-xget cpu 'data-endian)))
1455 )
1456
1457 ; Return endianness of floats.
1458
1459 (define (cpu-float-endian cpu)
1460   (let ((endian (elm-xget cpu 'endian)))
1461     (if endian
1462         endian
1463         (elm-xget cpu 'float-endian)))
1464 )
1465
1466 ; Parse a cpu family description
1467 ; This is the main routine for building a <cpu> object from a cpu
1468 ; description in the .cpu file.
1469 ; All arguments are in raw (non-evaluated) form.
1470
1471 (define (/cpu-parse context name comment attrs
1472                     endian insn-endian data-endian float-endian
1473                     word-bitsize insn-chunk-bitsize file-transform parallel-insns)
1474   (logit 2 "Processing cpu family " name " ...\n")
1475
1476   ;; Pick out name first to augment the error context.
1477   (let* ((name (parse-name context name))
1478          (context (context-append-name context name)))
1479
1480     (if (keep-cpu? name)
1481         (make <cpu>
1482               name
1483               (parse-comment context comment)
1484               (atlist-parse context attrs "cpu")
1485               endian insn-endian data-endian float-endian
1486               word-bitsize
1487               insn-chunk-bitsize
1488               file-transform
1489               parallel-insns
1490               0 ; default max-delay. will compute correct value
1491               )
1492         (begin
1493           (logit 2 "Ignoring " name ".\n")
1494           #f))) ; cpu is not to be kept
1495 )
1496
1497 ; Read a cpu family description
1498 ; This is the main routine for analyzing a cpu description in the .cpu file.
1499 ; CONTEXT is a <context> object for error messages.
1500 ; ARG-LIST is an associative list of field name and field value.
1501 ; /cpu-parse is invoked to create the <cpu> object.
1502
1503 (define (/cpu-read context . arg-list)
1504   (let (
1505         (name nil)
1506         (comment nil)
1507         (attrs nil)
1508         (endian #f)
1509         (insn-endian #f)
1510         (data-endian #f)
1511         (float-endian #f)
1512         (word-bitsize #f)
1513         (insn-chunk-bitsize 0)
1514         (file-transform "")
1515         ;; FIXME: Hobbit computes the wrong symbol for `parallel-insns'
1516         ;; in the `case' expression below because there is a local var
1517         ;; of the same name ("__1" gets appended to the symbol name).
1518         (parallel-insns- #f)
1519         )
1520
1521     ;; Loop over each element in ARG-LIST, recording what's found.
1522     (let loop ((arg-list arg-list))
1523       (if (null? arg-list)
1524           nil
1525           (let ((arg (car arg-list))
1526                 (elm-name (caar arg-list)))
1527             (case elm-name
1528               ((name) (set! name (cadr arg)))
1529               ((comment) (set! comment (cadr arg)))
1530               ((attrs) (set! attrs (cdr arg)))
1531               ((endian) (set! endian (cadr arg)))
1532               ((insn-endian) (set! insn-endian (cadr arg)))
1533               ((data-endian) (set! data-endian (cadr arg)))
1534               ((float-endian) (set! float-endian (cadr arg)))
1535               ((word-bitsize) (set! word-bitsize (cadr arg)))
1536               ((insn-chunk-bitsize) (set! insn-chunk-bitsize (cadr arg)))
1537               ((file-transform) (set! file-transform (cadr arg)))
1538               ((parallel-insns) (set! parallel-insns- (cadr arg)))
1539               (else (parse-error context "invalid cpu arg" arg)))
1540             (loop (cdr arg-list)))))
1541
1542     ;; Now that we've identified the elements, build the object.
1543     (/cpu-parse context name comment attrs
1544                 endian insn-endian data-endian float-endian
1545                 word-bitsize insn-chunk-bitsize file-transform parallel-insns-))
1546 )
1547
1548 ; Define a cpu family object, name/value pair list version.
1549
1550 (define define-cpu
1551   (lambda arg-list
1552     (let ((c (apply /cpu-read (cons (make-current-context "define-cpu")
1553                                     arg-list))))
1554       (if c
1555           (begin
1556             (current-cpu-add! c)
1557             (mode-set-word-modes! (cpu-word-bitsize c))
1558             (hw-update-word-modes!)
1559             ))
1560       c))
1561 )
1562 \f
1563 ; The `<mach>' object describes one member of a `cpu' family.
1564
1565 (define <mach>
1566   (class-make '<mach> '(<ident>)
1567               '(
1568                 ; cpu family this mach is a member of
1569                 cpu
1570                 ; bfd name of mach
1571                 bfd-name
1572                 ; list of <isa> objects
1573                 isas
1574                 )
1575               nil)
1576 )
1577
1578 ; Accessors.
1579
1580 (define-getters <mach> mach (cpu bfd-name isas))
1581
1582 (define (mach-enum obj)
1583   (string-append "MACH_" (string-upcase (gen-sym obj)))
1584 )
1585
1586 (define (mach-number obj) (mach-enum obj))
1587
1588 (define (machs-for-cpu cpu)
1589   (let ((cpu-name (obj:name cpu)))
1590     (find (lambda (mach)
1591             (eq? (obj:name (mach-cpu mach)) cpu-name))
1592           (current-mach-list)))
1593 )
1594
1595 ; Parse a machine entry.
1596 ; The result is a <mach> object or #f if the mach isn't to be kept.
1597 ; All arguments are in raw (non-evaluated) form.
1598
1599 (define (/mach-parse context name comment attrs cpu bfd-name isas)
1600   (logit 2 "Processing mach " name " ...\n")
1601
1602   ;; Pick out name first to augment the error context.
1603   (let* ((name (parse-name context name))
1604          (context (context-append-name context name)))
1605
1606     (if (not (list? isas))
1607         (parse-error context "isa spec not a list" isas))
1608     (let ((cpu-obj (current-cpu-lookup cpu))
1609           (isa-list (map current-isa-lookup isas)))
1610       (if (not (memq name (current-arch-mach-name-list)))
1611           (parse-error context "mach name is not present in `define-arch'" name))
1612       (if (null? cpu)
1613           (parse-error context "missing cpu spec" cpu))
1614       (if (not cpu-obj)
1615           (parse-error context "unknown cpu" cpu))
1616       (if (null? isas)
1617           (parse-error context "missing isas spec" isas))
1618       (if (not (all-true? isa-list))
1619           (parse-error context "unknown isa in" isas))
1620       (if (not (string? bfd-name))
1621           (parse-error context "bfd-name not a string" bfd-name))
1622
1623       (if (keep-mach? (list name))
1624
1625           (make <mach>
1626                 name
1627                 (parse-comment context comment)
1628                 (atlist-parse context attrs "mach")
1629                 cpu-obj
1630                 bfd-name
1631                 isa-list)
1632
1633           (begin
1634             (logit 2 "Ignoring " name ".\n")
1635             #f)))) ; mach is not to be kept
1636 )
1637
1638 ; Read a mach entry.
1639 ; CONTEXT is a <context> object for error messages.
1640 ; ARG-LIST is an associative list of field name and field value.
1641
1642 (define (/mach-read context . arg-list)
1643   (let (
1644         (name nil)
1645         (attrs nil)
1646         (comment nil)
1647         (cpu nil)
1648         (bfd-name #f)
1649         (isas #f)
1650         )
1651
1652     (let loop ((arg-list arg-list))
1653       (if (null? arg-list)
1654           nil
1655           (let ((arg (car arg-list))
1656                 (elm-name (caar arg-list)))
1657             (case elm-name
1658               ((name) (set! name (cadr arg)))
1659               ((comment) (set! comment (cadr arg)))
1660               ((attrs) (set! attrs (cdr arg)))
1661               ((cpu) (set! cpu (cadr arg)))
1662               ((bfd-name) (set! bfd-name (cadr arg)))
1663               ((isas) (set! isas (cdr arg)))
1664               (else (parse-error context "invalid mach arg" arg)))
1665             (loop (cdr arg-list)))))
1666
1667     ;; Now that we've identified the elements, build the object.
1668     (/mach-parse context name comment attrs cpu
1669                  ;; Default bfd-name is same as object's name.
1670                  (if bfd-name bfd-name (symbol->string name))
1671                  ;; Default isa is the first one.
1672                  (if isas isas (list (obj:name (car (current-isa-list)))))))
1673 )
1674
1675 ; Define a <mach> object, name/value pair list version.
1676
1677 (define define-mach
1678   (lambda arg-list
1679     (let ((m (apply /mach-read (cons (make-current-context "define-mach")
1680                                      arg-list))))
1681       (if m
1682           (current-mach-add! m))
1683       m))
1684 )
1685 \f
1686 ; Miscellaneous state derived from the input data.
1687 ; FIXME: being redone
1688
1689 ; Size of a word in bits.
1690 ; All selected cpu families must have same value or error.
1691 ; Ergo, don't use this if multiple word-bitsize values are expected.
1692 ; E.g. opcodes support for architectures with both 32 and 64 variants.
1693
1694 (define (state-word-bitsize)
1695   (let* ((wb-list (map cpu-word-bitsize (current-cpu-list)))
1696          (result (car wb-list)))
1697     (for-each (lambda (wb)
1698                 (if (!= result wb)
1699                     (error "multiple word-bitsize values" wb-list)))
1700               wb-list)
1701     result)
1702 )
1703
1704 ; Return maximum word bitsize.
1705
1706 (define (state-max-word-bitsize)
1707   (apply max (map cpu-word-bitsize (current-cpu-list)))
1708 )
1709
1710 ; Size of normal instruction.
1711 ; All selected isas must have same value or error.
1712
1713 (define (state-default-insn-bitsize)
1714   (let ((dib (map isa-default-insn-bitsize (current-isa-list))))
1715     ; FIXME: ensure all have same value.
1716     (car dib))
1717 )
1718
1719 ; Number of bytes of insn we can initially fetch.
1720 ; All selected isas must have same value or error.
1721
1722 (define (state-base-insn-bitsize)
1723   (let ((bib (map isa-base-insn-bitsize (current-isa-list))))
1724     ; FIXME: ensure all have same value.
1725     (car bib))
1726 )
1727
1728 ; Return parallel-insns spec.
1729
1730 (define (state-parallel-insns)
1731   ; Assert only one cpu family has been selected.
1732   (assert-keep-one)
1733
1734   (let ((par-insns (map isa-parallel-insns (current-isa-list)))
1735         (cpu-par-insns (cpu-parallel-insns (current-cpu))))
1736     ; ??? The m32r does have parallel execution, but to keep support for the
1737     ; base mach simpler, a cpu family is allowed to override the isa spec.
1738     (or cpu-par-insns
1739         ; FIXME: ensure all have same value.
1740         (car par-insns)))
1741 )
1742
1743 ; Return boolean indicating if parallel execution support is required.
1744
1745 (define (state-parallel-exec?)
1746   (> (state-parallel-insns) 1)
1747 )
1748
1749 ; Return liw-insns spec.
1750
1751 (define (state-liw-insns)
1752   (let ((liw-insns (map isa-liw-insns (current-isa-list))))
1753     ; FIXME: ensure all have same value.
1754     (car liw-insns))
1755 )
1756
1757 ; Return decode-assist spec.
1758
1759 (define (state-decode-assist)
1760   (isa-decode-assist (current-isa))
1761 )
1762
1763 ; Return boolean indicating if current isa conditionally executes all insn.
1764
1765 (define (state-conditional-exec?)
1766   (isa-conditional-exec? (current-isa))
1767 )
1768 \f
1769 ; Architecture or cpu wide values derived from other data.
1770
1771 (define <derived-arch-data>
1772   (class-make '<derived-arch-data>
1773               nil
1774               '(
1775                 ; whether all insns can be recorded in a host int
1776                 integral-insn?
1777
1778                 ; whether a large int is needed for insns
1779                 large-insn-word?
1780                 )
1781               nil)
1782 )
1783
1784 ;; Called after the .cpu file has been read in to prime derived value
1785 ;; computation.
1786 ;; Often this data isn't needed so we only computed it if we have to.
1787 ;; The computation can require a single selected ISA; if we don't require
1788 ;; the data don't unnecessarily flag an error.
1789
1790 (define (/adata-set-derived! arch)
1791   ;; Don't compute this data unless we need to.
1792   (arch-set-derived!
1793    arch
1794    (make <derived-arch-data>
1795      ;; integral-insn?
1796      (delay (isa-integral-insn? (current-isa)))
1797      ;; insn-word-bitsize
1798      (> (apply max (map isa-base-insn-bitsize (current-isa-list))) 32)
1799      ))
1800 )
1801
1802 ; Accessors.
1803
1804 (define (adata-integral-insn? arch)
1805   (force (elm-xget (arch-derived arch) 'integral-insn?))
1806 )
1807
1808 (define (adata-large-insn-word? arch)
1809   (elm-xget (arch-derived arch) 'large-insn-word?)
1810 )
1811 \f
1812 ; Instruction analysis control.
1813
1814 ;; The maximum number of virtual insns.
1815 ;; They can be recorded with negative ordinals, and multi-insns are currently
1816 ;; also recorded as negative numbers, so leave enough space.
1817 (define MAX-VIRTUAL-INSNS 100)
1818
1819 ;; Subroutine of arch-analyze-insns! to simplify it.
1820 ;; Sanity check the instruction set.
1821
1822 (define (/sanity-check-insns arch)
1823   (let ((insn-list (arch-insn-list arch)))
1824
1825     ;; Ensure instruction base values agree with their masks.
1826     ;; Errors can come from bad .cpu files, bugs, or both.
1827     ;; It's better to catch such errors early.
1828     ;; If it is an error in the .cpu file, we don't want to crash
1829     ;; on a Guile error.
1830
1831     (for-each
1832
1833      (lambda (insn)
1834
1835        (let ((base-len (insn-base-mask-length insn))
1836              (base-mask (insn-base-mask insn))
1837              (base-value (insn-base-value insn)))
1838          (if (not (= (cg-logand (cg-logxor base-mask (mask base-len))
1839                                 base-value)
1840                      0))
1841              (context-owner-error
1842               #f insn
1843               "While performing sanity checks"
1844               (string-append "Instruction has opcode bits outside of its mask.\n"
1845                              "This usually means some kind of error in the instruction's ifield list.\n"
1846                              "base mask: 0x" (number->hex base-mask)
1847                              ", base value: 0x" (number->hex base-value)
1848                              "\nfield list:"
1849                              (string-map (lambda (f)
1850                                            (string-append " "
1851                                                           (ifld-pretty-print f)))
1852                                          (insn-iflds insn))
1853                              )))
1854
1855          ;; Insert more checks here.
1856
1857          ))
1858
1859      (non-multi-insns (non-alias-insns insn-list))))
1860
1861   *UNSPECIFIED*
1862 )
1863
1864 ;; Instantiate the multi-insns of ARCH (if there are any).
1865
1866 (define (/instantiate-multi-insns! arch)
1867   ;; Skip if already done, we don't want to create duplicates.
1868
1869   (if (not (arch-multi-insns-instantiated? arch))
1870       (begin
1871
1872         (if (any-true? (map multi-insn? (arch-insn-list arch)))
1873
1874             (begin
1875               ; Instantiate sub-insns of all multi-insns.
1876               (logit 1 "Instantiating multi-insns ...\n")
1877
1878               ;; FIXME: Hack to remove differences in generated code when we
1879               ;; switched to recording insns in hash tables.
1880               ;; Multi-insn got instantiated after the list of insns had been
1881               ;; reversed and they got added to the front of the list, in
1882               ;; reverse order.  Blech!
1883               ;; Eventually remove this, have a flag day, and check in the
1884               ;; updated files.
1885               ;; NOTE: This causes major diffs to opcodes/m32c-*.[ch].
1886               (let ((orig-ord (arch-next-ordinal arch)))
1887                 (arch-set-next-ordinal! arch (- MAX-VIRTUAL-INSNS))
1888                 (for-each (lambda (insn)
1889                             (multi-insn-instantiate! insn))
1890                           (multi-insns (arch-insn-list arch)))
1891                 (arch-set-next-ordinal! arch orig-ord))
1892
1893               (logit 1 "Done instantiating multi-insns.\n")
1894               ))
1895
1896         (arch-set-multi-insns-instantiated?! arch #t)
1897         ))
1898 )
1899
1900 ;; Subroutine of arch-analyze-insns! to simplify it.
1901 ;; Canonicalize INSNS of ARCH.
1902
1903 (define (/canonicalize-insns! arch insn-list)
1904   (logit 1 "Canonicalizing instruction semantics ...\n")
1905
1906   (for-each (lambda (insn)
1907               (cond ((insn-canonical-semantics insn)
1908                      #t) ;; already done
1909                     ((insn-semantics insn)
1910                      (logit 2 "Canonicalizing semantics for " (obj:name insn) " ...\n")
1911                      (let ((canon-sem
1912                             (rtx-canonicalize
1913                              (make-obj-context insn
1914                                                (string-append "canonicalizing semantics of "
1915                                                               (obj:str-name insn)))
1916                              'VOID (obj-isa-list insn) nil
1917                              (insn-semantics insn))))
1918                        (insn-set-canonical-semantics! insn canon-sem)))
1919                     (else
1920                      (logit 2 "Skipping instruction " (obj:name insn) ", no semantics ...\n"))))
1921             insn-list)
1922
1923   (logit 1 "Done canonicalization.\n")
1924 )
1925
1926 ; Analyze the instruction set.
1927 ; The name is explicitly vague because it's intended that all insn analysis
1928 ; would be controlled here.
1929 ; If the instruction set has already been sufficiently analyzed, do nothing.
1930 ; INCLUDE-ALIASES? is #t if alias insns are to be included.
1931 ; ANALYZE-SEMANTICS? is #t if insn semantics are to be analyzed.
1932 ;
1933 ; This is a very expensive operation, so we only do it as necessary.
1934 ; There are (currently) two different kinds of users: assemblers and
1935 ; simulators.  Assembler style apps don't always need to analyze the semantics.
1936 ; Simulator style apps don't want to include the alias insns.
1937
1938 (define (arch-analyze-insns! arch include-aliases? analyze-semantics?)
1939   ; Catch apps that haven't set word sizes yet.
1940   (mode-ensure-word-sizes-defined)
1941
1942   (if (or (not (arch-insns-analyzed? arch))
1943           (not (eq? analyze-semantics? (arch-semantics-analyzed? arch)))
1944           (not (eq? include-aliases? (arch-aliases-analyzed? arch))))
1945
1946       (begin
1947
1948         (/instantiate-multi-insns! arch)
1949
1950         (let ((insn-list (non-multi-insns
1951                           (if include-aliases?
1952                               (arch-insn-list arch)
1953                               (non-alias-insns (arch-insn-list arch))))))
1954
1955           ;; Compile each insns semantics, traversers/evaluators require it.
1956           (/canonicalize-insns! arch insn-list)
1957
1958           ;; This is expensive so indicate start/finish.
1959           (logit 1 "Analyzing instruction set ...\n")
1960
1961           (let ((fmt-lists
1962                  (ifmt-compute! insn-list
1963                                 analyze-semantics?)))
1964
1965             (arch-set-ifmt-list! arch (car fmt-lists))
1966             (arch-set-sfmt-list! arch (cadr fmt-lists))
1967             (arch-set-insns-analyzed?! arch #t)
1968             (arch-set-semantics-analyzed?! arch analyze-semantics?)
1969             (arch-set-aliases-analyzed?! arch include-aliases?)
1970
1971             ;; Now that the instruction formats are computed,
1972             ;; do some sanity checks.
1973             (logit 1 "Performing sanity checks ...\n")
1974             (/sanity-check-insns arch)
1975
1976             (logit 1 "Done analysis.\n")
1977             ))
1978         ))
1979
1980   *UNSPECIFIED*
1981 )
1982 \f
1983 ; Called before a .cpu file is read in.
1984
1985 (define (arch-init!)
1986
1987   (reader-add-command! 'define-arch
1988                        "\
1989 Define an architecture, name/value pair list version.
1990 "
1991                        nil 'arg-list define-arch)
1992
1993   (reader-add-command! 'define-isa
1994                        "\
1995 Define an instruction set architecture, name/value pair list version.
1996 "
1997                        nil 'arg-list define-isa)
1998   (reader-add-command! 'modify-isa
1999                        "\
2000 Modify an isa, name/value pair list version.
2001 "
2002                        nil 'arg-list modify-isa)
2003
2004   (reader-add-command! 'define-cpu
2005                        "\
2006 Define a cpu family, name/value pair list version.
2007 "
2008                        nil 'arg-list define-cpu)
2009
2010   *UNSPECIFIED*
2011 )
2012
2013 ; Called before a .cpu file is read in.
2014
2015 (define (mach-init!)
2016   (let ((arch CURRENT-ARCH))
2017     (arch-set-ifld-table! arch (/make-ident-object-table 127))
2018     (arch-set-op-table! arch (/make-ident-object-table 127))
2019     (arch-set-insn-table! arch (/make-ident-object-table 509))
2020     (arch-set-minsn-table! arch (/make-ident-object-table 127))
2021     )
2022
2023   (reader-add-command! 'define-mach
2024                        "\
2025 Define a machine, name/value pair list version.
2026 "
2027                        nil 'arg-list define-mach)
2028
2029   *UNSPECIFIED*
2030 )
2031
2032 ; Called after .cpu file is read in.
2033
2034 (define (arch-finish!)
2035   (let ((arch CURRENT-ARCH))
2036
2037     ; Lists are constructed in the reverse order they appear in the file
2038     ; [for simplicity and efficiency].  Restore them to file order for the
2039     ; human reader/debugger.
2040     ; We don't need to do this for ifld, op, insn, minsn lists because
2041     ; they are handled differently.
2042     (arch-set-enum-list! arch (reverse (arch-enum-list arch)))
2043     (arch-set-kw-list! arch (reverse (arch-kw-list arch)))
2044     (arch-set-isa-list! arch (reverse (arch-isa-list arch)))
2045     (arch-set-cpu-list! arch (reverse (arch-cpu-list arch)))
2046     (arch-set-mach-list! arch (reverse (arch-mach-list arch)))
2047     (arch-set-model-list! arch (reverse (arch-model-list arch)))
2048     (arch-set-hw-list! arch (reverse (arch-hw-list arch)))
2049     (arch-set-subr-list! arch (reverse (arch-subr-list arch)))
2050     )
2051
2052   *UNSPECIFIED*
2053 )
2054
2055 ; Called after .cpu file is read in.
2056
2057 (define (mach-finish!)
2058   (/adata-set-derived! CURRENT-ARCH)
2059
2060   *UNSPECIFIED*
2061 )