From: "Jose E. Marchesi" <jemarch@gnu.org>
To: Tom Tromey <tom@tromey.com>
Cc: cgen@sourceware.org
Subject: Re: [RFC 02/14] Remove some 'fastcall' code
Date: Sun, 20 Aug 2023 10:13:35 +0200 [thread overview]
Message-ID: <874jkurv0w.fsf@gnu.org> (raw)
In-Reply-To: <20230819174900.866436-3-tom@tromey.com> (Tom Tromey's message of "Sat, 19 Aug 2023 11:42:01 -0600")
> 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))
next prev parent reply other threads:[~2023-08-20 8:13 UTC|newest]
Thread overview: 28+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=874jkurv0w.fsf@gnu.org \
--to=jemarch@gnu.org \
--cc=cgen@sourceware.org \
--cc=tom@tromey.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).