[RFC 00/14] Port to Guile 3.0

public inbox for cgen@sourceware.org
 help / color / mirror / Atom feed

* [RFC 00/14] Port to Guile 3.0
@ 2023-08-19 17:41 Tom Tromey
  2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
                   ` (15 more replies)
  0 siblings, 16 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:41 UTC (permalink / raw)
  To: cgen

I tried re-running cgen this week and was surprised to find it didn't
work with any version of Guile that I had available.  Apparently it
works with the long-since-obsolete Guile 1.8, and nothing newer.

This series is my attempt at a port, with random other cleanups mixed
in.

Note that Guile 2.x also doesn't really seem to work -- it was very
slow and never completed.  I got impatient, so I'm not sure if it
would have eventually, or if there is some bug.

I didn't try Guile 1.8 but I would assume it no longer works after
this series.

The Guile compiler cannot be used due to the loading approach taken in
cgen.  This can be fixed but it is a somewhat larger effort, either
involving real modules or the use of the slib require/provide system.

Another possible change would be removing cos.scm in favor of Guile's
built-in object system.  Patch #10 is basically a hack to work around
a problem with the custom object system.  It can probably be fixed in
a better way, but I didn't bother.

I rebuilt all the cgen code in binutils-gdb with this patch after
Alan's recent regeneration, and verified there are no changes.

Tom

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 01/14] Add a .gitignore
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:04   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 02/14] Remove some 'fastcall' code Tom Tromey
                   ` (14 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

Add a .gitignore to make 'git status' easier to read.
---
 .gitignore | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)
 create mode 100644 .gitignore

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..f8a37bb
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,17 @@
+Makefile
+config.log
+config.status
+stamp-cgen
+autom4te.cache
+*.info
+*.tmp
+*.out
+testsuite/*.cpu
+testsuite/test-utils.sh
+*~
+
+# In case someone runs automake -a locally.
+config.guess
+config.sub
+install-sh
+missing
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 01/14] Add a .gitignore
  2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
@ 2023-08-20  8:04   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:04 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


OK.
Thanks.

> Add a .gitignore to make 'git status' easier to read.
> ---
>  .gitignore | 17 +++++++++++++++++
>  1 file changed, 17 insertions(+)
>  create mode 100644 .gitignore
>
> diff --git a/.gitignore b/.gitignore
> new file mode 100644
> index 0000000..f8a37bb
> --- /dev/null
> +++ b/.gitignore
> @@ -0,0 +1,17 @@
> +Makefile
> +config.log
> +config.status
> +stamp-cgen
> +autom4te.cache
> +*.info
> +*.tmp
> +*.out
> +testsuite/*.cpu
> +testsuite/test-utils.sh
> +*~
> +
> +# In case someone runs automake -a locally.
> +config.guess
> +config.sub
> +install-sh
> +missing

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 02/14] Remove some 'fastcall' code
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
  2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:13   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 03/14] Remove bound-symbol? Tom Tromey
                   ` (13 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

There are some comments referring to 'fastcall', which apparently is
some sort of compilation mode for the presumably obsolete Hobbit
scheme compiler.

This patch removes this code and in the process removes some
unnecessary global variables, by turning them into let bindings.
---
 sem-frags.scm | 125 ++++++++++++++++++++++----------------------------
 utils.scm     |  21 ---------
 2 files changed, 54 insertions(+), 92 deletions(-)

diff --git a/sem-frags.scm b/sem-frags.scm
index 0fb26f4..0e471a0 100644
--- a/sem-frags.scm
+++ b/sem-frags.scm
@@ -159,12 +159,6 @@
 
 ; Hash a statement.
 
-; Computed hash value.
-; Global 'cus /frag-hash-compute! is defined globally so we can use
-; /fastcall (FIXME: Need /fastcall to work on non-global procs).
-
-(define /frag-hash-value-tmp 0)
-
 (define (/frag-hash-string str)
   (let loop ((chars (map char->integer (string->list str))) (result 0))
     (if (null? chars)
@@ -172,77 +166,66 @@
 	(loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff))))
 )
 
-;; MODE is the name of the mode.
-
-(define (/frag-hash-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
-  (let ((h 0))
-    (case (rtx-name expr)
-      ((operand)
-       (set! h (/frag-hash-string (symbol->string (rtx-operand-name expr)))))
-      ((local)
-       (set! h (/frag-hash-string (symbol->string (rtx-local-name expr)))))
-      ((const)
-       (set! h (rtx-const-value expr)))
-      (else
-       (set! h (rtx-num rtx-obj))))
-    (set! /frag-hash-value-tmp
-	  ; Keep number small.
-	  (modulo (+ (* /frag-hash-value-tmp 3) h op-pos)
-		  #xfffffff)))
-
-  ; #f -> "continue with normal traversing"
-  #f
-)
-
 (define (/frag-hash-stmt stmt locals size)
-  (set! /frag-hash-value-tmp 0)
-  (rtx-traverse-with-locals #f #f stmt /frag-hash-compute! locals #f)
-  (modulo /frag-hash-value-tmp size)
+  (let ((/frag-hash-value-tmp 0))
+    (rtx-traverse-with-locals
+     #f #f stmt /frag-hash-compute!
+     (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
+       (let ((h 0))
+	 (case (rtx-name expr)
+	   ((operand)
+	    (set! h (/frag-hash-string (symbol->string (rtx-operand-name expr)))))
+	   ((local)
+	    (set! h (/frag-hash-string (symbol->string (rtx-local-name expr)))))
+	   ((const)
+	    (set! h (rtx-const-value expr)))
+	   (else
+	    (set! h (rtx-num rtx-obj))))
+	 (set! /frag-hash-value-tmp
+	       ;; Keep number small.
+	       (modulo (+ (* /frag-hash-value-tmp 3) h op-pos)
+		       #xfffffff)))
+
+       ;; #f -> "continue with normal traversing"
+       #f
+       )
+     locals #f)
+    (modulo /frag-hash-value-tmp size))
 )
 
 ; Compute the speed/size costs of a statement.
 
-; Compute speed/size costs.
-; Global 'cus /frag-cost-compute! is defined globally so we can use
-; /fastcall (FIXME: Need /fastcall to work on non-global procs).
-
-(define /frag-speed-cost-tmp 0)
-(define /frag-size-cost-tmp 0)
-
-;; MODE is the name of the mode.
-
-(define (/frag-cost-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
-  ; FIXME: wip
-  (let ((speed 0)
-	(size 0))
-    (case (rtx-class rtx-obj)
-      ((ARG)
-       #f) ; these don't contribute to costs (at least for now)
-      ((SET)
-       ; FIXME: speed/size = 0?
-       (set! speed 1)
-       (set! size 1))
-      ((UNARY BINARY TRINARY COMPARE)
-       (set! speed 1)
-       (set! size 1))
-      ((IF)
-       (set! speed 2)
-       (set! size 2))
-      (else
-       (set! speed 4)
-       (set! size 4)))
-    (set! /frag-speed-cost-tmp (+ /frag-speed-cost-tmp speed))
-    (set! /frag-size-cost-tmp (+ /frag-size-cost-tmp size)))
-
-  ; #f -> "continue with normal traversing"
-  #f
-)
-
 (define (/frag-stmt-cost stmt locals)
-  (set! /frag-speed-cost-tmp 0)
-  (set! /frag-size-cost-tmp 0)
-  (rtx-traverse-with-locals #f #f stmt /frag-cost-compute! locals #f)
-  (cons /frag-speed-cost-tmp /frag-size-cost-tmp)
+  (let ((/frag-speed-cost-tmp 0)
+	(/frag-size-cost-tmp 0))
+    (rtx-traverse-with-locals
+     #f #f stmt
+     (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
+       ;; FIXME: wip
+       (let ((speed 0)
+	     (size 0))
+	 (case (rtx-class rtx-obj)
+	   ((ARG)
+	    #f) ; these don't contribute to costs (at least for now)
+	   ((SET)
+	    ;; FIXME: speed/size = 0?
+	    (set! speed 1)
+	    (set! size 1))
+	   ((UNARY BINARY TRINARY COMPARE)
+	    (set! speed 1)
+	    (set! size 1))
+	   ((IF)
+	    (set! speed 2)
+	    (set! size 2))
+	   (else
+	    (set! speed 4)
+	    (set! size 4)))
+	 (set! /frag-speed-cost-tmp (+ /frag-speed-cost-tmp speed))
+	 (set! /frag-size-cost-tmp (+ /frag-size-cost-tmp size)))
+       ;; #f -> "continue with normal traversing"
+       #f)
+     locals #f)
+    (cons /frag-speed-cost-tmp /frag-size-cost-tmp))
 )
 
 ; Add STMT to statement table DATA.
diff --git a/utils.scm b/utils.scm
index 8204838..330880b 100644
--- a/utils.scm
+++ b/utils.scm
@@ -13,27 +13,6 @@
 
 (define nil '())
 
-; Hobbit support code; for when not using hobbit.
-; FIXME: eliminate this stuff ASAP.
-
-(defmacro /fastcall-make (proc) proc)
-
-(defmacro fastcall4 (proc arg1 arg2 arg3 arg4)
-  (list proc arg1 arg2 arg3 arg4)
-)
-
-(defmacro fastcall5 (proc arg1 arg2 arg3 arg4 arg5)
-  (list proc arg1 arg2 arg3 arg4 arg5)
-)
-
-(defmacro fastcall6 (proc arg1 arg2 arg3 arg4 arg5 arg6)
-  (list proc arg1 arg2 arg3 arg4 arg5 arg6)
-)
-
-(defmacro fastcall7 (proc arg1 arg2 arg3 arg4 arg5 arg6 arg7)
-  (list proc arg1 arg2 arg3 arg4 arg5 arg6 arg7)
-)
-
 ; Value doesn't matter too much here, just ensure it's portable.
 (define *UNSPECIFIED* (if #f 1))
 
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 02/14] Remove some 'fastcall' code
  2023-08-19 17:42 ` [RFC 02/14] Remove some 'fastcall' code Tom Tromey
@ 2023-08-20  8:13   ` Jose E. Marchesi
  2023-08-22 16:52     ` Tom Tromey
  0 siblings, 1 reply; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:13 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


> There are some comments referring to 'fastcall', which apparently is
> some sort of compilation mode for the presumably obsolete Hobbit
> scheme compiler.

I don't think that the Hobbit support has been tested any time in recent
years.  If Frank agrees, I would say it is ok to remove code handling
Hobbit specific stuff.

> This patch removes this code and in the process removes some
> unnecessary global variables, by turning them into let bindings.

The change LGTM.

The only comment I have is that it seems to me the / prefix for symbol
names seems to be used for globals?  I don't think locally let-defined
symbols are to be using that prefix...

> ---
>  sem-frags.scm | 125 ++++++++++++++++++++++----------------------------
>  utils.scm     |  21 ---------
>  2 files changed, 54 insertions(+), 92 deletions(-)
>
> diff --git a/sem-frags.scm b/sem-frags.scm
> index 0fb26f4..0e471a0 100644
> --- a/sem-frags.scm
> +++ b/sem-frags.scm
> @@ -159,12 +159,6 @@
>  
>  ; Hash a statement.
>  
> -; Computed hash value.
> -; Global 'cus /frag-hash-compute! is defined globally so we can use
> -; /fastcall (FIXME: Need /fastcall to work on non-global procs).
> -
> -(define /frag-hash-value-tmp 0)
> -
>  (define (/frag-hash-string str)
>    (let loop ((chars (map char->integer (string->list str))) (result 0))
>      (if (null? chars)
> @@ -172,77 +166,66 @@
>  	(loop (cdr chars) (modulo (+ (* result 7) (car chars)) #xfffffff))))
>  )
>  
> -;; MODE is the name of the mode.
> -
> -(define (/frag-hash-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
> -  (let ((h 0))
> -    (case (rtx-name expr)
> -      ((operand)
> -       (set! h (/frag-hash-string (symbol->string (rtx-operand-name expr)))))
> -      ((local)
> -       (set! h (/frag-hash-string (symbol->string (rtx-local-name expr)))))
> -      ((const)
> -       (set! h (rtx-const-value expr)))
> -      (else
> -       (set! h (rtx-num rtx-obj))))
> -    (set! /frag-hash-value-tmp
> -	  ; Keep number small.
> -	  (modulo (+ (* /frag-hash-value-tmp 3) h op-pos)
> -		  #xfffffff)))
> -
> -  ; #f -> "continue with normal traversing"
> -  #f
> -)
> -
>  (define (/frag-hash-stmt stmt locals size)
> -  (set! /frag-hash-value-tmp 0)
> -  (rtx-traverse-with-locals #f #f stmt /frag-hash-compute! locals #f)
> -  (modulo /frag-hash-value-tmp size)
> +  (let ((/frag-hash-value-tmp 0))
> +    (rtx-traverse-with-locals
> +     #f #f stmt /frag-hash-compute!
> +     (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
> +       (let ((h 0))
> +	 (case (rtx-name expr)
> +	   ((operand)
> +	    (set! h (/frag-hash-string (symbol->string (rtx-operand-name expr)))))
> +	   ((local)
> +	    (set! h (/frag-hash-string (symbol->string (rtx-local-name expr)))))
> +	   ((const)
> +	    (set! h (rtx-const-value expr)))
> +	   (else
> +	    (set! h (rtx-num rtx-obj))))
> +	 (set! /frag-hash-value-tmp
> +	       ;; Keep number small.
> +	       (modulo (+ (* /frag-hash-value-tmp 3) h op-pos)
> +		       #xfffffff)))
> +
> +       ;; #f -> "continue with normal traversing"
> +       #f
> +       )
> +     locals #f)
> +    (modulo /frag-hash-value-tmp size))
>  )
>  
>  ; Compute the speed/size costs of a statement.
>  
> -; Compute speed/size costs.
> -; Global 'cus /frag-cost-compute! is defined globally so we can use
> -; /fastcall (FIXME: Need /fastcall to work on non-global procs).
> -
> -(define /frag-speed-cost-tmp 0)
> -(define /frag-size-cost-tmp 0)
> -
> -;; MODE is the name of the mode.
> -
> -(define (/frag-cost-compute! rtx-obj expr parent-expr op-pos tstate appstuff)
> -  ; FIXME: wip
> -  (let ((speed 0)
> -	(size 0))
> -    (case (rtx-class rtx-obj)
> -      ((ARG)
> -       #f) ; these don't contribute to costs (at least for now)
> -      ((SET)
> -       ; FIXME: speed/size = 0?
> -       (set! speed 1)
> -       (set! size 1))
> -      ((UNARY BINARY TRINARY COMPARE)
> -       (set! speed 1)
> -       (set! size 1))
> -      ((IF)
> -       (set! speed 2)
> -       (set! size 2))
> -      (else
> -       (set! speed 4)
> -       (set! size 4)))
> -    (set! /frag-speed-cost-tmp (+ /frag-speed-cost-tmp speed))
> -    (set! /frag-size-cost-tmp (+ /frag-size-cost-tmp size)))
> -
> -  ; #f -> "continue with normal traversing"
> -  #f
> -)
> -
>  (define (/frag-stmt-cost stmt locals)
> -  (set! /frag-speed-cost-tmp 0)
> -  (set! /frag-size-cost-tmp 0)
> -  (rtx-traverse-with-locals #f #f stmt /frag-cost-compute! locals #f)
> -  (cons /frag-speed-cost-tmp /frag-size-cost-tmp)
> +  (let ((/frag-speed-cost-tmp 0)
> +	(/frag-size-cost-tmp 0))
> +    (rtx-traverse-with-locals
> +     #f #f stmt
> +     (lambda (rtx-obj expr parent-expr op-pos tstate appstuff)
> +       ;; FIXME: wip
> +       (let ((speed 0)
> +	     (size 0))
> +	 (case (rtx-class rtx-obj)
> +	   ((ARG)
> +	    #f) ; these don't contribute to costs (at least for now)
> +	   ((SET)
> +	    ;; FIXME: speed/size = 0?
> +	    (set! speed 1)
> +	    (set! size 1))
> +	   ((UNARY BINARY TRINARY COMPARE)
> +	    (set! speed 1)
> +	    (set! size 1))
> +	   ((IF)
> +	    (set! speed 2)
> +	    (set! size 2))
> +	   (else
> +	    (set! speed 4)
> +	    (set! size 4)))
> +	 (set! /frag-speed-cost-tmp (+ /frag-speed-cost-tmp speed))
> +	 (set! /frag-size-cost-tmp (+ /frag-size-cost-tmp size)))
> +       ;; #f -> "continue with normal traversing"
> +       #f)
> +     locals #f)
> +    (cons /frag-speed-cost-tmp /frag-size-cost-tmp))
>  )
>  
>  ; Add STMT to statement table DATA.
> diff --git a/utils.scm b/utils.scm
> index 8204838..330880b 100644
> --- a/utils.scm
> +++ b/utils.scm
> @@ -13,27 +13,6 @@
>  
>  (define nil '())
>  
> -; Hobbit support code; for when not using hobbit.
> -; FIXME: eliminate this stuff ASAP.
> -
> -(defmacro /fastcall-make (proc) proc)
> -
> -(defmacro fastcall4 (proc arg1 arg2 arg3 arg4)
> -  (list proc arg1 arg2 arg3 arg4)
> -)
> -
> -(defmacro fastcall5 (proc arg1 arg2 arg3 arg4 arg5)
> -  (list proc arg1 arg2 arg3 arg4 arg5)
> -)
> -
> -(defmacro fastcall6 (proc arg1 arg2 arg3 arg4 arg5 arg6)
> -  (list proc arg1 arg2 arg3 arg4 arg5 arg6)
> -)
> -
> -(defmacro fastcall7 (proc arg1 arg2 arg3 arg4 arg5 arg6 arg7)
> -  (list proc arg1 arg2 arg3 arg4 arg5 arg6 arg7)
> -)
> -
>  ; Value doesn't matter too much here, just ensure it's portable.
>  (define *UNSPECIFIED* (if #f 1))

^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 02/14] Remove some 'fastcall' code
  2023-08-20  8:13   ` Jose E. Marchesi
@ 2023-08-22 16:52     ` Tom Tromey
  0 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-22 16:52 UTC (permalink / raw)
  To: Jose E. Marchesi; +Cc: Tom Tromey, cgen

>> This patch removes this code and in the process removes some
>> unnecessary global variables, by turning them into let bindings.

Jose> The change LGTM.

Jose> The only comment I have is that it seems to me the / prefix for symbol
Jose> names seems to be used for globals?  I don't think locally let-defined
Jose> symbols are to be using that prefix...

I removed the leading "/"

Tom

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 03/14] Remove bound-symbol?
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
  2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
  2023-08-19 17:42 ` [RFC 02/14] Remove some 'fastcall' code Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:14   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 04/14] Remove =? and >=? aliases Tom Tromey
                   ` (12 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

bound-symbol? is not used, remove it.
---
 utils.scm | 13 -------------
 1 file changed, 13 deletions(-)

diff --git a/utils.scm b/utils.scm
index 330880b..616065b 100644
--- a/utils.scm
+++ b/utils.scm
@@ -465,19 +465,6 @@
 		(backslash chars (cdr str)))))
 )
 
-; Return a boolean indicating if S is bound to a value.
-;(define old-symbol-bound? symbol-bound?)
-;(define (symbol-bound? s) (old-symbol-bound? #f s))
-
-; Return a boolean indicating if S is a symbol and is bound to a value.
-
-(define (bound-symbol? s)
-  (and (symbol? s)
-       (or (symbol-bound? #f s)
-	   ;(module-bound? cgen-module s)
-	   ))
-)
-
 ; Return X.
 
 (define (identity x) x)
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 03/14] Remove bound-symbol?
  2023-08-19 17:42 ` [RFC 03/14] Remove bound-symbol? Tom Tromey
@ 2023-08-20  8:14   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:14 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


OK.  Thanks.

> bound-symbol? is not used, remove it.
> ---
>  utils.scm | 13 -------------
>  1 file changed, 13 deletions(-)
>
> diff --git a/utils.scm b/utils.scm
> index 330880b..616065b 100644
> --- a/utils.scm
> +++ b/utils.scm
> @@ -465,19 +465,6 @@
>  		(backslash chars (cdr str)))))
>  )
>  
> -; Return a boolean indicating if S is bound to a value.
> -;(define old-symbol-bound? symbol-bound?)
> -;(define (symbol-bound? s) (old-symbol-bound? #f s))
> -
> -; Return a boolean indicating if S is a symbol and is bound to a value.
> -
> -(define (bound-symbol? s)
> -  (and (symbol? s)
> -       (or (symbol-bound? #f s)
> -	   ;(module-bound? cgen-module s)
> -	   ))
> -)
> -
>  ; Return X.
>  
>  (define (identity x) x)

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 04/14] Remove =? and >=? aliases
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (2 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 03/14] Remove bound-symbol? Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:15   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 05/14] Fix bug in insn.scm Tom Tromey
                   ` (11 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

=? and >=? are aliases for = and >=.  Remove these and update the few
users.
---
 enum.scm     | 2 +-
 guile.scm    | 4 ----
 opcodes.scm  | 4 ++--
 sim-test.scm | 4 ++--
 4 files changed, 5 insertions(+), 9 deletions(-)

diff --git a/enum.scm b/enum.scm
index 1faeb5f..5390e08 100644
--- a/enum.scm
+++ b/enum.scm
@@ -278,7 +278,7 @@
 				  "sanitize-"
 				  san-code " */")
 		   "")
