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