[RFC 02/14] Remove some 'fastcall' code

Tom Tromey tom@tromey.com
Sat Aug 19 17:42:01 GMT 2023


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



More information about the Cgen mailing list