-	       (if (or san? (=? (remainder n 4) 0))
+	       (if (or san? (= (remainder n 4) 0))
 		   "\n "
 		   "")
 	       (if (= n 0)
diff --git a/guile.scm b/guile.scm
index d2b8d8d..85c37d4 100644
--- a/guile.scm
+++ b/guile.scm
@@ -37,10 +37,6 @@
       )
 )
 
-; FIXME: to be deleted
-(define =? =)
-(define >=? >=)
-
 (if (not (symbol-bound? #f '%stat))
     (begin
       (define %stat stat)
diff --git a/opcodes.scm b/opcodes.scm
index 66ce9dd..1644fcd 100644
--- a/opcodes.scm
+++ b/opcodes.scm
@@ -771,12 +771,12 @@
 			   (begin
 			     (close-port port)
 			     ; End of file, did we find the text?
-			     (if (=? start -1)
+			     (if (= start -1)
 				 ""
 				 (substring result start index))))
 			  ((char=? char #\newline)
 			   ; Check for start delim or end delim?
-			   (if (=? start -1)
+			   (if (= start -1)
 			       (if (string=? (substring result line
 							(+ (string-length start-delim)
 							   line))
diff --git a/sim-test.scm b/sim-test.scm
index 8176070..3029105 100644
--- a/sim-test.scm
+++ b/sim-test.scm
@@ -106,8 +106,8 @@
   (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
 	(len (length op-list)))
     ; FIXME: Make slicker later.
-    (cond ((=? len 0) (list (list)))
-	  ((=? len 1) test-data)
+    (cond ((= len 0) (list (list)))
+	  ((= len 1) test-data)
 	  (else (list (map car test-data)))))
 )
 
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 04/14] Remove =? and >=? aliases
  2023-08-19 17:42 ` [RFC 04/14] Remove =? and >=? aliases Tom Tromey
@ 2023-08-20  8:15   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:15 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


OK.  Thanks.

> =? and >=? are aliases for = and >=.  Remove these and update the few
> users.
> ---
>  enum.scm     | 2 +-
>  guile.scm    | 4 ----
>  opcodes.scm  | 4 ++--
>  sim-test.scm | 4 ++--
>  4 files changed, 5 insertions(+), 9 deletions(-)
>
> diff --git a/enum.scm b/enum.scm
> index 1faeb5f..5390e08 100644
> --- a/enum.scm
> +++ b/enum.scm
> @@ -278,7 +278,7 @@
>  				  "sanitize-"
>  				  san-code " */")
>  		   "")
> -	       (if (or san? (=? (remainder n 4) 0))
> +	       (if (or san? (= (remainder n 4) 0))
>  		   "\n "
>  		   "")
>  	       (if (= n 0)
> diff --git a/guile.scm b/guile.scm
> index d2b8d8d..85c37d4 100644
> --- a/guile.scm
> +++ b/guile.scm
> @@ -37,10 +37,6 @@
>        )
>  )
>  
> -; FIXME: to be deleted
> -(define =? =)
> -(define >=? >=)
> -
>  (if (not (symbol-bound? #f '%stat))
>      (begin
>        (define %stat stat)
> diff --git a/opcodes.scm b/opcodes.scm
> index 66ce9dd..1644fcd 100644
> --- a/opcodes.scm
> +++ b/opcodes.scm
> @@ -771,12 +771,12 @@
>  			   (begin
>  			     (close-port port)
>  			     ; End of file, did we find the text?
> -			     (if (=? start -1)
> +			     (if (= start -1)
>  				 ""
>  				 (substring result start index))))
>  			  ((char=? char #\newline)
>  			   ; Check for start delim or end delim?
> -			   (if (=? start -1)
> +			   (if (= start -1)
>  			       (if (string=? (substring result line
>  							(+ (string-length start-delim)
>  							   line))
> diff --git a/sim-test.scm b/sim-test.scm
> index 8176070..3029105 100644
> --- a/sim-test.scm
> +++ b/sim-test.scm
> @@ -106,8 +106,8 @@
>    (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
>  	(len (length op-list)))
>      ; FIXME: Make slicker later.
> -    (cond ((=? len 0) (list (list)))
> -	  ((=? len 1) test-data)
> +    (cond ((= len 0) (list (list)))
> +	  ((= len 1) test-data)
>  	  (else (list (map car test-data)))))
>  )

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 05/14] Fix bug in insn.scm
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (3 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 04/14] Remove =? and >=? aliases Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:15   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 06/14] Remove support for old versions of Guile Tom Tromey
                   ` (10 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

insn.scm has a bit of invalid code.  I forget, but perhaps this was
pointed out by the Guile compiler.  Fix it.
---
 insn.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/insn.scm b/insn.scm
index 7a230df..b5eb2ba 100644
--- a/insn.scm
+++ b/insn.scm
@@ -320,8 +320,7 @@
 				  (- (arch-next-ordinal CURRENT-ARCH) 2))
 	  )
 
-	(begin
-	  logit 3 "    failed ifield assertions.\n")))
+	(logit 3 "    failed ifield assertions.\n")))
 
   *UNSPECIFIED*
 )
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 05/14] Fix bug in insn.scm
  2023-08-19 17:42 ` [RFC 05/14] Fix bug in insn.scm Tom Tromey
@ 2023-08-20  8:15   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:15 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


OK.  Thanks.

> insn.scm has a bit of invalid code.  I forget, but perhaps this was
> pointed out by the Guile compiler.  Fix it.
> ---
>  insn.scm | 3 +--
>  1 file changed, 1 insertion(+), 2 deletions(-)
>
> diff --git a/insn.scm b/insn.scm
> index 7a230df..b5eb2ba 100644
> --- a/insn.scm
> +++ b/insn.scm
> @@ -320,8 +320,7 @@
>  				  (- (arch-next-ordinal CURRENT-ARCH) 2))
>  	  )
>  
> -	(begin
> -	  logit 3 "    failed ifield assertions.\n")))
> +	(logit 3 "    failed ifield assertions.\n")))
>  
>    *UNSPECIFIED*
>  )

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 06/14] Remove support for old versions of Guile
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (4 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 05/14] Fix bug in insn.scm Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 07/14] Use define-macro in rtl.scm Tom Tromey
                   ` (9 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

This removes support for older versions of Guile.
---
 README    |  2 +-
 cos.scm   |  9 +------
 guile.scm | 71 +++++--------------------------------------------------
 3 files changed, 8 insertions(+), 74 deletions(-)

diff --git a/README b/README
index cc286d4..e9f9c7f 100644
--- a/README
+++ b/README
@@ -43,7 +43,7 @@ Binutils/GDB developers wishing to use CGEN must configure Binutils/GDB with
 opcodes/Makefile and sim/<arch>/Makefile for the supported processors.
 
 CGEN uses Guile so Guile must be installed.
-CGEN has been tested with Guile 1.4.1, 1.6.8, and 1.8.5.
+CGEN has been tested with Guile 3.0.7.
 Support for older versions of Guile will be removed in time.
 
 Source Layout
diff --git a/cos.scm b/cos.scm
index 0210b20..1ba4c54 100644
--- a/cos.scm
+++ b/cos.scm
@@ -1263,11 +1263,4 @@
 \f
 ;; Misc. internal utilities.
 
-;; We need a fast vector copy operation.
-;; If `vector-copy' doesn't exist (which is assumed to be the fast one),
-;; provide a simple version.
-
-(if (defined? 'vector-copy)
-    (define /object-vector-copy vector-copy)
-    (define (/object-vector-copy v) (list->vector (vector->list v)))
-)
+(define /object-vector-copy vector-copy)
diff --git a/guile.scm b/guile.scm
index 85c37d4..9d7c64c 100644
--- a/guile.scm
+++ b/guile.scm
@@ -3,56 +3,14 @@
 ; This file is part of CGEN.
 ; See file COPYING.CGEN for details.
 
-(define *guile-major-version* (string->number (major-version)))
-(define *guile-minor-version* (string->number (minor-version)))
+(define (eval1 expr)
+  (eval expr (current-module)))
 
-; eval takes a module argument in 1.6 and later
+(define load primitive-load-path)
 
-(if (or (> *guile-major-version* 1)
-	(>= *guile-minor-version* 6))
-    (define (eval1 expr)
-      (eval expr (current-module)))
-    (define (eval1 expr)
-      (eval expr))
-)
+(define %stat stat)
 
-; symbol-bound? is deprecated in 1.6
-
-(if (or (> *guile-major-version* 1)
-	(>= *guile-minor-version* 6))
-    (define (symbol-bound? table s)
-      (if table
-	  (error "must pass #f for symbol-bound? first arg"))
-      ; FIXME: Not sure this is 100% correct.
-      (module-defined? (current-module) s))
-)
-
-(if (symbol-bound? #f 'load-from-path)
-    (begin
-      (define (load file)
-	(begin
-	  ;(load-from-path file)
-	  (primitive-load-path file)
-	  ))
-      )
-)
-
-(if (not (symbol-bound? #f '%stat))
-    (begin
-      (define %stat stat)
-      )
-)
-
-(if (symbol-bound? #f 'debug-enable)
-    (debug-enable 'backtrace)
-)
-
-; Guile 1.3 has reverse!, Guile 1.2 has list-reverse!.
-; CGEN uses reverse!
-(if (and (not (symbol-bound? #f 'reverse!))
-	 (symbol-bound? #f 'list-reverse!))
-    (define reverse! list-reverse!)
-)
+(debug-enable 'backtrace)
 
 (define (debug-write . objs)
   (map (lambda (o)
@@ -60,28 +18,11 @@
        objs)
   (newline (current-error-port)))
 
-;; Guile 1.8 no longer has "." in %load-path so relative path loads
-;; no longer work.
-
-(if (or (> *guile-major-version* 1)
-	(>= *guile-minor-version* 8))
-    (set! %load-path (append %load-path (list ".")))
-)
+(add-to-load-path ".")
 
 \f
 ;;; Enabling and disabling debugging features of the host Scheme.
 
-;;; For the initial load proces, turn everything on.  We'll disable it
-;;; before we start doing the heavy computation.
-(if (memq 'debug-extensions *features*)
-    (begin
-      (debug-enable 'backtrace)
-      (debug-enable 'debug)
-      (debug-enable 'backwards)
-      (debug-set! depth 2000)
-      (debug-set! maxdepth 2000)
-      (debug-set! stack 100000)
-      (debug-set! frames 10)))
 (read-enable 'positions)
 
 ;;; Call THUNK, with debugging enabled if FLAG is true, or disabled if
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 07/14] Use define-macro in rtl.scm
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (5 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 06/14] Remove support for old versions of Guile Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 08/14] Remove let bindings of macros Tom Tromey
                   ` (8 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

rtl.scm uses defmacro:syntax-transformer, but that no longer exists in
more recent versions of Guile.

Replace these uses with define-macro -- which IMO is clearer anyway.

Note that defmacro could not be used here, as Guile's implementation
has a bug that prevents it from being used with non-canonical lists.
---
 rtl.scm | 37 +++++++++++++------------------------
 1 file changed, 13 insertions(+), 24 deletions(-)

diff --git a/rtl.scm b/rtl.scm
index c74fea1..beda406 100644
--- a/rtl.scm
+++ b/rtl.scm
@@ -283,12 +283,9 @@
       *UNSPECIFIED*))
 )
 
