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 ; The "50" is a generic indicator that we're between 1.1 and 1.2.
  67 (define /CGEN-VERSION '(1 1 50))
  68 (define (cgen-major) (car /CGEN-VERSION))
  69 (define (cgen-minor) (cadr /CGEN-VERSION))
  70 (define (cgen-fixlevel) (caddr /CGEN-VERSION))
  71
  72 ; A list of two numbers designating the description language version.
  73 ; Note that this is different from /CGEN-VERSION.
  74 ; See section "RTL Versions" of the docs.
  75 (define /CGEN-RTL-VERSION #f)
  76 (define /default-rtl-version '(0 7))
  77 (define (cgen-rtl-version) /CGEN-RTL-VERSION)
  78 (define (cgen-rtl-major) (car /CGEN-RTL-VERSION))
  79 (define (cgen-rtl-minor) (cadr /CGEN-RTL-VERSION))
  80
  81 ;; Utilities for testing the rtl version.
  82 (define (rtl-version-equal? major minor)
  83   (equal? (cgen-rtl-version) (list major minor))
  84 )
  85 (define (rtl-version-at-least? major minor)
  86   (let ((rmajor (cgen-rtl-major))
  87         (rminor (cgen-rtl-major)))
  88     (or (> rmajor major)
  89         (and (= rmajor major)
  90              (>= rminor minor))))
  91 )
  92 (define (rtl-version-older? major minor)
  93   (not (rtl-version-at-least? major minor))
  94 )
  95
  96 ;; List of supported versions
  97 (define /supported-rtl-versions '((0 7) (0 8)))
  98
  99 (define (/cmd-define-rtl-version major minor)
 100   (if (not (non-negative-integer? major))
 101       (parse-error #f "Invalid major version number" major))
 102   (if (not (non-negative-integer? minor))
 103       (parse-error #f "Invalid minor version number" minor))
 104
 105   (let ((new-version (list major minor)))
 106     (if (not (member new-version /supported-rtl-versions))
 107         (parse-error #f "Unsupported/invalid rtl version" new-version))
 108     (if (not (equal? new-version /CGEN-RTL-VERSION))
 109         (logit 1 "Setting RTL version to " major "." minor " ...\n"))
 110     (set! /CGEN-RTL-VERSION new-version))
 111 )
 112
 113 ; Which application is in use (UNKNOWN, DESC, OPCODES, SIMULATOR, ???).
 114 ; This is mostly for descriptive purposes.
 115 (define APPLICATION 'UNKNOWN)
 116 \f
 117 ;; Load the base cgen files.
 118
 119 (load "pmacros")
 120 (load "cos")
 121 (load "slib/logical")
 122 (load "slib/sort")
 123 ; Used to pretty-print debugging messages.
 124 (load "slib/pp")
 125 ; Used by pretty-print.
 126 (load "slib/random")
 127 (load "slib/genwrite")
 128 (load "utils")
 129 (load "utils-cgen")
 130 (load "attr")
 131 (load "enum")
 132 (load "mach")
 133 (load "model")
 134 (load "types")
 135 (load "mode")
 136 (load "ifield")
 137 (load "iformat")
 138 (load "hardware")
 139 (load "operand")
 140 (load "insn")
 141 (load "minsn")
 142 (load "decode")
 143 (load "rtl")
 144 (load "rtl-traverse")
 145 (load "rtl-xform")
 146 (load "rtx-funcs")
 147 (load "rtl-c")
 148 (load "semantics")
 149 (load "sem-frags")
 150 (load "utils-gen")
 151 (load "pgmr-tools")
 152 \f
 153 ; Reader state data.
 154 ; All state regarding the reading of a .cpu file is kept in an object of
 155 ; class <reader>.
 156
 157 ; Class to record info for each top-level `command' (for lack of a better
 158 ; word) in the description file.
 159 ; Top level commands are things like define-*.
 160
 161 (define <command>
 162   (class-make '<command>
 163               '(<ident>)
 164               '(
 165                 ; argument spec to `lambda'
 166                 arg-spec
 167                 ; lambda that processes the entry
 168                 handler
 169                 )
 170               nil)
 171 )
 172
 173 (define command-arg-spec (elm-make-getter <command> 'arg-spec))
 174 (define command-handler (elm-make-getter <command> 'handler))
 175
 176 ; Return help text for COMMAND.
 177
 178 (define (command-help cmd)
 179   (string-append
 180    (obj:comment cmd)
 181    "Arguments: "
 182    (with-output-to-string (lambda () (write (command-arg-spec cmd))))
 183    "\n")
 184 )
 185
 186 ; A pair of two lists: machs to keep, machs to drop.
 187 ; The default is "keep all machs", "drop none".
 188
 189 (define /keep-all-machs '((all)))
 190
 191 ; Main reader state class.
 192
 193 (define <reader>
 194   (class-make '<reader>
 195               nil
 196               (list
 197                ; Selected machs to keep.
 198                ; A pair of two lists: the car lists the machs to keep, the cdr
 199                ; lists the machs to drop.  Two special entries are `all' and
 200                ; `base'.  Both are only valid in the keep list.  `base' is a
 201                ; place holder for objects that are common to all machine
 202                ; variants in the architecture, it is the default value of the
 203                ; MACH attribute.  If `all' is present the drop list is still
 204                ; processed.
 205                (cons 'keep-mach /keep-all-machs)
 206
 207                ; Selected isas to keep or `all'.
 208                '(keep-isa . (all))
 209
 210                ; Boolean indicating if command tracing is on.
 211                (cons 'trace-commands? #f)
 212
 213                ; Boolean indicating if pmacro tracing is on.
 214                (cons 'trace-pmacros? #f)
 215
 216                ; Issue diagnostics for instruction format issues.
 217                (cons 'verify-iformat? #f)
 218
 219                ; Currently select cpu family, computed from `keep-mach'.
 220                ; Some applications don't care, and this is moderately
 221                ; expensive to compute so we use delay/force.
 222                'current-cpu
 223
 224                ; Associative list of file entry commands
 225                ; (e.g. define-insn, etc.).
 226                ; Each entry is (name . command-object).
 227                (cons 'commands nil)
 228
 229                ; The current source location.
 230                ; This is recorded here by the higher level reader and is
 231                ; fetched by commands as necessary.
 232                'location
 233                )
 234               nil)
 235 )
 236
 237 ; Accessors.
 238
 239 (define-getters <reader> reader
 240   (keep-mach keep-isa
 241    trace-commands? trace-pmacros? verify-iformat?
 242    current-cpu commands location))
 243 (define-setters <reader> reader
 244   (keep-mach keep-isa
 245    trace-commands? trace-pmacros? verify-iformat?
 246    current-cpu commands location))
 247
 248 (define (reader-add-command! name comment attrs arg-spec handler)
 249   (reader-set-commands! CURRENT-READER
 250                         (acons name
 251                                (make <command> name comment attrs
 252                                      arg-spec handler)
 253                                (reader-commands CURRENT-READER)))
 254 )
 255
 256 (define (/reader-lookup-command name)
 257   (assq-ref (reader-commands CURRENT-READER) name)
 258 )
 259
 260 ; Reader state for current .cpu file.
 261
 262 (define CURRENT-READER #f)
 263
 264 ; Return the current source location in readable form.
 265 ; FIXME: Currently unused, keep for reference for awhile.
 266
 267 (define (/readable-current-location)
 268   (let ((loc (current-reader-location)))
 269     (if loc
 270         (location->string loc)
 271         ;; Blech, we don't have a current reader location.  That's odd.
 272         ;; Fall back to the current input port's location.
 273         (string-append (or (port-filename (current-input-port))
 274                             "<input>")
 275                         ":"
 276                         (number->string (port-line (current-input-port)))
 277                         ":")))
 278 )
 279
 280 ;; Subroutine of parse-error, parse-warning to simplify them.
 281 ;; Flag an error or a warning.
 282 ;; EMITTER is a function of one argument, the message to print.
 283
 284 (define (/parse-diagnostic emitter context message expr maybe-help-text)
 285   (if (not context)
 286       (set! context (make <context> (current-reader-location) #f)))
 287
 288   (let* ((loc (or (context-location context) (unspecified-location)))
 289          (top-sloc (location-top loc))
 290          (intro "While reading description")
 291          (prefix (or (context-prefix context) "Error"))
 292          (text (string-append prefix ": " message)))
 293
 294     (emitter
 295      (simple-format
 296       #f
 297       "\n~A:\n@ ~A:\n\n~A: ~A: ~S~A"
 298       intro
 299       (location->string loc)
 300       (single-location->simple-string top-sloc)
 301       text
 302       expr
 303       (if maybe-help-text
 304           (string-append "\n\n" maybe-help-text)
 305           ""))))
 306 )
 307
 308 ;; Signal a parse error while reading a .cpu file.
 309 ;; Processing stops immediately.
 310 ;; If CONTEXT is #f, use a default context of the current reader location
 311 ;; and an empty prefix.
 312 ;; If MAYBE-HELP-TEXT is specified, elide the last trailing \n.
 313 ;; Multiple lines of help text need embedded newlines, and should be no longer
 314 ;; than 79 characters.
 315
 316 (define (parse-error context errmsg expr . maybe-help-text)
 317   (/parse-diagnostic error
 318                      context
 319                      errmsg
 320                      expr
 321                      (if (null? maybe-help-text) "" (car maybe-help-text)))
 322 )
 323
 324 ;; Same as parse-error, but continue processing.
 325
 326 (define (parse-error-continuable context errmsg expr . maybe-help-text)
 327   (set! /continuable-error-found? #t)
 328   (/parse-diagnostic (lambda (text) (message "Error: " text "\n"))
 329                      context
 330                      errmsg
 331                      expr
 332                      (if (null? maybe-help-text) #f (car maybe-help-text)))
 333 )
 334
 335 ;; Signal a parse warning while reading a .cpu file.
 336 ;; If CONTEXT is #f, use a default context of the current reader location
 337 ;; and an empty prefix.
 338 ;; If MAYBE-HELP-TEXT is specified, elide the last trailing \n.
 339 ;; Multiple lines of help text need embedded newlines, and should be no longer
 340 ;; than 79 characters.
 341
 342 (define (parse-warning context errmsg expr . maybe-help-text)
 343   (/parse-diagnostic (lambda (text) (message "Warning: " text "\n"))
 344                      context
 345                      errmsg
 346                      expr
 347                      (if (null? maybe-help-text) #f (car maybe-help-text)))
 348 )
 349
 350 ; Return the current source location.
 351 ;
 352 ; If CURRENT-READER is uninitialized, return "unspecified" location.
 353 ; This is done so that things like define-pmacro work in interactive mode.
 354
 355 (define (current-reader-location)
 356   (if CURRENT-READER
 357       (reader-location CURRENT-READER)
 358       (unspecified-location))
 359 )
 360
 361 ; Process a macro-expanded entry.
 362
 363 (define (/reader-process-expanded-1! entry)
 364   (let ((location (location-property entry)))
 365
 366     ;; Set the current source location for better diagnostics.
 367     ;; Access with current-reader-location.
 368     (reader-set-location! CURRENT-READER location)
 369
 370     (if (reader-trace-commands? CURRENT-READER)
 371         (message "Processing command:\n  @ "
 372                  (if location (location->string location) "location unknown")
 373                  "\n"
 374                  (with-output-to-string (lambda () (pretty-print entry)))))
 375
 376     (let ((command (/reader-lookup-command (car entry)))
 377           (context (make-current-context #f)))
 378
 379       (if command
 380
 381           (let* ((handler (command-handler command))
 382                  (arg-spec (command-arg-spec command))
 383                  (num-args (num-args arg-spec)))
 384             (if (cdr num-args)
 385                 ;; Variable number of trailing arguments.
 386                 (if (< (length (cdr entry)) (car num-args))
 387                     (parse-error context
 388                                  (string-append "Incorrect number of arguments to "
 389                                                 (symbol->string (car entry))
 390                                                 ", expecting at least "
 391                                                 (number->string (car num-args)))
 392                                  entry
 393                                  (command-help command))
 394                     (apply handler (cdr entry)))
 395                 ;; Fixed number of arguments.
 396                 (if (!= (length (cdr entry)) (car num-args))
 397                     (parse-error context
 398                                  (string-append "Incorrect number of arguments to "
 399                                                 (symbol->string (car entry))
 400                                                 ", expecting "
 401                                                 (number->string (car num-args)))
 402                                  entry
 403                                  (command-help command))
 404                     (apply handler (cdr entry)))))
 405
 406           (parse-error context "unknown entry type" entry))))
 407
 408   *UNSPECIFIED*
 409 )
 410
 411 ;; Process 1 or more macro-expanded entries.
 412 ;; ENTRY is expected to have a location-property object property.
 413
 414 ;; NOTE: This is "public" so the .eval pmacro can use it.
 415 ;; This is also used by /cmd-if.
 416
 417 (define (reader-process-expanded! entry)
 418   ;; () is used to indicate a no-op
 419   (cond ((null? entry)
 420          #f) ;; nothing to do
 421         ;; `begin' is used to group a collection of entries into one,
 422         ;; since pmacro can only return one expression (borrowed from
 423         ;; Scheme of course).
 424         ;; Recurse in case there are nested begins.
 425         ((eq? (car entry) 'begin)
 426          (for-each reader-process-expanded!
 427                    (cdr entry)))
 428         (else
 429          (/reader-process-expanded-1! entry)))
 430
 431   *UNSPECIFIED*
 432 )
 433
 434 ; Process file entry ENTRY.
 435 ; LOC is a <location> object for ENTRY.
 436
 437 (define (/reader-process! entry loc)
 438   (if (not (form? entry))
 439       (parse-error loc "improperly formed entry" entry))
 440
 441   ; First do macro expansion, but not if define-pmacro of course.
 442   ; ??? Singling out define-pmacro this way seems a bit odd.  The way to look
 443   ; at it, I guess, is to think of define-pmacro as (currently) the only
 444   ; "syntactic" command (it doesn't pre-evaluate its arguments).
 445   (let ((expansion (if (eq? (car entry) 'define-pmacro)
 446                        (begin (location-property-set! entry loc) entry)
 447                        (if (reader-trace-pmacros? CURRENT-READER)
 448                            (pmacro-trace entry loc)
 449                            (pmacro-expand entry loc)))))
 450     (reader-process-expanded! expansion))
 451
 452   *UNSPECIFIED*
 453 )
 454
 455 ; Read in and process FILE.
 456 ;
 457 ; It would be nice to get the line number of the beginning of the object,
 458 ; but that's extra work, so for now we do the simple thing and use
 459 ; port-line after we've read an entry.
 460
 461 (define (reader-read-file! file)
 462   (let ((readit (lambda ()
 463                   (let loop ((entry (read)))
 464                     (if (eof-object? entry)
 465                         #t ; done
 466                         (begin
 467                           ;; ??? The location we pass here isn't ideal.
 468                           ;; Ideally we'd pass the start location of the
 469                           ;; expression, instead we currently pass the end
 470                           ;; location (it's easier).
 471                           ;; ??? Use source-properties of entry, and only if
 472                           ;; not present fall back on current-input-location.
 473                           (/reader-process! entry (current-input-location #t))
 474                           (loop (read)))))))
 475         )
 476
 477     (with-input-from-file file readit))
 478
 479   *UNSPECIFIED*
 480 )
 481 \f
 482 ; Cpu data is recorded in an object of class <arch>.
 483 ; This is necessary as we need to allow recording of multiple cpu descriptions
 484 ; simultaneously.
 485 ; Class <arch> is defined in mach.scm.
 486
 487 ; Global containing all data of the currently selected architecture.
 488
 489 (define CURRENT-ARCH #f)
 490 \f
 491 ; `keep-mach' processing.
 492
 493 ; Return the currently selected cpu family.
 494 ; If a specific cpu family has been selected, each machine that is kept must
 495 ; be in that cpu family [so there's no ambiguity in the result].
 496 ; This is a moderately expensive computation so use delay/force.
 497
 498 (define (current-cpu) (force (reader-current-cpu CURRENT-READER)))
 499
 500 ; Return a boolean indicating if CPU-NAME is to be kept.
 501 ; ??? Currently this is always true.  Note that this doesn't necessarily apply
 502 ; to machs in CPU-NAME.
 503
 504 (define (keep-cpu? cpu-name) #t)
 505
 506 ; Cover proc to set `keep-mach'.
 507 ; MACH-NAME-LIST is a comma separated string of machines to keep and drop
 508 ; (if prefixed with !).
 509
 510 (define (/keep-mach-set! mach-name-list)
 511   (let* ((mach-name-list (string-cut mach-name-list #\,))
 512          (keep (find (lambda (name) (not (char=? (string-ref name 0) #\!)))
 513                      mach-name-list))
 514          (drop (map (lambda (name) (string->symbol (string-drop 1 name)))
 515                     (find (lambda (name) (char=? (string-ref name 0) #\!))
 516                           mach-name-list))))
 517     (reader-set-keep-mach! CURRENT-READER
 518                            (cons (map string->symbol keep)
 519                                  (map string->symbol drop)))
 520     ; Reset current-cpu.
 521     (reader-set-current-cpu!
 522      CURRENT-READER
 523      (delay (let ((selected-machs (find (lambda (mach)
 524                                           (keep-mach? (list (obj:name mach))))
 525                                         (current-mach-list))))
 526               (if (= (length selected-machs) 0)
 527                   (error "no machs selected"))
 528               (if (not (all-true? (map (lambda (mach)
 529                                          (eq? (obj:name (mach-cpu mach))
 530                                               (obj:name (mach-cpu (car selected-machs)))))
 531                                        selected-machs)))
 532                   (error "machs from different cpu families selected"))
 533               (mach-cpu (car selected-machs)))))
 534
 535     *UNSPECIFIED*)
 536 )
 537
 538 ; Validate the user-provided keep-mach list against the list of machs
 539 ; specified in the .cpu file (in define-arch).
 540
 541 (define (keep-mach-validate!)
 542   (let ((mach-names (cons 'all (current-arch-mach-name-list)))
 543         (keep-mach (reader-keep-mach CURRENT-READER)))
 544     (for-each (lambda (mach)
 545                 (if (not (memq mach mach-names))
 546                     (error "unknown mach to keep:" mach)))
 547               (car keep-mach))
 548     (for-each (lambda (mach)
 549                 (if (not (memq mach mach-names))
 550                     (error "unknown mach to drop:" mach)))
 551               (cdr keep-mach))
 552     )
 553   *UNSPECIFIED*
 554 )
 555
 556 ; Return #t if a machine in MACH-LIST, a list of symbols, is to be kept.
 557 ; If any machine in MACH-LIST is to be kept, the result is #t.
 558 ; If MACH-LIST is the empty list (no particular mach specified, thus the base
 559 ; mach), the result is #t.
 560
 561 (define (keep-mach? mach-list)
 562   (if (null? mach-list)
 563       #t
 564       (let* ((keep-mach (reader-keep-mach CURRENT-READER))
 565              (keep (cons 'base (car keep-mach)))
 566              (drop (cdr keep-mach))
 567              (keep? (map (lambda (m) (memq m keep)) mach-list))
 568              (all? (memq 'all keep))
 569              (drop? (map (lambda (m) (memq m drop)) mach-list)))
 570         (any-true? (map (lambda (k d)
 571                           ; keep if K(ept) or ALL? and not D(ropped)
 572                           (->bool (and (or k all?) (not d))))
 573                         keep? drop?))))
 574 )
 575
 576 ; Return non-#f if the object containing ATLIST is to be kept.
 577 ; OBJ is the container object or #f if there is none.
 578 ; The object is kept if its attribute list specifies a `MACH' that is
 579 ; kept (and not dropped) or does not have the `MACH' attribute (which means
 580 ; it has the default value which means it's for use with all machines).
 581
 582 (define (keep-mach-atlist? atlist obj)
 583   ; The MACH attribute is not created until the .cpu file is read in which
 584   ; is too late for us [we will get called for builtin objects].
 585   ; Thus we peek inside the attribute list directly.
 586   ; ??? Maybe postpone creation of builtins until after define-arch?
 587   (let ((machs (atlist-attr-value-no-default atlist 'MACH obj)))
 588     (if (null? machs)
 589         #t
 590         (keep-mach? machs)))
 591 )
 592
 593 ; Return a boolean indicating if the object containing ATLIST is to be kept.
 594 ; OBJ is the container object or #f if there is none.
 595 ; The object is kept if both its isa and its mach are kept.
 596
 597 (define (keep-atlist? atlist obj)
 598   (and (keep-mach-atlist? atlist obj)
 599        (keep-isa-atlist? atlist obj))
 600 )
 601
 602 ; Return a boolean indicating if multiple cpu families are being kept.
 603
 604 (define (keep-multiple?)
 605   (let ((selected-machs (find (lambda (mach)
 606                                 (keep-mach? (list (obj:name mach))))
 607                               (current-mach-list))))
 608     (not (all-true? (map (lambda (mach)
 609                            (eq? (obj:name (mach-cpu mach))
 610                                 (obj:name (mach-cpu (car selected-machs)))))
 611                          selected-machs))))
 612 )
 613
 614 ; Return a boolean indicating if everything is kept.
 615
 616 (define (keep-all?)
 617   (equal? (reader-keep-mach CURRENT-READER) /keep-all-machs)
 618 )
 619
 620 ; Ensure all cpu families were kept, necessary for generating files that
 621 ; encompass the entire architecture.
 622
 623 (define (assert-keep-all)
 624   (if (not (keep-all?))
 625       (error "no can do, all cpu families not selected"))
 626   *UNSPECIFIED*
 627 )
 628
 629 ; Ensure exactly one cpu family was kept, necessary for generating files that
 630 ; are specific to one cpu family.
 631
 632 (define (assert-keep-one)
 633   (if (keep-multiple?)
 634       (error "no can do, multiple cpu families selected"))
 635   *UNSPECIFIED*
 636 )
 637 \f
 638 ; `keep-isa' processing.
 639
 640 ; Cover proc to set `keep-isa'.
 641 ; ISA-NAME-LIST is a comma separated string of isas to keep.
 642 ; ??? We don't support the !drop notation of keep-mach processing.
 643 ; Perhaps we should as otherwise there are two different styles the user
 644 ; has to remember.  On the other hand, !drop support is moderately complicated,
 645 ; and it can be added in an upward compatible manner later.
 646
 647 (define (/keep-isa-set! isa-name-list)
 648   (let ((isa-name-list (map string->symbol (string-cut isa-name-list #\,))))
 649     (reader-set-keep-isa! CURRENT-READER isa-name-list)
 650     )
 651   *UNSPECIFIED*
 652 )
 653
 654 ; Validate the user-provided keep-isa list against the list of isas
 655 ; specified in the .cpu file (in define-arch).
 656
 657 (define (keep-isa-validate!)
 658   (let ((isa-names (cons 'all (current-arch-isa-name-list)))
 659         (keep-isa (reader-keep-isa CURRENT-READER)))
 660     (for-each (lambda (isa)
 661                 (if (not (memq isa isa-names))
 662                     (error "unknown isa to keep:" isa)))
 663               keep-isa)
 664     )
 665   *UNSPECIFIED*
 666 )
 667
 668 ; Return currently selected isa (there must be exactly one).
 669
 670 (define (current-isa)
 671   (let ((keep-isa (reader-keep-isa CURRENT-READER)))
 672     (if (equal? keep-isa '(all))
 673         (let ((isas (current-isa-list)))
 674           (if (= (length isas) 1)
 675               (car isas)
 676               (error "multiple isas selected" keep-isa)))
 677         (if (= (length keep-isa) 1)
 678             (current-isa-lookup (car keep-isa))
 679             (error "multiple isas selected" keep-isa))))
 680 )
 681
 682 ; Return #t if an isa in ISA-LIST, a list of symbols, is to be kept.
 683 ; If any isa in ISA-LIST is to be kept, the result is #t.
 684 ; If ISA-LIST is the empty list (no particular isa specified) use the default
 685 ; isa.
 686
 687 (define (keep-isa? isa-list)
 688   ;; If unspecified, the default is the first one in the list.
 689   (if (null? isa-list)
 690       (set! isa-list (list (car (current-arch-isa-name-list)))))
 691
 692   (let* ((keep (reader-keep-isa CURRENT-READER))
 693          (keep? (map (lambda (i)
 694                        (or (memq i keep)
 695                            (memq 'all keep)))
 696                      isa-list)))
 697     (any-true? keep?))
 698 )
 699
 700 ; Return #t if the object containing ATLIST is to be kept.
 701 ; OBJ is the container object or #f if there is none.
 702 ; The object is kept if its attribute list specifies an `ISA' that is
 703 ; kept or does not have the `ISA' attribute (which means it has the default
 704 ; value) and the default isa is being kept.
 705
 706 (define (keep-isa-atlist? atlist obj)
 707   (let ((isas (atlist-attr-value atlist 'ISA obj)))
 708     (keep-isa? isas))
 709 )
 710
 711 ; Return non-#f if object OBJ is to be kept, according to its ISA attribute.
 712
 713 (define (keep-isa-obj? obj)
 714   (keep-isa-atlist? (obj-atlist obj) obj)
 715 )
 716
 717 ; Return a boolean indicating if multiple isas are being kept.
 718
 719 (define (keep-isa-multiple?)
 720   (let ((keep (reader-keep-isa CURRENT-READER)))
 721     (or (> (length keep) 1)
 722         (and (memq 'all keep)
 723              (> (length (current-arch-isa-name-list)) 1))))
 724 )
 725
 726 ; Return list of isa names currently being kept.
 727
 728 (define (current-keep-isa-name-list)
 729   (reader-keep-isa CURRENT-READER)
 730 )
 731 \f
 732 ;; Tracing support.
 733 ;; This is akin to the "logit" support, but is for specific things that
 734 ;; can be named (whereas logit support is based on a simple integer verbosity
 735 ;; level).
 736
 737 ;;; Enable the specified tracing.
 738 ;;; TRACE-OPTIONS is a comma-separated list of things to trace.
 739 ;;;
 740 ;;; Currently supported tracing:
 741 ;;; commands - trace invocation of description file commands (e.g. define-insn)
 742 ;;; pmacros  - trace pmacro expansion
 743 ;;; all      - trace everything
 744 ;;;
 745 ;;; [If we later need to support disabling some tracing, one way is to
 746 ;;; recognize an "-" in front of an option.]
 747
 748 (define (/set-trace-options! trace-options)
 749   (let ((all (list "commands" "pmacros"))
 750         (requests (string-cut trace-options #\,)))
 751     (if (member "all" requests)
 752         (append! requests all))
 753     (for-each (lambda (item)
 754               (cond ((string=? "commands" item)
 755                      (reader-set-trace-commands?! CURRENT-READER #t))
 756                     ((string=? "pmacros" item)
 757                      (reader-set-trace-pmacros?! CURRENT-READER #t))
 758                     ((string=? "all" item)
 759                      #t) ;; handled above
 760                     (else
 761                      (cgen-usage 'unknown (string-append "-t " item)
 762                                  common-arguments))))
 763               requests))
 764
 765   *UNSPECIFIED*
 766 )
 767 \f
 768 ;; Diagnostic support.
 769
 770 ;;; Enable the specified diagnostics.
 771 ;;; DIAGNOSTIC-OPTIONS is a comma-separated list of things to trace.
 772 ;;;
 773 ;;; Currently supported diagnostics:
 774 ;;; iformat - issue diagnostics for iformat issues
 775 ;;; all - turn on all diagnostics
 776 ;;;
 777 ;;; [If we later need to support disabling some diagnostic, one way is to
 778 ;;; recognize an "-" in front of an option.]
 779
 780 (define (/set-diagnostic-options! diagnostic-options)
 781   (let ((all (list "iformat"))
 782         (requests (string-cut diagnostic-options #\,)))
 783     (if (member "all" requests)
 784         (append! requests all))
 785     (for-each (lambda (item)
 786               (cond ((string=? "iformat" item)
 787                      (reader-set-verify-iformat?! CURRENT-READER #t))
 788                     ((string=? "all" item)
 789                      #t) ;; handled above
 790                     (else
 791                      (cgen-usage 'unknown (string-append "-w " item)
 792                                  common-arguments))))
 793               requests))
 794
 795   *UNSPECIFIED*
 796 )
 797 \f
 798 ; If #f, treat reserved fields as operands and extract them with the insn.
 799 ; Code can then be emitted in the extraction routines to validate them.
 800 ; If #t, treat reserved fields as part of the opcode.
 801 ; This complicates the decoding process as these fields have to be
 802 ; checked too.
 803 ; ??? Unimplemented.
 804
 805 (define option:reserved-as-opcode? #f)
 806
 807 ; Process options passed in on the command line.
 808 ; OPTIONS is a space separated string of name=value values.
 809 ; Each application is required to provide: option-init!, option-set!.
 810
 811 (define (set-cgen-options! options)
 812   (option-init!)
 813   (for-each (lambda (opt)
 814               (if (null? opt)
 815                   #t ; ignore extraneous spaces
 816                   (let ((name (string->symbol (car opt)))
 817                         (value (cdr opt)))
 818                     (logit 1 "Setting option `" name "' to \""
 819                            (apply string-append value) "\".\n")
 820                     (option-set! name value))))
 821             (map (lambda (opt) (string-cut opt #\=))
 822                  (string-cut options #\space)))
 823 )
 824 \f
 825 ; Application specific object creation support.
 826 ;
 827 ; Each entry in the .cpu file has a basic container class.
 828 ; Each application adds functionality by subclassing the container
 829 ; and registering with set-for-new! the proper class to create.
 830 ; ??? Not sure this is the best way to handle this, but it does keep the
 831 ; complexity down while not requiring as dynamic a language as I had before.
 832 ; ??? Class local variables would provide a more efficient way to do this.
 833 ; Assuming one wants to continue on this route.
 834
 835 (define /cpu-new-class-list nil)
 836
 837 (define (set-for-new! parent child)
 838   (set! /cpu-new-class-list (acons parent child /cpu-new-class-list))
 839 )
 840
 841 ; Lookup the class registered with set-for-new!
 842 ; If none registered, return PARENT.
 843
 844 (define (lookup-for-new parent)
 845   (let ((child (assq-ref /cpu-new-class-list parent)))
 846     (if child
 847         child
 848         parent))
 849 )
 850 \f
 851 ; .cpu file loader support
 852
 853 ;; #t if an error was found (but processing continued)
 854 (define /continuable-error-found? #f)
 855
 856 ;; Initialize a new <reader> object.
 857 ;; This doesn't add cgen-specific commands, leaving each element (ifield,
 858 ;; hardware, etc.) to add their own.
 859 ;; The "result" is stored in global CURRENT-READER.
 860
 861 (define (/init-reader!)
 862   (set! CURRENT-READER (new <reader>))
 863
 864   (set! /CGEN-RTL-VERSION /default-rtl-version)
 865
 866   (set! /continuable-error-found? #f)
 867
 868   (reader-add-command! 'define-rtl-version
 869                        "Specify the RTL version being used.\n"
 870                        nil '(major minor) /cmd-define-rtl-version)
 871
 872   (reader-add-command! 'include
 873                        "Include a file.\n"
 874                        nil '(file) /cmd-include)
 875   (reader-add-command! 'if
 876                        "(if test then . else)\n"
 877                        nil '(test then . else) /cmd-if)
 878
 879   ; Rather than add cgen-internal specific stuff to pmacros.scm, we create
 880   ; the pmacro commands here.
 881   (pmacros-init!)
 882   (reader-add-command! 'define-pmacro
 883                        "\
 884 Define a preprocessor-style macro.
 885 "
 886                        nil '(name arg1 . arg-rest) define-pmacro)
 887
 888   *UNSPECIFIED*
 889 )
 890
 891 ;; Called at the end of .cpu file loading.
 892
 893 (define (/finish-reader! file)
 894   (if /continuable-error-found?
 895       (error (string-append "Error loading " file)))
 896   *UNSPECIFIED*
 897 )
 898
 899 ; Prepare to parse a .cpu file.
 900 ; This initializes the application independent tables.
 901 ; KEEP-MACH specifies what machs to keep.
 902 ; KEEP-ISA specifies what isas to keep.
 903 ; OPTIONS is a list of options to control code generation.
 904 ; The values are application dependent.
 905
 906 (define (/init-parse-cpu! keep-mach keep-isa options)
 907   (set! /cpu-new-class-list nil)
 908
 909   (set! CURRENT-ARCH (new <arch>))
 910   (/keep-mach-set! keep-mach)
 911   (/keep-isa-set! keep-isa)
 912   (set-cgen-options! options)
 913
 914   ; The order here is important.
 915   (arch-init!) ; Must be done first.
 916   (enum-init!)
 917   (attr-init!)
 918   (types-init!)
 919   (mach-init!)
 920   (model-init!)
 921   (mode-init!)
 922   (ifield-init!)
 923   (hardware-init!)
 924   (operand-init!)
 925   (insn-init!)
 926   (minsn-init!)
 927   (rtl-init!)
 928   (rtl-c-init!)
 929   (utils-init!)
 930
 931   *UNSPECIFIED*
 932 )
 933
 934 ; Install any builtin objects.
 935 ; This is deferred until define-arch is read.
 936 ; One reason is that attributes MACH and ISA don't exist until then.
 937
 938 (define (reader-install-builtin!)
 939   ; The order here is important.
 940   (attr-builtin!)
 941   (mode-builtin!)
 942   (ifield-builtin!)
 943   (hardware-builtin!)
 944   (operand-builtin!)
 945   ; This is mainly for the insn attributes.
 946   (insn-builtin!)
 947   (rtl-builtin!)
 948   *UNSPECIFIED*
 949 )
 950
 951 ; Do anything necessary for the application independent parts after parsing
 952 ; a .cpu file.
 953 ; The lists get cons'd in reverse order.  One thing this does is change them
 954 ; back to file order, it makes things easier for the human viewer.
 955
 956 (define (/finish-parse-cpu!)
 957   ; The order here is generally the reverse of init-parse-cpu!.
 958   (rtl-finish!)
 959   (minsn-finish!)
 960   (insn-finish!)
 961   (operand-finish!)
 962   (hardware-finish!)
 963   (ifield-finish!)
 964   (mode-finish!)
 965   (model-finish!)
 966   (mach-finish!)
 967   (types-finish!)
 968   (attr-finish!)
 969   (enum-finish!)
 970   (arch-finish!) ; Must be done last.
 971
 972   *UNSPECIFIED*
 973 )
 974
 975 ; Perform a global error checking pass after the .cpu file has been read in.
 976
 977 (define (/global-error-checks)
 978   ; ??? None yet.
 979   ; TODO:
 980   ; - all hardware elements with same name must have same rank and
 981   ;   compatible modes (which for now means same float mode or all int modes)
 982   #f
 983 )
 984
 985 ; .cpu file include mechanism
 986
 987 (define (/cmd-include file)
 988   (logit 1 "Including file " (string-append arch-path "/" file) " ...\n")
 989   (reader-read-file! (string-append arch-path "/" file))
 990   (logit 2 "Resuming previous file ...\n")
 991 )
 992
 993 ; Version of `if' invokable at the top level of a description file.
 994 ; This is a work-in-progress.  Its presence in the description file is ok,
 995 ; but the implementation will need to evolve.
 996
 997 (define (/cmd-if test then . else)
 998   (if (> (length else) 1)
 999       (parse-error #f
1000                    "wrong number of arguments to `if'"
1001                    (cons 'if (cons test (cons then else)))))
1002   ; ??? rtx-eval test
1003   (if (or (not (pair? test))
1004           (not (memq (car test) '(keep-isa? keep-mach? application-is?))))
1005       (parse-error #f
1006                    "only (if (keep-mach?|keep-isa?|application-is? ...) ...) are currently supported"
1007                    test))
1008   (case (car test)
1009     ((keep-isa?)
1010      (if (keep-isa? (cadr test))
1011          (reader-process-expanded! then)
1012          (if (null? else)
1013              #f
1014              (reader-process-expanded! (car else)))))
1015     ((keep-mach?)
1016      (if (keep-mach? (cadr test))
1017          (reader-process-expanded! then)
1018          (if (null? else)
1019              #f
1020              (reader-process-expanded! (car else)))))
1021     ((application-is?)
1022      (if (eq? APPLICATION (cadr test))
1023          (reader-process-expanded! then)
1024          (if (null? else)
1025              #f
1026              (reader-process-expanded! (car else))))))
1027 )
1028
1029 ; Top level routine for loading .cpu files.
1030 ; FILE is the name of the .cpu file to load.
1031 ; KEEP-MACH is a string of comma separated machines to keep
1032 ; (or not keep if prefixed with !).
1033 ; KEEP-ISA is a string of comma separated isas to keep.
1034 ; OPTIONS is the OPTIONS argument to -init-parse-cpu!.
1035 ; TRACE-OPTIONS is a random list of things to trace.
1036 ; DIAGNOSTIC-OPTIONS is a random list of things to warn/error about.
1037 ; APP-INITER! is an application specific zero argument proc (thunk)
1038 ; to call after -init-parse-cpu!
1039 ; APP-FINISHER! is an application specific zero argument proc to call after
1040 ; -finish-parse-cpu!
1041 ; ANALYZER! is a zero argument proc to call after loading the .cpu file.
1042 ; It is expected to set up various tables and things useful for the application
1043 ; in question.
1044 ;
1045 ; This function isn't local because it's used by dev.scm.
1046
1047 (define (cpu-load file keep-mach keep-isa options
1048                   trace-options diagnostic-options
1049                   app-initer! app-finisher! analyzer!)
1050   (/init-reader!)
1051   (/init-parse-cpu! keep-mach keep-isa options)
1052   (/set-trace-options! trace-options)
1053   (/set-diagnostic-options! diagnostic-options)
1054   (app-initer!)
1055   (logit 1 "Loading cpu description " file " ...\n")
1056   (logit 1 "machs:   " keep-mach "\n")
1057   (logit 1 "isas:    " keep-isa "\n")
1058   (logit 1 "options: " options "\n")
1059   (logit 1 "trace:   " trace-options "\n")
1060   (logit 1 "diags:   " diagnostic-options "\n")
1061   (set! arch-path (dirname file))
1062   (reader-read-file! file)
1063   (/finish-parse-cpu!)
1064   (/finish-reader! file)
1065   (logit 1 "Processing cpu description " file " ...\n")
1066   (app-finisher!)
1067   (/global-error-checks)
1068   (analyzer!)
1069   *UNSPECIFIED*
1070 )
1071 \f
1072 ; Argument parsing utilities.
1073
1074 ; Generate a usage message.
1075 ; ERRTYPE is one of 'help, 'unknown, 'missing.
1076 ; OPTION is the option that had the error or "" if ERRTYPE is 'help.
1077
1078 (define (cgen-usage errtype option arguments)
1079   (let ((cep (current-error-port)))
1080     (case errtype
1081       ((help) #f)
1082       ((unknown) (display (string-append "Unknown option: " option "\n") cep))
1083       ((missing) (display (string-append "Missing argument: " option "\n") cep))
1084       (else (display "Unknown error!\n" cep)))
1085     (display "Usage: cgen arguments ...\n" cep)
1086     (for-each (lambda (arg)
1087                 (display (string-append
1088                           (let ((arg-str (string-append (car arg) " "
1089                                                         (or (cadr arg) ""))))
1090                             (if (< (string-length arg-str) 16)
1091                                 (string-take 16 arg-str)
1092                                 arg-str))
1093                           "  - " (caddr arg)
1094                           (apply string-append
1095                                  (map (lambda (text)
1096                                         (string-append "\n"
1097                                                        (string-take 20 "")
1098                                                        text))
1099                                       (cdddr arg)))
1100                           "\n")
1101                          cep))
1102               arguments)
1103     (display "...\n" cep)
1104     (case errtype
1105       ((help) (quit 0))
1106       ((unknown missing) (quit 1))
1107       (else (quit 2))))
1108 )
1109
1110 ; Poor man's getopt.
1111 ; [We don't know where to find the real one until we've parsed the args,
1112 ; and this isn't something we need to get too fancy about anyways.]
1113 ; The result is always ((a . b) . c).
1114 ; If the argument is valid, the result is ((opt-spec . arg) . remaining-argv),
1115 ; or (('unknown . option) . remaining-argv) if `option' isn't recognized,
1116 ; or (('missing . option) . remaining argv) if `option' is missing a required
1117 ; argument,
1118 ; or ((#f . #f) . #f) if there are no more arguments.
1119 ; OPT-SPEC is a list of option specs.
1120 ; Each element is an alist of at least 3 elements: option argument help-text.
1121 ; `option' is a string or symbol naming the option.  e.g. -a, --help, "-i".
1122 ; symbols are supported for backward compatibility, -i is a complex number.
1123 ; `argument' is a string naming the argument or #f if the option takes no
1124 ; arguments.
1125 ; `help-text' is a string that is printed with the usage information.
1126 ; Elements beyond `help-text' are ignored.
1127
1128 (define (/getopt argv opt-spec)
1129   (if (null? argv)
1130       (cons (cons #f #f) #f)
1131       (let ((opt (assoc (car argv) opt-spec)))
1132         (cond ((not opt) (cons (cons 'unknown (car argv)) (cdr argv)))
1133               ((and (cadr opt) (null? (cdr argv)))
1134                (cons (cons 'missing (car argv)) (cdr argv)))
1135               ((cadr opt) (cons (cons opt (cadr argv)) (cddr argv)))
1136               (else ; must be option that doesn't take an argument
1137                (cons (cons opt #f) (cdr argv))))))
1138 )
1139
1140 ; Return (cadr args) or print a pretty error message if not possible.
1141
1142 (define (option-arg args)
1143   (if (and (pair? args) (pair? (cdr args)))
1144       (cadr args)
1145       (parse-error (make-prefix-context "option processing")
1146                    "missing argument to"
1147                    (car args)))
1148 )
1149
1150 ; List of common arguments.
1151 ;
1152 ; ??? Another useful arg would be one that says "do file generation with
1153 ; arguments specified up til now, then continue with next batch of args".
1154
1155 (define common-arguments
1156   '(("-a" "arch-file" "specify path of .cpu file to load")
1157     ("-b" #f          "use debugging evaluator, for backtraces")
1158     ("-d" #f          "start interactive debugging session")
1159     ("-f" "flags"     "specify a set of flags to control code generation")
1160     ("-h" #f          "print usage information")
1161     ("--help" #f      "print usage information")
1162     ("-i" "isa-list"  "specify isa-list entries to keep")
1163     ("-m" "mach-list" "specify mach-list entries to keep")
1164     ("-s" "srcdir"    "set srcdir")
1165     ("-t" "trace-options" "specify list of things to trace"
1166                        "Options:"
1167                        "commands - trace cgen commands (e.g. define-insn)"
1168                        "pmacros  - trace pmacro expansion"
1169                        "all      - trace everything")
1170     ("-v" #f          "increment verbosity level")
1171     ("-w" "diagnostic-options" "specify list of things to issue diagnostics about"
1172                        "Options:"
1173                        "iformat - verify instruction formats are valid"
1174                        "all     - turn on all diagnostics")
1175
1176     ("--version" #f   "print version info")
1177     )
1178 )
1179
1180 ; Default place to look.
1181 ; This gets overridden to point to the directory of the loaded .cpu file.
1182 ; ??? Ideally this would be local to this file.
1183
1184 (define arch-path (string-append srcdir "/cpu"))
1185
1186 ; Accessors for application option specs
1187
1188 (define (opt-get-first-pass opt)
1189   (or (list-ref opt 3) (lambda args #f)))
1190 (define (opt-get-second-pass opt)
1191   (or (list-ref opt 4) (lambda args #f)))
1192
1193 ; Parse options and call generators.
1194 ; ARGS is a #:keyword delimited list of arguments.
1195 ; #:app-name name
1196 ; #:arg-spec optspec ; FIXME: rename to #:opt-spec
1197 ; #:init init-routine
1198 ; #:finish finish-routine
1199 ; #:analyze analysis-routine
1200 ; #:argv command-line-arguments
1201 ;
1202 ; ARGSPEC is a list of (option option-arg comment option-handler) elements.
1203 ; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and
1204 ; processes the option.
1205
1206 (define /cgen
1207   (lambda args
1208     (let ((app-name "unknown")
1209           (opt-spec nil)
1210           (app-init! (lambda () #f))
1211           (app-finish! (lambda () #f))
1212           (app-analyze! (lambda () #f))
1213           (argv (list "cgen"))
1214           )
1215       (let loop ((args args))
1216         (if (not (null? args))
1217             (case (car args)
1218               ((#:app-name) (begin
1219                               (set! app-name (option-arg args))
1220                               (loop (cddr args))))
1221               ((#:arg-spec) (begin
1222                               (set! opt-spec (option-arg args))
1223                               (loop (cddr args))))
1224               ((#:init) (begin
1225                           (set! app-init! (option-arg args))
1226                           (loop (cddr args))))
1227               ((#:finish) (begin
1228                             (set! app-finish! (option-arg args))
1229                             (loop (cddr args))))
1230               ((#:analyze) (begin
1231                              (set! app-analyze! (option-arg args))
1232                              (loop (cddr args))))
1233               ((#:argv) (begin
1234                           (set! argv (option-arg args))
1235                           (loop (cddr args))))
1236               (else (error "cgen: unknown argument" (car args))))))
1237
1238       ; ARGS has been processed, now we can process ARGV.
1239
1240       (let (
1241             (opt-spec (append common-arguments opt-spec))
1242             (app-args nil)    ; application's args are queued here
1243             (repl? #f)
1244             (arch-file #f)
1245             (keep-mach "all") ; default is all machs
1246             (keep-isa "all")  ; default is all isas
1247             (flags "")
1248             (moreopts? #t)
1249             (debugging #f)    ; default is off, for speed
1250             (trace-options "")
1251             (diagnostic-options "")
1252             (cep (current-error-port))
1253             (str=? string=?)
1254             )
1255
1256         (let loop ((argv (cdr argv)))
1257           (let* ((new-argv (/getopt argv opt-spec))
1258                  (opt (caar new-argv))
1259                  (arg (cdar new-argv)))
1260             (case opt
1261               ((#f) (set! moreopts? #f))
1262               ((unknown) (cgen-usage 'unknown arg opt-spec))
1263               ((missing) (cgen-usage 'missing arg opt-spec))
1264               (else
1265                (cond ((str=? "-a" (car opt))
1266                       (set! arch-file arg)
1267                       )
1268                      ((str=? "-b" (car opt))
1269                       (set! debugging #t)
1270                       )
1271                      ((str=? "-d" (car opt))
1272                       (let ((prompt (string-append "cgen-" app-name "> ")))
1273                         (set! repl? #t)
1274                         (set-repl-prompt! prompt)
1275                         (if (feature? 'readline)
1276                             (set-readline-prompt! prompt))
1277                         ))
1278                      ((str=? "-f" (car opt))
1279                       (set! flags arg)
1280                       )
1281                      ((str=? "-h" (car opt))
1282                       (cgen-usage 'help "" opt-spec)
1283                       )
1284                      ((str=? "--help" (car opt))
1285                       (cgen-usage 'help "" opt-spec)
1286                       )
1287                      ((str=? "-i" (car opt))
1288                       (set! keep-isa arg)
1289                       )
1290                      ((str=? "-m" (car opt))
1291                       (set! keep-mach arg)
1292                       )
1293                      ((str=? "-s" (car opt))
1294                       #f ; ignore, already processed by caller
1295                       )
1296                      ((str=? "-t" (car opt))
1297                       (set! trace-options arg)
1298                       )
1299                      ((str=? "-v" (car opt))
1300                       (verbose-inc!)
1301                       )
1302                      ((str=? "-w" (car opt))
1303                       (set! diagnostic-options arg)
1304                       )
1305                      ((str=? "--version" (car opt))
1306                       (begin
1307                         (display "Cpu tools GENerator version ")
1308                         (display (cgen-major))
1309                         (display ".")
1310                         (display (cgen-minor))
1311                         (display ".")
1312                         (display (cgen-fixlevel))
1313                         (newline)
1314                         (display "RTL version ")
1315                         (display (cgen-rtl-major))
1316                         (display ".")
1317                         (display (cgen-rtl-minor))
1318                         (newline)
1319                         (quit 0)
1320                         ))
1321                      ; Else this is an application specific option.
1322                      (else
1323                       ; Record it for later processing.  Note that they're
1324                       ; recorded in reverse order (easier).  This is undone
1325                       ; later.
1326                       (set! app-args (acons opt arg app-args)))
1327                      )))
1328             (if moreopts? (loop (cdr new-argv)))
1329             )
1330           ) ; end of loop
1331
1332         ; All arguments have been parsed.
1333
1334         (cgen-call-with-debugging
1335          debugging
1336          (lambda ()
1337
1338            (if (not arch-file)
1339                (error "-a option missing, no architecture specified"))
1340
1341            (if repl?
1342                (debug-repl nil))
1343
1344            (cpu-load arch-file
1345                      keep-mach keep-isa flags
1346                      trace-options diagnostic-options
1347                      app-init! app-finish! app-analyze!)
1348
1349            ;; Start another repl loop if -d.
1350            ;; Awkward.  Both places are useful, though this is more useful.
1351            (if repl?
1352                (debug-repl nil))
1353
1354            ;; Done with processing the arguments.  Application arguments
1355            ;; are processed in two passes.  This is because the app may
1356            ;; have arguments that specify things that affect file
1357            ;; generation (e.g. to specify another input file) and we
1358            ;; don't want to require an ordering of the options.
1359            (for-each (lambda (opt-arg)
1360                        (let ((opt (car opt-arg))
1361                              (arg (cdr opt-arg)))
1362                          (if (cadr opt)
1363                              ((opt-get-first-pass opt) arg)
1364                              ((opt-get-first-pass opt)))))
1365                      (reverse app-args))
1366
1367            (for-each (lambda (opt-arg)
1368                        (let ((opt (car opt-arg))
1369                              (arg (cdr opt-arg)))
1370                          (if (cadr opt)
1371                              ((opt-get-second-pass opt) arg)
1372                              ((opt-get-second-pass opt)))))
1373                      (reverse app-args))))
1374         )
1375       )
1376     #f) ; end of lambda
1377 )
1378
1379 ; Main entry point called by application file generators.
1380
1381 (define cgen
1382   (lambda args
1383     (cgen-debugging-stack-start /cgen args))
1384 )