cgen/read.scm

   1 ; Top level file for reading and recording .cpu file contents.
   2 ; Copyright (C) 2000, 2001, 2006, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; This file [and its subordinates] contain no C code (well, as little as
   7 ; possible).  That lives at a layer above us.
   8
   9 ; A .cpu file consists of several sections:
  10 ;
  11 ; - basic definitions (e.g. cpu variants, word size, endianness, etc.)
  12 ; - enums (enums are used throughout so by convention there is a special
  13 ;   section in which they're defined)
  14 ; - attributes
  15 ; - instruction fields and formats
  16 ; - hardware descriptions (e.g. registers, allowable immediate values)
  17 ; - model descriptions (e.g. pipelines, latencies, etc.)
  18 ; - instruction operands (mapping of insn fields to associated hardware)
  19 ; - instruction definitions
  20 ; - macro instruction definitions
  21
  22 ; TODO:
  23 ; - memory access, layout, etc.
  24 ; - floating point quirks
  25 ; - ability to describe an ABI
  26 ; - anything else that comes along
  27
  28 ; Notes:
  29 ; - by convention most objects are subclasses of <ident> (having name, comment,
  30 ;   and attrs elements and they are the first three elements of any .cpu file
  31 ;   entry
  32
  33 ; Guidelines:
  34 ; - Try to conform to R5RS, try to limit guile-ness.
  35 ;   The current code is undoubtedly off in many places.
  36
  37 ; Conventions:
  38 ; [I want there to be a plethora of conventions and I want them strictly
  39 ; adhered to.  ??? There's probably a few violations here and there.
  40 ; No big deal - fix them!]
  41 ; These conventions are subject to revision.
  42 ;
  43 ; - procs/vars local to a file are named "-foo"
  44 ; - only routines that emit application code begin with "gen-"
  45 ; - symbols beginning with "c-" are either variables containing C code
  46 ;   or procedures that generate C code, similarily for C++ and "c++-"
  47 ; - variables containing C code begin with "c-"
  48 ; - only routines that emit an entire file begin with "cgen-"
  49 ; - all .cpu file elements shall have -foo-parse and -foo-read procedures
  50 ; - global vars containing class definitions shall be named "<class-name>"
  51 ; - procs related to a particular class shall be named "class-name-proc-name",
  52 ;   class-name may be abbreviated
  53 ; - procs that test whether something is an object of a particular class
  54 ;   shall be named "class-name?"
  55 ; - in keeping with Scheme conventions, predicates shall have a "?" suffix
  56 ; - in keeping with Scheme conventions, methods and procedures that modify an
  57 ;   argument or have other side effects shall have a "!" suffix,
  58 ;   usually these procs return "*UNSPECIFIED*"
  59 ; - all -foo-parse,parse-foo procs shall have `context' as the first arg
  60 ;   [FIXME: not all such procs have been converted]
  61 ; - stay away from non-portable C symbols.
  62 \f
  63 ; Variables representing misc. global constants.
  64
  65 ; A list of three numbers designating the cgen version: major minor fixlevel.
  66 (define -CGEN-VERSION '(1 1 0))
  67 (define (cgen-major) (car -CGEN-VERSION))
  68 (define (cgen-minor) (cadr -CGEN-VERSION))
  69 (define (cgen-fixlevel) (caddr -CGEN-VERSION))
  70
  71 ; A list of three numbers designating the description language version.
  72 ; Note that this is different from -CGEN-VERSION.
  73 (define -CGEN-LANG-VERSION '(0 7 2))
  74 (define (cgen-lang-major) (car -CGEN-LANG-VERSION))
  75 (define (cgen-lang-minor) (cadr -CGEN-LANG-VERSION))
  76 (define (cgen-lang-fixlevel) (caddr -CGEN-LANG-VERSION))
  77
  78 ; Which application is in use (UNKNOWN, DESC, OPCODES, SIMULATOR, ???).
  79 ; This is mostly for descriptive purposes.
  80 (define APPLICATION 'UNKNOWN)
  81 \f
  82 ; Things are organized so that files can be compiled with Hobbit for
  83 ; experimentation.  Thus we need one file that loads all the other files.
  84 ; This is that file, though it would make sense to move the code in this
  85 ; file to another.
  86
  87 ; If a routine to initialize compiled-in code is defined, run it.
  88 (if (defined? 'cgen-init-c) (cgen-init-c))
  89
  90 ; If this is set to #f, the file is always loaded.
  91 ; Don't override any current setting, e.g. from dev.scm.
  92 (if (not (defined? 'CHECK-LOADED?))
  93     (define CHECK-LOADED? #t))
  94
  95 ; Unlink file if we're reloaded (say in an interactive session).
  96 ; Dynamic loading is enabled by setting LIBCPU.SO to the pathname of the .so.
  97 (if (and (defined? 'libcpu.so) (dynamic-object? libcpu.so))
  98     (dynamic-unlink libcpu.so))
  99 (define libcpu.so #f)
 100 (if (and (defined? 'LIBCPU.SO)
 101          (file-exists? LIBCPU.SO))
 102     (set! libcpu.so (dynamic-link LIBCPU.SO))
 103 )
 104
 105 ; List of loaded files.
 106
 107 (if (not (defined? '-loaded-file-list))
 108     (define -loaded-file-list '()))
 109
 110 ; Return non-zero if FILE was loaded last time through.
 111
 112 (define (-loaded-file? file)
 113   (->bool (memq (string->symbol file) -loaded-file-list))
 114 )
 115
 116 ; Record FILE as compiled in.
 117
 118 (define (-loaded-file-record! file)
 119   (let ((file (string->symbol file)))
 120     (if (not (memq file -loaded-file-list))
 121         (set! -loaded-file-list (cons file -loaded-file-list))))
 122 )
 123
 124 ; Load FILE if SYM is not compiled in.
 125
 126 (define (maybe-load file init-func sym)
 127   ; Return non-#f if FUNC is present in DYNOBJ.
 128   (define (dynamic-func? func dynobj)
 129     (catch #t
 130            (lambda () (dynamic-func func dynobj))
 131            (lambda args #f))
 132     )
 133
 134   (let ((init-func (string-append "init_" (if init-func init-func file))))
 135     (cond ((and libcpu.so
 136                 (dynamic-func? init-func libcpu.so))
 137            (dynamic-call init-func libcpu.so)
 138            (display (string-append "Skipping " file ", dynamically loaded.\n")))
 139           ((or (not CHECK-LOADED?)
 140                (not (defined? sym))
 141                (-loaded-file? file))
 142            (-loaded-file-record! file)
 143            (load file))
 144           (else
 145            (display (string-append "Skipping " file ", already loaded.\n")))))
 146 )
 147
 148 (maybe-load "pmacros" #f 'define-pmacro)
 149 (maybe-load "cos" #f 'make)
 150 (maybe-load "slib/logical" #f 'logical:logand)
 151 (maybe-load "slib/sort" #f 'sort)
 152 ; Used to pretty-print debugging messages.
 153 (maybe-load "slib/pp" #f 'pretty-print)
 154 ; Used by pretty-print.
 155 (maybe-load "slib/random" #f 'random)
 156 (maybe-load "slib/genwrite" #f 'generic-write)
 157 (maybe-load "utils" #f 'logit)
 158 (maybe-load "utils-cgen" "utils_cgen" 'obj:name)
 159 (maybe-load "attr" #f '<attribute>)
 160 (maybe-load "enum" #f '<enum>)
 161 (maybe-load "mach" #f '<mach>)
 162 (maybe-load "model" #f '<model>)
 163 (maybe-load "types" #f '<scalar>)
 164 (maybe-load "mode" #f '<mode>)
 165 (maybe-load "ifield" #f '<ifield>)
 166 (maybe-load "iformat" #f '<iformat>)
 167 (maybe-load "hardware" #f '<hardware-base>)
 168 (maybe-load "operand" #f '<operand>)
 169 (maybe-load "insn" #f '<insn>)
 170 (maybe-load "minsn" #f '<macro-insn>)
 171 (maybe-load "decode" #f 'decode-build-table)
 172 (maybe-load "rtl" "rtl" '<rtx-func>)
 173 (maybe-load "rtl-traverse" "rtl_traverse" 'rtx-traverse)
 174 (maybe-load "rtl-xform" "rtx_simplify" 'rtx-simplify)
 175 (maybe-load "rtx-funcs" "rtx_funcs" 'def-rtx-funcs)
 176 (maybe-load "rtl-c" "rtl_c" '<c-expr>)
 177 (maybe-load "semantics" #f 'semantic-compile)
 178 (maybe-load "sem-frags" "sem_frags" 'gen-threaded-engine)
 179 (maybe-load "utils-gen" "utils_gen" 'attr-gen-decl)
 180 (maybe-load "pgmr-tools" "pgmr_tools" 'pgmr-pretty-print-insn-format)
 181 \f
 182 ; Reader state data.
 183 ; All state regarding the reading of a .cpu file is kept in an object of
 184 ; class <reader>.
 185
 186 ; Class to record info for each top-level `command' (for lack of a better
 187 ; word) in the description file.
 188 ; Top level commands are things like define-*.
 189
 190 (define <command>
 191   (class-make '<command>
 192               '(<ident>)
 193               '(
 194                 ; argument spec to `lambda'
 195                 arg-spec
 196                 ; lambda that processes the entry
 197                 handler
 198                 )
 199               nil)
 200 )
 201
 202 (define command-arg-spec (elm-make-getter <command> 'arg-spec))
 203 (define command-handler (elm-make-getter <command> 'handler))
 204
 205 ; Return help text for COMMAND.
 206
 207 (define (command-help cmd)
 208   (string-append
 209    (obj:comment cmd)
 210    "Arguments: "
 211    (with-output-to-string (lambda () (write (command-arg-spec cmd))))
 212    "\n")
 213 )
 214
 215 ; A pair of two lists: machs to keep, machs to drop.
 216 ; Keep all machs, drop none.
 217
 218 (define -keep-all-machs '((all)))
 219
 220 ; Main reader state class.
 221
 222 (define <reader>
 223   (class-make '<reader>
 224               nil
 225               (list
 226                ; Selected machs to keep.
 227                ; A pair of two lists: the car lists the machs to keep, the cdr
 228                ; lists the machs to drop.  Two special entries are `all' and
 229                ; `base'.  Both are only valid in the keep list.  `base' is a
 230                ; place holder for objects that are common to all machine
 231                ; variants in the architecture, it is the default value of the
 232                ; MACH attribute.  If `all' is present the drop list is still
 233                ; processed.
 234                (cons 'keep-mach -keep-all-machs)
 235
 236                ; Selected isas to keep or `all'.
 237                '(keep-isa . (all))
 238
 239                ; Currently select cpu family, computed from `keep-mach'.
 240                ; Some applications don't care, and this is moderately
 241                ; expensive to compute so we use delay/force.
 242                'current-cpu
 243
 244                ; Associative list of file entry commands
 245                ; (e.g. define-insn, etc.).
 246                ; Each entry is (name . command-object).
 247                (cons 'commands nil)
 248                )
 249               nil)
 250 )
 251
 252 ; Accessors.
 253
 254 (define-getters <reader> reader (keep-mach keep-isa current-cpu commands))
 255 (define-setters <reader> reader (keep-mach keep-isa current-cpu commands))
 256
 257 (define (reader-add-command! name comment attrs arg-spec handler)
 258   (reader-set-commands! CURRENT-READER
 259                         (acons name
 260                                (make <command> name comment attrs
 261                                      arg-spec handler)
 262                                (reader-commands CURRENT-READER)))
 263 )
 264
 265 (define (reader-lookup-command name)
 266   (assq-ref (reader-commands CURRENT-READER) name)
 267 )
 268
 269 ; Reader state for current .cpu file.
 270
 271 (define CURRENT-READER #f)
 272
 273 ; Signal an error while reading a .cpu file.
 274
 275 (define (reader-error msg expr help-text)
 276   (let ((errmsg
 277          (string-append (or (port-filename (current-input-port))
 278                             "<input>")
 279                         ":"
 280                         (number->string (port-line (current-input-port)))
 281                         ": "
 282                         msg
 283                         ":")))
 284     (error (string-append errmsg "\n" help-text)
 285            expr))
 286 )
 287
 288 ; Signal a parse error while reading a .cpu file.
 289
 290 (define (parse-error errtxt message . args)
 291   (reader-error (string-append errtxt ": " message ":") args "")
 292 )
 293
 294 ; Process a macro-expanded entry.
 295
 296 (define (-reader-process-expanded-1 entry)
 297   (logit 4 (with-output-to-string (lambda () (pretty-print entry))))
 298   (let ((command (reader-lookup-command (car entry))))
 299     (if command
 300         (let* ((handler (command-handler command))
 301                (arg-spec (command-arg-spec command))
 302                (num-args (num-args arg-spec)))
 303           (if (cdr num-args)
 304               ; Variable number of trailing arguments.
 305               (if (< (length (cdr entry)) (car num-args))
 306                   (reader-error (string-append "Incorrect number of arguments to "
 307                                                (car entry)
 308                                                ", expecting at least "
 309                                                (number->string (car num-args)))
 310                                 entry
 311                                 (command-help command))
 312                   (apply handler (cdr entry)))
 313               ; Fixed number of arguments.
 314               (if (!= (length (cdr entry)) (car num-args))
 315                   (reader-error (string-append "Incorrect number of arguments to "
 316                                                (car entry)
 317                                                ", expecting "
 318                                                (number->string (car num-args)))
 319                                 entry
 320                                 (command-help command))
 321                   (apply handler (cdr entry)))))
 322         (reader-error "unknown entry type" entry "")))
 323   *UNSPECIFIED*
 324 )
 325
 326 ;; Process 1 or more macro-expanded entries.
 327
 328 (define (reader-process-expanded entry)
 329   ;; () is used to indicate a no-op
 330   (cond ((null? entry)
 331          #f) ;; nothing to do
 332         ;; `begin' is used to group a collection of entries into one,
 333         ;; since pmacro can only return one expression (borrowed from
 334         ;; Scheme of course).
 335         ;; Recurse in case there are nested begins.
 336         ((eq? (car entry) 'begin)
 337          (for-each reader-process-expanded
 338                    (cdr entry)))
 339         (else
 340          (-reader-process-expanded-1 entry)))
 341 )
 342
 343 ; Process file entry ENTRY.
 344
 345 (define (reader-process entry)
 346   (if (not (form? entry))
 347       (reader-error "improperly formed entry" entry ""))
 348
 349   ; First do macro expansion, but not if define-pmacro of course.
 350   (let ((expansion (if (eq? (car entry) 'define-pmacro)
 351                        entry
 352                        (pmacro-expand entry))))
 353     (reader-process-expanded expansion))
 354 )
 355
 356 ; Read in and process FILE.
 357 ;
 358 ; It would be nice to get the line number of the beginning of the object,
 359 ; but that's extra work, so for now we do the simple thing and use
 360 ; port-line after we've read an entry.
 361
 362 (define (reader-read-file! file)
 363   (let ((readit (lambda ()
 364                   (let loop ((entry (read)))
 365                     (if (eof-object? entry)
 366                         #t ; done
 367                         (begin
 368                           (reader-process entry)
 369                           (loop (read)))))))
 370         )
 371
 372     (with-input-from-file file readit)
 373     *UNSPECIFIED*)
 374 )
 375 \f
 376 ; Cpu data is recorded in an object of class <arch>.
 377 ; This is necessary as we need to allow recording of multiple cpu descriptions
 378 ; simultaneously.
 379 ; Class <arch> is defined in mach.scm.
 380
 381 ; Global containing all data of the currently selected architecture.
 382
 383 (define CURRENT-ARCH #f)
 384 \f
 385 ; `keep-mach' processing.
 386
 387 ; Return the currently selected cpu family.
 388 ; If a specific cpu family has been selected, each machine that is kept must
 389 ; be in that cpu family [so there's no ambiguity in the result].
 390 ; This is a moderately expensive computation so use delay/force.
 391
 392 (define (current-cpu) (force (reader-current-cpu CURRENT-READER)))
 393
 394 ; Return a boolean indicating if CPU-NAME is to be kept.
 395 ; ??? Currently this is always true.  Note that this doesn't necessarily apply
 396 ; to machs in CPU-NAME.
 397
 398 (define (keep-cpu? cpu-name) #t)
 399
 400 ; Cover proc to set `keep-mach'.
 401 ; MACH-NAME-LIST is a comma separated string of machines to keep and drop
 402 ; (if prefixed with !).
 403
 404 (define (-keep-mach-set! mach-name-list)
 405   (let* ((mach-name-list (string-cut mach-name-list #\,))
 406          (keep (find (lambda (name) (not (char=? (string-ref name 0) #\!)))
 407                      mach-name-list))
 408          (drop (map (lambda (name) (string->symbol (string-drop 1 name)))
 409                     (find (lambda (name) (char=? (string-ref name 0) #\!))
 410                           mach-name-list))))
 411     (reader-set-keep-mach! CURRENT-READER
 412                            (cons (map string->symbol keep)
 413                                  (map string->symbol drop)))
 414     ; Reset current-cpu.
 415     (reader-set-current-cpu!
 416      CURRENT-READER
 417      (delay (let ((selected-machs (find (lambda (mach)
 418                                           (keep-mach? (list (obj:name mach))))
 419                                         (current-mach-list))))
 420               (if (= (length selected-machs) 0)
 421                   (error "no machs selected"))
 422               (if (not (all-true? (map (lambda (mach)
 423                                          (eq? (obj:name (mach-cpu mach))
 424                                               (obj:name (mach-cpu (car selected-machs)))))
 425                                        selected-machs)))
 426                   (error "machs from different cpu families selected"))
 427               (mach-cpu (car selected-machs)))))
 428
 429     *UNSPECIFIED*)
 430 )
 431
 432 ; Validate the user-provided keep-mach list against the list of machs
 433 ; specified in the .cpu file (in define-arch).
 434
 435 (define (keep-mach-validate!)
 436   (let ((mach-names (cons 'all (current-arch-mach-name-list)))
 437         (keep-mach (reader-keep-mach CURRENT-READER)))
 438     (for-each (lambda (mach)
 439                 (if (not (memq mach mach-names))
 440                     (error "unknown mach to keep:" mach)))
 441               (car keep-mach))
 442     (for-each (lambda (mach)
 443                 (if (not (memq mach mach-names))
 444                     (error "unknown mach to drop:" mach)))
 445               (cdr keep-mach))
 446     )
 447   *UNSPECIFIED*
 448 )
 449
 450 ; Return #t if a machine in MACH-LIST, a list of symbols, is to be kept.
 451 ; If any machine in MACH-LIST is to be kept, the result is #t.
 452 ; If MACH-LIST is the empty list (no particular mach specified, thus the base
 453 ; mach), the result is #t.
 454
 455 (define (keep-mach? mach-list)
 456   (if (null? mach-list)
 457       #t
 458       (let* ((keep-mach (reader-keep-mach CURRENT-READER))
 459              (keep (cons 'base (car keep-mach)))
 460              (drop (cdr keep-mach))
 461              (keep? (map (lambda (m) (memq m keep)) mach-list))
 462              (all? (memq 'all keep))
 463              (drop? (map (lambda (m) (memq m drop)) mach-list)))
 464         (any-true? (map (lambda (k d)
 465                           ; keep if K(ept) or ALL? and not D(ropped)
 466                           (->bool (and (or k all?) (not d))))
 467                         keep? drop?))))
 468 )
 469
 470 ; Return non-#f if the object containing ATLIST is to be kept.
 471 ; OBJ is the container object or #f if there is none.
 472 ; The object is kept if its attribute list specifies a `MACH' that is
 473 ; kept (and not dropped) or does not have the `MACH' attribute (which means
 474 ; it has the default value which means it's for use with all machines).
 475
 476 (define (keep-mach-atlist? atlist obj)
 477   ; The MACH attribute is not created until the .cpu file is read in which
 478   ; is too late for us [we will get called for builtin objects].
 479   ; Thus we peek inside the attribute list directly.
 480   ; ??? Maybe postpone creation of builtins until after define-arch?
 481   (let ((machs (atlist-attr-value-no-default atlist 'MACH obj)))
 482     (if (null? machs)
 483         #t
 484         (keep-mach? (bitset-attr->list machs))))
 485 )
 486
 487 ; Return a boolean indicating if the object containing ATLIST is to be kept.
 488 ; OBJ is the container object or #f if there is none.
 489 ; The object is kept if both its isa and its mach are kept.
 490
 491 (define (keep-atlist? atlist obj)
 492   (and (keep-mach-atlist? atlist obj)
 493        (keep-isa-atlist? atlist obj))
 494 )
 495
 496 ; Return a boolean indicating if multiple cpu families are being kept.
 497
 498 (define (keep-multiple?)
 499   (let ((selected-machs (find (lambda (mach)
 500                                 (keep-mach? (list (obj:name mach))))
 501                               (current-mach-list))))
 502     (not (all-true? (map (lambda (mach)
 503                            (eq? (obj:name (mach-cpu mach))
 504                                 (obj:name (mach-cpu (car selected-machs)))))
 505                          selected-machs))))
 506 )
 507
 508 ; Return a boolean indicating if everything is kept.
 509
 510 (define (keep-all?)
 511   (equal? (reader-keep-mach CURRENT-READER) -keep-all-machs)
 512 )
 513
 514 ; Ensure all cpu families were kept, necessary for generating files that
 515 ; encompass the entire architecture.
 516
 517 (define (assert-keep-all)
 518   (if (not (keep-all?))
 519       (error "no can do, all cpu families not selected"))
 520   *UNSPECIFIED*
 521 )
 522
 523 ; Ensure exactly one cpu family was kept, necessary for generating files that
 524 ; are specific to one cpu family.
 525
 526 (define (assert-keep-one)
 527   (if (keep-multiple?)
 528       (error "no can do, multiple cpu families selected"))
 529   *UNSPECIFIED*
 530 )
 531 \f
 532 ; `keep-isa' processing.
 533
 534 ; Cover proc to set `keep-isa'.
 535 ; ISA-NAME-LIST is a comma separated string of isas to keep.
 536 ; ??? We don't support the !drop notation of keep-mach processing.
 537 ; Perhaps we should as otherwise there are two different styles the user
 538 ; has to remember.  On the other hand, !drop support is moderately complicated,
 539 ; and it can be added in an upward compatible manner later.
 540
 541 (define (-keep-isa-set! isa-name-list)
 542   (let ((isa-name-list (map string->symbol (string-cut isa-name-list #\,))))
 543     (reader-set-keep-isa! CURRENT-READER isa-name-list)
 544     )
 545   *UNSPECIFIED*
 546 )
 547
 548 ; Validate the user-provided keep-isa list against the list of isas
 549 ; specified in the .cpu file (in define-arch).
 550
 551 (define (keep-isa-validate!)
 552   (let ((isa-names (cons 'all (current-arch-isa-name-list)))
 553         (keep-isa (reader-keep-isa CURRENT-READER)))
 554     (for-each (lambda (isa)
 555                 (if (not (memq isa isa-names))
 556                     (error "unknown isa to keep:" isa)))
 557               keep-isa)
 558     )
 559   *UNSPECIFIED*
 560 )
 561
 562 ; Return currently selected isa (there must be exactly one).
 563
 564 (define (current-isa)
 565   (let ((keep-isa (reader-keep-isa CURRENT-READER)))
 566     (if (equal? keep-isa '(all))
 567         (let ((isas (current-isa-list)))
 568           (if (= (length isas) 1)
 569               (car isas)
 570               (error "multiple isas selected" keep-isa)))
 571         (if (= (length keep-isa) 1)
 572             (current-isa-lookup (car keep-isa))
 573             (error "multiple isas selected" keep-isa))))
 574 )
 575
 576 ; Return #t if an isa in ISA-LIST, a list of symbols, is to be kept.
 577 ; If any isa in ISA-LIST is to be kept, the result is #t.
 578 ; If ISA-LIST is the empty list (no particular isa specified) use the default
 579 ; isa.
 580
 581 (define (keep-isa? isa-list)
 582   (if (null? isa-list)
 583       (set! isa-list (list (car (current-arch-isa-name-list)))))
 584   (let* ((keep (reader-keep-isa CURRENT-READER))
 585          (keep? (map (lambda (i)
 586                        (or (memq i keep)
 587                            (memq 'all keep)))
 588                      isa-list)))
 589     (any-true? keep?))
 590 )
 591
 592 ; Return #t if the object containing ATLIST is to be kept.
 593 ; OBJ is the container object or #f if there is none.
 594 ; The object is kept if its attribute list specifies an `ISA' that is
 595 ; kept or does not have the `ISA' attribute (which means it has the default
 596 ; value) and the default isa is being kept.
 597
 598 (define (keep-isa-atlist? atlist obj)
 599   (let ((isas (atlist-attr-value atlist 'ISA obj)))
 600     (keep-isa? (bitset-attr->list isas)))
 601 )
 602
 603 ; Return non-#f if object OBJ is to be kept, according to its ISA attribute.
 604
 605 (define (keep-isa-obj? obj)
 606   (keep-isa-atlist? (obj-atlist obj) obj)
 607 )
 608
 609 ; Return a boolean indicating if multiple isas are being kept.
 610
 611 (define (keep-isa-multiple?)
 612   (let ((keep (reader-keep-isa CURRENT-READER)))
 613     (or (> (length keep) 1)
 614         (and (memq 'all keep)
 615              (> (length (current-arch-isa-name-list)) 1))))
 616 )
 617
 618 ; Return list of isa names currently being kept.
 619
 620 (define (current-keep-isa-name-list)
 621   (reader-keep-isa CURRENT-READER)
 622 )
 623 \f
 624 ; If #f, treat reserved fields as operands and extract them with the insn.
 625 ; Code can then be emitted in the extraction routines to validate them.
 626 ; If #t, treat reserved fields as part of the opcode.
 627 ; This complicates the decoding process as these fields have to be
 628 ; checked too.
 629 ; ??? Unimplemented.
 630
 631 (define option:reserved-as-opcode? #f)
 632
 633 ; Process options passed in on the command line.
 634 ; OPTIONS is a space separated string of name=value values.
 635 ; Each application is required to provide: option-init!, option-set!.
 636
 637 (define (set-cgen-options! options)
 638   (option-init!)
 639   (for-each (lambda (opt)
 640               (if (null? opt)
 641                   #t ; ignore extraneous spaces
 642                   (let ((name (string->symbol (car opt)))
 643                         (value (cdr opt)))
 644                     (logit 1 "Setting option `" name "' to \""
 645                            (apply string-append value) "\".\n")
 646                     (option-set! name value))))
 647             (map (lambda (opt) (string-cut opt #\=))
 648                  (string-cut options #\space)))
 649 )
 650 \f
 651 ; Application specific object creation support.
 652 ;
 653 ; Each entry in the .cpu file has a basic container class.
 654 ; Each application adds functionality by subclassing the container
 655 ; and registering with set-for-new! the proper class to create.
 656 ; ??? Not sure this is the best way to handle this, but it does keep the
 657 ; complexity down while not requiring as dynamic a language as I had before.
 658 ; ??? Class local variables would provide a more efficient way to do this.
 659 ; Assuming one wants to continue on this route.
 660
 661 (define -cpu-new-class-list nil)
 662
 663 (define (set-for-new! parent child)
 664   (set! -cpu-new-class-list (acons parent child -cpu-new-class-list))
 665 )
 666
 667 ; Lookup the class registered with set-for-new!
 668 ; If none registered, return PARENT.
 669
 670 (define (lookup-for-new parent)
 671   (let ((child (assq-ref -cpu-new-class-list parent)))
 672     (if child
 673         child
 674         parent))
 675 )
 676 \f
 677 ; .cpu file loader support
 678
 679 ; Prepare to parse a .cpu file.
 680 ; This initializes the application independent tables.
 681 ; KEEP-MACH specifies what machs to keep.
 682 ; KEEP-ISA specifies what isas to keep.
 683 ; OPTIONS is a list of options to control code generation.
 684 ; The values are application dependent.
 685
 686 (define (-init-parse-cpu! keep-mach keep-isa options)
 687   (set! -cpu-new-class-list nil)
 688
 689   (set! CURRENT-READER (new <reader>))
 690   (set! CURRENT-ARCH (new <arch>))
 691   (-keep-mach-set! keep-mach)
 692   (-keep-isa-set! keep-isa)
 693   (set-cgen-options! options)
 694
 695   (reader-add-command! 'include
 696                        "Include a file.\n"
 697                        nil '(file) include
 698   )
 699   (reader-add-command! 'if
 700                        "(if test then . else)\n"
 701                        nil '(test then . else) cmd-if
 702   )
 703
 704   ; Rather than add cgen-internal specific stuff to pmacros.scm, we create
 705   ; the pmacro commands here.
 706   (pmacros-init!)
 707   (reader-add-command! 'define-pmacro
 708                        "\
 709 Define a preprocessor-style macro.
 710 "
 711                        nil '(name arg1 . arg-rest) define-pmacro)
 712
 713   ; The order here is important.
 714   (arch-init!) ; Must be done first.
 715   (enum-init!)
 716   (attr-init!)
 717   (types-init!)
 718   (mach-init!)
 719   (model-init!)
 720   (mode-init!)
 721   (ifield-init!)
 722   (hardware-init!)
 723   (operand-init!)
 724   (insn-init!)
 725   (minsn-init!)
 726   (rtl-init!)
 727   (rtl-c-init!)
 728   (utils-init!)
 729
 730   *UNSPECIFIED*
 731 )
 732
 733 ; Install any builtin objects.
 734 ; This is deferred until define-arch is read.
 735 ; One reason is that attributes MACH and ISA don't exist until then.
 736
 737 (define (reader-install-builtin!)
 738   ; The order here is important.
 739   (attr-builtin!)
 740   (mode-builtin!)
 741   (ifield-builtin!)
 742   (hardware-builtin!)
 743   (operand-builtin!)
 744   ; This is mainly for the insn attributes.
 745   (insn-builtin!)
 746   (rtl-builtin!)
 747   *UNSPECIFIED*
 748 )
 749
 750 ; Do anything necessary for the application independent parts after parsing
 751 ; a .cpu file.
 752 ; The lists get cons'd in reverse order.  One thing this does is change them
 753 ; back to file order, it makes things easier for the human viewer.
 754
 755 (define (-finish-parse-cpu!)
 756   ; The order here is generally the reverse of init-parse-cpu!.
 757   (rtl-finish!)
 758   (minsn-finish!)
 759   (insn-finish!)
 760   (operand-finish!)
 761   (hardware-finish!)
 762   (ifield-finish!)
 763   (mode-finish!)
 764   (model-finish!)
 765   (mach-finish!)
 766   (types-finish!)
 767   (attr-finish!)
 768   (enum-finish!)
 769   (arch-finish!) ; Must be done last.
 770
 771   *UNSPECIFIED*
 772 )
 773
 774 ; Perform a global error checking pass after the .cpu file has been read in.
 775
 776 (define (-global-error-checks)
 777   ; ??? None yet.
 778   ; TODO:
 779   ; - all hardware elements with same name must have same rank and
 780   ;   compatible modes (which for now means same float mode or all int modes)
 781   #f
 782 )
 783
 784 ; .cpu file include mechanism
 785
 786 (define (include file)
 787   (logit 1 "Including file " (string-append arch-path "/" file) " ...\n")
 788   (reader-read-file! (string-append arch-path "/" file))
 789   (logit 2 "Resuming previous file ...\n")
 790 )
 791
 792 ; Version of `if' invokable at the top level of a description file.
 793 ; This is a work-in-progress.  Its presence in the description file is ok,
 794 ; but the implementation will need to evolve.
 795
 796 (define (cmd-if test then . else)
 797   (if (> (length else) 1)
 798       (reader-error "wrong number of arguments to `if'"
 799                     (cons 'if (cons test (cons then else)))
 800                     ""))
 801   ; ??? rtx-eval test
 802   (if (not (memq (car test) '(keep-isa? keep-mach? application-is?)))
 803       (reader-error "only (if (keep-mach?|keep-isa?|application-is? ...) ...) are currently supported" test ""))
 804   (case (car test)
 805     ((keep-isa?)
 806      (if (keep-isa? (cadr test))
 807          (eval1 then)
 808          (if (null? else)
 809              #f
 810              (eval1 (car else)))))
 811     ((keep-mach?)
 812      (if (keep-mach? (cadr test))
 813          (eval1 then)
 814          (if (null? else)
 815              #f
 816              (eval1 (car else)))))
 817     ((application-is?)
 818      (if (eq? APPLICATION (cadr test))
 819          (eval1 then)
 820          (if (null? else)
 821              #f
 822              (eval1 (car else))))))
 823 )
 824
 825 ; Top level routine for loading .cpu files.
 826 ; FILE is the name of the .cpu file to load.
 827 ; KEEP-MACH is a string of comma separated machines to keep
 828 ; (or not keep if prefixed with !).
 829 ; KEEP-ISA is a string of comma separated isas to keep.
 830 ; OPTIONS is the OPTIONS argument to -init-parse-cpu!.
 831 ; APP-INITER! is an application specific zero argument proc (thunk)
 832 ; to call after -init-parse-cpu!
 833 ; APP-FINISHER! is an application specific zero argument proc to call after
 834 ; -finish-parse-cpu!
 835 ; ANALYZER! is a zero argument proc to call after loading the .cpu file.
 836 ; It is expected to set up various tables and things useful for the application
 837 ; in question.
 838 ;
 839 ; This function isn't local because it's used by dev.scm.
 840
 841 (define (cpu-load file keep-mach keep-isa options
 842                   app-initer! app-finisher! analyzer!)
 843   (-init-parse-cpu! keep-mach keep-isa options)
 844   (app-initer!)
 845   (logit 1 "Loading cpu description " file " ...\n")
 846   (set! arch-path (dirname file))
 847   (reader-read-file! file)
 848   (logit 2 "Processing cpu description " file " ...\n")
 849   (-finish-parse-cpu!)
 850   (app-finisher!)
 851   (-global-error-checks)
 852   (analyzer!)
 853   *UNSPECIFIED*
 854 )
 855 \f
 856 ; Argument parsing utilities.
 857
 858 ; Generate a usage message.
 859 ; ERRTYPE is one of 'help, 'unknown, 'missing.
 860 ; OPTION is the option that had the error or "" if ERRTYPE is 'help.
 861
 862 (define (cgen-usage errtype option arguments)
 863   (let ((cep (current-error-port)))
 864     (case errtype
 865       ((help) #f)
 866       ((unknown) (display (string-append "Unknown option: " option "\n") cep))
 867       ((missing) (display (string-append "Missing argument: " option "\n") cep))
 868       (else (display "Unknown error!\n" cep)))
 869     (display "Usage: cgen arguments ...\n" cep)
 870     (for-each (lambda (arg)
 871                 (display (string-append (car arg)
 872                                         " " (if (cadr arg) (cadr arg) "")
 873                                         "  - " (caddr arg)
 874                                         "\n")
 875                          cep))
 876               arguments)
 877     (display "...\n" cep)
 878     (case errtype
 879       ((help) (quit 0))
 880       ((unknown missing) (quit 1))
 881       (else (quit 2))))
 882 )
 883
 884 ; Poor man's getopt.
 885 ; [We don't know where to find the real one until we've parsed the args,
 886 ; and this isn't something we need to get too fancy about anyways.]
 887 ; The result is always ((a . b) . c).
 888 ; If the argument is valid, the result is ((opt-spec . arg) . remaining-argv),
 889 ; or (('unknown . option) . remaining-argv) if `option' isn't recognized,
 890 ; or (('missing . option) . remaining argv) if `option' is missing a required
 891 ; argument,
 892 ; or ((#f . #f) . #f) if there are no more arguments.
 893 ; OPT-SPEC is a list of option specs.
 894 ; Each element is an alist of at least 3 elements: option argument help-text.
 895 ; `option' is a string or symbol naming the option.  e.g. -a, --help, "-i".
 896 ; symbols are supported for backward compatibility, -i is a complex number.
 897 ; `argument' is a string naming the argument or #f if the option takes no
 898 ; arguments.
 899 ; `help-text' is a string that is printed with the usage information.
 900 ; Elements beyond `help-text' are ignored.
 901
 902 (define (-getopt argv opt-spec)
 903   (if (null? argv)
 904       (cons (cons #f #f) #f)
 905       (let ((opt (assoc (car argv) opt-spec)))
 906         (cond ((not opt) (cons (cons 'unknown (car argv)) (cdr argv)))
 907               ((and (cadr opt) (null? (cdr argv)))
 908                (cons (cons 'missing (car argv)) (cdr argv)))
 909               ((cadr opt) (cons (cons opt (cadr argv)) (cddr argv)))
 910               (else ; must be option that doesn't take an argument
 911                (cons (cons opt #f) (cdr argv))))))
 912 )
 913
 914 ; Return (cadr args) or print a pretty error message if not possible.
 915
 916 (define (option-arg args)
 917   (if (and (pair? args) (pair? (cdr args)))
 918       (cadr args)
 919       (parse-error "option processing" "missing argument to" (car args)))
 920 )
 921
 922 ; Record of arguments passed to debug-repl, so they can be accessed in
 923 ; the repl loop.
 924
 925 (define debug-env #f)
 926
 927 ; Return list of recorded variables for debugging.
 928
 929 (define (debug-var-names) (map car debug-env))
 930
 931 ; Return value of recorded var NAME.
 932
 933 (define (debug-var name) (assq-ref debug-env name))
 934
 935 ; A handle on /dev/tty, so we can be sure we're talking with the user.
 936 ; We open this the first time we actually need it.
 937 (define debug-tty #f)
 938
 939 ; Return the port we should use for interacting with the user,
 940 ; opening it if necessary.
 941 (define (debug-tty-port)
 942   (if (not debug-tty)
 943       (set! debug-tty (open-file "/dev/tty" "r+")))
 944   debug-tty)
 945
 946 ; Enter a repl loop for debugging purposes.
 947 ; Use (quit) to exit cgen completely.
 948 ; Use (debug-quit) or (quit 0) to exit the debugging session and
 949 ; resume argument processing.
 950 ;
 951 ; ENV-ALIST can be anything, but it is intended to be an alist of values
 952 ; the caller will want to be able to access in the repl loop.
 953 ; It is stored in global `debug-env'.
 954 ;
 955 ; FIXME: Move to utils.scm.
 956
 957 (define (debug-repl env-alist)
 958   (with-input-and-output-to
 959    (debug-tty-port)
 960    (lambda ()
 961      (set! debug-env env-alist)
 962      (let loop ()
 963        (let ((rc (top-repl)))
 964          (if (null? rc)
 965              (quit 1))                  ; indicate error to `make'
 966          (if (not (equal? rc '(0)))
 967              (loop))))))
 968 )
 969
 970 ; Utility for debug-repl.
 971
 972 (define (debug-quit)
 973   ; Keep around for later debugging.
 974   ;(set! debug-env #f)
 975
 976   (quit 0)
 977 )
 978
 979 ; Macro to simplify calling debug-repl.
 980 ; Usage: (debug-repl-env var-name1 var-name2 ...)
 981
 982 (defmacro debug-repl-env var-names
 983   (let ((env (map (lambda (var-name)
 984                     (list 'cons (list 'quote var-name) var-name))
 985                   var-names)))
 986     (list 'debug-repl (cons 'list env)))
 987 )
 988
 989 ; List of common arguments.
 990 ;
 991 ; ??? Another useful arg would be one that says "do file generation with
 992 ; arguments specified up til now, then continue with next batch of args".
 993
 994 (define common-arguments
 995   '(("-a" "arch-file" "specify path of .cpu file to load")
 996     ("-b" #f          "use debugging evaluator, for backtraces")
 997     ("-d" #f          "start interactive debugging session")
 998     ("-f" "flags"     "specify a set of flags to control code generation")
 999     ("-h" #f          "print usage information")
1000     ("--help" #f      "print usage information")
1001     ("-i" "isa-list"  "specify isa-list entries to keep")
1002     ("-m" "mach-list" "specify mach-list entries to keep")
1003     ("-s" "srcdir"    "set srcdir")
1004     ("-v" #f          "increment verbosity level")
1005     ("--version" #f   "print version info")
1006     )
1007 )
1008
1009 ; Default place to look.
1010 ; This gets overridden to point to the directory of the loaded .cpu file.
1011 ; ??? Ideally this would be local to this file.
1012 (define arch-path (string-append srcdir "/cpu"))
1013
1014 ; Accessors for application option specs
1015 (define (opt-get-first-pass opt)
1016   (or (list-ref opt 3) (lambda args #f)))
1017 (define (opt-get-second-pass opt)
1018   (or (list-ref opt 4) (lambda args #f)))
1019
1020 ; Parse options and call generators.
1021 ; ARGS is a #:keyword delimited list of arguments.
1022 ; #:app-name name
1023 ; #:arg-spec optspec ; FIXME: rename to #:opt-spec
1024 ; #:init init-routine
1025 ; #:finish finish-routine
1026 ; #:analyze analysis-routine
1027 ; #:argv command-line-arguments
1028 ;
1029 ; ARGSPEC is a list of (option option-arg comment option-handler) elements.
1030 ; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and
1031 ; processes the option.
1032
1033 (define -cgen
1034   (lambda args
1035     (let ((app-name "unknown")
1036           (opt-spec nil)
1037           (app-init! (lambda () #f))
1038           (app-finish! (lambda () #f))
1039           (app-analyze! (lambda () #f))
1040           (argv (list "cgen"))
1041           )
1042       (let loop ((args args))
1043         (if (not (null? args))
1044             (case (car args)
1045               ((#:app-name) (begin
1046                               (set! app-name (option-arg args))
1047                               (loop (cddr args))))
1048               ((#:arg-spec) (begin
1049                               (set! opt-spec (option-arg args))
1050                               (loop (cddr args))))
1051               ((#:init) (begin
1052                           (set! app-init! (option-arg args))
1053                           (loop (cddr args))))
1054               ((#:finish) (begin
1055                             (set! app-finish! (option-arg args))
1056                             (loop (cddr args))))
1057               ((#:analyze) (begin
1058                              (set! app-analyze! (option-arg args))
1059                              (loop (cddr args))))
1060               ((#:argv) (begin
1061                           (set! argv (option-arg args))
1062                           (loop (cddr args))))
1063               (else (error "cgen: unknown argument" (car args))))))
1064
1065       ; ARGS has been processed, now we can process ARGV.
1066
1067       (let (
1068             (opt-spec (append common-arguments opt-spec))
1069             (app-args nil)    ; application's args are queued here
1070             (repl? #f)
1071             (arch-file #f)
1072             (keep-mach "all") ; default is all machs
1073             (keep-isa "all")  ; default is all isas
1074             (flags "")
1075             (moreopts? #t)
1076             (debugging #f)    ; default is off, for speed
1077             (cep (current-error-port))
1078             (str=? string=?)
1079             )
1080
1081         (let loop ((argv (cdr argv)))
1082           (let* ((new-argv (-getopt argv opt-spec))
1083                  (opt (caar new-argv))
1084                  (arg (cdar new-argv)))
1085             (case opt
1086               ((#f) (set! moreopts? #f))
1087               ((unknown) (cgen-usage 'unknown arg opt-spec))
1088               ((missing) (cgen-usage 'missing arg opt-spec))
1089               (else
1090                (cond ((str=? "-a" (car opt))
1091                       (set! arch-file arg)
1092                       )
1093                      ((str=? "-b" (car opt))
1094                       (set! debugging #t)
1095                       )
1096                      ((str=? "-d" (car opt))
1097                       (let ((prompt (string-append "cgen-" app-name "> ")))
1098                         (set! repl? #t)
1099                         (set-repl-prompt! prompt)
1100                         (if (feature? 'readline)
1101                             (set-readline-prompt! prompt))
1102                         ))
1103                      ((str=? "-f" (car opt))
1104                       (set! flags arg)
1105                       )
1106                      ((str=? "-h" (car opt))
1107                       (cgen-usage 'help "" opt-spec)
1108                       )
1109                      ((str=? "--help" (car opt))
1110                       (cgen-usage 'help "" opt-spec)
1111                       )
1112                      ((str=? "-i" (car opt))
1113                       (set! keep-isa arg)
1114                       )
1115                      ((str=? "-m" (car opt))
1116                       (set! keep-mach arg)
1117                       )
1118                      ((str=? "-s" (car opt))
1119                       #f ; ignore, already processed by caller
1120                       )
1121                      ((str=? "-v" (car opt))
1122                       (verbose-inc!)
1123                       )
1124                      ((str=? "--version" (car opt))
1125                       (begin
1126                         (display "Cpu tools GENerator version ")
1127                         (display (cgen-major))
1128                         (display ".")
1129                         (display (cgen-minor))
1130                         (display ".")
1131                         (display (cgen-fixlevel))
1132                         (newline)
1133                         (quit 0)
1134                         ))
1135                      ; Else this is an application specific option.
1136                      (else
1137                       ; Record it for later processing.  Note that they're
1138                       ; recorded in reverse order (easier).  This is undone
1139                       ; later.
1140                       (set! app-args (acons opt arg app-args)))
1141                      )))
1142             (if moreopts? (loop (cdr new-argv)))
1143             )
1144           ) ; end of loop
1145
1146         ; All arguments have been parsed.
1147
1148         (cgen-call-with-debugging
1149          debugging
1150          (lambda ()
1151
1152            (if (not arch-file)
1153                (error "-a option missing, no architecture specified"))
1154
1155            (if repl?
1156                (debug-repl nil))
1157            (cpu-load arch-file
1158                      keep-mach keep-isa flags
1159                      app-init! app-finish! app-analyze!)
1160
1161            ;; Start another repl loop if -d.
1162            ;; Awkward.  Both places are useful, though this is more useful.
1163            (if repl?
1164                (debug-repl nil))
1165
1166            ;; Done with processing the arguments.  Application arguments
1167            ;; are processed in two passes.  This is because the app may
1168            ;; have arguments that specify things that affect file
1169            ;; generation (e.g. to specify another input file) and we
1170            ;; don't want to require an ordering of the options.
1171            (for-each (lambda (opt-arg)
1172                        (let ((opt (car opt-arg))
1173                              (arg (cdr opt-arg)))
1174                          (if (cadr opt)
1175                              ((opt-get-first-pass opt) arg)
1176                              ((opt-get-first-pass opt)))))
1177                      (reverse app-args))
1178
1179            (for-each (lambda (opt-arg)
1180                        (let ((opt (car opt-arg))
1181                              (arg (cdr opt-arg)))
1182                          (if (cadr opt)
1183                              ((opt-get-second-pass opt) arg)
1184                              ((opt-get-second-pass opt)))))
1185                      (reverse app-args))))
1186         )
1187       )
1188     #f) ; end of lambda
1189 )
1190
1191 ; Main entry point called by application file generators.
1192
1193 (define cgen
1194   (lambda args
1195     (cgen-debugging-stack-start -cgen args))
1196 )