1 ;; Top level file for reading and recording .cpu file contents.
2 ;; Copyright (C) 2000, 2001, 2006, 2009, 2010 Red Hat, Inc.
3 ;; This file is part of CGEN.
4 ;; See file COPYING.CGEN for details.
6 ;; This file [and its subordinates] contain no C code (well, as little as
7 ;; possible). That lives at a layer above us.
9 ;; A .cpu file consists of several sections:
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)
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
23 ;; - memory access, layout, etc.
24 ;; - floating point quirks
25 ;; - ability to describe an ABI
26 ;; - anything else that comes along
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
34 ;; - Try to conform to R5RS, try to limit guile-ness.
35 ;; The current code is undoubtedly off in many places.
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.
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.
63 ;; Variables representing misc. global constants.
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))
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))
81 ;; Utilities for testing the rtl version.
82 (define (rtl-version-equal? major minor)
83 (equal? (cgen-rtl-version) (list major minor))
85 (define (rtl-version-at-least? major minor)
86 (let ((rmajor (cgen-rtl-major))
87 (rminor (cgen-rtl-minor)))
92 (define (rtl-version-older? major minor)
93 (not (rtl-version-at-least? major minor))
96 ;; List of supported versions
97 (define /supported-rtl-versions '((0 7) (0 8) (0 9)))
99 ;; Return a boolean indicating if VERSION is valid.
101 (define (/rtl-version-valid? version) (member version /supported-rtl-versions))
103 (define (/cmd-define-rtl-version major minor)
104 (if (not (non-negative-integer? major))
105 (parse-error #f "Invalid major version number" major))
106 (if (not (non-negative-integer? minor))
107 (parse-error #f "Invalid minor version number" minor))
109 (let ((new-version (list major minor)))
110 (if (not (member new-version /supported-rtl-versions))
111 (parse-error #f "Unsupported/invalid rtl version" new-version))
112 (if (not (equal? new-version /CGEN-RTL-VERSION))
114 (logit 1 "Setting RTL version to " major "." minor " ...\n")
115 ;; Pmacros are rtl-version-dependent. If we've changed the RTL
116 ;; version, re-initialize.
117 (pmacros-init! new-version)
118 (set! /CGEN-RTL-VERSION new-version))))
121 ;; Which application is in use (UNKNOWN, DESC, OPCODES, SIMULATOR, ???).
122 ;; This is mostly for descriptive purposes.
123 (define APPLICATION 'UNKNOWN)
125 ;; Load the base cgen files.
129 (load "slib/logical")
131 ;; Used to pretty-print debugging messages.
133 ;; Used by pretty-print.
135 (load "slib/genwrite")
152 (load "rtl-traverse")
161 ;; Reader state data.
162 ;; All state regarding the reading of a .cpu file is kept in an object of
165 ;; Class to record info for each top-level `command' (for lack of a better
166 ;; word) in the description file.
167 ;; Top level commands are things like define-*.
170 (class-make '<command>
173 ;; argument spec to `lambda'
175 ;; lambda that processes the entry
181 (define command-arg-spec (elm-make-getter <command> 'arg-spec))
182 (define command-handler (elm-make-getter <command> 'handler))
184 ;; Return help text for COMMAND.
186 (define (command-help cmd)
190 (with-output-to-string (lambda () (write (command-arg-spec cmd))))
194 ;; A pair of two lists: machs to keep, machs to drop.
195 ;; The default is "keep all machs", "drop none".
197 (define /keep-all-machs '((all)))
199 ;; Main reader state class.
202 (class-make '<reader>
205 ;; Selected machs to keep.
206 ;; A pair of two lists: the car lists the machs to keep, the cdr
207 ;; lists the machs to drop. Two special entries are `all' and
208 ;; `base'. Both are only valid in the keep list. `base' is a
209 ;; place holder for objects that are common to all machine
210 ;; variants in the architecture, it is the default value of the
211 ;; MACH attribute. If `all' is present the drop list is still
213 (cons 'keep-mach /keep-all-machs)
215 ;; Selected isas to keep or `all'.
218 ;; Boolean indicating if command tracing is on.
219 (cons 'trace-commands? #f)
221 ;; Boolean indicating if pmacro tracing is on.
222 (cons 'trace-pmacros? #f)
224 ;; Issue diagnostics for instruction format issues.
225 (cons 'verify-iformat? #f)
227 ;; Currently select cpu family, computed from `keep-mach'.
228 ;; Some applications don't care, and this is moderately
229 ;; expensive to compute so we use delay/force.
232 ;; Associative list of file entry commands
233 ;; (e.g. define-insn, etc.).
234 ;; Each entry is (name . command-object).
237 ;; The current source location.
238 ;; This is recorded here by the higher level reader and is
239 ;; fetched by commands as necessary.
247 (define-getters <reader> reader
249 trace-commands? trace-pmacros? verify-iformat?
250 current-cpu commands location))
251 (define-setters <reader> reader
253 trace-commands? trace-pmacros? verify-iformat?
254 current-cpu commands location))
256 (define (reader-add-command! name comment attrs arg-spec handler)
257 (reader-set-commands! CURRENT-READER
259 (make <command> name comment attrs
261 (reader-commands CURRENT-READER)))
264 (define (/reader-lookup-command name)
265 (assq-ref (reader-commands CURRENT-READER) name)
268 ;; Reader state for current .cpu file.
270 (define CURRENT-READER #f)
272 ;; Return the current source location in readable form.
273 ;; FIXME: Currently unused, keep for reference for awhile.
275 (define (/readable-current-location)
276 (let ((loc (current-reader-location)))
278 (location->string loc)
279 ;; Blech, we don't have a current reader location. That's odd.
280 ;; Fall back to the current input port's location.
281 (string-append (or (port-filename (current-input-port))
284 (number->string (port-line (current-input-port)))
288 ;; Subroutine of parse-error, parse-warning to simplify them.
289 ;; Flag an error or a warning.
290 ;; EMITTER is a function of one argument, the message to print.
292 (define (/parse-diagnostic emitter context message expr maybe-help-text)
294 (set! context (make <context> (current-reader-location) #f)))
296 (let* ((loc (or (context-location context) (unspecified-location)))
297 (top-sloc (location-top loc))
298 (intro "While reading description")
299 (prefix (or (context-prefix context) "Error"))
300 (text (string-append prefix ": " message)))
305 "\n~A:\n@ ~A:\n\n~A: ~A: ~S~A"
307 (location->string loc)
308 (single-location->simple-string top-sloc)
312 (string-append "\n\n" maybe-help-text)
316 ;; Signal a parse error while reading a .cpu file.
317 ;; Processing stops immediately.
318 ;; If CONTEXT is #f, use a default context of the current reader location
319 ;; and an empty prefix.
320 ;; If MAYBE-HELP-TEXT is specified, elide the last trailing \n.
321 ;; Multiple lines of help text need embedded newlines, and should be no longer
322 ;; than 79 characters.
324 (define (parse-error context errmsg expr . maybe-help-text)
325 (/parse-diagnostic error
329 (if (null? maybe-help-text) "" (car maybe-help-text)))
332 ;; Same as parse-error, but continue processing.
334 (define (parse-error-continuable context errmsg expr . maybe-help-text)
335 (set! /continuable-error-found? #t)
336 (/parse-diagnostic (lambda (text) (message "Error: " text "\n"))
340 (if (null? maybe-help-text) #f (car maybe-help-text)))
343 ;; Signal a parse warning while reading a .cpu file.
344 ;; If CONTEXT is #f, use a default context of the current reader location
345 ;; and an empty prefix.
346 ;; If MAYBE-HELP-TEXT is specified, elide the last trailing \n.
347 ;; Multiple lines of help text need embedded newlines, and should be no longer
348 ;; than 79 characters.
350 (define (parse-warning context errmsg expr . maybe-help-text)
351 (/parse-diagnostic (lambda (text) (message "Warning: " text "\n"))
355 (if (null? maybe-help-text) #f (car maybe-help-text)))
358 ;; Return the current source location.
360 ;; If CURRENT-READER is uninitialized, return "unspecified" location.
361 ;; This is done so that things like define-pmacro work in interactive mode.
363 (define (current-reader-location)
365 (reader-location CURRENT-READER)
366 (unspecified-location))
369 ;; Pmacro-expand EXPR.
371 (define (/reader-expand expr loc)
372 (if (reader-trace-pmacros? CURRENT-READER)
373 (pmacro-trace expr loc)
374 (pmacro-expand expr loc))
377 ;; Process a pmacro-expanded entry.
379 (define (/reader-process-expanded-1! entry)
380 (let ((location (location-property entry)))
382 (if (not (form? entry))
383 (parse-error location "improperly formed entry" entry))
385 ;; Set the current source location for better diagnostics.
386 ;; Access with current-reader-location.
387 (reader-set-location! CURRENT-READER location)
389 (if (reader-trace-commands? CURRENT-READER)
390 (message "Processing command:\n @ "
391 (if location (location->string location) "location unknown")
393 (with-output-to-string (lambda () (pretty-print entry)))))
395 (let ((command (/reader-lookup-command (car entry)))
396 (context (make-current-context #f)))
400 (let* ((handler (command-handler command))
401 (arg-spec (command-arg-spec command))
402 (num-args (num-args arg-spec)))
404 ;; Variable number of trailing arguments.
405 (if (< (length (cdr entry)) (car num-args))
407 (string-append "Incorrect number of arguments to "
408 (symbol->string (car entry))
409 ", expecting at least "
410 (number->string (car num-args)))
412 (command-help command))
413 (apply handler (cdr entry)))
414 ;; Fixed number of arguments.
415 (if (!= (length (cdr entry)) (car num-args))
417 (string-append "Incorrect number of arguments to "
418 (symbol->string (car entry))
420 (number->string (car num-args)))
422 (command-help command))
423 (apply handler (cdr entry)))))
425 (parse-error context "unknown entry type" entry))))
430 ;; Process one or more pmacro-expanded entries.
431 ;; ENTRY is expected to have a location-property object property.
433 (define (reader-process-expanded! entry)
434 ;; () is used to indicate a no-op
437 ;; `begin' is used to group a collection of entries into one,
438 ;; since pmacro can only return one expression (borrowed from
439 ;; Scheme of course).
440 ;; Recurse in case there are nested begins.
441 ((eq? (car entry) 'begin)
442 (for-each reader-process-expanded!
445 (/reader-process-expanded-1! entry)))
450 ;; Process ENTRY, which is not yet pmacro-expanded.
452 (define (reader-process! entry)
453 (/reader-process-with-loc! entry
454 (or (location-property entry)
455 (unspecified-location)))
458 ;; Process file entry ENTRY.
459 ;; LOC is a <location> object for ENTRY.
461 (define (/reader-process-with-loc! entry loc)
462 ;; () is used to indicate a no-op
465 ;; `begin' is used to group a collection of entries into one,
466 ;; since pmacro can only return one expression (borrowed from
467 ;; Scheme of course).
468 ;; Recurse in case there are nested begins.
469 ((eq? (car entry) 'begin)
470 (for-each (lambda (e) (/reader-process-with-loc! e loc))
472 ;; Don't do pmacro-expansion for `define-pmacro'.
473 ;; ??? Singling out define-pmacro this way seems a bit odd. The way to
474 ;; look at it, I guess, is to think of define-pmacro as (currently) the
475 ;; only "syntactic" command (it doesn't pre-evaluate its arguments).
476 ;; Defer pmacro-expansion for `if' too.
477 ((memq (car entry) '(define-pmacro if))
478 (location-property-set! entry loc)
479 (/reader-process-expanded-1! entry))
481 ;; First do pmacro expansion.
482 (let ((expansion (/reader-expand entry loc)))
483 (reader-process-expanded! expansion))))
488 ;; Read in and process FILE.
490 ;; It would be nice to get the line number of the beginning of the object,
491 ;; but that's extra work, so for now we do the simple thing and use
492 ;; port-line after we've read an entry.
494 (define (reader-read-file! file)
495 (let ((readit (lambda ()
496 (let loop ((entry (read)))
497 (if (eof-object? entry)
500 ;; ??? The location we pass here isn't ideal.
501 ;; Ideally we'd pass the start location of the
502 ;; expression, instead we currently pass the end
503 ;; location (it's easier).
504 ;; ??? Use source-properties of entry, and only if
505 ;; not present fall back on current-input-location.
506 (/reader-process-with-loc! entry (current-input-location #t))
510 (with-input-from-file file readit))
515 ;; Cpu data is recorded in an object of class <arch>.
516 ;; This is necessary as we need to allow recording of multiple cpu descriptions
518 ;; Class <arch> is defined in mach.scm.
520 ;; Global containing all data of the currently selected architecture.
522 (define CURRENT-ARCH #f)
524 ;; `keep-mach' processing.
526 ;; Return the currently selected cpu family.
527 ;; If a specific cpu family has been selected, each machine that is kept must
528 ;; be in that cpu family [so there's no ambiguity in the result].
529 ;; This is a moderately expensive computation so use delay/force.
531 (define (current-cpu) (force (reader-current-cpu CURRENT-READER)))
533 ;; Return a boolean indicating if CPU-NAME is to be kept.
534 ;; ??? Currently this is always true. Note that this doesn't necessarily apply
535 ;; to machs in CPU-NAME.
537 (define (keep-cpu? cpu-name) #t)
539 ;; Cover proc to set `keep-mach'.
540 ;; MACH-NAME-LIST is a comma separated string of machines to keep and drop
541 ;; (if prefixed with !).
543 (define (/keep-mach-set! mach-name-list)
544 (let* ((mach-name-list (string-cut mach-name-list #\,))
545 (keep (find (lambda (name) (not (char=? (string-ref name 0) #\!)))
547 (drop (map (lambda (name) (string->symbol (string-drop 1 name)))
548 (find (lambda (name) (char=? (string-ref name 0) #\!))
550 (reader-set-keep-mach! CURRENT-READER
551 (cons (map string->symbol keep)
552 (map string->symbol drop)))
553 ;; Reset current-cpu.
554 (reader-set-current-cpu!
556 (delay (let ((selected-machs (find (lambda (mach)
557 (keep-mach? (list (obj:name mach))))
558 (current-mach-list))))
559 (if (= (length selected-machs) 0)
560 (error "no machs selected"))
561 (if (not (all-true? (map (lambda (mach)
562 (eq? (obj:name (mach-cpu mach))
563 (obj:name (mach-cpu (car selected-machs)))))
565 (error "machs from different cpu families selected"))
566 (mach-cpu (car selected-machs)))))
571 ;; Validate the user-provided keep-mach list against the list of machs
572 ;; specified in the .cpu file (in define-arch).
574 (define (keep-mach-validate!)
575 (let ((mach-names (cons 'all (current-arch-mach-name-list)))
576 (keep-mach (reader-keep-mach CURRENT-READER)))
577 (for-each (lambda (mach)
578 (if (not (memq mach mach-names))
579 (error "unknown mach to keep:" mach)))
581 (for-each (lambda (mach)
582 (if (not (memq mach mach-names))
583 (error "unknown mach to drop:" mach)))
589 ;; Return #t if a machine in MACH-LIST, a list of symbols, is to be kept.
590 ;; If any machine in MACH-LIST is to be kept, the result is #t.
591 ;; If MACH-LIST is the empty list (no particular mach specified, thus the base
592 ;; mach), the result is #t.
594 (define (keep-mach? mach-list)
595 (if (null? mach-list)
597 (let* ((keep-mach (reader-keep-mach CURRENT-READER))
598 (keep (cons 'base (car keep-mach)))
599 (drop (cdr keep-mach))
600 (keep? (map (lambda (m) (memq m keep)) mach-list))
601 (all? (memq 'all keep))
602 (drop? (map (lambda (m) (memq m drop)) mach-list)))
603 (any-true? (map (lambda (k d)
604 ;; keep if K(ept) or ALL? and not D(ropped)
605 (->bool (and (or k all?) (not d))))
609 ;; Return non-#f if the object containing ATLIST is to be kept.
610 ;; OBJ is the container object or #f if there is none.
611 ;; The object is kept if its attribute list specifies a `MACH' that is
612 ;; kept (and not dropped) or does not have the `MACH' attribute (which means
613 ;; it has the default value which means it's for use with all machines).
615 (define (keep-mach-atlist? atlist obj)
616 ;; The MACH attribute is not created until the .cpu file is read in which
617 ;; is too late for us [we will get called for builtin objects].
618 ;; Thus we peek inside the attribute list directly.
619 ;; ??? Maybe postpone creation of builtins until after define-arch?
620 (let ((machs (atlist-attr-value-no-default atlist 'MACH obj)))
626 ;; Return a boolean indicating if the object containing ATLIST is to be kept.
627 ;; OBJ is the container object or #f if there is none.
628 ;; The object is kept if both its isa and its mach are kept.
630 (define (keep-atlist? atlist obj)
631 (and (keep-mach-atlist? atlist obj)
632 (keep-isa-atlist? atlist obj))
635 ;; Return a boolean indicating if multiple cpu families are being kept.
637 (define (keep-multiple?)
638 (let ((selected-machs (find (lambda (mach)
639 (keep-mach? (list (obj:name mach))))
640 (current-mach-list))))
641 (not (all-true? (map (lambda (mach)
642 (eq? (obj:name (mach-cpu mach))
643 (obj:name (mach-cpu (car selected-machs)))))
647 ;; Return a boolean indicating if everything is kept.
650 (equal? (reader-keep-mach CURRENT-READER) /keep-all-machs)
653 ;; Ensure all cpu families were kept, necessary for generating files that
654 ;; encompass the entire architecture.
656 (define (assert-keep-all)
657 (if (not (keep-all?))
658 (error "no can do, all cpu families not selected"))
662 ;; Ensure exactly one cpu family was kept, necessary for generating files that
663 ;; are specific to one cpu family.
665 (define (assert-keep-one)
667 (error "no can do, multiple cpu families selected"))
671 ;; `keep-isa' processing.
673 ;; Cover proc to set `keep-isa'.
674 ;; ISA-NAME-LIST is a comma separated string of isas to keep.
675 ;; ??? We don't support the !drop notation of keep-mach processing.
676 ;; Perhaps we should as otherwise there are two different styles the user
677 ;; has to remember. On the other hand, !drop support is moderately complicated,
678 ;; and it can be added in an upward compatible manner later.
680 (define (/keep-isa-set! isa-name-list)
681 (let ((isa-name-list (map string->symbol (string-cut isa-name-list #\,))))
682 (reader-set-keep-isa! CURRENT-READER isa-name-list)
687 ;; Validate the user-provided keep-isa list against the list of isas
688 ;; specified in the .cpu file (in define-arch).
690 (define (keep-isa-validate!)
691 (let ((isa-names (cons 'all (current-arch-isa-name-list)))
692 (keep-isa (reader-keep-isa CURRENT-READER)))
693 (for-each (lambda (isa)
694 (if (not (memq isa isa-names))
695 (error "unknown isa to keep:" isa)))
701 ;; Return currently selected isa (there must be exactly one).
703 (define (current-isa)
704 (let ((keep-isa (reader-keep-isa CURRENT-READER)))
705 (if (equal? keep-isa '(all))
706 (let ((isas (current-isa-list)))
707 (if (= (length isas) 1)
709 (error "multiple isas selected" keep-isa)))
710 (if (= (length keep-isa) 1)
711 (current-isa-lookup (car keep-isa))
712 (error "multiple isas selected" keep-isa))))
715 ;; Return #t if an isa in ISA-LIST, a list of symbols, is to be kept.
716 ;; If any isa in ISA-LIST is to be kept, the result is #t.
717 ;; If ISA-LIST is the empty list (no particular isa specified) use the default
720 (define (keep-isa? isa-list)
721 ;; If unspecified, the default is the first one in the list.
723 (set! isa-list (list (car (current-arch-isa-name-list)))))
725 (let* ((keep (reader-keep-isa CURRENT-READER))
726 (keep? (map (lambda (i)
733 ;; Return #t if the object containing ATLIST is to be kept.
734 ;; OBJ is the container object or #f if there is none.
735 ;; The object is kept if its attribute list specifies an `ISA' that is
736 ;; kept or does not have the `ISA' attribute (which means it has the default
737 ;; value) and the default isa is being kept.
739 (define (keep-isa-atlist? atlist obj)
740 (let ((isas (atlist-attr-value atlist 'ISA obj)))
744 ;; Return non-#f if object OBJ is to be kept, according to its ISA attribute.
746 (define (keep-isa-obj? obj)
747 (keep-isa-atlist? (obj-atlist obj) obj)
750 ;; Return a boolean indicating if multiple isas are being kept.
752 (define (keep-isa-multiple?)
753 (let ((keep (reader-keep-isa CURRENT-READER)))
754 (or (> (length keep) 1)
755 (and (memq 'all keep)
756 (> (length (current-arch-isa-name-list)) 1))))
759 ;; Return list of isa names currently being kept.
761 (define (current-keep-isa-name-list)
762 (reader-keep-isa CURRENT-READER)
766 ;; This is akin to the "logit" support, but is for specific things that
767 ;; can be named (whereas logit support is based on a simple integer verbosity
770 ;;; Enable the specified tracing.
771 ;;; TRACE-OPTIONS is a comma-separated list of things to trace.
773 ;;; Currently supported tracing:
774 ;;; commands - trace invocation of description file commands (e.g. define-insn)
775 ;;; pmacros - trace pmacro expansion
776 ;;; all - trace everything
778 ;;; [If we later need to support disabling some tracing, one way is to
779 ;;; recognize an "-" in front of an option.]
781 (define (/set-trace-options! trace-options)
782 (let ((all (list "commands" "pmacros"))
783 (requests (string-cut trace-options #\,)))
784 (if (member "all" requests)
785 (append! requests all))
786 (for-each (lambda (item)
787 (cond ((string=? "commands" item)
788 (reader-set-trace-commands?! CURRENT-READER #t))
789 ((string=? "pmacros" item)
790 (reader-set-trace-pmacros?! CURRENT-READER #t))
791 ((string=? "all" item)
794 (cgen-usage 'unknown (string-append "-t " item)
801 ;; Diagnostic support.
803 ;;; Enable the specified diagnostics.
804 ;;; DIAGNOSTIC-OPTIONS is a comma-separated list of things to trace.
806 ;;; Currently supported diagnostics:
807 ;;; iformat - issue diagnostics for iformat issues
808 ;;; all - turn on all diagnostics
810 ;;; [If we later need to support disabling some diagnostic, one way is to
811 ;;; recognize an "-" in front of an option.]
813 (define (/set-diagnostic-options! diagnostic-options)
814 (let ((all (list "iformat"))
815 (requests (string-cut diagnostic-options #\,)))
816 (if (member "all" requests)
817 (append! requests all))
818 (for-each (lambda (item)
819 (cond ((string=? "iformat" item)
820 (reader-set-verify-iformat?! CURRENT-READER #t))
821 ((string=? "all" item)
824 (cgen-usage 'unknown (string-append "-w " item)
831 ;; If #f, treat reserved fields as operands and extract them with the insn.
832 ;; Code can then be emitted in the extraction routines to validate them.
833 ;; If #t, treat reserved fields as part of the opcode.
834 ;; This complicates the decoding process as these fields have to be
836 ;; ??? Unimplemented.
838 (define option:reserved-as-opcode? #f)
840 ;; Process options passed in on the command line.
841 ;; OPTIONS is a space separated string of name=value values.
842 ;; Each application is required to provide: option-init!, option-set!.
844 (define (set-cgen-options! options)
846 (for-each (lambda (opt)
848 #t ;; ignore extraneous spaces
849 (let ((name (string->symbol (car opt)))
851 (logit 1 "Setting option `" name "' to \""
852 (apply string-append value) "\".\n")
853 (option-set! name value))))
854 (map (lambda (opt) (string-cut opt #\=))
855 (string-cut options #\space)))
858 ;; Application specific object creation support.
860 ;; Each entry in the .cpu file has a basic container class.
861 ;; Each application adds functionality by subclassing the container
862 ;; and registering with set-for-new! the proper class to create.
863 ;; ??? Not sure this is the best way to handle this, but it does keep the
864 ;; complexity down while not requiring as dynamic a language as I had before.
865 ;; ??? Class local variables would provide a more efficient way to do this.
866 ;; Assuming one wants to continue on this route.
868 (define /cpu-new-class-list nil)
870 (define (set-for-new! parent child)
871 (set! /cpu-new-class-list (acons parent child /cpu-new-class-list))
874 ;; Lookup the class registered with set-for-new!
875 ;; If none registered, return PARENT.
877 (define (lookup-for-new parent)
878 (let ((child (assq-ref /cpu-new-class-list parent)))
884 ;; .cpu file loader support
886 ;; #t if an error was found (but processing continued)
887 (define /continuable-error-found? #f)
889 ;; Initialize a new <reader> object.
890 ;; This doesn't add cgen-specific commands, leaving each element (ifield,
891 ;; hardware, etc.) to add their own.
892 ;; The "result" is stored in global CURRENT-READER.
894 (define (/init-reader!)
895 (set! CURRENT-READER (new <reader>))
897 (set! /CGEN-RTL-VERSION /default-rtl-version)
899 (set! /continuable-error-found? #f)
901 (reader-add-command! 'define-rtl-version
902 "Specify the RTL version being used.\n"
903 nil '(major minor) /cmd-define-rtl-version)
905 (reader-add-command! 'include
907 nil '(file) /cmd-include)
908 (reader-add-command! 'if
909 "(if test then . else)\n"
910 nil '(test then . else) /cmd-if)
912 ;; Rather than add cgen-internal specific stuff to pmacros.scm, we create
913 ;; the pmacro commands here.
914 (pmacros-init! /default-rtl-version)
915 (reader-add-command! 'define-pmacro
917 Define a preprocessor-style macro.
919 nil '(name arg1 . arg-rest) define-pmacro)
924 ;; Called at the end of .cpu file loading.
926 (define (/finish-reader! file)
927 (if /continuable-error-found?
928 (error (string-append "Error loading " file)))
932 ;; Prepare to parse a .cpu file.
933 ;; This initializes the application independent tables.
934 ;; KEEP-MACH specifies what machs to keep.
935 ;; KEEP-ISA specifies what isas to keep.
936 ;; OPTIONS is a list of options to control code generation.
937 ;; The values are application dependent.
939 (define (/init-parse-cpu! keep-mach keep-isa options)
940 (set! /cpu-new-class-list nil)
942 (set! CURRENT-ARCH (new <arch>))
943 (/keep-mach-set! keep-mach)
944 (/keep-isa-set! keep-isa)
945 (set-cgen-options! options)
947 ;; The order here is important.
948 (arch-init!) ;; Must be done first.
967 ;; Install any builtin objects.
968 ;; This is deferred until define-arch is read.
969 ;; One reason is that attributes MACH and ISA don't exist until then.
971 (define (reader-install-builtin!)
972 ;; The order here is important.
979 ;; This is mainly for the insn attributes.
985 ;; Do anything necessary for the application independent parts after parsing
987 ;; The lists get cons'd in reverse order. One thing this does is change them
988 ;; back to file order, it makes things easier for the human viewer.
990 (define (/finish-parse-cpu!)
991 ;; The order here is generally the reverse of init-parse-cpu!.
1004 (arch-finish!) ;; Must be done last.
1009 ;; Perform a global error checking pass after the .cpu file has been read in.
1011 (define (/global-error-checks)
1014 ;; - all hardware elements with same name must have same rank and
1015 ;; compatible modes (which for now means same float mode or all int modes)
1019 ;; .cpu file include mechanism
1020 ;; If FILE is not an absolute path, prepend ARCH-PATH.
1022 (define (/cmd-include file)
1023 (let ((full-path (if (eq? (string-ref file 0) #\/)
1025 (string-append arch-path "/" file))))
1026 (logit 1 "Including file " full-path " ...\n")
1027 (reader-read-file! full-path)
1028 (logit 2 "Resuming previous file ...\n"))
1032 ;; Version of `if' invokable at the top level of a description file.
1033 ;; This is a work-in-progress. Its presence in the description file is ok,
1034 ;; but the implementation will need to evolve.
1036 (define (/cmd-if test then . else)
1037 (if (> (length else) 1)
1039 "wrong number of arguments to `if'"
1040 (cons 'if (cons test (cons then else)))))
1042 (let ((etest (/reader-expand test (or (location-property test)
1043 (unspecified-location)))))
1045 ;; ??? rtx-eval etest
1046 (if (or (not (pair? etest))
1047 (not (memq (car etest)
1048 '(keep-isa? keep-mach? application-is? rtl-version-equal? rtl-version-at-least?))))
1050 "only (if (keep-mach?|keep-isa?|application-is?|rtl-version-equal?|rtl-version-at-least? ...) ...) are currently supported"
1055 ((keep-isa?) (keep-isa? (cadr etest)))
1056 ((keep-mach?) (keep-mach? (cadr etest)))
1057 ((application-is?) (eq? APPLICATION (cadr etest)))
1058 ((rtl-version-equal?)
1059 (if (/rtl-version-valid? (cdr etest))
1060 (rtl-version-equal? (cadr etest) (caddr etest))
1061 (parse-error #f "invalid rtl version" (cdr etest))))
1062 ((rtl-version-at-least?)
1063 (if (/rtl-version-valid? (cdr etest))
1064 (rtl-version-at-least? (cadr etest) (caddr etest))
1065 (parse-error #f "invalid rtl version" (cdr etest)))))))
1069 (logit 3 "Processing then clause: " then "\n")
1070 (reader-process! then))
1074 (logit 3 "Processing else clause: " (car else) "\n")
1075 (reader-process! (car else)))))))
1078 ;; Top level routine for loading .cpu files.
1079 ;; FILE is the name of the .cpu file to load.
1080 ;; KEEP-MACH is a string of comma separated machines to keep
1081 ;; (or not keep if prefixed with !).
1082 ;; KEEP-ISA is a string of comma separated isas to keep.
1083 ;; OPTIONS is the OPTIONS argument to -init-parse-cpu!.
1084 ;; TRACE-OPTIONS is a random list of things to trace.
1085 ;; DIAGNOSTIC-OPTIONS is a random list of things to warn/error about.
1086 ;; APP-INITER! is an application specific zero argument proc (thunk)
1087 ;; to call after -init-parse-cpu!
1088 ;; APP-FINISHER! is an application specific zero argument proc to call after
1089 ;; -finish-parse-cpu!
1090 ;; ANALYZER! is a zero argument proc to call after loading the .cpu file.
1091 ;; It is expected to set up various tables and things useful for the application
1094 ;; This function isn't local because it's used by dev.scm.
1096 (define (cpu-load file keep-mach keep-isa options
1097 trace-options diagnostic-options
1098 app-initer! app-finisher! analyzer!)
1100 (/init-parse-cpu! keep-mach keep-isa options)
1101 (/set-trace-options! trace-options)
1102 (/set-diagnostic-options! diagnostic-options)
1104 (logit 1 "Loading cpu description " file " ...\n")
1105 (logit 1 "machs: " keep-mach "\n")
1106 (logit 1 "isas: " keep-isa "\n")
1107 (logit 1 "options: " options "\n")
1108 (logit 1 "trace: " trace-options "\n")
1109 (logit 1 "diags: " diagnostic-options "\n")
1110 (set! arch-path (dirname file))
1111 (reader-read-file! file)
1112 (/finish-parse-cpu!)
1113 (/finish-reader! file)
1114 (logit 1 "Processing cpu description " file " ...\n")
1116 (/global-error-checks)
1121 ;; Argument parsing utilities.
1123 ;; Generate a usage message.
1124 ;; ERRTYPE is one of 'help, 'unknown, 'missing.
1125 ;; OPTION is the option that had the error or "" if ERRTYPE is 'help.
1127 (define (cgen-usage errtype option arguments)
1128 (let ((cep (current-error-port)))
1131 ((unknown) (display (string-append "Unknown option: " option "\n") cep))
1132 ((missing) (display (string-append "Missing argument: " option "\n") cep))
1133 (else (display "Unknown error!\n" cep)))
1134 (display "Usage: cgen arguments ...\n" cep)
1135 (for-each (lambda (arg)
1136 (display (string-append
1137 (let ((arg-str (string-append (car arg) " "
1138 (or (cadr arg) ""))))
1139 (if (< (string-length arg-str) 16)
1140 (string-take 16 arg-str)
1143 (apply string-append
1152 (display "...\n" cep)
1155 ((unknown missing) (quit 1))
1159 ;; Poor man's getopt.
1160 ;; [We don't know where to find the real one until we've parsed the args,
1161 ;; and this isn't something we need to get too fancy about anyways.]
1162 ;; The result is always ((a . b) . c).
1163 ;; If the argument is valid, the result is ((opt-spec . arg) . remaining-argv),
1164 ;; or (('unknown . option) . remaining-argv) if `option' isn't recognized,
1165 ;; or (('missing . option) . remaining argv) if `option' is missing a required
1167 ;; or ((#f . #f) . #f) if there are no more arguments.
1168 ;; OPT-SPEC is a list of option specs.
1169 ;; Each element is an alist of at least 3 elements: option argument help-text.
1170 ;; `option' is a string or symbol naming the option. e.g. -a, --help, "-i".
1171 ;; symbols are supported for backward compatibility, -i is a complex number.
1172 ;; `argument' is a string naming the argument or #f if the option takes no
1174 ;; `help-text' is a string that is printed with the usage information.
1175 ;; Elements beyond `help-text' are ignored.
1177 (define (/getopt argv opt-spec)
1179 (cons (cons #f #f) #f)
1180 (let ((opt (assoc (car argv) opt-spec)))
1181 (cond ((not opt) (cons (cons 'unknown (car argv)) (cdr argv)))
1182 ((and (cadr opt) (null? (cdr argv)))
1183 (cons (cons 'missing (car argv)) (cdr argv)))
1184 ((cadr opt) (cons (cons opt (cadr argv)) (cddr argv)))
1185 (else ;; must be option that doesn't take an argument
1186 (cons (cons opt #f) (cdr argv))))))
1189 ;; Return (cadr args) or print a pretty error message if not possible.
1191 (define (option-arg args)
1192 (if (and (pair? args) (pair? (cdr args)))
1194 (parse-error (make-prefix-context "option processing")
1195 "missing argument to"
1199 ;; List of common arguments.
1201 ;; ??? Another useful arg would be one that says "do file generation with
1202 ;; arguments specified up til now, then continue with next batch of args".
1204 (define common-arguments
1205 '(("-a" "arch-file" "specify path of .cpu file to load")
1206 ("-b" #f "use debugging evaluator, for backtraces")
1207 ("-d" #f "start interactive debugging session")
1208 ("-f" "flags" "specify a set of flags to control code generation")
1209 ("-h" #f "print usage information")
1210 ("--help" #f "print usage information")
1211 ("-i" "isa-list" "specify isa-list entries to keep")
1212 ("-m" "mach-list" "specify mach-list entries to keep")
1213 ("-s" "srcdir" "set srcdir")
1214 ("-t" "trace-options" "specify list of things to trace"
1216 "commands - trace cgen commands (e.g. define-insn)"
1217 "pmacros - trace pmacro expansion"
1218 "all - trace everything")
1219 ("-v" #f "increment verbosity level")
1220 ("-w" "diagnostic-options" "specify list of things to issue diagnostics about"
1222 "iformat - verify instruction formats are valid"
1223 "all - turn on all diagnostics")
1225 ("--version" #f "print version info")
1229 ;; Default place to look.
1230 ;; This gets overridden to point to the directory of the loaded .cpu file.
1231 ;; ??? Ideally this would be local to this file.
1233 (define arch-path (string-append srcdir "/cpu"))
1235 ;; Accessors for application option specs
1237 (define (opt-get-first-pass opt)
1238 (or (list-ref opt 3) (lambda args #f)))
1239 (define (opt-get-second-pass opt)
1240 (or (list-ref opt 4) (lambda args #f)))
1242 ;; Parse options and call generators.
1243 ;; ARGS is a #:keyword delimited list of arguments.
1245 ;; #:arg-spec optspec ;; FIXME: rename to #:opt-spec
1246 ;; #:init init-routine
1247 ;; #:finish finish-routine
1248 ;; #:analyze analysis-routine
1249 ;; #:argv command-line-arguments
1251 ;; ARGSPEC is a list of (option option-arg comment option-handler) elements.
1252 ;; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and
1253 ;; processes the option.
1257 (let ((app-name "unknown")
1259 (app-init! (lambda () #f))
1260 (app-finish! (lambda () #f))
1261 (app-analyze! (lambda () #f))
1262 (argv (list "cgen"))
1264 (let loop ((args args))
1265 (if (not (null? args))
1267 ((#:app-name) (begin
1268 (set! app-name (option-arg args))
1269 (loop (cddr args))))
1270 ((#:arg-spec) (begin
1271 (set! opt-spec (option-arg args))
1272 (loop (cddr args))))
1274 (set! app-init! (option-arg args))
1275 (loop (cddr args))))
1277 (set! app-finish! (option-arg args))
1278 (loop (cddr args))))
1280 (set! app-analyze! (option-arg args))
1281 (loop (cddr args))))
1283 (set! argv (option-arg args))
1284 (loop (cddr args))))
1285 (else (error "cgen: unknown argument" (car args))))))
1287 ;; ARGS has been processed, now we can process ARGV.
1290 (opt-spec (append common-arguments opt-spec))
1291 (app-args nil) ;; application's args are queued here
1294 (keep-mach "all") ;; default is all machs
1295 (keep-isa "all") ;; default is all isas
1298 (debugging #f) ;; default is off, for speed
1300 (diagnostic-options "")
1301 (cep (current-error-port))
1305 (let loop ((argv (cdr argv)))
1306 (let* ((new-argv (/getopt argv opt-spec))
1307 (opt (caar new-argv))
1308 (arg (cdar new-argv)))
1310 ((#f) (set! moreopts? #f))
1311 ((unknown) (cgen-usage 'unknown arg opt-spec))
1312 ((missing) (cgen-usage 'missing arg opt-spec))
1314 (cond ((str=? "-a" (car opt))
1315 (set! arch-file arg)
1317 ((str=? "-b" (car opt))
1320 ((str=? "-d" (car opt))
1321 (let ((prompt (string-append "cgen-" app-name "> ")))
1323 (set-repl-prompt! prompt)
1324 (if (feature? 'readline)
1325 (set-readline-prompt! prompt))
1327 ((str=? "-f" (car opt))
1330 ((str=? "-h" (car opt))
1331 (cgen-usage 'help "" opt-spec)
1333 ((str=? "--help" (car opt))
1334 (cgen-usage 'help "" opt-spec)
1336 ((str=? "-i" (car opt))
1339 ((str=? "-m" (car opt))
1340 (set! keep-mach arg)
1342 ((str=? "-s" (car opt))
1343 #f ;; ignore, already processed by caller
1345 ((str=? "-t" (car opt))
1346 (set! trace-options arg)
1348 ((str=? "-v" (car opt))
1351 ((str=? "-w" (car opt))
1352 (set! diagnostic-options arg)
1354 ((str=? "--version" (car opt))
1356 (display "Cpu tools GENerator version ")
1357 (display (cgen-major))
1359 (display (cgen-minor))
1361 (display (cgen-fixlevel))
1363 (display "RTL version ")
1364 (display (cgen-rtl-major))
1366 (display (cgen-rtl-minor))
1370 ;; Else this is an application specific option.
1372 ;; Record it for later processing. Note that they're
1373 ;; recorded in reverse order (easier). This is undone
1375 (set! app-args (acons opt arg app-args)))
1377 (if moreopts? (loop (cdr new-argv)))
1381 ;; All arguments have been parsed.
1383 (cgen-call-with-debugging
1388 (error "-a option missing, no architecture specified"))
1394 keep-mach keep-isa flags
1395 trace-options diagnostic-options
1396 app-init! app-finish! app-analyze!)
1398 ;; Start another repl loop if -d.
1399 ;; Awkward. Both places are useful, though this is more useful.
1403 ;; Done with processing the arguments. Application arguments
1404 ;; are processed in two passes. This is because the app may
1405 ;; have arguments that specify things that affect file
1406 ;; generation (e.g. to specify another input file) and we
1407 ;; don't want to require an ordering of the options.
1408 (for-each (lambda (opt-arg)
1409 (let ((opt (car opt-arg))
1410 (arg (cdr opt-arg)))
1412 ((opt-get-first-pass opt) arg)
1413 ((opt-get-first-pass opt)))))
1416 (for-each (lambda (opt-arg)
1417 (let ((opt (car opt-arg))
1418 (arg (cdr opt-arg)))
1420 ((opt-get-second-pass opt) arg)
1421 ((opt-get-second-pass opt)))))
1422 (reverse app-args))))
1425 #f) ;; end of lambda
1428 ;; Main entry point called by application file generators.
1432 (cgen-debugging-stack-start /cgen args))