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