summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-01 21:57:46 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-01 22:02:19 +0100
commit11dea3c363eb019b4c3694c3321dbf676e6aa039 (patch)
treed96f576d83344dfadd56c8f366baee6da0285c78
parent793fb46a1e69fa2156805e4a97b340cf62e096a6 (diff)
downloadguile-11dea3c363eb019b4c3694c3321dbf676e6aa039.tar.gz
disassembler: Show intrinsic name for 'call-' instructions.
* module/system/vm/disassembler.scm (code-annotation)[intrinsic-name]: New procedure. Add clauses for intrinsics. * NEWS: Update.
-rw-r--r--NEWS5
-rw-r--r--module/system/vm/disassembler.scm47
2 files changed, 51 insertions, 1 deletions
diff --git a/NEWS b/NEWS
index 644e8bbab..07011c3c6 100644
--- a/NEWS
+++ b/NEWS
@@ -48,6 +48,11 @@ IPv6 support; they can be used with `bind'.
Likewise, the `IPPROTO_IPV6' and `IPV6_V6ONLY' constants are defined,
for use with `setsockopt'.
+** Disassembler now shows intrinsic names
+
+Disassembler output now includes the name of intrinsics next to each
+`call-' instruction (info "(guile) Intrinsic Call Instructions").
+
* Bug fixes
** Type sizes are correctly determined when cross-compiling
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index cc055491d..2c9755ab9 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -1,6 +1,6 @@
;;; Guile bytecode disassembler
-;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2020 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009-2010, 2012-2015, 2017-2020, 2022 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -229,6 +229,10 @@ address of that offset."
(pointer->scm
(dereference-pointer (make-pointer addr)))))
+ (define (intrinsic-name index)
+ (and=> (intrinsic-index->name index)
+ (compose list symbol->string)))
+
(match code
(((or 'j 'je 'jl 'jge 'jne 'jnl 'jnge) target)
(list "-> ~A" (vector-ref labels (- (+ offset target) start))))
@@ -284,6 +288,47 @@ address of that offset."
"anonymous procedure")))
(push-addr! addr name)
(list "~A at #x~X" name addr)))
+
+ ;; intrinsics
+ (('call-thread index)
+ (intrinsic-name index))
+ (('call-thread-scm _ index)
+ (intrinsic-name index))
+ (('call-thread-scm-scm _ _ index)
+ (intrinsic-name index))
+ (('call-scm-sz-u32 _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-thread _ index)
+ (intrinsic-name index))
+ (('call-scm<-u64 _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-s64 _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scm _ _ index)
+ (intrinsic-name index))
+ (('call-u64<-scm _ _ index)
+ (intrinsic-name index))
+ (('call-s64<-scm _ _ index)
+ (intrinsic-name index))
+ (('call-f64<-scm _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scm-scm _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scm-uim _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scm-u64 _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm-scm _ _ index)
+ (intrinsic-name index))
+ (('call-scm-scm-scm _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm-uimm-scm _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scm-uimm _ _ _ index)
+ (intrinsic-name index))
+ (('call-scm<-scmn-scmn _ _ _ index)
+ (intrinsic-name index))
+
(('make-non-immediate dst target)
(let ((val (reference-scm target)))
(when (program? val)