From 67afab7bc7d548ea576a09179c3902247cc1b8f4 Mon Sep 17 00:00:00 2001 From: Doug Evans Date: Tue, 21 Jul 2009 04:23:59 +0000 Subject: [PATCH] * model.scm (parse-insn-timing): Tweak logging message. * operand.scm: Comment and whitespace tweaks. (op:type): Tweak error message. (op-ifield): Tweak logging message. (-derived-operand-parse, anyof-merge-semantics): Ditto. * read.scm: Whitespace cleanup. * utils.scm: Whitespace cleanup. --- ChangeLog | 10 ++++++++++ model.scm | 2 +- operand.scm | 29 ++++++++++++++--------------- read.scm | 4 ++++ utils.scm | 6 +++++- 5 files changed, 34 insertions(+), 17 deletions(-) diff --git a/ChangeLog b/ChangeLog index 08b47d5..4a9f814 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,13 @@ +2009-07-20 Doug Evans + + * model.scm (parse-insn-timing): Tweak logging message. + * operand.scm: Comment and whitespace tweaks. + (op:type): Tweak error message. + (op-ifield): Tweak logging message. + (-derived-operand-parse, anyof-merge-semantics): Ditto. + * read.scm: Whitespace cleanup. + * utils.scm: Whitespace cleanup. + 2009-07-19 Doug Evans Fix binding of nested pmacro parameters. diff --git a/model.scm b/model.scm index c7bba2d..c1712cb 100644 --- a/model.scm +++ b/model.scm @@ -272,7 +272,7 @@ ; are returned as (model1), i.e. an empty unit list. (define (parse-insn-timing context insn-timing-desc) - (logit 3 "parse-insn-timing: context==" context ", desc==" insn-timing-desc "\n") + (logit 3 " parse-insn-timing: context= " context ", desc= " insn-timing-desc "\n") (map (lambda (model-timing-desc) (let* ((model-name (car model-timing-desc)) (model (current-model-lookup model-name))) diff --git a/operand.scm b/operand.scm index 5478505..e14686c 100644 --- a/operand.scm +++ b/operand.scm @@ -91,7 +91,8 @@ ; the instruction. (cond? . #f) - ; whether (and by how much) this instance of the operand is delayed. + ; whether (and by how much) this instance of the operand is + ; delayed. (delayed . #f) ) nil) @@ -153,7 +154,7 @@ (let* ((hw-name (op:hw-name op)) (hw-objs (current-hw-sem-lookup hw-name))) (if (!= (length hw-objs) 1) - (error "can't resolve h/w reference" hw-name)) + (error "cannot resolve h/w reference" hw-name)) ((elm-make-setter 'type) op (car hw-objs)) (car hw-objs)))))) ) @@ -182,11 +183,12 @@ ; Result is the object or #f if there is none. (define (op-ifield op) - (logit 4 "op-ifield op=" (obj:name op) " indx=" (obj:name (op:index op)) "\n") + (logit 4 " op-ifield op= " (obj:name op) + ", indx= " (obj:name (op:index op)) "\n") (let ((indx (op:index op))) (if indx (let ((maybe-ifld (hw-index:value (op:index op)))) - (logit 4 " ifld=" (obj:name maybe-ifld) "\n") + (logit 4 " ifld=" (obj:name maybe-ifld) "\n") (cond ((ifield? maybe-ifld) maybe-ifld) ((derived-ifield? maybe-ifld) maybe-ifld) ((ifield? indx) indx) @@ -418,7 +420,6 @@ (lambda () scalar-index)) ) - ; Placeholder for indices of "anyof" operands. ; There only needs to be one of these, so we create one and always use that. @@ -443,8 +444,6 @@ (elm-xset! derived-index 'value #f) (lambda () derived-index)) ) - - ; Hardware selector support. ; @@ -874,8 +873,9 @@ ;(elm-set! result 'hw-name base-ifield) (elm-set! result 'index parsed-encoding) ; (elm-set! result 'index (hw-index-derived)) ; A temporary dummy - (logit 2 "new derived-operand; name=" name " hw-name= " (op:hw-name result) - " index=" (obj:name parsed-encoding) "\n") + (logit 2 " new derived-operand; name= " name + ", hw-name= " (op:hw-name result) + ", index=" (obj:name parsed-encoding) "\n") (derived-ifield-set-owner! parsed-encoding result) result)) @@ -1113,7 +1113,6 @@ (elm-get anyof-instance 'name) ) - (define (-anyof-merge-syntax syntax value-names values) (let ((syntax-elements (syntax-break-out syntax))) (syntax-make (map (lambda (e) @@ -1239,7 +1238,7 @@ (else e))) semantics))))) - (logit 4 "Merged semantics [" semantics "] -> [" result "]\n") + (logit 4 " merged semantics: [" semantics "] -> [" result "]\n") result) ) @@ -1301,7 +1300,7 @@ (-anyof-merge-setter (op:setter choice) arg-names new-args) container))) - ; + (elm-set! result 'index encoding) ; Creating the link from {encoding} to {result}. (derived-ifield-set-owner! encoding result) @@ -1400,9 +1399,9 @@ ; For each choice, scan the operands for further derived operands. ; If found, replace the choice with the list of its subchoices. - ; If not found, create an object for it. This is basically - ; just a copy of the object, but {anyof-operand} is recorded with it so - ; that we can later resolve `follows' specs. + ; If not found, create an object for it. This is + ; basically just a copy of the object, but {anyof-operand} is recorded + ; with it so that we can later resolve `follows' specs. (let loop ((choices (anyof-choices anyof-operand))) (if (not (null? choices)) diff --git a/read.scm b/read.scm index e3c6422..35c2b15 100644 --- a/read.scm +++ b/read.scm @@ -940,10 +940,12 @@ Define a preprocessor-style macro. ; A handle on /dev/tty, so we can be sure we're talking with the user. ; We open this the first time we actually need it. + (define debug-tty #f) ; Return the port we should use for interacting with the user, ; opening it if necessary. + (define (debug-tty-port) (if (not debug-tty) (set! debug-tty (open-file "/dev/tty" "r+"))) @@ -1015,9 +1017,11 @@ Define a preprocessor-style macro. ; Default place to look. ; This gets overridden to point to the directory of the loaded .cpu file. ; ??? Ideally this would be local to this file. + (define arch-path (string-append srcdir "/cpu")) ; Accessors for application option specs + (define (opt-get-first-pass opt) (or (list-ref opt 3) (lambda args #f))) (define (opt-get-second-pass opt) diff --git a/utils.scm b/utils.scm index a6b379e..2d0900f 100644 --- a/utils.scm +++ b/utils.scm @@ -320,6 +320,7 @@ ;; original value is restored whether THUNK returns normally, throws ;; an exception, or invokes a continuation that leaves the call's ;; dynamic scope. + (define (setter-getter-fluid-let setter getter value thunk) (let ((swap (lambda () (let ((temp (getter))) @@ -334,6 +335,7 @@ ;; This ensures the current ports get restored whether THUNK exits ;; normally, throws an exception, or leaves the call's dynamic scope ;; by applying a continuation. + (define (with-input-and-output-to port thunk) (setter-getter-fluid-let set-current-input-port current-input-port port @@ -567,21 +569,23 @@ ) ;; left fold + (define (foldl kons accum lis) (if (null? lis) accum (foldl kons (kons accum (car lis)) (cdr lis)))) ;; right fold + (define (foldr kons knil lis) (if (null? lis) knil (kons (car lis) (foldr kons knil (cdr lis))))) ;; filter list on predicate + (define (filter p ls) (foldr (lambda (x a) (if (p x) (cons x a) a)) '() ls)) - ; APL's +\ operation on a vector of numbers. (define (plus-scan l) -- 2.43.5