-(define define-rtx-node
-  ; Written this way so Hobbit can handle it.
-  (defmacro:syntax-transformer (lambda arg-list
-				 (apply def-rtx-node arg-list)
-				 nil))
-)
+(define-macro (define-rtx-node . args)
+  (cons 'def-rtx-node
+	(map (lambda (arg) `',arg) args)))
 
 ; Same as define-rtx-node but don't pre-evaluate the arguments.
 ; Remember that `mode' must be the first argument.
@@ -314,12 +311,9 @@
       *UNSPECIFIED*))
 )
 
-(define define-rtx-syntax-node
-  ; Written this way so Hobbit can handle it.
-  (defmacro:syntax-transformer (lambda arg-list
-				 (apply def-rtx-syntax-node arg-list)
-				 nil))
-)
+(define-macro (define-rtx-syntax-node . args)
+  (cons 'def-rtx-syntax-node
+	(map (lambda (arg) `',arg) args)))
 
 ; Same as define-rtx-node but return an operand (usually an <operand> object).
 ; ??? `mode' must be the first argument?
@@ -345,12 +339,9 @@
       *UNSPECIFIED*))
 )
 
-(define define-rtx-operand-node
-  ; Written this way so Hobbit can handle it.
-  (defmacro:syntax-transformer (lambda arg-list
-				 (apply def-rtx-operand-node arg-list)
-				 nil))
-)
+(define-macro (define-rtx-operand-node . args)
+  (cons 'def-rtx-operand-node
+	(map (lambda (arg) `',arg) args)))
 
 ; Convert one rtx expression into another.
 ; NAME-ARGS is a list of the operation name and arguments.
@@ -374,12 +365,10 @@
       *UNSPECIFIED*))
 )
 
-(define define-rtx-macro-node
-  ; Written this way so Hobbit can handle it.
-  (defmacro:syntax-transformer (lambda arg-list
-				 (apply def-rtx-macro-node arg-list)
-				 nil))
-)
+(define-macro (define-rtx-macro-node . args)
+  (cons 'def-rtx-macro-node
+	(map (lambda (arg) `',arg) args)))
+
 \f
 ; RTL macro expansion.
 ; RTL macros are different than pmacros.  The difference is that the expansion
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 08/14] Remove let bindings of macros
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (6 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 07/14] Use define-macro in rtl.scm Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:33   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 09/14] Remove define-in-define Tom Tromey
                   ` (7 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

rtx-funcs.scm assumes that it can let-bind to macros and the right
thing will happen.  However, this is not correct according to more
recent versions of Guile, which more cleanly separate the expansion
and evaluation phases.

Remove the bindings and simply refer to the wordier names.
---
 rtx-funcs.scm | 246 ++++++++++++++++++++++++--------------------------
 1 file changed, 118 insertions(+), 128 deletions(-)

diff --git a/rtx-funcs.scm b/rtx-funcs.scm
index f16864a..5fd1957 100644
--- a/rtx-funcs.scm
+++ b/rtx-funcs.scm
@@ -17,16 +17,6 @@
 
 (define (def-rtx-funcs)
 
-; Do not change the indentation here.
-(let
-(
- ; These are defined in rtl.scm.
- (drn define-rtx-node)
- (drsn define-rtx-syntax-node)
- (dron define-rtx-operand-node)
- (drmn define-rtx-macro-node)
-)
-
 ; The reason for the odd indenting above is so that emacs begins indenting the
 ; following code at column 1.
 \f
@@ -35,7 +25,7 @@
 ; The code will expect the mode to be compatible even though `error'
 ; "doesn't return".  A small concession for simpler code.
 
-(drn (error &options &mode message)
+(define-rtx-node (error &options &mode message)
      #f
      (OPTIONS VOIDORNUMMODE STRING) (NA NA NA)
      MISC
@@ -45,7 +35,7 @@
 ; Enums
 ; Default mode is INT.
 
-(drn (enum &options &mode enum-name)
+(define-rtx-node (enum &options &mode enum-name)
      #f
      (OPTIONS ANYINTMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/ENUM-NAME/ ?
      ARG
@@ -60,7 +50,7 @@
 ; Ifields are normally specified by name, but they are subsequently wrapped
 ; in this.
 
-(dron (ifield &options &mode ifld-name)
+(define-rtx-operand-node (ifield &options &mode ifld-name)
       #f
       (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/IFIELD-NAME/ ?
       ARG
@@ -79,7 +69,7 @@
 ; Operands are normally specified by name, but they are subsequently wrapped
 ; in this.
 
-(dron (operand &options &mode op-name)
+(define-rtx-operand-node (operand &options &mode op-name)
       #f
       (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/OPERAND-NAME/ ?
       ARG
@@ -110,7 +100,7 @@
 ; It can be the name of an existing operand.
 ; ??? Might also support numbering by allowing NEW-NAME to be a number.
 
-(drsn (name &options &mode new-name value)
+(define-rtx-syntax-node (name &options &mode new-name value)
       #f
       (OPTIONS ANYNUMMODE SYMBOL RTX) (NA NA NA ANY)
       ARG
@@ -126,14 +116,14 @@
 ; it expresses all the state].
 ; Compiled operands are wrapped in this so that they still look like rtx.
 
-(dron (xop &options &mode object)
+(define-rtx-operand-node (xop &options &mode object)
       #f
       (OPTIONS ANYNUMMODE OBJECT) (NA NA NA) ;; ??? s/OBJECT/OPERAND/ ?
       ARG
       object
 )
 
-;(dron (opspec: &options &mode op-name op-num hw-ref attrs)
+;(define-rtx-operand-node (opspec: &options &mode op-name op-num hw-ref attrs)
 ;      (OPTIONS ANYNUMMODE SYMBOL NUMBER RTX ATTRS) (NA NA NA NA ANY NA)
 ;      ARG
 ;      (let ((opval (rtx-eval-with-estate hw-ref (mode:lookup &mode) *estate*)))
@@ -152,7 +142,7 @@
 ; Local variables are normally specified by name, but they are subsequently
 ; wrapped in this.
 
-(dron (local &options &mode local-name)
+(define-rtx-operand-node (local &options &mode local-name)
       #f
       (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/LOCAL-NAME/ ?
       ARG
@@ -169,7 +159,7 @@
 ;
 ; ??? Since operands are given names and not numbers this isn't currently used.
 ;
-;(drsn (dup &options &mode op-name)
+;(define-rtx-syntax-node (dup &options &mode op-name)
 ;     #f
 ;     (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA)
 ;     ;(s-dup *estate* op-name)
@@ -185,7 +175,7 @@
 ; and written if output operand).
 ; ??? What about input/output operands.
 
-(drsn (ref &options &mode name)
+(define-rtx-syntax-node (ref &options &mode name)
       BI
       (OPTIONS BIMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/OPERAND-NAME/ ?
       ARG
@@ -197,7 +187,7 @@
 ; ??? Mode handling incomplete, this doesn't handle mem, which it could.
 ; Until then we fix the mode of the result to INT.
 
-(dron (index-of &options &mode op-rtx)
+(define-rtx-operand-node (index-of &options &mode op-rtx)
       INT
       (OPTIONS INTMODE RTX) (NA NA ANY)
       ARG
@@ -221,7 +211,7 @@
 
 ; Same as index-of, but improves readability for registers.
 
-(drmn (regno reg)
+(define-rtx-macro-node (regno reg)
       (list 'index-of reg)
 )
 \f
@@ -235,7 +225,7 @@
 ; These are implemented as syntax nodes as we must pass INDX to `s-hw'
 ; unevaluated.
 ; ??? Not currently supported.  Not sure whether it should be.
-;(drsn (hw &options &mode hw-elm . indx-sel)
+;(define-rtx-syntax-node (hw &options &mode hw-elm . indx-sel)
 ;      (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT)
 ;      ARG
 ;      (let ((indx (if (pair? indx-sel) (car indx-sel) 0))
@@ -247,7 +237,7 @@
 
 ; Register accesses.
 ; INDX-SEL is an optional index and possible selector.
-(dron (reg &options &mode hw-elm . indx-sel)
+(define-rtx-operand-node (reg &options &mode hw-elm . indx-sel)
       #f
       (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT) ;; ??? s/SYMBOL/HW-NAME/ ?
       ARG
@@ -261,7 +251,7 @@
 ; A raw-reg bypasses the getter/setter stuff.  It's usually used in
 ; getter/setter definitions.
 
-(dron (raw-reg &options &mode hw-elm . indx-sel)
+(define-rtx-operand-node (raw-reg &options &mode hw-elm . indx-sel)
       #f
       (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT) ;; ??? s/SYMBOL/HW-NAME/ ?
       ARG
@@ -275,7 +265,7 @@
 )
 
 ; Memory accesses.
-(dron (mem &options &mode addr . sel)
+(define-rtx-operand-node (mem &options &mode addr . sel)
       #f
       (OPTIONS EXPLNUMMODE RTX . RTX) (NA NA AI . INT)
       ARG
@@ -289,14 +279,14 @@
 ; The program counter.
 ; ??? Hmmm... needed?  The pc is usually specified as `pc' which is shorthand
 ; for (operand pc).
-;(dron (pc) () () ARG s-pc)
+;(define-rtx-operand-node (pc) () () ARG s-pc)
 
 ; Fetch bytes from the instruction stream of size MODE.
 ; FIXME: Later need to augment this by passing an indicator to the mem-fetch
 ; routines that we're doing an ifetch.
 ; ??? wip!
 
-(drmn (ifetch mode pc)
+(define-rtx-macro-node (ifetch mode pc)
       (list 'mem mode pc) ; hw-selector-ispace
 )
 
@@ -305,14 +295,14 @@
 ; index into the scache [as an offset from the first insn].
 ; ??? wip!
 
-(drmn (decode mode pc insn num)
+(define-rtx-macro-node (decode mode pc insn num)
       (list 'c-call mode 'EXTRACT pc insn num)
 )
 
 ; NUM is the same number passed to `decode'.
 ; ??? wip!
 
-(drmn (execute mode num)
+(define-rtx-macro-node (execute mode num)
       (list 'c-call mode 'EXECUTE num)
 )
 \f
@@ -325,7 +315,7 @@
 ; The mode of the result is the mode of RTX.
 ; ??? wip!
 
-(drn (delay &options &mode n rtx)
+(define-rtx-node (delay &options &mode n rtx)
      #f
      (OPTIONS VOIDORNUMMODE RTX RTX) (NA NA INT MATCHEXPR)
      MISC
@@ -337,7 +327,7 @@
 ; The target is required to define SEM_ANNUL_INSN.
 ; ??? wip!
 
-(drmn (annul yes?)
+(define-rtx-macro-node (annul yes?)
       ; The pc reference here is hidden in c-code to not generate a spurious
       ; pc input operand.
       (list 'c-call 'VOID "SEM_ANNUL_INSN" (list 'c-code 'IAI "pc") yes?)
@@ -348,7 +338,7 @@
 ; ??? This is similar to annul.  Deletion of one of them defered.
 ; ??? wip!
 
-(drn (skip &options &mode yes?)
+(define-rtx-node (skip &options &mode yes?)
      VOID
      (OPTIONS VOIDMODE RTX) (NA NA INT)
      MISC
@@ -370,7 +360,7 @@
 ; We just want the symbols.
 ; FIXME: Hmmm... it currently isn't a syntax node.
 
-(drn (eq-attr &options &mode owner attr value)
+(define-rtx-node (eq-attr &options &mode owner attr value)
      BI
       (OPTIONS BIMODE RTX SYMBOL SYMORNUM) (NA NA ANY NA NA)
       MISC
@@ -390,7 +380,7 @@
 ; This uses INTMODE because we can't otherwise determine the
 ; mode of the result (if elided).
 
-(drn (int-attr &options &mode obj attr-name)
+(define-rtx-node (int-attr &options &mode obj attr-name)
      #f
      (OPTIONS INTMODE RTX SYMBOL) (NA NA ANY NA)
      MISC
@@ -399,14 +389,14 @@
 
 ;; Deprecated alias for int-attr.
 
-(drmn (attr arg1 . rest)
+(define-rtx-macro-node (attr arg1 . rest)
       (cons 'int-attr (cons arg1 rest))
 )
 
 ; Same as `quote', for use in attributes cus "quote" sounds too jargonish.
 ; [Ok, not a strong argument for using "symbol", but so what?]
 
-(drsn (symbol &options &mode name)
+(define-rtx-syntax-node (symbol &options &mode name)
       SYM
       (OPTIONS SYMMODE SYMBOL) (NA NA NA)
       ARG
@@ -415,7 +405,7 @@
 
 ; Return the current instruction.
 
-(drn (current-insn &options &mode)
+(define-rtx-node (current-insn &options &mode)
      INSN
      (OPTIONS INSNMODE) (NA NA)
      MISC
@@ -428,7 +418,7 @@
 ; Return the currently selected machine.
 ; This can either be a compile-time or run-time value.
 
-(drn (current-mach &options &mode)
+(define-rtx-node (current-mach &options &mode)
      MACH
      (OPTIONS MACHMODE) (NA NA)
      MISC
@@ -438,7 +428,7 @@
 ; Constants.
 
 ; FIXME: Need to consider 64 bit hosts.
-(drn (const &options &mode c)
+(define-rtx-node (const &options &mode c)
      #f
      (OPTIONS ANYNUMMODE NUMBER) (NA NA NA)
      ARG
@@ -452,7 +442,7 @@
 ; Arguments are specified most significant to least significant.
 ; ??? Not all of the combinations are supported in the simulator.
 ; They'll get added as necessary.
-(drn (join &options &out-mode in-mode arg1 . arg-rest)
+(define-rtx-node (join &options &out-mode in-mode arg1 . arg-rest)
      #f
      (OPTIONS ANYNUMMODE ANYNUMMODE RTX . RTX) (NA NA NA ANY . ANY)
      MISC
@@ -475,7 +465,7 @@
 ; and code which analyzes it would otherwise use the result mode (specified by
 ; `&mode') for the mode of operand0.
 
-(drn (subword &options &mode value word-num)
+(define-rtx-node (subword &options &mode value word-num)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA ANY INT)
      ARG
@@ -485,13 +475,13 @@
 ; ??? The split and concat stuff is just an experiment and should not be used.
 ; What's there now is just "thoughts put down on paper."
 
-(drmn (split split-mode in-mode di)
+(define-rtx-macro-node (split split-mode in-mode di)
       ; FIXME: Ensure compatible modes
       ;(list 'c-raw-call 'BLK (string-append "SPLIT" in-mode split-mode) di)
       '(const 0)
 )
 
-(drmn (concat modes arg1 . arg-rest)
+(define-rtx-macro-node (concat modes arg1 . arg-rest)
       ; FIXME: Here might be the place to ensure
       ; (= (length modes) (length (cons arg1 arg-rest))).
       ;(cons 'c-raw-call (cons modes (cons "CONCAT" (cons arg1 arg-rest))))
@@ -502,7 +492,7 @@
 ; ??? GCC RTL calls this "unspec" which is arguably a more application
 ; independent name.
 
-(drn (c-code &options &mode text)
+(define-rtx-node (c-code &options &mode text)
      #f
      (OPTIONS ANYCEXPRMODE STRING) (NA NA NA)
      UNSPEC
@@ -519,7 +509,7 @@
 ; If it is VOID this call is a statement and ';' is appended.
 ; Otherwise it is part of an expression.
 
-(drn (c-call &options &mode name . args)
+(define-rtx-node (c-call &options &mode name . args)
      #f
      (OPTIONS ANYCEXPRMODE STRING . RTX) (NA NA NA . ANY)
      UNSPEC
@@ -528,7 +518,7 @@
 
 ; Same as c-call but without implicit first arg of `current_cpu'.
 
-(drn (c-raw-call &options &mode name . args)
+(define-rtx-node (c-raw-call &options &mode name . args)
      #f
      (OPTIONS ANYCEXPRMODE STRING . RTX) (NA NA NA . ANY)
      UNSPEC
@@ -537,7 +527,7 @@
 \f
 ; Set/get/miscellaneous
 
-(drn (nop &options &mode)
+(define-rtx-node (nop &options &mode)
      VOID
      (OPTIONS VOIDMODE) (NA NA)
      MISC
@@ -546,7 +536,7 @@
 
 ; Clobber - mark an object as modified without explaining why or how.
 
-(drn (clobber &options &mode object)
+(define-rtx-node (clobber &options &mode object)
      VOID
      (OPTIONS VOIDORNUMMODE RTX) (NA NA MATCHEXPR)
      MISC
@@ -572,14 +562,14 @@
 ; ??? One might want a `!' suffix as in `set!', but methinks that's following
 ; Scheme too closely.
 
-(drn (set &options &mode dst src)
+(define-rtx-node (set &options &mode dst src)
      VOID
      (OPTIONS ANYNUMMODE SETRTX RTX) (NA NA MATCHEXPR MATCH2)
      SET
      #f
 )
 
-(drn (set-quiet &options &mode dst src)
+(define-rtx-node (set-quiet &options &mode dst src)
      VOID
      (OPTIONS ANYNUMMODE SETRTX RTX) (NA NA MATCHEXPR MATCH2)
      SET
@@ -614,14 +604,14 @@
 ;   from the arguments [elsewhere is a description of the tradeoffs]
 ; - ???
 
-(drn (neg &options &mode s1)
+(define-rtx-node (neg &options &mode s1)
      #f
      (OPTIONS ANYNUMMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
 
-(drn (abs &options &mode s1)
+(define-rtx-node (abs &options &mode s1)
      #f
      (OPTIONS ANYNUMMODE RTX) (NA NA MATCHEXPR)
      UNARY
@@ -631,7 +621,7 @@
 ; For integer values this is a bitwise operation (each bit inverted).
 ; For floating point values this produces 1/x.
 ; ??? Might want different names.
-(drn (inv &options &mode s1)
+(define-rtx-node (inv &options &mode s1)
      #f
      (OPTIONS ANYINTMODE RTX) (NA NA MATCHEXPR)
      UNARY
@@ -641,20 +631,20 @@
 ; This is a boolean operation.
 ; MODE is the mode of S1.  The result always has mode BI.
 ; ??? Perhaps `mode' shouldn't be here.
-(drn (not &options &mode s1)
+(define-rtx-node (not &options &mode s1)
      BI
      (OPTIONS ANYINTMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
 
-(drn (add &options &mode s1 s2)
+(define-rtx-node (add &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (sub &options &mode s1 s2)
+(define-rtx-node (sub &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
@@ -665,37 +655,37 @@
 ; "s3" here must have type BI.
 ; For the *flag rtx's, MODE is the mode of S1,S2; the result always has
 ; mode BI.
-(drn (addc &options &mode s1 s2 s3)
+(define-rtx-node (addc &options &mode s1 s2 s3)
      #f
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (addc-cflag &options &mode s1 s2 s3)
+(define-rtx-node (addc-cflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (addc-oflag &options &mode s1 s2 s3)
+(define-rtx-node (addc-oflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (subc &options &mode s1 s2 s3)
+(define-rtx-node (subc &options &mode s1 s2 s3)
      #f
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (subc-cflag &options &mode s1 s2 s3)
+(define-rtx-node (subc-cflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (subc-oflag &options &mode s1 s2 s3)
+(define-rtx-node (subc-oflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
@@ -703,25 +693,25 @@
 )
 
 ;; ??? These are deprecated.  Delete in time.
-(drn (add-cflag &options &mode s1 s2 s3)
+(define-rtx-node (add-cflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (add-oflag &options &mode s1 s2 s3)
+(define-rtx-node (add-oflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (sub-cflag &options &mode s1 s2 s3)
+(define-rtx-node (sub-cflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
      #f
 )
-(drn (sub-oflag &options &mode s1 s2 s3)
+(define-rtx-node (sub-oflag &options &mode s1 s2 s3)
      BI
      (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
      TRINARY
@@ -734,14 +724,14 @@
 ; operation.
 
 ; Return bit indicating if VALUE is zero/non-zero.
-(drmn (zflag arg1 . rest) ; mode value)
+(define-rtx-macro-node (zflag arg1 . rest) ; mode value)
       (if (null? rest) ; mode missing?
 	  (list 'eq 'DFLT arg1 0)
 	  (list 'eq arg1 (car rest) 0))
 )
 
 ; Return bit indicating if VALUE is negative/non-negative.
-(drmn (nflag arg1 . rest) ; mode value)
+(define-rtx-macro-node (nflag arg1 . rest) ; mode value)
       (if (null? rest) ; mode missing?
 	  (list 'lt 'DFLT arg1 0)
 	  (list 'lt arg1 (car rest) 0))
@@ -749,21 +739,21 @@
 
 ; Multiply/divide.
 
-(drn (mul &options &mode s1 s2)
+(define-rtx-node (mul &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
 ; 1's complement overflow
-(drn (mul-o1flag &options &mode s1 s2)
+(define-rtx-node (mul-o1flag &options &mode s1 s2)
      BI
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
 ; 2's complement overflow
-(drn (mul-o2flag &options &mode s1 s2)
+(define-rtx-node (mul-o2flag &options &mode s1 s2)
      BI
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
@@ -773,31 +763,31 @@
 ; ??? Need two variants, one that avoids implementation defined situations
 ; [both host and target], and one that specifies implementation defined
 ; situations [target].
-(drn (div &options &mode s1 s2)
+(define-rtx-node (div &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (udiv &options &mode s1 s2)
+(define-rtx-node (udiv &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (mod &options &mode s1 s2)
+(define-rtx-node (mod &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (umod &options &mode s1 s2)
+(define-rtx-node (umod &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (rem &options &mode s1 s2)
+(define-rtx-node (rem &options &mode s1 s2)
      #f
      (OPTIONS ANYFLOATMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
@@ -808,40 +798,40 @@
 
 ; various floating point routines
 
-(drn (sqrt &options &mode s1)
+(define-rtx-node (sqrt &options &mode s1)
      #f
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
 
-(drn (cos &options &mode s1)
+(define-rtx-node (cos &options &mode s1)
      #f
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
 
-(drn (sin &options &mode s1)
+(define-rtx-node (sin &options &mode s1)
      #f
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
 
-(drn (nan &options &mode s1)
+(define-rtx-node (nan &options &mode s1)
      BI
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
-(drn (qnan &options &mode s1)
+(define-rtx-node (qnan &options &mode s1)
      BI
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
      #f
 )
-(drn (snan &options &mode s1)
+(define-rtx-node (snan &options &mode s1)
      BI
      (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
      UNARY
@@ -850,28 +840,28 @@
 
 ; min/max
 
-(drn (min &options &mode s1 s2)
+(define-rtx-node (min &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
 
-(drn (max &options &mode s1 s2)
+(define-rtx-node (max &options &mode s1 s2)
      #f
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
 
-(drn (umin &options &mode s1 s2)
+(define-rtx-node (umin &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
 
-(drn (umax &options &mode s1 s2)
+(define-rtx-node (umax &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
@@ -879,19 +869,19 @@
 )
 
 ; These are bitwise operations.
-(drn (and &options &mode s1 s2)
+(define-rtx-node (and &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (or &options &mode s1 s2)
+(define-rtx-node (or &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
      #f
 )
-(drn (xor &options &mode s1 s2)
+(define-rtx-node (xor &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      BINARY
@@ -900,33 +890,33 @@
 
 ; Shift operations.
 
-(drn (sll &options &mode s1 s2)
+(define-rtx-node (sll &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
      BINARY
      #f
 )
-(drn (srl &options &mode s1 s2)
+(define-rtx-node (srl &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
      BINARY
      #f
 )
 ; ??? In non-sim case, ensure s1 is in right C type for right result.
-(drn (sra &options &mode s1 s2)
+(define-rtx-node (sra &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
      BINARY
      #f
 )
 ; Rotates don't really have a sign, so doesn't matter what we say.
-(drn (ror &options &mode s1 s2)
+(define-rtx-node (ror &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
      BINARY
      #f
 )
-(drn (rol &options &mode s1 s2)
+(define-rtx-node (rol &options &mode s1 s2)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
      BINARY
@@ -940,13 +930,13 @@
 ; ??? 'twould also simplify several .cpu description entries.
 ; On the other hand, handling an arbitrary number of args isn't supported by
 ; ISA's, which the main goal of what we're trying to represent.
-(drn (andif &options &mode s1 s2)
+(define-rtx-node (andif &options &mode s1 s2)
      BI
      (OPTIONS BIMODE RTX RTX) (NA NA ANYINT ANYINT)
      BINARY ; IF?
      #f
 )
-(drn (orif &options &mode s1 s2)
+(define-rtx-node (orif &options &mode s1 s2)
      BI
      (OPTIONS BIMODE RTX RTX) (NA NA ANYINT ANYINT)
      BINARY ; IF?
@@ -956,26 +946,26 @@
 ; `bitfield' is an experimental operation.
 ; It's not really needed but it might help simplify some things.
 ;
-;(drn (bitfield mode src start length)
+;(define-rtx-node (bitfield mode src start length)
 ;     ...
 ;     ...
 ;)
 \f
 ;; Integer conversions.
 
-(drn (ext &options &mode s1)
+(define-rtx-node (ext &options &mode s1)
      #f
      (OPTIONS ANYINTMODE RTX) (NA NA ANY)
      UNARY
      #f
 )
-(drn (zext &options &mode s1)
+(define-rtx-node (zext &options &mode s1)
      #f
      (OPTIONS ANYINTMODE RTX) (NA NA ANY)
      UNARY
      #f
 )
-(drn (trunc &options &mode s1)
+(define-rtx-node (trunc &options &mode s1)
      #f
      (OPTIONS ANYINTMODE RTX) (NA NA ANY)
      UNARY
@@ -984,37 +974,37 @@
 
 ;; Conversions involving floating point values.
 
-(drn (fext &options &mode how s1)
+(define-rtx-node (fext &options &mode how s1)
      #f
      (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
      UNARY
      #f
 )
-(drn (ftrunc &options &mode how s1)
+(define-rtx-node (ftrunc &options &mode how s1)
      #f
      (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
      UNARY
      #f
 )
-(drn (float &options &mode how s1)
+(define-rtx-node (float &options &mode how s1)
      #f
      (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
      UNARY
      #f
 )
-(drn (ufloat &options &mode how s1)
+(define-rtx-node (ufloat &options &mode how s1)
      #f
      (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
      UNARY
      #f
 )
-(drn (fix &options &mode how s1)
+(define-rtx-node (fix &options &mode how s1)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA INT ANY)
      UNARY
      #f
 )
-(drn (ufix &options &mode how s1)
+(define-rtx-node (ufix &options &mode how s1)
      #f
      (OPTIONS ANYINTMODE RTX RTX) (NA NA INT ANY)
      UNARY
@@ -1024,70 +1014,70 @@
 ; Comparisons.
 ; MODE is the mode of S1,S2.  The result always has mode BI.
 
-(drn (eq &options &mode s1 s2)
+(define-rtx-node (eq &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (ne &options &mode s1 s2)
+(define-rtx-node (ne &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
 ; ??? In non-sim case, ensure s1,s2 is in right C type for right result.
-(drn (lt &options &mode s1 s2)
+(define-rtx-node (lt &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (le &options &mode s1 s2)
+(define-rtx-node (le &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (gt &options &mode s1 s2)
+(define-rtx-node (gt &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (ge &options &mode s1 s2)
+(define-rtx-node (ge &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
 ; ??? In non-sim case, ensure s1,s2 is in right C type for right result.
-(drn (ltu &options &mode s1 s2)
+(define-rtx-node (ltu &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (leu &options &mode s1 s2)
+(define-rtx-node (leu &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (gtu &options &mode s1 s2)
+(define-rtx-node (gtu &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
-(drn (geu &options &mode s1 s2)
+(define-rtx-node (geu &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
      #f
 )
 ; Detect NaNs
-(drn (unordered &options &mode s1 s2)
+(define-rtx-node (unordered &options &mode s1 s2)
      BI
      (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
      COMPARE
@@ -1100,7 +1090,7 @@
 ; Return a boolean (BI mode) indicating if VALUE is in SET.
 ; VALUE is any constant rtx.  SET is a `number-list' rtx.
 
-(drn (member &options &mode value set)
+(define-rtx-node (member &options &mode value set)
      #f
      (OPTIONS BIMODE RTX RTX) (NA NA INT INT)
      MISC
@@ -1119,7 +1109,7 @@
 ;; FIXME: "number" in "number-list" implies floats are ok.
 ;; Rename to integer-list, int-list, or some such.
 
-(drn (number-list &options &mode value-list)
+(define-rtx-node (number-list &options &mode value-list)
      #f
      (OPTIONS INTMODE NUMBER . NUMBER) (NA NA NA . NA)
      MISC
@@ -1129,7 +1119,7 @@
 ; Conditional execution.
 
 ; FIXME: make syntax node?
-(drn (if &options &mode cond then . else)
+(define-rtx-node (if &options &mode cond then . else)
      #f
      ;; ??? It would be cleaner if TESTRTX had to have BI mode.
      (OPTIONS ANYEXPRMODE TESTRTX RTX . RTX) (NA NA ANYINT MATCHEXPR . MATCH3)
@@ -1142,7 +1132,7 @@
 ; ??? The syntax here isn't quite right, there must be at least one cond rtx.
 ; ??? Intermediate expressions (the ones before the last one) needn't have
 ; the same mode as the result.
-(drsn (cond &options &mode . cond-code-list)
+(define-rtx-syntax-node (cond &options &mode . cond-code-list)
      #f
       (OPTIONS ANYEXPRMODE . CONDRTX) (NA NA . MATCHEXPR)
       COND
@@ -1152,7 +1142,7 @@
 ; ??? The syntax here isn't quite right, there must be at least one case.
 ; ??? Intermediate expressions (the ones before the last one) needn't have
 ; the same mode as the result.
-(drn (case &options &mode test . case-list)
+(define-rtx-node (case &options &mode test . case-list)
      #f
      (OPTIONS ANYEXPRMODE RTX . CASERTX) (NA NA ANY . MATCHEXPR)
      COND
@@ -1166,7 +1156,7 @@
 ; IGNORE is for consistency with sequence.  ??? Delete some day.
 ; ??? There's no real need for mode either, but convention requires it.
 
-(drsn (parallel &options &mode ignore expr . exprs)
+(define-rtx-syntax-node (parallel &options &mode ignore expr . exprs)
      #f
       (OPTIONS VOIDMODE LOCALS RTX . RTX) (NA NA NA VOID . VOID)
       SEQUENCE
@@ -1176,7 +1166,7 @@
 ; This has to be a syntax node to handle locals properly: they're not defined
 ; yet and thus pre-evaluating the expressions doesn't work.
 
-(drsn (sequence &options &mode locals expr . exprs)
+(define-rtx-syntax-node (sequence &options &mode locals expr . exprs)
      #f
       (OPTIONS VOIDORNUMMODE LOCALS RTX . RTX) (NA NA NA MATCHSEQ . MATCHSEQ)
       SEQUENCE
@@ -1186,7 +1176,7 @@
 ; This has to be a syntax node to handle iter-var properly: it's not defined
 ; yet and thus pre-evaluating the expressions doesn't work.
 
-(drsn (do-count &options &mode iter-var nr-times expr . exprs)
+(define-rtx-syntax-node (do-count &options &mode iter-var nr-times expr . exprs)
      #f
       (OPTIONS VOIDMODE ITERATION RTX RTX . RTX) (NA NA NA INT VOID . VOID)
       SEQUENCE
@@ -1198,11 +1188,11 @@
 ; ??? Maybe closures shouldn't be separate from sequences,
 ; but I'm less convinced these days.
 
-(drsn (closure &options &mode isa-name-list env-stack expr)
+(define-rtx-syntax-node (closure &options &mode isa-name-list env-stack expr)
      #f
       (OPTIONS VOIDORNUMMODE SYMBOLLIST ENVSTACK RTX) (NA NA NA NA MATCHEXPR)
       MISC
       #f
 )
 \f
-)) ; End of def-rtx-funcs
+) ; End of def-rtx-funcs
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 08/14] Remove let bindings of macros
  2023-08-19 17:42 ` [RFC 08/14] Remove let bindings of macros Tom Tromey
@ 2023-08-20  8:33   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:33 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


OK.  Thanks.

> rtx-funcs.scm assumes that it can let-bind to macros and the right
> thing will happen.  However, this is not correct according to more
> recent versions of Guile, which more cleanly separate the expansion
> and evaluation phases.
>
> Remove the bindings and simply refer to the wordier names.
> ---
>  rtx-funcs.scm | 246 ++++++++++++++++++++++++--------------------------
>  1 file changed, 118 insertions(+), 128 deletions(-)
>
> diff --git a/rtx-funcs.scm b/rtx-funcs.scm
> index f16864a..5fd1957 100644
> --- a/rtx-funcs.scm
> +++ b/rtx-funcs.scm
> @@ -17,16 +17,6 @@
>  
>  (define (def-rtx-funcs)
>  
> -; Do not change the indentation here.
> -(let
> -(
> - ; These are defined in rtl.scm.
> - (drn define-rtx-node)
> - (drsn define-rtx-syntax-node)
> - (dron define-rtx-operand-node)
> - (drmn define-rtx-macro-node)
> -)
> -
>  ; The reason for the odd indenting above is so that emacs begins indenting the
>  ; following code at column 1.
>  \f
> @@ -35,7 +25,7 @@
>  ; The code will expect the mode to be compatible even though `error'
>  ; "doesn't return".  A small concession for simpler code.
>  
> -(drn (error &options &mode message)
> +(define-rtx-node (error &options &mode message)
>       #f
>       (OPTIONS VOIDORNUMMODE STRING) (NA NA NA)
>       MISC
> @@ -45,7 +35,7 @@
>  ; Enums
>  ; Default mode is INT.
>  
> -(drn (enum &options &mode enum-name)
> +(define-rtx-node (enum &options &mode enum-name)
>       #f
>       (OPTIONS ANYINTMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/ENUM-NAME/ ?
>       ARG
> @@ -60,7 +50,7 @@
>  ; Ifields are normally specified by name, but they are subsequently wrapped
>  ; in this.
>  
> -(dron (ifield &options &mode ifld-name)
> +(define-rtx-operand-node (ifield &options &mode ifld-name)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/IFIELD-NAME/ ?
>        ARG
> @@ -79,7 +69,7 @@
>  ; Operands are normally specified by name, but they are subsequently wrapped
>  ; in this.
>  
> -(dron (operand &options &mode op-name)
> +(define-rtx-operand-node (operand &options &mode op-name)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/OPERAND-NAME/ ?
>        ARG
> @@ -110,7 +100,7 @@
>  ; It can be the name of an existing operand.
>  ; ??? Might also support numbering by allowing NEW-NAME to be a number.
>  
> -(drsn (name &options &mode new-name value)
> +(define-rtx-syntax-node (name &options &mode new-name value)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL RTX) (NA NA NA ANY)
>        ARG
> @@ -126,14 +116,14 @@
>  ; it expresses all the state].
>  ; Compiled operands are wrapped in this so that they still look like rtx.
>  
> -(dron (xop &options &mode object)
> +(define-rtx-operand-node (xop &options &mode object)
>        #f
>        (OPTIONS ANYNUMMODE OBJECT) (NA NA NA) ;; ??? s/OBJECT/OPERAND/ ?
>        ARG
>        object
>  )
>  
> -;(dron (opspec: &options &mode op-name op-num hw-ref attrs)
> +;(define-rtx-operand-node (opspec: &options &mode op-name op-num hw-ref attrs)
>  ;      (OPTIONS ANYNUMMODE SYMBOL NUMBER RTX ATTRS) (NA NA NA NA ANY NA)
>  ;      ARG
>  ;      (let ((opval (rtx-eval-with-estate hw-ref (mode:lookup &mode) *estate*)))
> @@ -152,7 +142,7 @@
>  ; Local variables are normally specified by name, but they are subsequently
>  ; wrapped in this.
>  
> -(dron (local &options &mode local-name)
> +(define-rtx-operand-node (local &options &mode local-name)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/LOCAL-NAME/ ?
>        ARG
> @@ -169,7 +159,7 @@
>  ;
>  ; ??? Since operands are given names and not numbers this isn't currently used.
>  ;
> -;(drsn (dup &options &mode op-name)
> +;(define-rtx-syntax-node (dup &options &mode op-name)
>  ;     #f
>  ;     (OPTIONS ANYNUMMODE SYMBOL) (NA NA NA)
>  ;     ;(s-dup *estate* op-name)
> @@ -185,7 +175,7 @@
>  ; and written if output operand).
>  ; ??? What about input/output operands.
>  
> -(drsn (ref &options &mode name)
> +(define-rtx-syntax-node (ref &options &mode name)
>        BI
>        (OPTIONS BIMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/OPERAND-NAME/ ?
>        ARG
> @@ -197,7 +187,7 @@
>  ; ??? Mode handling incomplete, this doesn't handle mem, which it could.
>  ; Until then we fix the mode of the result to INT.
>  
> -(dron (index-of &options &mode op-rtx)
> +(define-rtx-operand-node (index-of &options &mode op-rtx)
>        INT
>        (OPTIONS INTMODE RTX) (NA NA ANY)
>        ARG
> @@ -221,7 +211,7 @@
>  
>  ; Same as index-of, but improves readability for registers.
>  
> -(drmn (regno reg)
> +(define-rtx-macro-node (regno reg)
>        (list 'index-of reg)
>  )
>  \f
> @@ -235,7 +225,7 @@
>  ; These are implemented as syntax nodes as we must pass INDX to `s-hw'
>  ; unevaluated.
>  ; ??? Not currently supported.  Not sure whether it should be.
> -;(drsn (hw &options &mode hw-elm . indx-sel)
> +;(define-rtx-syntax-node (hw &options &mode hw-elm . indx-sel)
>  ;      (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT)
>  ;      ARG
>  ;      (let ((indx (if (pair? indx-sel) (car indx-sel) 0))
> @@ -247,7 +237,7 @@
>  
>  ; Register accesses.
>  ; INDX-SEL is an optional index and possible selector.
> -(dron (reg &options &mode hw-elm . indx-sel)
> +(define-rtx-operand-node (reg &options &mode hw-elm . indx-sel)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT) ;; ??? s/SYMBOL/HW-NAME/ ?
>        ARG
> @@ -261,7 +251,7 @@
>  ; A raw-reg bypasses the getter/setter stuff.  It's usually used in
>  ; getter/setter definitions.
>  
> -(dron (raw-reg &options &mode hw-elm . indx-sel)
> +(define-rtx-operand-node (raw-reg &options &mode hw-elm . indx-sel)
>        #f
>        (OPTIONS ANYNUMMODE SYMBOL . RTX) (NA NA NA . INT) ;; ??? s/SYMBOL/HW-NAME/ ?
>        ARG
> @@ -275,7 +265,7 @@
>  )
>  
>  ; Memory accesses.
> -(dron (mem &options &mode addr . sel)
> +(define-rtx-operand-node (mem &options &mode addr . sel)
>        #f
>        (OPTIONS EXPLNUMMODE RTX . RTX) (NA NA AI . INT)
>        ARG
> @@ -289,14 +279,14 @@
>  ; The program counter.
>  ; ??? Hmmm... needed?  The pc is usually specified as `pc' which is shorthand
>  ; for (operand pc).
> -;(dron (pc) () () ARG s-pc)
> +;(define-rtx-operand-node (pc) () () ARG s-pc)
>  
>  ; Fetch bytes from the instruction stream of size MODE.
>  ; FIXME: Later need to augment this by passing an indicator to the mem-fetch
>  ; routines that we're doing an ifetch.
>  ; ??? wip!
>  
> -(drmn (ifetch mode pc)
> +(define-rtx-macro-node (ifetch mode pc)
>        (list 'mem mode pc) ; hw-selector-ispace
>  )
>  
> @@ -305,14 +295,14 @@
>  ; index into the scache [as an offset from the first insn].
>  ; ??? wip!
>  
> -(drmn (decode mode pc insn num)
> +(define-rtx-macro-node (decode mode pc insn num)
>        (list 'c-call mode 'EXTRACT pc insn num)
>  )
>  
>  ; NUM is the same number passed to `decode'.
>  ; ??? wip!
>  
> -(drmn (execute mode num)
> +(define-rtx-macro-node (execute mode num)
>        (list 'c-call mode 'EXECUTE num)
>  )
>  \f
> @@ -325,7 +315,7 @@
>  ; The mode of the result is the mode of RTX.
>  ; ??? wip!
>  
> -(drn (delay &options &mode n rtx)
> +(define-rtx-node (delay &options &mode n rtx)
>       #f
>       (OPTIONS VOIDORNUMMODE RTX RTX) (NA NA INT MATCHEXPR)
>       MISC
> @@ -337,7 +327,7 @@
>  ; The target is required to define SEM_ANNUL_INSN.
>  ; ??? wip!
>  
> -(drmn (annul yes?)
> +(define-rtx-macro-node (annul yes?)
>        ; The pc reference here is hidden in c-code to not generate a spurious
>        ; pc input operand.
>        (list 'c-call 'VOID "SEM_ANNUL_INSN" (list 'c-code 'IAI "pc") yes?)
> @@ -348,7 +338,7 @@
>  ; ??? This is similar to annul.  Deletion of one of them defered.
>  ; ??? wip!
>  
> -(drn (skip &options &mode yes?)
> +(define-rtx-node (skip &options &mode yes?)
>       VOID
>       (OPTIONS VOIDMODE RTX) (NA NA INT)
>       MISC
> @@ -370,7 +360,7 @@
>  ; We just want the symbols.
>  ; FIXME: Hmmm... it currently isn't a syntax node.
>  
> -(drn (eq-attr &options &mode owner attr value)
> +(define-rtx-node (eq-attr &options &mode owner attr value)
>       BI
>        (OPTIONS BIMODE RTX SYMBOL SYMORNUM) (NA NA ANY NA NA)
>        MISC
> @@ -390,7 +380,7 @@
>  ; This uses INTMODE because we can't otherwise determine the
>  ; mode of the result (if elided).
>  
> -(drn (int-attr &options &mode obj attr-name)
> +(define-rtx-node (int-attr &options &mode obj attr-name)
>       #f
>       (OPTIONS INTMODE RTX SYMBOL) (NA NA ANY NA)
>       MISC
> @@ -399,14 +389,14 @@
>  
>  ;; Deprecated alias for int-attr.
>  
> -(drmn (attr arg1 . rest)
> +(define-rtx-macro-node (attr arg1 . rest)
>        (cons 'int-attr (cons arg1 rest))
>  )
>  
>  ; Same as `quote', for use in attributes cus "quote" sounds too jargonish.
>  ; [Ok, not a strong argument for using "symbol", but so what?]
>  
> -(drsn (symbol &options &mode name)
> +(define-rtx-syntax-node (symbol &options &mode name)
>        SYM
>        (OPTIONS SYMMODE SYMBOL) (NA NA NA)
>        ARG
> @@ -415,7 +405,7 @@
>  
>  ; Return the current instruction.
>  
> -(drn (current-insn &options &mode)
> +(define-rtx-node (current-insn &options &mode)
>       INSN
>       (OPTIONS INSNMODE) (NA NA)
>       MISC
> @@ -428,7 +418,7 @@
>  ; Return the currently selected machine.
>  ; This can either be a compile-time or run-time value.
>  
> -(drn (current-mach &options &mode)
> +(define-rtx-node (current-mach &options &mode)
>       MACH
>       (OPTIONS MACHMODE) (NA NA)
>       MISC
> @@ -438,7 +428,7 @@
>  ; Constants.
>  
>  ; FIXME: Need to consider 64 bit hosts.
> -(drn (const &options &mode c)
> +(define-rtx-node (const &options &mode c)
>       #f
>       (OPTIONS ANYNUMMODE NUMBER) (NA NA NA)
>       ARG
> @@ -452,7 +442,7 @@
>  ; Arguments are specified most significant to least significant.
>  ; ??? Not all of the combinations are supported in the simulator.
>  ; They'll get added as necessary.
> -(drn (join &options &out-mode in-mode arg1 . arg-rest)
> +(define-rtx-node (join &options &out-mode in-mode arg1 . arg-rest)
>       #f
>       (OPTIONS ANYNUMMODE ANYNUMMODE RTX . RTX) (NA NA NA ANY . ANY)
>       MISC
> @@ -475,7 +465,7 @@
>  ; and code which analyzes it would otherwise use the result mode (specified by
>  ; `&mode') for the mode of operand0.
>  
> -(drn (subword &options &mode value word-num)
> +(define-rtx-node (subword &options &mode value word-num)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA ANY INT)
>       ARG
> @@ -485,13 +475,13 @@
>  ; ??? The split and concat stuff is just an experiment and should not be used.
>  ; What's there now is just "thoughts put down on paper."
>  
> -(drmn (split split-mode in-mode di)
> +(define-rtx-macro-node (split split-mode in-mode di)
>        ; FIXME: Ensure compatible modes
>        ;(list 'c-raw-call 'BLK (string-append "SPLIT" in-mode split-mode) di)
>        '(const 0)
>  )
>  
> -(drmn (concat modes arg1 . arg-rest)
> +(define-rtx-macro-node (concat modes arg1 . arg-rest)
>        ; FIXME: Here might be the place to ensure
>        ; (= (length modes) (length (cons arg1 arg-rest))).
>        ;(cons 'c-raw-call (cons modes (cons "CONCAT" (cons arg1 arg-rest))))
> @@ -502,7 +492,7 @@
>  ; ??? GCC RTL calls this "unspec" which is arguably a more application
>  ; independent name.
>  
> -(drn (c-code &options &mode text)
> +(define-rtx-node (c-code &options &mode text)
>       #f
>       (OPTIONS ANYCEXPRMODE STRING) (NA NA NA)
>       UNSPEC
> @@ -519,7 +509,7 @@
>  ; If it is VOID this call is a statement and ';' is appended.
>  ; Otherwise it is part of an expression.
>  
> -(drn (c-call &options &mode name . args)
> +(define-rtx-node (c-call &options &mode name . args)
>       #f
>       (OPTIONS ANYCEXPRMODE STRING . RTX) (NA NA NA . ANY)
>       UNSPEC
> @@ -528,7 +518,7 @@
>  
>  ; Same as c-call but without implicit first arg of `current_cpu'.
>  
> -(drn (c-raw-call &options &mode name . args)
> +(define-rtx-node (c-raw-call &options &mode name . args)
>       #f
>       (OPTIONS ANYCEXPRMODE STRING . RTX) (NA NA NA . ANY)
>       UNSPEC
> @@ -537,7 +527,7 @@
>  \f
>  ; Set/get/miscellaneous
>  
> -(drn (nop &options &mode)
> +(define-rtx-node (nop &options &mode)
>       VOID
>       (OPTIONS VOIDMODE) (NA NA)
>       MISC
> @@ -546,7 +536,7 @@
>  
>  ; Clobber - mark an object as modified without explaining why or how.
>  
> -(drn (clobber &options &mode object)
> +(define-rtx-node (clobber &options &mode object)
>       VOID
>       (OPTIONS VOIDORNUMMODE RTX) (NA NA MATCHEXPR)
>       MISC
> @@ -572,14 +562,14 @@
>  ; ??? One might want a `!' suffix as in `set!', but methinks that's following
>  ; Scheme too closely.
>  
> -(drn (set &options &mode dst src)
> +(define-rtx-node (set &options &mode dst src)
>       VOID
>       (OPTIONS ANYNUMMODE SETRTX RTX) (NA NA MATCHEXPR MATCH2)
>       SET
>       #f
>  )
>  
> -(drn (set-quiet &options &mode dst src)
> +(define-rtx-node (set-quiet &options &mode dst src)
>       VOID
>       (OPTIONS ANYNUMMODE SETRTX RTX) (NA NA MATCHEXPR MATCH2)
>       SET
> @@ -614,14 +604,14 @@
>  ;   from the arguments [elsewhere is a description of the tradeoffs]
>  ; - ???
>  
> -(drn (neg &options &mode s1)
> +(define-rtx-node (neg &options &mode s1)
>       #f
>       (OPTIONS ANYNUMMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
>  
> -(drn (abs &options &mode s1)
> +(define-rtx-node (abs &options &mode s1)
>       #f
>       (OPTIONS ANYNUMMODE RTX) (NA NA MATCHEXPR)
>       UNARY
> @@ -631,7 +621,7 @@
>  ; For integer values this is a bitwise operation (each bit inverted).
>  ; For floating point values this produces 1/x.
>  ; ??? Might want different names.
> -(drn (inv &options &mode s1)
> +(define-rtx-node (inv &options &mode s1)
>       #f
>       (OPTIONS ANYINTMODE RTX) (NA NA MATCHEXPR)
>       UNARY
> @@ -641,20 +631,20 @@
>  ; This is a boolean operation.
>  ; MODE is the mode of S1.  The result always has mode BI.
>  ; ??? Perhaps `mode' shouldn't be here.
> -(drn (not &options &mode s1)
> +(define-rtx-node (not &options &mode s1)
>       BI
>       (OPTIONS ANYINTMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
>  
> -(drn (add &options &mode s1 s2)
> +(define-rtx-node (add &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (sub &options &mode s1 s2)
> +(define-rtx-node (sub &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
> @@ -665,37 +655,37 @@
>  ; "s3" here must have type BI.
>  ; For the *flag rtx's, MODE is the mode of S1,S2; the result always has
>  ; mode BI.
> -(drn (addc &options &mode s1 s2 s3)
> +(define-rtx-node (addc &options &mode s1 s2 s3)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (addc-cflag &options &mode s1 s2 s3)
> +(define-rtx-node (addc-cflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (addc-oflag &options &mode s1 s2 s3)
> +(define-rtx-node (addc-oflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (subc &options &mode s1 s2 s3)
> +(define-rtx-node (subc &options &mode s1 s2 s3)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (subc-cflag &options &mode s1 s2 s3)
> +(define-rtx-node (subc-cflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (subc-oflag &options &mode s1 s2 s3)
> +(define-rtx-node (subc-oflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
> @@ -703,25 +693,25 @@
>  )
>  
>  ;; ??? These are deprecated.  Delete in time.
> -(drn (add-cflag &options &mode s1 s2 s3)
> +(define-rtx-node (add-cflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (add-oflag &options &mode s1 s2 s3)
> +(define-rtx-node (add-oflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (sub-cflag &options &mode s1 s2 s3)
> +(define-rtx-node (sub-cflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
>       #f
>  )
> -(drn (sub-oflag &options &mode s1 s2 s3)
> +(define-rtx-node (sub-oflag &options &mode s1 s2 s3)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX RTX) (NA NA MATCHEXPR MATCH2 BI)
>       TRINARY
> @@ -734,14 +724,14 @@
>  ; operation.
>  
>  ; Return bit indicating if VALUE is zero/non-zero.
> -(drmn (zflag arg1 . rest) ; mode value)
> +(define-rtx-macro-node (zflag arg1 . rest) ; mode value)
>        (if (null? rest) ; mode missing?
>  	  (list 'eq 'DFLT arg1 0)
>  	  (list 'eq arg1 (car rest) 0))
>  )
>  
>  ; Return bit indicating if VALUE is negative/non-negative.
> -(drmn (nflag arg1 . rest) ; mode value)
> +(define-rtx-macro-node (nflag arg1 . rest) ; mode value)
>        (if (null? rest) ; mode missing?
>  	  (list 'lt 'DFLT arg1 0)
>  	  (list 'lt arg1 (car rest) 0))
> @@ -749,21 +739,21 @@
>  
>  ; Multiply/divide.
>  
> -(drn (mul &options &mode s1 s2)
> +(define-rtx-node (mul &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
>  ; 1's complement overflow
> -(drn (mul-o1flag &options &mode s1 s2)
> +(define-rtx-node (mul-o1flag &options &mode s1 s2)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
>  ; 2's complement overflow
> -(drn (mul-o2flag &options &mode s1 s2)
> +(define-rtx-node (mul-o2flag &options &mode s1 s2)
>       BI
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
> @@ -773,31 +763,31 @@
>  ; ??? Need two variants, one that avoids implementation defined situations
>  ; [both host and target], and one that specifies implementation defined
>  ; situations [target].
> -(drn (div &options &mode s1 s2)
> +(define-rtx-node (div &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (udiv &options &mode s1 s2)
> +(define-rtx-node (udiv &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (mod &options &mode s1 s2)
> +(define-rtx-node (mod &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (umod &options &mode s1 s2)
> +(define-rtx-node (umod &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (rem &options &mode s1 s2)
> +(define-rtx-node (rem &options &mode s1 s2)
>       #f
>       (OPTIONS ANYFLOATMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
> @@ -808,40 +798,40 @@
>  
>  ; various floating point routines
>  
> -(drn (sqrt &options &mode s1)
> +(define-rtx-node (sqrt &options &mode s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
>  
> -(drn (cos &options &mode s1)
> +(define-rtx-node (cos &options &mode s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
>  
> -(drn (sin &options &mode s1)
> +(define-rtx-node (sin &options &mode s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
>  
> -(drn (nan &options &mode s1)
> +(define-rtx-node (nan &options &mode s1)
>       BI
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
> -(drn (qnan &options &mode s1)
> +(define-rtx-node (qnan &options &mode s1)
>       BI
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
>       #f
>  )
> -(drn (snan &options &mode s1)
> +(define-rtx-node (snan &options &mode s1)
>       BI
>       (OPTIONS ANYFLOATMODE RTX) (NA NA MATCHEXPR)
>       UNARY
> @@ -850,28 +840,28 @@
>  
>  ; min/max
>  
> -(drn (min &options &mode s1 s2)
> +(define-rtx-node (min &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
>  
> -(drn (max &options &mode s1 s2)
> +(define-rtx-node (max &options &mode s1 s2)
>       #f
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
>  
> -(drn (umin &options &mode s1 s2)
> +(define-rtx-node (umin &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
>  
> -(drn (umax &options &mode s1 s2)
> +(define-rtx-node (umax &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
> @@ -879,19 +869,19 @@
>  )
>  
>  ; These are bitwise operations.
> -(drn (and &options &mode s1 s2)
> +(define-rtx-node (and &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (or &options &mode s1 s2)
> +(define-rtx-node (or &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
>       #f
>  )
> -(drn (xor &options &mode s1 s2)
> +(define-rtx-node (xor &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       BINARY
> @@ -900,33 +890,33 @@
>  
>  ; Shift operations.
>  
> -(drn (sll &options &mode s1 s2)
> +(define-rtx-node (sll &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
>       BINARY
>       #f
>  )
> -(drn (srl &options &mode s1 s2)
> +(define-rtx-node (srl &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
>       BINARY
>       #f
>  )
>  ; ??? In non-sim case, ensure s1 is in right C type for right result.
> -(drn (sra &options &mode s1 s2)
> +(define-rtx-node (sra &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
>       BINARY
>       #f
>  )
>  ; Rotates don't really have a sign, so doesn't matter what we say.
> -(drn (ror &options &mode s1 s2)
> +(define-rtx-node (ror &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
>       BINARY
>       #f
>  )
> -(drn (rol &options &mode s1 s2)
> +(define-rtx-node (rol &options &mode s1 s2)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA MATCHEXPR INT)
>       BINARY
> @@ -940,13 +930,13 @@
>  ; ??? 'twould also simplify several .cpu description entries.
>  ; On the other hand, handling an arbitrary number of args isn't supported by
>  ; ISA's, which the main goal of what we're trying to represent.
> -(drn (andif &options &mode s1 s2)
> +(define-rtx-node (andif &options &mode s1 s2)
>       BI
>       (OPTIONS BIMODE RTX RTX) (NA NA ANYINT ANYINT)
>       BINARY ; IF?
>       #f
>  )
> -(drn (orif &options &mode s1 s2)
> +(define-rtx-node (orif &options &mode s1 s2)
>       BI
>       (OPTIONS BIMODE RTX RTX) (NA NA ANYINT ANYINT)
>       BINARY ; IF?
> @@ -956,26 +946,26 @@
>  ; `bitfield' is an experimental operation.
>  ; It's not really needed but it might help simplify some things.
>  ;
> -;(drn (bitfield mode src start length)
> +;(define-rtx-node (bitfield mode src start length)
>  ;     ...
>  ;     ...
>  ;)
>  \f
>  ;; Integer conversions.
>  
> -(drn (ext &options &mode s1)
> +(define-rtx-node (ext &options &mode s1)
>       #f
>       (OPTIONS ANYINTMODE RTX) (NA NA ANY)
>       UNARY
>       #f
>  )
> -(drn (zext &options &mode s1)
> +(define-rtx-node (zext &options &mode s1)
>       #f
>       (OPTIONS ANYINTMODE RTX) (NA NA ANY)
>       UNARY
>       #f
>  )
> -(drn (trunc &options &mode s1)
> +(define-rtx-node (trunc &options &mode s1)
>       #f
>       (OPTIONS ANYINTMODE RTX) (NA NA ANY)
>       UNARY
> @@ -984,37 +974,37 @@
>  
>  ;; Conversions involving floating point values.
>  
> -(drn (fext &options &mode how s1)
> +(define-rtx-node (fext &options &mode how s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
>       UNARY
>       #f
>  )
> -(drn (ftrunc &options &mode how s1)
> +(define-rtx-node (ftrunc &options &mode how s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
>       UNARY
>       #f
>  )
> -(drn (float &options &mode how s1)
> +(define-rtx-node (float &options &mode how s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
>       UNARY
>       #f
>  )
> -(drn (ufloat &options &mode how s1)
> +(define-rtx-node (ufloat &options &mode how s1)
>       #f
>       (OPTIONS ANYFLOATMODE RTX RTX) (NA NA INT ANY)
>       UNARY
>       #f
>  )
> -(drn (fix &options &mode how s1)
> +(define-rtx-node (fix &options &mode how s1)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA INT ANY)
>       UNARY
>       #f
>  )
> -(drn (ufix &options &mode how s1)
> +(define-rtx-node (ufix &options &mode how s1)
>       #f
>       (OPTIONS ANYINTMODE RTX RTX) (NA NA INT ANY)
>       UNARY
> @@ -1024,70 +1014,70 @@
>  ; Comparisons.
>  ; MODE is the mode of S1,S2.  The result always has mode BI.
>  
> -(drn (eq &options &mode s1 s2)
> +(define-rtx-node (eq &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (ne &options &mode s1 s2)
> +(define-rtx-node (ne &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
>  ; ??? In non-sim case, ensure s1,s2 is in right C type for right result.
> -(drn (lt &options &mode s1 s2)
> +(define-rtx-node (lt &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (le &options &mode s1 s2)
> +(define-rtx-node (le &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (gt &options &mode s1 s2)
> +(define-rtx-node (gt &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (ge &options &mode s1 s2)
> +(define-rtx-node (ge &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
>  ; ??? In non-sim case, ensure s1,s2 is in right C type for right result.
> -(drn (ltu &options &mode s1 s2)
> +(define-rtx-node (ltu &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (leu &options &mode s1 s2)
> +(define-rtx-node (leu &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (gtu &options &mode s1 s2)
> +(define-rtx-node (gtu &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
> -(drn (geu &options &mode s1 s2)
> +(define-rtx-node (geu &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
>       #f
>  )
>  ; Detect NaNs
> -(drn (unordered &options &mode s1 s2)
> +(define-rtx-node (unordered &options &mode s1 s2)
>       BI
>       (OPTIONS ANYNUMMODE RTX RTX) (NA NA MATCHEXPR MATCH2)
>       COMPARE
> @@ -1100,7 +1090,7 @@
>  ; Return a boolean (BI mode) indicating if VALUE is in SET.
>  ; VALUE is any constant rtx.  SET is a `number-list' rtx.
>  
> -(drn (member &options &mode value set)
> +(define-rtx-node (member &options &mode value set)
>       #f
>       (OPTIONS BIMODE RTX RTX) (NA NA INT INT)
>       MISC
> @@ -1119,7 +1109,7 @@
>  ;; FIXME: "number" in "number-list" implies floats are ok.
>  ;; Rename to integer-list, int-list, or some such.
>  
> -(drn (number-list &options &mode value-list)
> +(define-rtx-node (number-list &options &mode value-list)
>       #f
>       (OPTIONS INTMODE NUMBER . NUMBER) (NA NA NA . NA)
>       MISC
> @@ -1129,7 +1119,7 @@
>  ; Conditional execution.
>  
>  ; FIXME: make syntax node?
> -(drn (if &options &mode cond then . else)
> +(define-rtx-node (if &options &mode cond then . else)
>       #f
>       ;; ??? It would be cleaner if TESTRTX had to have BI mode.
>       (OPTIONS ANYEXPRMODE TESTRTX RTX . RTX) (NA NA ANYINT MATCHEXPR . MATCH3)
> @@ -1142,7 +1132,7 @@
>  ; ??? The syntax here isn't quite right, there must be at least one cond rtx.
>  ; ??? Intermediate expressions (the ones before the last one) needn't have
>  ; the same mode as the result.
> -(drsn (cond &options &mode . cond-code-list)
> +(define-rtx-syntax-node (cond &options &mode . cond-code-list)
>       #f
>        (OPTIONS ANYEXPRMODE . CONDRTX) (NA NA . MATCHEXPR)
>        COND
> @@ -1152,7 +1142,7 @@
>  ; ??? The syntax here isn't quite right, there must be at least one case.
>  ; ??? Intermediate expressions (the ones before the last one) needn't have
>  ; the same mode as the result.
> -(drn (case &options &mode test . case-list)
> +(define-rtx-node (case &options &mode test . case-list)
>       #f
>       (OPTIONS ANYEXPRMODE RTX . CASERTX) (NA NA ANY . MATCHEXPR)
>       COND
> @@ -1166,7 +1156,7 @@
>  ; IGNORE is for consistency with sequence.  ??? Delete some day.
>  ; ??? There's no real need for mode either, but convention requires it.
>  
> -(drsn (parallel &options &mode ignore expr . exprs)
> +(define-rtx-syntax-node (parallel &options &mode ignore expr . exprs)
>       #f
>        (OPTIONS VOIDMODE LOCALS RTX . RTX) (NA NA NA VOID . VOID)
>        SEQUENCE
> @@ -1176,7 +1166,7 @@
>  ; This has to be a syntax node to handle locals properly: they're not defined
>  ; yet and thus pre-evaluating the expressions doesn't work.
>  
> -(drsn (sequence &options &mode locals expr . exprs)
> +(define-rtx-syntax-node (sequence &options &mode locals expr . exprs)
>       #f
>        (OPTIONS VOIDORNUMMODE LOCALS RTX . RTX) (NA NA NA MATCHSEQ . MATCHSEQ)
>        SEQUENCE
> @@ -1186,7 +1176,7 @@
>  ; This has to be a syntax node to handle iter-var properly: it's not defined
>  ; yet and thus pre-evaluating the expressions doesn't work.
>  
> -(drsn (do-count &options &mode iter-var nr-times expr . exprs)
> +(define-rtx-syntax-node (do-count &options &mode iter-var nr-times expr . exprs)
>       #f
>        (OPTIONS VOIDMODE ITERATION RTX RTX . RTX) (NA NA NA INT VOID . VOID)
>        SEQUENCE
> @@ -1198,11 +1188,11 @@
>  ; ??? Maybe closures shouldn't be separate from sequences,
>  ; but I'm less convinced these days.
>  
> -(drsn (closure &options &mode isa-name-list env-stack expr)
> +(define-rtx-syntax-node (closure &options &mode isa-name-list env-stack expr)
>       #f
>        (OPTIONS VOIDORNUMMODE SYMBOLLIST ENVSTACK RTX) (NA NA NA NA MATCHEXPR)
>        MISC
>        #f
>  )
>  \f
> -)) ; End of def-rtx-funcs
> +) ; End of def-rtx-funcs

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 09/14] Remove define-in-define
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (7 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 08/14] Remove let bindings of macros Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 10/14] Hack cos.scm to work with new Guile Tom Tromey
                   ` (6 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

Guile does not like 'define' in certain contexts, such as within the
body of another 'define'.  This replaces some instances of this with
let or let*.
---
 pgmr-tools.scm | 250 +++++++++++++++++++++++++------------------------
 1 file changed, 129 insertions(+), 121 deletions(-)

diff --git a/pgmr-tools.scm b/pgmr-tools.scm
index 367213a..bfd9937 100644
--- a/pgmr-tools.scm
+++ b/pgmr-tools.scm
@@ -35,120 +35,125 @@
 
 (define (pgmr-pretty-print-insn-format insn)
 
-  (define (to-width width n-str)
-    (string-take-with-filler (- width)
-			     n-str
-			     #\0))
+  (let* ((to-width
+	  (lambda (width n-str)
+	    (string-take-with-filler (- width)
+				     n-str
+				     #\0)))
 
-  (define (dump-insn-mask mask insn-length)
-    (string-append "0x" (to-width (quotient insn-length 4)
-				  (number->string mask 16))
-		   ", "
-		   (string-map
-		    (lambda (n)
-		      (string-append " " (to-width 4 (number->string n 2))))
-		    (reverse
-		     (split-bits (make-list (quotient insn-length 4) 4)
-				 mask)))))
+	 (dump-insn-mask
+	  (lambda (mask insn-length)
+	    (string-append "0x" (to-width (quotient insn-length 4)
+					  (number->string mask 16))
+			   ", "
+			   (string-map
+			    (lambda (n)
+			      (string-append " " (to-width 4 (number->string n 2))))
+			    (reverse
+			     (split-bits (make-list (quotient insn-length 4) 4)
+					 mask))))))
 
-  ; Print VALUE with digits not in MASK printed as "X".
-  (define (dump-insn-value value mask insn-length)
-    (string-append "0x" (to-width (quotient insn-length 4)
-				  (number->string value 16))
-		   ", "
-		   (string-map
-		    (lambda (n mask)
-		      (string-append
-		       " "
-		       (list->string
-			(map (lambda (char in-mask?)
-			       (if in-mask? char #\X))
-			     (string->list (to-width 4 (number->string n 2)))
-			     (bits->bools mask 4)))))
-		    (reverse
-		     (split-bits (make-list (quotient insn-length 4) 4)
-				 value))
-		    (reverse
-		     (split-bits (make-list (quotient insn-length 4) 4)
-				 mask)))))
+	 ;; Print VALUE with digits not in MASK printed as "X".
+	 (dump-insn-value
+	  (lambda (value mask insn-length)
+	    (string-append "0x" (to-width (quotient insn-length 4)
+					  (number->string value 16))
+			   ", "
+			   (string-map
+			    (lambda (n mask)
+			      (string-append
+			       " "
+			       (list->string
+				(map (lambda (char in-mask?)
+				       (if in-mask? char #\X))
+				     (string->list (to-width 4 (number->string n 2)))
+				     (bits->bools mask 4)))))
+			    (reverse
+			     (split-bits (make-list (quotient insn-length 4) 4)
+					 value))
+			    (reverse
+			     (split-bits (make-list (quotient insn-length 4) 4)
+					 mask))))))
 
-  (define (dump-ifield f)
-    (string-append " Name: "
-		   (obj:name f)
-		   ", "
-		   "Start: "
-		   (number->string
-		    (+ (bitrange-word-offset (-ifld-bitrange f))
-		       (bitrange-start (-ifld-bitrange f))))
-		   ", "
-		   "Length: "
-		   (number->string (ifld-length f))
-		   "\n"))
+	 (dump-ifield
+	  (lambda (f)
+	    (string-append " Name: "
+			   (obj:name f)
+			   ", "
+			   "Start: "
+			   (number->string
+			    (+ (bitrange-word-offset (-ifld-bitrange f))
+			       (bitrange-start (-ifld-bitrange f))))
+			   ", "
+			   "Length: "
+			   (number->string (ifld-length f))
+			   "\n"))))
 
-  (let* ((iflds (sort-ifield-list (insn-iflds insn)
-				  (not (current-arch-insn-lsb0?))))
-	 (mask (compute-insn-base-mask iflds))
-	 (mask-length (compute-insn-base-mask-length iflds)))
+    (let* ((iflds (sort-ifield-list (insn-iflds insn)
+				    (not (current-arch-insn-lsb0?))))
+	   (mask (compute-insn-base-mask iflds))
+	   (mask-length (compute-insn-base-mask-length iflds)))
 
-    (display
-     (string-append
-      "Instruction: " (obj:name insn)
-      "\n"
-      "Syntax: "
-      (insn-syntax insn)
-      "\n"
-      "Fields:\n"
-      (string-map dump-ifield iflds)
-      "Instruction length (computed from ifield list): "
-      (number->string (apply + (map ifld-length iflds)))
-      "\n"
-      "Mask:  "
-      (dump-insn-mask mask mask-length)
-      "\n"
-      "Value: "
-      (let ((value (apply +
-			  (map (lambda (fld)
-				 (ifld-value fld mask-length
-					     (ifld-get-value fld)))
-			       (find ifld-constant? (ifields-base-ifields (insn-iflds insn)))))))
-	(dump-insn-value value mask mask-length))
-      ; TODO: Print value spaced according to fields.
-      "\n"
-      )))
-)
+      (display
+       (string-append
+	"Instruction: " (obj:name insn)
+	"\n"
+	"Syntax: "
+	(insn-syntax insn)
+	"\n"
+	"Fields:\n"
+	(string-map dump-ifield iflds)
+	"Instruction length (computed from ifield list): "
+	(number->string (apply + (map ifld-length iflds)))
+	"\n"
+	"Mask:  "
+	(dump-insn-mask mask mask-length)
+	"\n"
+	"Value: "
+	(let ((value (apply +
+			    (map (lambda (fld)
+				   (ifld-value fld mask-length
+					       (ifld-get-value fld)))
+				 (find ifld-constant? (ifields-base-ifields (insn-iflds insn)))))))
+	  (dump-insn-value value mask mask-length))
+					; TODO: Print value spaced according to fields.
+	"\n"
+	)))
+    ))
 
 ; Pretty print an instruction's value.
 
 (define (pgmr-pretty-print-insn-value insn value)
-  (define (dump-ifield ifld value name-width)
-    (string-append
-     (string-take name-width (obj:str-name ifld))
-     ": "
-     (number->string value)
-     ", 0x"
-     (number->hex value)
-     "\n"))
+  (let ((dump-ifield
+	 (lambda (ifld value name-width)
+	   (string-append
+	    (string-take name-width (obj:str-name ifld))
+	    ": "
+	    (number->string value)
+	    ", 0x"
+	    (number->hex value)
+	    "\n"))))
 
-  (let ((ifld-values (map (lambda (ifld)
-			    (ifld-extract ifld insn value))
-			  (insn-iflds insn)))
-	(max-name-length (apply max
-				(map string-length
-				     (map obj:name
-					  (insn-iflds insn)))))
-	)
+    (let ((ifld-values (map (lambda (ifld)
+			      (ifld-extract ifld insn value))
+			    (insn-iflds insn)))
+	  (max-name-length (apply max
+				  (map string-length
+				       (map obj:name
+					    (insn-iflds insn)))))
+	  )
 
-    (display
-     (string-append
-      "Instruction: " (obj:name insn)
-      "\n"
-      "Fields:\n"
-      (string-map (lambda (ifld value)
-		    (dump-ifield ifld value max-name-length))
-		  (insn-iflds insn)
-		  ifld-values)
-      )))
-)
+      (display
+       (string-append
+	"Instruction: " (obj:name insn)
+	"\n"
+	"Fields:\n"
+	(string-map (lambda (ifld value)
+		      (dump-ifield ifld value max-name-length))
+		    (insn-iflds insn)
+		    ifld-values)
+	)))
+    ))
 \f
 ; Return the <insn> object matching VALUE.
 ; VALUE is either a single number of size base-insn-bitsize,
@@ -161,23 +166,26 @@
 		       #f) ; don't need to analyze semantics
 
   ; Return a boolean indicating if BASE matches the base part of <insn> INSN.
-  (define (match-base base insn)
-    (let ((mask (compute-insn-base-mask (insn-iflds insn)))
-	  (ivalue (insn-value insn)))
-      ; return (value & mask) == ivalue
-      (= (logand base mask) ivalue)))
+  (let ((match-base
+	 (lambda (base insn)
+	   (let ((mask (compute-insn-base-mask (insn-iflds insn)))
+		 (ivalue (insn-value insn)))
+					; return (value & mask) == ivalue
+	     (= (logand base mask) ivalue))))
 
-  (define (match-rest value insn)
-    #t)
+	(match-rest
+	 (lambda (value insn)
+	   #t)))
 
-  (let ((base (if (list? value) (car value) value)))
-    (let loop ((insns (current-insn-list)))
-      (if (null? insns)
-	  #f
-	  (let ((insn (car insns)))
-	    (if (and (= length (insn-length insn))
-		     (match-base base insn)
-		     (match-rest value insn))
-		insn
-		(loop (cdr insns)))))))
-)
+    (let ((base (if (list? value) (car value) value)))
+      (let loop ((insns (current-insn-list)))
+	(if (null? insns)
+	    #f
+	    (let ((insn (car insns)))
+	      (if (and (= length (insn-length insn))
+		       (match-base base insn)
+		       (match-rest value insn))
+		  insn
+		  (loop (cdr insns)))))))
+    )
+  )
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 10/14] Hack cos.scm to work with new Guile
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (8 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 09/14] Remove define-in-define Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 11/14] Invalid code in rtx-traverse.scm Tom Tromey
                   ` (5 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

cos.scm calls procedure->memoizing-macro, which no longer exists in Guile.

This patch hacks around this by having the member accessors always use
the "slow" path.  In practice, with Guile 3.0, this is still fast
enough on my machine.

Longer term this code should all be removed in favor of GOOPS.
---
 cos.scm | 56 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 28 insertions(+), 28 deletions(-)

diff --git a/cos.scm b/cos.scm
index 1ba4c54..34f1848 100644
--- a/cos.scm
+++ b/cos.scm
@@ -905,16 +905,16 @@
 
 ;; Subroutine of elm-get.
 
-(define (/elm-make-method-getter self elm-name)
-  (/object-check self "elm-get")
-  (let ((index (/class-lookup-element (/object-class-desc self) elm-name)))
-    (if index
-	(procedure->memoizing-macro
-	 (lambda (exp env)
-	   `(lambda (obj)
-	      (/object-elm-get obj ,index))))
-	(/object-error "elm-get" self "element not present: " elm-name)))
-)
+;; (define (/elm-make-method-getter self elm-name)
+;;   (/object-check self "elm-get")
+;;   (let ((index (/class-lookup-element (/object-class-desc self) elm-name)))
+;;     (if index
+;; 	(procedure->memoizing-macro
+;; 	 (lambda (exp env)
+;; 	   `(lambda (obj)
+;; 	      (/object-elm-get obj ,index))))
+;; 	(/object-error "elm-get" self "element not present: " elm-name)))
+;; )
 
 ;; Get an element from an object.
 ;; If OBJ is `self' then the caller is required to be a method and we emit
@@ -929,33 +929,33 @@
 ;; operation with O(1).  Cute, but I'm hoping there's an easier/better way.
 
 (defmacro elm-get (self elm-name)
-  (if (eq? self 'self)
-      `(((/elm-make-method-getter ,self ,elm-name)) ,self)
-      `(elm-xget ,self ,elm-name))
-)
+  ;; (if (eq? self 'self)
+  ;;     `(((/elm-make-method-getter ,self ,elm-name)) ,self)
+  `(elm-xget ,self ,elm-name)
+  )
 
 ;; Subroutine of elm-set!.
 
-(define (/elm-make-method-setter self elm-name)
-  (/object-check self "elm-set!")
-  (let ((index (/class-lookup-element (/object-class-desc self) elm-name)))
-    (if index
-	(procedure->memoizing-macro
-	 (lambda (exp env)
-	   `(lambda (obj new-val)
-	      (/object-elm-set! obj ,index new-val))))
-	(/object-error "elm-set!" self "element not present: " elm-name)))
-)
+;; (define (/elm-make-method-setter self elm-name)
+;;   (/object-check self "elm-set!")
+;;   (let ((index (/class-lookup-element (/object-class-desc self) elm-name)))
+;;     (if index
+;; 	(procedure->memoizing-macro
+;; 	 (lambda (exp env)
+;; 	   `(lambda (obj new-val)
+;; 	      (/object-elm-set! obj ,index new-val))))
+;; 	(/object-error "elm-set!" self "element not present: " elm-name)))
+;; )
 
 ;; Set an element in an object.
 ;; This can only be used by methods.
 ;; See the comments for `elm-get'!
 
 (defmacro elm-set! (self elm-name new-val)
-  (if (eq? self 'self)
-      `(((/elm-make-method-setter ,self ,elm-name)) ,self ,new-val)
-      `(elm-xset! ,self ,elm-name ,new-val))
-)
+  ;; (if (eq? self 'self)
+  ;;     `(((/elm-make-method-setter ,self ,elm-name)) ,self ,new-val)
+  `(elm-xset! ,self ,elm-name ,new-val)
+  )
 
 ;; Get an element from an object.
 ;; This is for invoking from outside a method, and without having to
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 11/14] Invalid code in rtx-traverse.scm
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (9 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 10/14] Hack cos.scm to work with new Guile Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:42   ` Jose E. Marchesi
  2023-08-19 17:42 ` [RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start Tom Tromey
                   ` (4 subsequent siblings)
  15 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

The Guile compiler pointed out a 3-argument call to cons in
rtx-traverse.scm.  Presumably this code is never run, but this patch
replaces it with what I think is the correct form.
---
 rtl-traverse.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/rtl-traverse.scm b/rtl-traverse.scm
index de7911a..6023648 100644
--- a/rtl-traverse.scm
+++ b/rtl-traverse.scm
@@ -1757,7 +1757,7 @@
 	(if (procedure? fn)
 	    ; Don't traverse operands for syntax expressions.
 	    (if (eq? (rtx-style rtx-obj) 'SYNTAX)
-		(apply fn (cons tstate cdr expr))
+		(apply fn (cons tstate (cdr expr)))
 		(let ((operands (/rtx-traverse-operands rtx-obj expr tstate appstuff)))
 		  (apply fn (cons tstate operands))))
 	    fn)
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 11/14] Invalid code in rtx-traverse.scm
  2023-08-19 17:42 ` [RFC 11/14] Invalid code in rtx-traverse.scm Tom Tromey
@ 2023-08-20  8:42   ` Jose E. Marchesi
  0 siblings, 0 replies; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:42 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


> The Guile compiler pointed out a 3-argument call to cons in
> rtx-traverse.scm.  Presumably this code is never run, but this patch
> replaces it with what I think is the correct form.

This LGTM.

The same snippet is commented out in rtx-eval-with-estate:

;		; Don't eval operands for syntax expressions.
;		(if (eq? (rtx-style rtx-obj) 'SYNTAX)
;		    (apply fn (cons estate (cdr expr)))
;		    (let ((operands
;			   (/rtx-eval-operands rtx-obj expr estate)))
;		      (apply fn (cons estate operands))))

And it is (apply fn (cons estate (cdr expr))) there.

> ---
>  rtl-traverse.scm | 2 +-
>  1 file changed, 1 insertion(+), 1 deletion(-)
>
> diff --git a/rtl-traverse.scm b/rtl-traverse.scm
> index de7911a..6023648 100644
> --- a/rtl-traverse.scm
> +++ b/rtl-traverse.scm
> @@ -1757,7 +1757,7 @@
>  	(if (procedure? fn)
>  	    ; Don't traverse operands for syntax expressions.
>  	    (if (eq? (rtx-style rtx-obj) 'SYNTAX)
> -		(apply fn (cons tstate cdr expr))
> +		(apply fn (cons tstate (cdr expr)))
>  		(let ((operands (/rtx-traverse-operands rtx-obj expr tstate appstuff)))
>  		  (apply fn (cons tstate operands))))
>  	    fn)

^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (10 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 11/14] Invalid code in rtx-traverse.scm Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 13/14] Load macros before uses Tom Tromey
                   ` (3 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

cgen-call-with-debugging and cgen-debugging-stack-start are ostensibly
just for Guile, but I don't think they provide much value with more
recent versions of Guile.  This patch removes them.
---
 guile.scm | 63 -----------------------------------------
 read.scm  | 85 ++++++++++++++++++++++++-------------------------------
 2 files changed, 37 insertions(+), 111 deletions(-)

diff --git a/guile.scm b/guile.scm
index 9d7c64c..5899f15 100644
--- a/guile.scm
+++ b/guile.scm
@@ -24,66 +24,3 @@
 ;;; Enabling and disabling debugging features of the host Scheme.
 
 (read-enable 'positions)
-
-;;; Call THUNK, with debugging enabled if FLAG is true, or disabled if
-;;; FLAG is false.
-;;;
-;;; (On systems other than Guile, this needn't actually do anything at
-;;; all, beyond calling THUNK, so long as your backtraces are still
-;;; helpful.  In Guile, the debugging evaluator is slower, so we don't
-;;; want to use it unless the user asked for it.)
-(define (cgen-call-with-debugging flag thunk)
-  (if (memq 'debug-extensions *features*)
-      ((if flag debug-enable debug-disable) 'debug))
-
-  ;; Now, make that debugging / no-debugging setting actually take
-  ;; effect.
-  ;;
-  ;; Guile has two separate evaluators, one that does the extra
-  ;; bookkeeping for backtraces, and one which doesn't, but runs
-  ;; faster.  However, the evaluation process (in either evaluator)
-  ;; ordinarily never consults the variable that says which evaluator
-  ;; to use: whatever evaluator was running just keeps rolling along.
-  ;; There are certain primitives, like some of the eval variants,
-  ;; that do actually check.  start-stack is one such primitive, but
-  ;; we don't want to shadow whatever other stack id is there, so we
-  ;; do all the real work in the ID argument, and do nothing in the
-  ;; EXP argument.  What a kludge.
-  (start-stack (begin (thunk) #t) #f))
-
-
-;;; Apply PROC to ARGS, marking that application as the bottom of the
-;;; stack for error backtraces.
-;;;
-;;; (On systems other than Guile, this doesn't really need to do
-;;; anything other than apply PROC to ARGS, as long as something
-;;; ensures that backtraces will work right.)
-(define (cgen-debugging-stack-start proc args)
-
-  ;; Naming this procedure, rather than using an anonymous lambda,
-  ;; allows us to pass less fragile cut info to save-stack.
-  (define (handler . args)
-		;;(display args (current-error-port))
-		;;(newline (current-error-port))
-		;; display-error takes 6 arguments.
-		;; If `quit' is called from elsewhere, it may not have 6
-		;; arguments.  Not sure how best to handle this.
-		(if (= (length args) 5)
-		    (begin
-		      (apply display-error #f (current-error-port) (cdr args))
-		      ;; Grab a copy of the current stack,
-		      (save-stack handler 0)
-		      (backtrace)))
-		(quit 1))
-
-  ;; Apply proc to args, and if any uncaught exception is thrown, call
-  ;; handler WITHOUT UNWINDING THE STACK (that's the 'lazy' part).  We
-  ;; need the stack left alone so we can produce a backtrace.
-  (lazy-catch #t
-	      (lambda ()
-		;; I have no idea why the 'load-stack' stack mark is
-		;; not still present on the stack; we're still loading
-		;; cgen-APP.scm, aren't we?  But stack-id returns #f
-		;; in handler if we don't do a start-stack here.
-		(start-stack proc (apply proc args)))
-	      handler))
diff --git a/read.scm b/read.scm
index ee3f488..8856da0 100644
--- a/read.scm
+++ b/read.scm
@@ -1252,7 +1252,7 @@ Define a preprocessor-style macro.
 ;; OPTION-HANDLER is either (lambda () ...) or (lambda (arg) ...) and
 ;; processes the option.
 
-(define /cgen
+(define cgen
   (lambda args
     (let ((app-name "unknown")
 	  (opt-spec nil)
@@ -1380,54 +1380,43 @@ Define a preprocessor-style macro.
 
 	;; All arguments have been parsed.
 
-	(cgen-call-with-debugging
-	 debugging
-	 (lambda ()
-
-	   (if (not arch-file)
-	       (error "-a option missing, no architecture specified"))
-
-	   (if repl?
-	       (debug-repl nil))
-
-	   (cpu-load arch-file
-		     keep-mach keep-isa flags
-		     trace-options diagnostic-options
-		     app-init! app-finish! app-analyze!)
-
-	   ;; Start another repl loop if -d.
-	   ;; Awkward.  Both places are useful, though this is more useful.
-	   (if repl?
-	       (debug-repl nil))
-
-	   ;; Done with processing the arguments.  Application arguments
-	   ;; are processed in two passes.  This is because the app may
-	   ;; have arguments that specify things that affect file
-	   ;; generation (e.g. to specify another input file) and we
-	   ;; don't want to require an ordering of the options.
-	   (for-each (lambda (opt-arg)
-		       (let ((opt (car opt-arg))
-			     (arg (cdr opt-arg)))
-			 (if (cadr opt)
-			     ((opt-get-first-pass opt) arg)
-			     ((opt-get-first-pass opt)))))
-		     (reverse app-args))
-
-	   (for-each (lambda (opt-arg)
-		       (let ((opt (car opt-arg))
-			     (arg (cdr opt-arg)))
-			 (if (cadr opt)
-			     ((opt-get-second-pass opt) arg)
-			     ((opt-get-second-pass opt)))))
-		     (reverse app-args))))
+	(if (not arch-file)
+	    (error "-a option missing, no architecture specified"))
+
+	(if repl?
+	    (debug-repl nil))
+
+	(cpu-load arch-file
+		  keep-mach keep-isa flags
+		  trace-options diagnostic-options
+		  app-init! app-finish! app-analyze!)
+
+	;; Start another repl loop if -d.
+	;; Awkward.  Both places are useful, though this is more useful.
+	(if repl?
+	    (debug-repl nil))
+
+	;; Done with processing the arguments.  Application arguments
+	;; are processed in two passes.  This is because the app may
+	;; have arguments that specify things that affect file
+	;; generation (e.g. to specify another input file) and we
+	;; don't want to require an ordering of the options.
+	(for-each (lambda (opt-arg)
+		    (let ((opt (car opt-arg))
+			  (arg (cdr opt-arg)))
+		      (if (cadr opt)
+			  ((opt-get-first-pass opt) arg)
+			  ((opt-get-first-pass opt)))))
+		  (reverse app-args))
+
+	(for-each (lambda (opt-arg)
+		    (let ((opt (car opt-arg))
+			  (arg (cdr opt-arg)))
+		      (if (cadr opt)
+			  ((opt-get-second-pass opt) arg)
+			  ((opt-get-second-pass opt)))))
+		  (reverse app-args))
 	)
       )
     #f) ;; end of lambda
 )
-
-;; Main entry point called by application file generators.
-
-(define cgen
-  (lambda args
-    (cgen-debugging-stack-start /cgen args))
-)
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 13/14] Load macros before uses
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (11 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-19 17:42 ` [RFC 14/14] Remove pprint.scm and cos-pprint.scm Tom Tromey
                   ` (2 subsequent siblings)
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

This hoists the various calls to 'load' to an earlier spot in
read.scm.  Without this patch, the call to logit
/cmd-define-rtl-version would not be expanded, leading to a mysterious
error about trying to 'apply' a syntax transformer.  That is, this is
another situation where the old code assumed that macro expansion
could be interleaved with evaluation.
---
 read.scm | 72 ++++++++++++++++++++++++++++----------------------------
 1 file changed, 36 insertions(+), 36 deletions(-)

diff --git a/read.scm b/read.scm
index 8856da0..e6c2bde 100644
--- a/read.scm
+++ b/read.scm
@@ -62,6 +62,42 @@
 \f
 ;; Variables representing misc. global constants.
 
+;; Load the base cgen files.
+
+(load "pmacros")
+(load "cos")
+(load "slib/logical")
+(load "slib/sort")
+;; Used to pretty-print debugging messages.
+(load "slib/pp")
+;; Used by pretty-print.
+(load "slib/random")
+(load "slib/genwrite")
+(load "utils")
+(load "utils-cgen")
+(load "attr")
+(load "enum")
+(load "mach")
+(load "model")
+(load "types")
+(load "mode")
+(load "ifield")
+(load "iformat")
+(load "hardware")
+(load "operand")
+(load "insn")
+(load "minsn")
+(load "decode")
+(load "rtl")
+(load "rtl-traverse")
+(load "rtl-xform")
+(load "rtx-funcs")
+(load "rtl-c")
+(load "semantics")
+(load "sem-frags")
+(load "utils-gen")
+(load "pgmr-tools")
+\f
 ;; A list of three numbers designating the cgen version: major minor fixlevel.
 ;; The "50" is a generic indicator that we're between 1.1 and 1.2.
 (define /CGEN-VERSION '(1 1 50))
@@ -122,42 +158,6 @@
 ;; This is mostly for descriptive purposes.
 (define APPLICATION 'UNKNOWN)
 \f
-;; Load the base cgen files.
-
-(load "pmacros")
-(load "cos")
-(load "slib/logical")
-(load "slib/sort")
-;; Used to pretty-print debugging messages.
-(load "slib/pp")
-;; Used by pretty-print.
-(load "slib/random")
-(load "slib/genwrite")
-(load "utils")
-(load "utils-cgen")
-(load "attr")
-(load "enum")
-(load "mach")
-(load "model")
-(load "types")
-(load "mode")
-(load "ifield")
-(load "iformat")
-(load "hardware")
-(load "operand")
-(load "insn")
-(load "minsn")
-(load "decode")
-(load "rtl")
-(load "rtl-traverse")
-(load "rtl-xform")
-(load "rtx-funcs")
-(load "rtl-c")
-(load "semantics")
-(load "sem-frags")
-(load "utils-gen")
-(load "pgmr-tools")
-\f
 ;; Reader state data.
 ;; All state regarding the reading of a .cpu file is kept in an object of
 ;; class <reader>.
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* [RFC 14/14] Remove pprint.scm and cos-pprint.scm
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (12 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 13/14] Load macros before uses Tom Tromey
@ 2023-08-19 17:42 ` Tom Tromey
  2023-08-20  8:03 ` [RFC 00/14] Port to Guile 3.0 Jose E. Marchesi
  2023-08-21 13:06 ` Julian Brown
  15 siblings, 0 replies; 28+ messages in thread
From: Tom Tromey @ 2023-08-19 17:42 UTC (permalink / raw)
  To: cgen; +Cc: Tom Tromey

pprint.scm and cos-pprint.scm are for debugging.  They aren't used
in-tree and Guile provides a pretty-printer now.
---
 cos-pprint.scm |  26 ------
 pprint.scm     | 212 -------------------------------------------------
 2 files changed, 238 deletions(-)
 delete mode 100644 cos-pprint.scm
 delete mode 100644 pprint.scm

diff --git a/cos-pprint.scm b/cos-pprint.scm
deleted file mode 100644
index 0bf55c6..0000000
--- a/cos-pprint.scm
+++ /dev/null
@@ -1,26 +0,0 @@
-;;;; cos-pprint.scm --- pretty-print definitions for COS
-;;;; Copyright (C) 2005, 2009 Red Hat, Inc.
-;;;; This file is part of CGEN.
-;;;; See file COPYING.CGEN for details.
-
-;;; To use this with pprint.scm:
-;;;
-;;;   (load "pprint.scm")
-;;;   (load "cos-pprint.scm")
-;;;
-;;; You must load this file second, so it can redefine the ELIDE? and
-;;; ELIDED-NAME hooks.
-;;;
-;;; See the documentation in pprint.scm for details.
-
-(define (elide? obj)
-  (or (object? obj) (class? obj)))
-
-(define (elided-name obj)
-  (cond ((class? obj) `(class ,(class-name obj)))
-	((object? obj)
-	 `(object ,(class-name (object-class obj))
-		  ,@(if (method-present? obj 'get-name)
-			(list (send obj 'get-name))
-			'())))
-	(else (error "unexpected elided object"))))
diff --git a/pprint.scm b/pprint.scm
deleted file mode 100644
index 63d78bf..0000000
--- a/pprint.scm
+++ /dev/null
@@ -1,212 +0,0 @@
-;;;; pprint.scm --- pretty-printing objects for CGEN
-;;;; Copyright (C) 2005, 2009 Red Hat, Inc.
-;;;; This file is part of CGEN.
-;;;; See file COPYING.CGEN for details.
-
-;;; This file defines a printing function PPRINT, and some hooks to
-;;; let you print certain kind of objects in a summary way, and get at
-;;; their full values later.
-
-;;; PPRINT is a printer for Scheme objects that prints lists or
-;;; vectors that contain shared structure or cycles and prints them in
-;;; a finite, legible way.
-;;;
-;;; Ordinary values print in the usual way:
-;;;
-;;;   guile> (pprint '(1 #(2 3) 4))
-;;;   (1 #(2 3) 4)
-;;;
-;;; Values can share structure:
-;;; 
-;;;   guile> (let* ((c (list 1 2))
-;;;                 (d (list c c)))
-;;;            (write d)
-;;;            (newline))
-;;;   ((1 2) (1 2))
-;;;
-;;; In that list, the two instances of (1 2) are actually the same object;
-;;; the top-level list refers to the same object twice.
-;;;
-;;; Printing that structure with PPRINT shows the sharing:
-;;; 
-;;;   guile> (let* ((c (list 1 2))
-;;;                 (d (list c c)))
-;;;            (pprint d))
-;;;   (#0=(1 2) #0#)
-;;;
-;;; Here the "#0=" before the list (1 2) labels it with the number
-;;; zero.  Then, the "#0#" as the second element of the top-level list
-;;; indicates that the object appears here, too, referring to it by
-;;; its label.
-;;;
-;;; If you have several objects that appear more than once, they each
-;;; get a separate label:
-;;;
-;;;   guile> (let* ((a (list 1 2))
-;;;                 (b (list 3 4))
-;;;                 (c (list a b a b)))
-;;;            (pprint c))
-;;;   (#0=(1 2) #1=(3 4) #0# #1#)
-;;;
-;;; Cyclic values just share structure with themselves:
-;;;
-;;;   guile> (let* ((a (list 1 #f)))
-;;;            (set-cdr! a a)
-;;;            (pprint a))
-;;;   #0=(1 . #0#)
-;;;
-;;;
-;;; PPRINT also consults the function ELIDE? and ELIDED-NAME to see
-;;; whether it should print a value in a summary form.  You can
-;;; re-define those functions to customize PPRINT's behavior;
-;;; cos-pprint.scm defines them to handle COS objects and classes
-;;; nicely.
-;;;
-;;; (ELIDE? OBJ) should return true if OBJ should be elided.
-;;; (ELIDED-NAME OBJ) should return a (non-cyclic!) object to be used
-;;; as OBJ's abbreviated form.
-;;;
-;;; PPRINT prints an elided object as a list ($ N NAME), where NAME is
-;;; the value returned by ELIDED-NAME to stand for the object, and N
-;;; is a number; each elided object gets its own number.  You can refer
-;;; to the elided object number N as ($ N).
-;;;
-;;; For example, if you've loaded CGEN, pprint.scm, and cos-pprint.scm
-;;; (you must load cos-pprint.scm *after* loading pprint.scm), you can
-;;; print a list containing the <insn> and <ident> classes:
-;;;
-;;;   guile> (pprint (list <insn> <ident>))
-;;;   (($ 1 (class <insn>)) ($ 2 (class <ident>)))
-;;;   guile> (class-name ($ 1))
-;;;   <insn>
-;;;   guile> (class-name ($ 2))
-;;;   <ident>
-;;;
-;;; As a special case, PPRINT never elides the object that was passed
-;;; to it directly.  So you can look inside an elided object by doing
-;;; just that:
-;;;
-;;;   guile> (pprint ($ 2))
-;;;   #0=#("class" <ident> () ((name #:unbound #f . 0) ...
-;;;
-
-
-;;; A list of elided objects, larger numbers first, and the number of
-;;; the first element.
-(define elide-table '())
-(define elide-table-last -1)
-
-;;; Add OBJ to the elided object list, and return its number.
-(define (add-elided-object obj)
-  (set! elide-table (cons obj elide-table))
-  (set! elide-table-last (+ elide-table-last 1))
-  elide-table-last)
-
-;;; Referencing elided objects.
-(define ($ n)
-  (if (<= 0 n elide-table-last)
-      (list-ref elide-table (- elide-table-last n))
-      "no such object"))
-
-;;; A default predicate for elision.
-(define (elide? obj) #f)
-
-;;; If (elide? OBJ) is true, return some sort of abbreviated list
-;;; structure that might be helpful to the user in identifying the
-;;; elided object.
-;;; A default definition.
-(define (elided-name obj) "")
-
-;;; This is a pretty-printer that handles cyclic and shared structure.
-(define (pprint original-obj)
-
-  ;; Return true if OBJ should be elided in this call to pprint.
-  ;; (We never elide the object we were passed itself.)
-  (define (elide-this-call? obj)
-    (and (not (eq? obj original-obj))
-	 (elide? obj)))
-
-  ;; First, traverse OBJ and build a hash table mapping objects
-  ;; referenced more than once to #t, and everything else to #f.
-  ;; (Only include entries for objects that might be interior nodes:
-  ;; pairs and vectors.)
-  (let ((shared
-	 ;; Guile's stupid hash tables don't resize the table; the
-	 ;; chains just get longer and longer.  So we need a big value here.
-	 (let ((seen   (make-hash-table 65521))
-	       (shared (make-hash-table 4093)))
-	   (define (walk! obj)
-	     (if (or (pair? obj) (vector? obj))
-		 (if (hashq-ref seen obj)
-		     (hashq-set! shared obj #t)
-		     (begin
-		       (hashq-set! seen obj #t)
-		       (cond ((elide-this-call? obj))
-			     ((pair? obj) (begin (walk! (car obj))
-						 (walk! (cdr obj))))
-			     ((vector? obj) (do ((i 0 (+ i 1)))
-						 ((>= i (vector-length obj)))
-					       (walk! (vector-ref obj i))))
-			     (else (error "unhandled interior type")))))))
-	   (walk! original-obj)
-	   shared)))
-
-    ;; A counter for shared structure labels.
-    (define fresh-shared-label
-      (let ((n 0))
-	(lambda ()
-	  (let ((l n))
-	    (set! n (+ n 1))
-	    l))))
-
-    (define (print obj)
-      (print-with-label obj (hashq-ref shared obj)))
-
-    ;; Print an object OBJ, which SHARED maps to L.
-    ;; L is always (hashq-ref shared obj), but we have that value handy
-    ;; at times, so this entry point lets us avoid looking it up again.
-    (define (print-with-label obj label)
-      (if (number? label)
-	  ;; If we've already visited this object, just print a
-	  ;; reference to its label.
-	  (map display `("#" ,label "#"))
-	  (begin
-	    ;; If it needs a label, attach one now.
-	    (if (eqv? label #t) (let ((label (fresh-shared-label)))
-				  (hashq-set! shared obj label)
-				  (map display `("#" ,label "="))))
-	    ;; Print the object.
-	    (cond ((elide-this-call? obj)
-		   (write (list '$ (add-elided-object obj) (elided-name obj))))
-		  ((pair? obj) (begin (display "(")
-				      (print-tail obj)))
-		  ((vector? obj) (begin (display "#(")
-					(do ((i 0 (+ i 1)))
-					    ((>= i (vector-length obj)))
-					  (print (vector-ref obj i))
-					  (if (< (+ i 1) (vector-length obj))
-					      (display " ")))
-					(display ")")))
-		  (else (write obj))))))
-
-    ;; Print a pair P as if it were the tail of a list; assume the
-    ;; opening paren and any previous elements have been printed.
-    (define (print-tail obj)
-      (print (car obj))
-      (force-output)
-      (let ((tail (cdr obj)))
-	(if (null? tail)
-	    (display ")")
-	    ;; We use the dotted pair syntax if the cdr isn't a pair, but
-	    ;; also if it needs to be labeled.
-	    (let ((tail-label (hashq-ref shared tail)))
-	      (if (or (not (pair? tail)) tail-label)
-		  (begin (display " . ")
-			 (print-with-label tail tail-label)
-			 (display ")"))
-		  (begin (display " ")
-			 (print-tail tail)))))))
-
-    (print original-obj)
-    (newline)))
-
-- 
2.41.0


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 00/14] Port to Guile 3.0
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (13 preceding siblings ...)
  2023-08-19 17:42 ` [RFC 14/14] Remove pprint.scm and cos-pprint.scm Tom Tromey
@ 2023-08-20  8:03 ` Jose E. Marchesi
  2023-08-20 17:26   ` Frank Ch. Eigler
  2023-08-21 13:06 ` Julian Brown
  15 siblings, 1 reply; 28+ messages in thread
From: Jose E. Marchesi @ 2023-08-20  8:03 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen


Hi Tom.

> I tried re-running cgen this week and was surprised to find it didn't
> work with any version of Guile that I had available.  Apparently it
> works with the long-since-obsolete Guile 1.8, and nothing newer.
>
> This series is my attempt at a port, with random other cleanups mixed
> in.

Thank you so much for doing this.  It is a very welcome change.  It
sucks to install guile 1.8 locally in order to use CGEN.

> Note that Guile 2.x also doesn't really seem to work -- it was very
> slow and never completed.  I got impatient, so I'm not sure if it
> would have eventually, or if there is some bug.
>
> I didn't try Guile 1.8 but I would assume it no longer works after
> this series.

I don't think that is a problem.

Guile 3.0 was released more than three years ago, it is available in
Fedora 35 and later, FreeBSD, OpenBSD, Guix, NixPkg stable, Mageia, SUSE
Tumbleweed, Parabola, Slackware current, Ubuntu 20 or later, Debian
stable.

> The Guile compiler cannot be used due to the loading approach taken in
> cgen.  This can be fixed but it is a somewhat larger effort, either
> involving real modules or the use of the slib require/provide system.
>
> Another possible change would be removing cos.scm in favor of Guile's
> built-in object system.  Patch #10 is basically a hack to work around
> a problem with the custom object system.  It can probably be fixed in
> a better way, but I didn't bother.
>
> I rebuilt all the cgen code in binutils-gdb with this patch after
> Alan's recent regeneration, and verified there are no changes.
>
> Tom

^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 00/14] Port to Guile 3.0
  2023-08-20  8:03 ` [RFC 00/14] Port to Guile 3.0 Jose E. Marchesi
@ 2023-08-20 17:26   ` Frank Ch. Eigler
  2023-08-20 19:52     ` Tom Tromey
  0 siblings, 1 reply; 28+ messages in thread
From: Frank Ch. Eigler @ 2023-08-20 17:26 UTC (permalink / raw)
  To: Tom Tromey, cgen, Jose E. Marchesi

Hi -

> > This series is my attempt at a port, with random other cleanups mixed
> > in.
> 
> Thank you so much for doing this.  It is a very welcome change.  It
> sucks to install guile 1.8 locally in order to use CGEN.

Ditto.  Much thanks.

- FChE


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 00/14] Port to Guile 3.0
  2023-08-20 17:26   ` Frank Ch. Eigler
@ 2023-08-20 19:52     ` Tom Tromey
  2023-08-21  1:38       ` Frank Ch. Eigler
  0 siblings, 1 reply; 28+ messages in thread
From: Tom Tromey @ 2023-08-20 19:52 UTC (permalink / raw)
  To: Frank Ch. Eigler; +Cc: Tom Tromey, cgen, Jose E. Marchesi

>> Thank you so much for doing this.  It is a very welcome change.  It
>> sucks to install guile 1.8 locally in order to use CGEN.

Frank> Ditto.  Much thanks.

I forgot to note -- I've only touched the files used by the binutils-gdb
repository.  So, for instance, I didn't update any of the sid code.

Tom

^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 00/14] Port to Guile 3.0
  2023-08-20 19:52     ` Tom Tromey
@ 2023-08-21  1:38       ` Frank Ch. Eigler
  0 siblings, 0 replies; 28+ messages in thread
From: Frank Ch. Eigler @ 2023-08-21  1:38 UTC (permalink / raw)
  To: Tom Tromey; +Cc: cgen, Jose E. Marchesi

Hi -

> >> Thank you so much for doing this.  It is a very welcome change.  It
> >> sucks to install guile 1.8 locally in order to use CGEN.
> 
> Frank> Ditto.  Much thanks.
> 
> I forgot to note -- I've only touched the files used by the binutils-gdb
> repository.  So, for instance, I didn't update any of the sid code.

No problem.  I'm all fine with your changes (though barely qualified
to judge, with cgen/scheme swapped out to tertiary storage).

- FChE


^ permalink raw reply	[flat|nested] 28+ messages in thread

* Re: [RFC 00/14] Port to Guile 3.0
  2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
                   ` (14 preceding siblings ...)
  2023-08-20  8:03 ` [RFC 00/14] Port to Guile 3.0 Jose E. Marchesi
@ 2023-08-21 13:06 ` Julian Brown
  15 siblings, 0 replies; 28+ messages in thread
From: Julian Brown @ 2023-08-21 13:06 UTC (permalink / raw)
  To: cgen

On Sat, 19 Aug 2023 11:41:59 -0600
Tom Tromey <tom@tromey.com> wrote:

> I tried re-running cgen this week and was surprised to find it didn't
> work with any version of Guile that I had available.  Apparently it
> works with the long-since-obsolete Guile 1.8, and nothing newer.
> 
> This series is my attempt at a port, with random other cleanups mixed
> in.

Thanks for doing this! I'd attempted to do an update myself (in the
context of a pet project, not speaking for my employer, etc. etc. --
https://github.com/itszor/vc4-toolchain/issues/11) though I never
managed to finish it.

Julian



^ permalink raw reply	[flat|nested] 28+ messages in thread

end of thread, other threads:[~2023-08-22 16:52 UTC | newest]

Thread overview: 28+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-08-19 17:41 [RFC 00/14] Port to Guile 3.0 Tom Tromey
2023-08-19 17:42 ` [RFC 01/14] Add a .gitignore Tom Tromey
2023-08-20  8:04   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 02/14] Remove some 'fastcall' code Tom Tromey
2023-08-20  8:13   ` Jose E. Marchesi
2023-08-22 16:52     ` Tom Tromey
2023-08-19 17:42 ` [RFC 03/14] Remove bound-symbol? Tom Tromey
2023-08-20  8:14   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 04/14] Remove =? and >=? aliases Tom Tromey
2023-08-20  8:15   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 05/14] Fix bug in insn.scm Tom Tromey
2023-08-20  8:15   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 06/14] Remove support for old versions of Guile Tom Tromey
2023-08-19 17:42 ` [RFC 07/14] Use define-macro in rtl.scm Tom Tromey
2023-08-19 17:42 ` [RFC 08/14] Remove let bindings of macros Tom Tromey
2023-08-20  8:33   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 09/14] Remove define-in-define Tom Tromey
2023-08-19 17:42 ` [RFC 10/14] Hack cos.scm to work with new Guile Tom Tromey
2023-08-19 17:42 ` [RFC 11/14] Invalid code in rtx-traverse.scm Tom Tromey
2023-08-20  8:42   ` Jose E. Marchesi
2023-08-19 17:42 ` [RFC 12/14] Nuke cgen-call-with-debugging and cgen-debugging-stack-start Tom Tromey
2023-08-19 17:42 ` [RFC 13/14] Load macros before uses Tom Tromey
2023-08-19 17:42 ` [RFC 14/14] Remove pprint.scm and cos-pprint.scm Tom Tromey
2023-08-20  8:03 ` [RFC 00/14] Port to Guile 3.0 Jose E. Marchesi
2023-08-20 17:26   ` Frank Ch. Eigler
2023-08-20 19:52     ` Tom Tromey
2023-08-21  1:38       ` Frank Ch. Eigler
2023-08-21 13:06 ` Julian Brown

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).