mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

disassembler: Show intrinsic name for 'call-' instructions.

Browse source 
* module/system/vm/disassembler.scm (code-annotation)[intrinsic-name]:
New procedure.
Add clauses for intrinsics.
* NEWS: Update.
This commit is contained in:
Ludovic Courtès 2022-11-01 21:57:46 +01:00
parent 793fb46a1e
commit 11dea3c363
2 changed files with 51 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

5
NEWS
View file

@ -48,6 +48,11 @@ IPv6 support; they can be used with `bind'.
Likewise, the `IPPROTO_IPV6' and `IPV6_V6ONLY' constants are defined, Likewise, the `IPPROTO_IPV6' and `IPV6_V6ONLY' constants are defined,
for use with `setsockopt'. 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 * Bug fixes
** Type sizes are correctly determined when cross-compiling ** Type sizes are correctly determined when cross-compiling

47
module/system/vm/disassembler.scm
View file

@ -1,6 +1,6 @@
;;; Guile bytecode disassembler ;;; 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 ;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public ;;; modify it under the terms of the GNU Lesser General Public
@ -229,6 +229,10 @@ address of that offset."
(pointer->scm (pointer->scm
(dereference-pointer (make-pointer addr))))) (dereference-pointer (make-pointer addr)))))
(define (intrinsic-name index)
(and=> (intrinsic-index->name index)
(compose list symbol->string)))
(match code (match code
(((or 'j 'je 'jl 'jge 'jne 'jnl 'jnge) target) (((or 'j 'je 'jl 'jge 'jne 'jnl 'jnge) target)
(list "-> ~A" (vector-ref labels (- (+ offset target) start)))) (list "-> ~A" (vector-ref labels (- (+ offset target) start))))
@ -284,6 +288,47 @@ address of that offset."
"anonymous procedure"))) "anonymous procedure")))
(push-addr! addr name) (push-addr! addr name)
(list "~A at #x~X" name addr))) (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) (('make-non-immediate dst target)
(let ((val (reference-scm target))) (let ((val (reference-scm target)))
(when (program? val) (when (program? val)