From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from omta37.uswest2.a.cloudfilter.net (omta37.uswest2.a.cloudfilter.net [35.89.44.36]) by sourceware.org (Postfix) with ESMTPS id 45FB13858410 for ; Sat, 19 Aug 2023 18:40:58 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 45FB13858410 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=tromey.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=tromey.com Received: from eig-obgw-5007a.ext.cloudfilter.net ([10.0.29.141]) by cmsmtp with ESMTP id XGfoqBtfyQFHRXQsbqWYpv; Sat, 19 Aug 2023 18:40:57 +0000 Received: from box5379.bluehost.com ([162.241.216.53]) by cmsmtp with ESMTPS id XQsaqHUHd6rKVXQsaqxYYO; Sat, 19 Aug 2023 18:40:56 +0000 X-Authority-Analysis: v=2.4 cv=HYcH8wI8 c=1 sm=1 tr=0 ts=64e10cb8 a=ApxJNpeYhEAb1aAlGBBbmA==:117 a=ApxJNpeYhEAb1aAlGBBbmA==:17 a=OWjo9vPv0XrRhIrVQ50Ab3nP57M=:19 a=dLZJa+xiwSxG16/P+YVxDGlgEgI=:19 a=UttIx32zK-AA:10 a=Qbun_eYptAEA:10 a=lyEDzmiRPtfbWA9J1qwA:9 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=tromey.com; s=default; h=Content-Transfer-Encoding:MIME-Version:References:In-Reply-To: Message-ID:Date:Subject:Cc:To:From:Sender:Reply-To:Content-Type:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=cfkYLw/bRtpW9mgEGb501jy4rJhTqphU6MDV9fBkkdI=; b=qpQARhL2Q2tp7Gg0JRd11iM8Lr bup2QBJ9eIWCOSPNhRbT4ChxJWOOKfontH7jPQ/LoKSZDWrk9OD+Vrltlzw97xSPk4xtHWcbbonXH hZ4SSD01R3AatzcydTdvOB0N2; Received: from 75-166-142-177.hlrn.qwest.net ([75.166.142.177]:36658 helo=localhost.localdomain) by box5379.bluehost.com with esmtpsa (TLS1.2) tls TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 (Exim 4.96) (envelope-from ) id 1qXQ4W-003yFg-2Q; Sat, 19 Aug 2023 11:49:12 -0600 From: Tom Tromey To: cgen@sourceware.org Cc: Tom Tromey Subject: [RFC 09/14] Remove define-in-define Date: Sat, 19 Aug 2023 11:42:08 -0600 Message-ID: <20230819174900.866436-10-tom@tromey.com> X-Mailer: git-send-email 2.41.0 In-Reply-To: <20230819174900.866436-1-tom@tromey.com> References: <20230819174900.866436-1-tom@tromey.com> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - box5379.bluehost.com X-AntiAbuse: Original Domain - sourceware.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - tromey.com X-BWhitelist: no X-Source-IP: 75.166.142.177 X-Source-L: No X-Exim-ID: 1qXQ4W-003yFg-2Q X-Source: X-Source-Args: X-Source-Dir: X-Source-Sender: 75-166-142-177.hlrn.qwest.net (localhost.localdomain) [75.166.142.177]:36658 X-Source-Auth: tom+tromey.com X-Email-Count: 1 X-Org: HG=bhshared;ORG=bluehost; X-Source-Cap: ZWx5bnJvYmk7ZWx5bnJvYmk7Ym94NTM3OS5ibHVlaG9zdC5jb20= X-Local-Domain: yes X-CMAE-Envelope: MS4xfGLXuR7lRwN6C0o+c61zaNt7+JMMhTGjA70ZTeaLj+Fbtlbxse6Gara4OPEBae1rRBlsr7rwe99m3hmCqtZVnWIavIoahGuNY3ml+NFzSY3uRJmxxEtc sw6pEXioMYRZN6ZxICbgWg8zL+Ft1d+gpt6Sd0jUdJsxhLyMusU/SdMKvziBC5xm2xaT4HgNsa4LTA== X-Spam-Status: No, score=-3024.9 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,GIT_PATCH_0,JMQ_SPF_NEUTRAL,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: 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) + ))) + )) ; Return the 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. - (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