;;; Copyright 2015 the V8 project authors.  All rights reserved.
;;; Use of this source code is governed by a BSD-style license that can be
;;; found in the LICENSE file.

(define-module (d8-gdb)
  #:use-module (ice-9 format)
  #:use-module (ice-9 rdelim)
  #:use-module ((gdb) #:hide (symbol?))
  #:use-module (gdb printing)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-2)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-41))

;;; Commentary:
;;;
;;; This file defines GDB extensions to pretty-print V8 objects.  To
;;; use, first you need a GDB that supports Guile, and then you need to
;;; have it load this file.  Probably the easiest way is to link it
;;; along side the file you are debugging:
;;;
;;;   ln -s `pwd`/tools/d8-gdb.scm out/x64.debug/
;;;
;;; Then d8-gdb.scm will be automatically loaded whenever d8 is run.  If
;;; you need it for other binaries, add more symlinks as appropriate,
;;; changing the link name.  To instead load the file manually, enter
;;; the following at the gdb prompt:
;;;
;;;   source tools/d8-gdb.scm
;;;
;;; If your GDB doesn't have Guile support, you'll have to build it
;;; yourself.  Fortunately it's not that bad.  See
;;;
;;;   https://groups.google.com/d/msg/v8-users/kIVoA7GZAcY/Hekm9QuaUKAJ
;;;
;;; for build instructions.
;;;
;;; Code:

(define (v8-name name)
  (string-append "v8::internal::" name))

(define (v8-base-name name)
  (string-append "v8::base::" name))

(define (v8-type name)
  (or (lookup-type (v8-name name))
      (error "type not found" name)))

(define (v8-handle-name name)
  (v8-name (string-append "Handle<" (v8-name name) ">")))

(define (v8-handle-type name)
  (or (lookup-type (v8-handle-name name))
      (error "type not found" name)))

(define (v8-pointer-type name)
  (type-pointer (lookup-type (v8-name name))))

(define (v8-symbol name)
  (or (and=> (lookup-symbol (v8-name name)) car)
      (error "symbol not found" name)))

(define (v8-base-symbol name)
  (or (and=> (lookup-symbol (v8-base-name name)) car)
      (error "symbol not found" name)))

(define (v8-constant name)
  (let ((sym (v8-symbol name)))
    (unless (symbol-constant? sym)
      (error "symbol not a constant" sym))
    (symbol-value sym)))

(define (v8-value-has-tag? val tag size)
  (value=? (value-logand (value-cast val (arch-uint-type (current-arch)))
                         (value-sub (value-lsh 1 (v8-constant size)) 1))
           (v8-constant tag)))

(define (v8-smi? obj)
  (v8-value-has-tag? obj "kSmiTag" "kSmiTagSize"))

(define (->type type-or-string)
  (if (string? type-or-string)
      (v8-type type-or-string)
      type-or-string))

(define (v8-field-ptr obj offset type)
  (let* ((char* (type-pointer (arch-char-type (current-arch))))
         (offset (if (string? offset)
                     (v8-constant offset)
                     offset))
         (byte-ptr (value-sub (value-add (value-cast obj char*)
                                         offset)
                              (v8-constant "kHeapObjectTag"))))
    (value-cast byte-ptr type)))

(define (v8-field obj offset type)
  (let ((type (type-pointer (->type type))))
    (value-dereference (v8-field-ptr obj offset type))))

(define (v8-smi-field-ptr obj offset)
  (v8-field-ptr obj offset (type-pointer (v8-type "Smi"))))

(define (v8-smi-value obj)
  (value->integer
   (value-cast
    (value-rsh (value-cast obj
                           (lookup-type "intptr_t"))
               (value-add (v8-constant "kSmiTagSize")
                          (v8-constant "kSmiShiftSize")))
    (arch-int-type (current-arch)))))

(define (v8-smi-field obj offset)
  (v8-smi-value (value-dereference (v8-smi-field-ptr obj offset))))

(define (v8-int-field-ptr obj offset)
  (v8-field-ptr obj offset (type-pointer (arch-int-type (current-arch)))))

(define (v8-int-field obj offset)
  (value-dereference (v8-int-field-ptr obj offset)))

(define (v8-pointer-field-ptr obj offset type)
  (v8-field-ptr obj offset (type-pointer (->type type))))

(define (v8-pointer-field obj offset type)
  (let ((type (type-pointer (->type type))))
    (value-dereference (v8-pointer-field-ptr obj offset type))))

(define (map-instance-type map)
  (value-cast
   (v8-field map "Map::kInstanceTypeOffset" (arch-uint8-type (current-arch)))
   (v8-type "InstanceType")))

;; Handles forwarding words, so is gc-safe.
(define (heap-object-map obj)
  (let ((map-word (value-field (v8-field obj "HeapObject::kMapOffset" "MapWord")
                               "value_")))
    (if (v8-smi? map-word)
        ;; It's a forwarding address: recurse.
        (heap-object-map
         (value-cast (value-add map-word (v8-constant "kHeapObjectTag"))
                     (v8-pointer-type "HeapObject")))
        (value-cast map-word (v8-pointer-type "Map")))))

(define (instance-type obj)
  (map-instance-type (heap-object-map obj)))

(define (camel-cased-instance-type type)
  (define (enum-type-name type)
    (let lp ((fields (type-fields (value-type type))))
      (match fields
        (() (format #f "(Unknown type ~a)" (value->integer type)))
        ((f . fields)
         (if (value=? (field-enumval f) type)
             (match (string-split (field-name f) #\:)
               ((_ ... tail) tail))
             (lp fields))))))
  (match (string-split (enum-type-name type) #\_)
    ((word ... "TYPE")
     (string-join (map (lambda (str)
                         (if (string-suffix? "JS" str)
                             str
                             (string-titlecase str)))
                       word)
                  ""))))

(define-syntax v8-constant-case
  (lambda (x)
    (define (visit-clauses var clauses)
      (syntax-case clauses (else)
        ((((name ...) body ...) clause ...)
         #`(if (or (value=? #,var (v8-constant name)) ...)
               (let () body ...)
               #,(visit-clauses var #'(clause ...))))
        (((else body ...))
         #'(let () body ...))
        (()
         #`(error "unexpected value" #,var))))
    (syntax-case x (else)
      ((_ exp clause ...)
       #`(let ((var exp))
           #,(visit-clauses #'var #'(clause ...)))))))
; (put 'v8-constant-case 'scheme-indent-function 1)

(define (v8-string? obj)
  (value<? (instance-type obj) (v8-constant "FIRST_NONSTRING_TYPE")))

(define (v8-string-length str)
  (v8-smi-field str "String::kLengthOffset"))

(define (raw-string-chars ptr start end one-byte?)
  (let* ((ptr (value-cast ptr (type-pointer (arch-uint8-type (current-arch)))))
         (elt-size (if one-byte? 1 2))
         (bytes (* elt-size (- end start))))
    (if (zero? bytes)
        ""
        (let ((port (open-memory
                     #:mode "r"
                     #:start (+ (value->integer ptr) (* elt-size start))
                     #:size bytes)))
          (set-port-encoding! port (if one-byte? "ISO-8859-1" "UTF-16"))
          (read-delimited "" port)))))

(define* (v8-seq-string-chars str start end #:key one-byte?)
  (let ((uint8* (type-pointer (arch-uint8-type (current-arch)))))
    (raw-string-chars (v8-field-ptr str "SeqString::kHeaderSize" uint8*)
                      start end one-byte?)))

(define* (v8-external-string-chars str start end #:key one-byte?)
  (let* ((type (v8-type (if one-byte?
                            "ExternalOneByteString::Resource"
                            "ExternalString::Resource")))
         (resource (v8-pointer-field str "ExternalString::kResourceOffset"
                                     type))
         (rtti (value-dynamic-type (value-dereference resource))))
    (define (get-pointer)
      (cond
       ((not (type? rtti))
        (error "could not get type of external string resource"))
       ((equal? rtti (v8-type "NativesExternalStringResource"))
        (value-field (value-cast resource (type-pointer rtti)) "data_"))
       ((lookup-symbol
         (string-append (type-name rtti) "::data"))
        => (lambda (pair)
             ;; Bah.  Give up and call the virtual method on the inferior.
             (let ((method (symbol-value (car pair))))
               (value-call method (list resource)))))
       (else
        (error "could not resolve ::data method for external resource" rtti))))
    (raw-string-chars (get-pointer) start end one-byte?)))

(define* (print-default port val #:optional
                        (type-name (type-print-name (value-type val))))
  (format port "(~a) 0x~x" type-name (value->integer val)))

(define (print-v8-smi port smi)
  (format port "~a" (v8-smi-value smi)))

(define* (print-v8-string port str #:optional (start 0)
                          (end (v8-string-length str)))
  (let ((type (instance-type str)))
    (v8-constant-case type
      (("SLICED_STRING_TYPE" "SLICED_ONE_BYTE_STRING_TYPE")
       (print-v8-string
        port
        (v8-pointer-field str "SlicedString::kParentOffset" "String")
        (+ start (v8-smi-field str "SlicedString::kOffsetOffset"))
        (- end start)))

      (("CONS_STRING_TYPE" "CONS_ONE_BYTE_STRING_TYPE")
       (let* ((left (v8-pointer-field str "ConsString::kFirstOffset" "String"))
              (left-len (v8-string-length left))
              (right (v8-pointer-field str "ConsString::kSecondOffset" "String")))
         (when (< start left-len)
           (print-v8-string port left start (min end left-len)))
         (when (> end left-len)
           (print-v8-string port right 0 (- end left-len)))))

      (("STRING_TYPE" "INTERNALIZED_STRING_TYPE")
       (display (v8-seq-string-chars str start end #:one-byte? #f) port))
      (("ONE_BYTE_STRING_TYPE" "ONE_BYTE_INTERNALIZED_STRING_TYPE")
       (display (v8-seq-string-chars str start end #:one-byte? #t) port))

      (("EXTERNAL_ONE_BYTE_STRING_TYPE")
       (display (v8-external-string-chars str start end #:one-byte? #t) port))
      (("EXTERNAL_STRING_TYPE")
       (display (v8-external-string-chars str start end #:one-byte? #f) port))

      (("EXTERNAL_ONE_BYTE_STRING_TYPE"
        "EXTERNAL_STRING_WITH_ONE_BYTE_DATA_TYPE"
        "SHORT_EXTERNAL_STRING_TYPE"
        "SHORT_EXTERNAL_ONE_BYTE_STRING_TYPE"
        "SHORT_EXTERNAL_STRING_WITH_ONE_BYTE_DATA_TYPE")
       (print-default port str (v8-name "ExternalString *")))

      (("EXTERNAL_INTERNALIZED_STRING_TYPE"
        "EXTERNAL_ONE_BYTE_INTERNALIZED_STRING_TYPE"
        "EXTERNAL_INTERNALIZED_STRING_WITH_ONE_BYTE_DATA_TYPE"
        "SHORT_EXTERNAL_INTERNALIZED_STRING_TYPE"
        "SHORT_EXTERNAL_ONE_BYTE_INTERNALIZED_STRING_TYPE"
        "SHORT_EXTERNAL_INTERNALIZED_STRING_WITH_ONE_BYTE_DATA_TYPE")
       (print-default port str (v8-name "ExternalInternalizedString *")))
      (else
       (format (current-warning-port) "warning: unknown string type ~a" type)
       (print-default port str (v8-name "String *"))))))

(define (v8-string-value string)
  (call-with-output-string (lambda (port) (print-v8-string port string))))

(define (print-v8-symbol port obj)
  (let ((name (v8-pointer-field obj "Symbol::kNameOffset" "Object")))
    (display "Symbol(" port)
    (if (v8-string? name)
        (print-v8-string port name)
        (format port "0x~x" (value->integer obj)))
    (display ")" port)))

(define (print-v8-oddball port obj)
  (let ((kind (v8-smi-field obj "Oddball::kKindOffset")))
    (format port "~a"
            (v8-constant-case kind
              (("Oddball::kFalse") "false")
              (("Oddball::kTrue") "true")
              (("Oddball::kTheHole") "the-hole")
              (("Oddball::kNull") "null")
              (("Oddball::kArgumentMarker") "argument-marker")
              (("Oddball::kUndefined") "undefined")
              (("Oddball::kUninitialized") "uninitialized")
              (else (string-append "Oddball(" (number->string kind ")")))))))

(define (print-v8-heap-number port obj)
  (let ((value (v8-field obj "HeapNumber::kValueOffset"
                         (arch-double-type (current-arch)))))
    (format port "~f" (value->real value))))

(define (print-v8-heap-object port obj)
  (cond
   ((v8-string? obj)
    (print-v8-string port obj))
   (else
    (let ((type (instance-type obj)))
      (v8-constant-case type
        (("SYMBOL_TYPE") (print-v8-symbol port obj))
        (("ODDBALL_TYPE") (print-v8-oddball port obj))
        (("HEAP_NUMBER_TYPE") (print-v8-heap-number port obj))
        (else
         (let ((actual-type (v8-name (string-append
                                      (camel-cased-instance-type type)
                                      " *")))
               (declared-type (type-print-name (value-type obj))))
           (if (equal? actual-type declared-type)
               (format port "(~a) 0x~x" actual-type (value->integer obj))
               (format port "(~a) ((~a) 0x~x)" declared-type actual-type
                       (value->integer obj))))))))))

(define (print-v8-object port obj)
  (if (v8-smi? obj)
      (print-v8-smi port obj)
      (print-v8-heap-object port obj)))

(define (print-v8-handle port handle)
  (let ((loc (value-field handle "location_")))
    (display "Handle(" port)
    (if (value=? loc 0)
        (print-default port loc
                       (type-print-name (type-target (value-type loc))))
        (print-v8-object port (value-dereference loc)))
    (display ")" port)))

(define (print-v8-maybe-handle port handle)
  (let ((loc (value-field handle "location_")))
    (if (value=? loc 0)
        (format port "MaybeHandle<~a>()"
                (type-print-name (type-target (value-type loc))))
        (begin
          (display "MaybeHandle(" port)
          (print-v8-object port (value-dereference loc))
          (display ")" port)))))

(define* (install-pretty-printers #:optional (objfile (current-objfile)))
  (define (writer-worker printer value)
    (lambda (_)
      (call-with-output-string
       (lambda (port) (printer port value)))))
  (define (make-worker hint printer value)
    (make-pretty-printer-worker hint (writer-worker printer value) #f))
  (define (default-predicate name)
    (lambda (value)
      (equal? (type-print-name (value-type value))
              (v8-name (string-append name " *")))))
  (define* (register! name hint printer #:key
                      (predicate (default-predicate name)))
    (define (handler pp value)
      (and (predicate value)
           (make-worker hint printer value)))
    (prepend-pretty-printer! objfile (make-pretty-printer name handler)))

  (register! "Object" #f print-v8-object)
  (register! "Smi" #f print-v8-smi)
  (register! "String" "string" print-v8-string)
  (register! "Handle" #f print-v8-handle
             #:predicate
             (lambda (value)
               (let ((type-name (type-print-name (value-type value))))
                 (string-prefix? (v8-name "Handle<") type-name))))
  (register! "MaybeHandle" #f print-v8-maybe-handle
             #:predicate
             (lambda (value)
               (let ((type-name (type-print-name (value-type value))))
                 (string-prefix? (v8-name "MaybeHandle<") type-name)))))


;;;
;;; The JavaScript stack.
;;;
(define-record-type <v8-frame>
  (make-v8-frame type sp fp pc constant-pool-address isolate)
  v8-frame?
  (type v8-frame-type)
  (sp v8-frame-sp)
  (fp v8-frame-fp)
  (pc v8-frame-pc)
  (constant-pool-address v8-frame-constant-pool-address)
  (isolate v8-frame-isolate))

;; This is the only function in this file that actually calls into the
;; inferior.  Sadly, there is no portable way to do this; even for
;; pthread backends, in which Thread::LocalStorageKey is actually a
;; pthread_key_t, you still can't get easily get at the value:
;; http://stackoverflow.com/questions/10841219/thread-specific-data-from-linux-core-dump
(define (get-thread-local key)
  (value-call (symbol-value (v8-base-symbol "Thread::GetThreadLocal"))
              (list key)))

;; thread id -> isolate
(define *isolates* (make-hash-table))

(define (selected-thread)
  ;; FIXMEEEEE
  #t)

(define* (cached-current-isolate #:optional (thread (selected-thread)))
  (hash-ref *isolates* thread))

(define (on-set-isolate-thread-locals bkpt)
  (let ((isolate (parse-and-eval "isolate")))
    (cond
     ((or (value-optimized-out? isolate)
          (value-null? isolate))
      (hash-set! *isolates* (selected-thread) #f))
     (else
      (hash-set! *isolates* (selected-thread) isolate))))
  ;; Don't stop.
  #f)

(define isolate-breakpoint
  (make-breakpoint (v8-name "Isolate::SetIsolateThreadLocals")))

(register-breakpoint! isolate-breakpoint)
(set-breakpoint-stop! isolate-breakpoint on-set-isolate-thread-locals)

;; -> Isolate*
(define (current-isolate)
  (or (cached-current-isolate)
      (value-cast (get-thread-local
                   (symbol-value (v8-symbol "Isolate::isolate_key_")))
                  (v8-pointer-type "Isolate"))))

;; int-or-pointer -> bool
(define (value-null? value)
  (value=? value 0))

;; Address Isolate* -> bool
(define (valid-stack-address? addr isolate)
  (and (not (value-null? addr))
       (value<=? addr
                 (value-field (value-field isolate "thread_local_top_")
                              "js_entry_sp_"))
       (value<=? (parse-and-eval "$sp") addr)))

;; Address -> Address
(define (compute-exit-frame-sp fp)
  (value-dereference
   (value-cast (value-add fp (v8-constant "ExitFrameConstants::kSPOffset"))
              (v8-pointer-type "Address"))))

;; Address -> Address*
(define (compute-exit-frame-pc-address sp)
  (value-cast (value-sub sp (v8-constant "kPCOnStackSize"))
              (v8-pointer-type "Address")))

;; Address -> Address*
(define (compute-exit-frame-constant-pool-address fp)
  (value-cast (value-add fp (v8-constant
                             "ExitFrameConstants::kConstantPoolOffset"))
              (v8-pointer-type "Address")))

;; Address -> bool
(define (valid-exit-frame? fp isolate)
  (and (valid-stack-address? fp isolate)
       (let ((sp (compute-exit-frame-sp fp)))
         (and (valid-stack-address? sp isolate)
              (let ((pc-address (compute-exit-frame-pc-address sp)))
                (and (valid-stack-address? pc-address isolate)
                     (not (value-null? (value-dereference pc-address)))))))))

;; Address -> Address
(define (compute-entry-frame-caller-fp fp)
  (value-dereference
   (value-cast (value-add fp (v8-constant
                              "EntryFrameConstants::kCallerFPOffset"))
               (v8-pointer-type "Address"))))

;; Address -> Address*
(define (compute-standard-frame-pc-address fp)
  (value-cast (value-add fp (v8-constant
                             "StandardFrameConstants::kCallerPCOffset"))
              (v8-pointer-type "Address")))

;; Address -> Object**
(define (compute-standard-frame-marker-address fp)
  (value-cast (value-add fp (v8-constant
                             "StandardFrameConstants::kMarkerOffset"))
              (type-pointer (v8-pointer-type "Object"))))

;; ThreadLocalTop Isolate* -> bool
(define (valid-thread-top? top isolate)
  (let ((c-entry-fp (value-field top "c_entry_fp_"))
        (handler (value-field top "handler_")))
    (and (valid-exit-frame? c-entry-fp isolate)
         ;; Should be at least one JS_ENTRY stack handler.
         (not (value-null? handler))
         ;; Check that there are no js frames on top of the native frames.
         (value<=? c-entry-fp handler))))

;; Address -> bool
(define (arguments-adaptor-frame? fp)
  (let ((obj (value-dereference
              (value-cast
               (value-add fp (v8-constant
                              "StandardFrameConstants::kContextOffset"))
               (type-pointer (v8-pointer-type "Object"))))))
    (and (v8-smi? obj)
         (eqv? (v8-smi-value obj)
               (v8-constant "StackFrame::ARGUMENTS_ADAPTOR")))))

;; HashMap int-or-pointer int? -> HashMap::Entry
;; Assume that pointer equality is the match function.
(define* (hash-map-lookup hashmap key #:optional (hash key))
  (let ((entries (value-field hashmap "map_"))
        (mask (value-sub (value-field hashmap "capacity_") 1)))
    (let lp ((hash hash))
      (let* ((entry (value-add entries (value-logand hash mask)))
             (entry-key (value-field entry "key")))
        (and (not (value-null? entry-key))
             (if (value=? key entry-key)
                 entry
                 (lp (1+ hash))))))))

(define (find-large-page lo-space addr)
  (let ((hashmap (value-field lo-space "chunk_map_"))
        (key (floor/ (value->integer addr)
                     (value->integer
                      (v8-constant "MemoryChunk::kAlignment")))))
    (and=> (hash-map-lookup hashmap key)
           (lambda (entry)
             (let* ((value (value-field entry "value"))
                    (page (value-cast value (v8-pointer-type "LargePage")))
                    (start (value-field page "area_start_"))
                    (end (value-field page "area_end_")))
               (and (value<=? start addr) (value<=? addr end) page))))))

(define (address->page addr)
  (value-cast (value-logand (value-cast addr (lookup-type "uintptr_t"))
                            (value-lognot
                             (v8-constant "Page::kPageAlignmentMask")))
              (v8-pointer-type "Page")))

(define (address->heap-object addr)
  (value-cast (value-add addr (v8-constant "kHeapObjectTag"))
              (v8-pointer-type "HeapObject")))

(define (round-up addr align)
  (value-logand (value-add addr (value-sub align 1))
                (value-sub 0 align)))

(define (code-instruction-start code)
  (v8-field-ptr code "Code::kHeaderSize" (v8-type "Address")))

(define (code-instruction-size code)
  (v8-int-field code "Code::kInstructionSizeOffset"))

(define (heap-object-size obj)
  (let ((type (instance-type obj)))
    (v8-constant-case type
      (("CODE_TYPE")
       (let ((body-size (round-up (code-instruction-size obj)
                                  (v8-constant "kObjectAlignment"))))
         (round-up (value-add (v8-constant "Code::kHeaderSize") body-size)
                   (v8-constant "kCodeAlignment"))))
      (("FREE_SPACE_TYPE")
       (v8-smi-field obj "FreeSpace::kSizeOffset"))
      (else
       (error "heap-object-size not yet implemented for type" type)))))

(define (page-valid? page)
  (not (value-null? page)))

(define (page-owner page)
  (let ((owner-as-intptr (value-cast (value-field page "owner_")
                                     (lookup-type "intptr_t"))))
    (and (value=? (v8-constant "kPageHeaderTag")
                  (value-logand owner-as-intptr
                                (v8-constant "kPageHeaderTagMask")))
         (value-cast (value-sub owner-as-intptr
                                (v8-constant "kPageHeaderTag"))
                     (v8-pointer-type "Space")))))

(define (paged-space-contains? space page)
  (false-if-exception
   (and (page-valid? page) (value=? (page-owner page) space))))

(define (lookup-code-for-pc pc isolate)
  (let* ((ipcc (value-field isolate "inner_pointer_to_code_cache_"))
         (heap (value-field isolate "heap_"))
         (lo-space (value-field heap "lo_space_")))
    (cond
     ((value-null? lo-space)
      ;; Heap not set up.
      #f)
     ((find-large-page lo-space pc)
      => (lambda (page)
           (value-cast page (v8-pointer-type "Code"))))
     (else
      (let ((code-space (value-field heap "code_space_"))
            (page (address->page pc)))
        (and
         (paged-space-contains? code-space page)
         (let* ((skip-list (value-field page "skip_list_"))
                (starts (value-field skip-list "starts_"))
                (region-number (value-rsh
                                (value-logand
                                 (value-cast pc (lookup-type "uintptr_t"))
                                 (v8-constant "Page::kPageAlignmentMask"))
                                (v8-constant "SkipList::kRegionSizeLog2")))
                (addr (value-subscript starts region-number))
                (code-space-info (value-field code-space "allocation_info_"))
                (top (value-field code-space-info "top_"))
                (limit (value-field code-space-info "limit_")))
           (let lp ((addr addr))
             (if (and (value=? addr top) (not (value=? addr limit)))
                 (lp limit)
                 (let ((obj (address->heap-object addr)))
                   (let ((next (value-add addr (heap-object-size obj))))
                     (if (value<? pc next)
                         (value-cast obj (v8-pointer-type "Code"))
                         (lp next)))))))))))))

(define (code-kind code)
  ;; Sadly, all-static classes are vulnerable to a bug in which GCC
  ;; folds the values early, but then forgets that the class is used
  ;; and.  Thinking that the class is unused, it then prunes the class
  ;; from debug output:
  ;;
  ;;   https://gcc.gnu.org/bugzilla/show_bug.cgi?id=65108
  ;; 
  ;; So here we hard-code some defaults.
  (define-syntax-rule (exception-or exp val)
    (catch #t (lambda () exp) (lambda _ val)))
  (value-rsh (value-logand (v8-int-field code "Code::kFlagsOffset")
                           (exception-or
                            (v8-constant "Code::KindField::kMask")
                            (ash (1- (ash 1 4)) 7)))
             (exception-or (v8-constant "Code::KindField::kShift")
                           7)))

(define (code-optimized? code)
  (value=? (code-kind code) (v8-constant "Code::OPTIMIZED_FUNCTION")))

(define (build-js-frame sp fp pc isolate)
  (define (frame-type type)
    (v8-constant-case type
      (("StackFrame::ENTRY") 'entry)
      (("StackFrame::ENTRY_CONSTRUCT") 'entry-construct)
      (("StackFrame::EXIT") 'exit)
      (("StackFrame::JAVA_SCRIPT") 'javascript)
      (("StackFrame::OPTIMIZED") 'optimized)
      (("StackFrame::STUB") 'stub)
      (("StackFrame::STUB_FAILURE_TRAMPOLINE") 'stub-failure-trampoline)
      (("StackFrame::INTERNAL") 'internal)
      (("StackFrame::CONSTRUCT") 'construct)
      (("StackFrame::ARGUMENTS_ADAPTOR") 'arguments-adaptor)
      (else #f)))
  (define (build-frame type)
    (let ((type-sym (frame-type type)))
      (and type-sym
           (make-v8-frame type-sym sp fp pc #f isolate))))
  (cond
   ((not (and (valid-stack-address? sp isolate)
              (valid-stack-address? fp isolate)))
    #f)
   ((arguments-adaptor-frame? fp)
    (make-v8-frame 'arguments-adaptor sp fp pc #f isolate))
   (else
    (let ((marker-obj (value-dereference
                       (compute-standard-frame-marker-address fp))))
      (if (v8-smi? marker-obj)
          (build-frame
           (value-cast (make-value (v8-smi-value marker-obj))
                       (v8-type "StackFrame::Type")))
          (let* ((code (lookup-code-for-pc pc isolate)))
            (and code
                 (build-frame
                  (if (code-optimized? code)
                      (v8-constant "StackFrame::OPTIMIZED")
                      (v8-constant "StackFrame::JAVA_SCRIPT"))))))))))

(define (compute-exit-frame-older-sp fp)
  (value-add fp (v8-constant "ExitFrameConstants::kCallerSPDisplacement")))

(define (compute-exit-frame-older-fp fp)
  (value-dereference
   (value-cast (value-add fp (v8-constant
                              "ExitFrameConstants::kCallerFPOffset"))
               (v8-pointer-type "Address"))))

;; Assuming there is no return address location resolver (i.e., we're
;; not in a simulator).
(define (compute-exit-frame-older-pc-address fp)
  (value-cast (value-add fp (v8-constant
                             "ExitFrameConstants::kCallerPCOffset"))
              (v8-pointer-type "Address")))

(define (compute-standard-frame-older-fp fp)
  (value-dereference
   (value-cast (value-add fp (v8-constant
                              "StandardFrameConstants::kCallerFPOffset"))
               (v8-pointer-type "Address"))))

(define (compute-standard-frame-older-sp fp)
  (value-add fp (v8-constant
                 "StandardFrameConstants::kCallerSPOffset")))

(define (compute-frame-older-sp fp type)
  (case type
    ((entry entry-construct) #f)
    ((exit stub) (compute-exit-frame-older-sp fp))
    ((javascript optimized arguments-adaptor internal stub-failure-trampoline)
     (compute-standard-frame-older-sp fp))
    (else (error "unexpected type" type))))

(define (make-exit-frame fp isolate)
  (let* ((sp (compute-exit-frame-sp fp))
         (pc-address (compute-exit-frame-pc-address sp))
         (pc (value-dereference pc-address))
         (pool-address (compute-exit-frame-constant-pool-address fp)))
    (make-v8-frame 'exit sp fp pc pool-address isolate)))

(define (v8-frame-older frame)
  (let ((sp (v8-frame-sp frame))
        (fp (v8-frame-fp frame))
        (isolate (v8-frame-isolate frame))
        (type (v8-frame-type frame)))
    (case type
      ((entry entry-construct)
       (let ((caller-fp (compute-entry-frame-caller-fp fp)))
         (and (valid-exit-frame? caller-fp isolate)
              (make-exit-frame caller-fp isolate))))
      ((exit)
       (build-js-frame (compute-exit-frame-older-sp fp)
                       (compute-exit-frame-older-fp fp)
                       (value-dereference
                        (compute-exit-frame-older-pc-address fp))
                       isolate))
      (else
       (let* ((pc-address (compute-standard-frame-pc-address fp))
              (pc (value-dereference pc-address))
              (sp (compute-frame-older-sp fp type))
              (fp (compute-standard-frame-older-fp fp)))
         (build-js-frame sp fp pc isolate))))))

;; This corresponds to the SafeStackFrameIterator constructor.
(define* (newest-v8-frame #:key (isolate (current-isolate)))
  (let* ((top (value-field isolate "thread_local_top_")))
    (cond
     ((valid-thread-top? top isolate)
      (make-exit-frame (value-field top "c_entry_fp_") isolate))
     (else
      (let* ((fp (value-cast (parse-and-eval "$rbp") (v8-type "Address")))
             (sp (value-cast (parse-and-eval "$sp") (v8-type "Address")))
             (pc (value-cast (parse-and-eval "$pc") (v8-type "Address"))))
        (if (valid-stack-address? (compute-standard-frame-marker-address fp)
                                  isolate)
            (build-js-frame sp fp pc isolate)
            ;; Top frame incomplete; advance to next.
            (v8-frame-older
             (make-v8-frame 'javascript sp fp pc #f isolate))))))))

(define (v8-frames)
  "Return a SRFI-41 stream of the current VM frame stack."
  (stream-unfold identity
                 v8-frame?
                 v8-frame-older
                 (newest-v8-frame)))

(define (js-frame-function-by-fp fp)
  (value-dereference
   (value-cast
    (value-add fp (v8-constant "JavaScriptFrameConstants::kFunctionOffset"))
    (type-pointer (v8-pointer-type "HeapObject")))))

(define (js-frame-function frame)
  (js-frame-function-by-fp (v8-frame-fp frame)))

(define (js-function-code function)
  (address->heap-object
   (value-sub (v8-field function "JSFunction::kCodeEntryOffset" "Address")
              (v8-constant "Code::kHeaderSize"))))

(define (js-function-shared-function-info function)
  (v8-pointer-field function
                    "JSFunction::kSharedFunctionInfoOffset"
                    "SharedFunctionInfo"))

(define (shared-function-info-name shared)
  (let ((name (v8-pointer-field shared
                                "SharedFunctionInfo::kNameOffset"
                                "Object")))
    (if (and (v8-string? name)
             (not (zero? (v8-string-length name))))
        (v8-string-value name)
        (let ((name (v8-pointer-field shared
                                      "SharedFunctionInfo::kInferredNameOffset"
                                      "Object")))
          (and (v8-string? name)
               (v8-string-value name))))))

(define (byte-array-start-address byte-array)
  (v8-field-ptr byte-array "FixedArrayBase::kHeaderSize" (v8-pointer-type "byte")))

(define (fixed-array-length byte-array)
  (v8-smi-field byte-array "FixedArrayBase::kLengthOffset"))

(define (byte-array-length byte-array)
  (fixed-array-length byte-array))

(define-record-type <reloc-info>
  (make-reloc-info type pc data)
  reloc-info?
  (type reloc-info-type)
  (pc reloc-info-pc)
  (data reloc-info-data))

(define (reloc-info-stream code)
  (let* ((pc (code-instruction-start code))
         (buf (v8-pointer-field code "Code::kRelocationInfoOffset" "ByteArray"))
         ;; Reloc info is written backwards.
         (end (byte-array-start-address buf))
         (size (byte-array-length buf))
         (pos (value-add end size))
         (last-id 0)
         (last-position 0))
    (define (current-byte)
      (value-dereference pos))
    (define (advance-pos! n)
      (set! pos (value-sub pos n)))
    (define (advance-last-id! n)
      (set! last-id (value-add last-id n)))
    (define (advance-last-position! n)
      (set! last-position (value-add last-position n)))
    (define (next-byte!)
      (advance-pos! 1)
      (current-byte))
    (define (next-tag!)
      (value-logand (next-byte!) (v8-constant "kTagMask")))
    (define (bits->mask bits)
      (value-sub (value-lsh 1 bits) 1))
    (define (extra-tag)
      (value-logand (value-rsh (current-byte) (v8-constant "kTagBits"))
                    (bits->mask (v8-constant "kExtraTagBits"))))
    (define (top-tag)
      (value-rsh (current-byte) (value-add (v8-constant "kTagBits")
                                           (v8-constant "kExtraTagBits"))))
    (define (tagged-pc-advance)
      (value-rsh (current-byte) (v8-constant "kTagBits")))
    (define (next-pc-advance!)
      (next-byte!))
    (define (advance-pc! diff)
      (set! pc (value-add pc diff)))
    (define (next-int!)
      (define type (lookup-type "int"))
      (let lp ((x (value-cast (make-value 0) type)) (i 0))
        (if (value<? i (v8-constant "kIntSize"))
            (let* ((shift (value-mul i (v8-constant "kBitsPerByte")))
                   (next (value-cast (next-byte!) type)))
              (lp (value-logior x (value-lsh next shift)) (1+ i)))
            x)))
    (define (next-intptr!)
      (define type (lookup-type "intptr_t"))
      (let lp ((x (value-cast (make-value 0) type)) (i 0))
        (if (value<? i (v8-constant "kIntptrSize"))
            (let* ((shift (value-mul i (v8-constant "kBitsPerByte")))
                   (next (value-cast (next-byte!) type)))
              (lp (value-logior x (value-lsh next shift)) (1+ i)))
            x)))
    (define (next-variable-length-pc-advance!)
      (value-lsh
       (let lp ((x (value-cast (make-value 0) (lookup-type "uint32_t"))) (i 0))
         (if (value<? i (v8-constant "kIntSize"))
             (let* ((part (next-byte!))
                    (diff (value-lsh
                           (value-rsh part (v8-constant "kLastChunkTagBits"))
                           (value-mul i (v8-constant "kChunkBits"))))
                    (x (value-logior x diff))
                    (mask (v8-constant "kLastChunkTagMask")))
               (if (value=? (value-logand part mask) 1)
                   x
                   (lp x (1+ i))))
             x))
       (v8-constant "kSmallPCDeltaBits")))
    (define (locatable-type-tag)
      (value-logand (current-byte)
                    (bits->mask (v8-constant "kLocatableTypeTagBits"))))
    (define (locatable-type-tagged-data)
      ;; Signed.
      (value-rsh (value-cast (current-byte) (arch-schar-type (current-arch)))
                 (v8-constant "kLocatableTypeTagBits")))
    (define (tagged-data)
      (value-rsh (current-byte) (v8-constant "kTagBits")))
    (let lp ()
      (define (return type data)
        (stream-cons (make-reloc-info type pc data) (lp)))
      (cond
       ((value<=? pos end) stream-null)
       (else
        (v8-constant-case (next-tag!)
          (("kEmbeddedObjectTag")
           (advance-pc! (tagged-pc-advance))
           (return 'embedded-object #f))
          (("kCodeTargetTag")
           (advance-pc! (tagged-pc-advance))
           (return 'code-target #f))
          (("kLocatableTag")
           (advance-pc! (tagged-pc-advance))
           (advance-pos! 1)
           (v8-constant-case (locatable-type-tag)
             (("kCodeWithIdTag")
              (advance-last-id! (locatable-type-tagged-data))
              (return 'code-target-with-id last-id))
             (("kDeoptReasonTag")
              (return 'deopt-reason (tagged-data)))
             (("kStatementPositionTag")
              (advance-last-position! (locatable-type-tagged-data))
              (return 'statement-position last-position))
             (("kNonstatementPositionTag" "kStatementPositionTag")
              (advance-last-position! (locatable-type-tagged-data))
              (return 'non-statement-position last-position))))
          (("kDefaultTag")
           (v8-constant-case (extra-tag)
             (("kPCJumpExtraTag")
              (advance-pc! (v8-constant-case (top-tag)
                             (("kVariableLengthPCJumpTopTag")
                              (next-variable-length-pc-advance!))
                             (else
                              (next-pc-advance!))))
              (lp))
             (("kDataJumpExtraTag")
              (v8-constant-case (top-tag)
                (("kCodeWithIdTag")
                 (return 'code-target-with-id (next-int!)))
                (("kCommentTag")
                 (return 'comment (next-intptr!)))
                (("kStatementPositionTag")
                 (advance-last-position! (next-int!))
                 (return 'statement-position last-position))
                (("kNonstatementPositionTag")
                 (advance-last-position! (next-int!))
                 (return 'non-statement-position last-position))))
             (("kPoolExtraTag")
              (v8-constant-case (top-tag)
                (("kConstPoolTag") (return 'const-pool (next-int!)))
                (("kVeneerPoolTag") (return 'veneer-pool (next-int!)))))
             (else
              (return
               (v8-constant-case
                   (value-add (v8-constant "RelocInfo::LAST_COMPACT_ENUM")
                              (extra-tag))
                 (("RelocInfo::CONSTRUCT_CALL") 'construct-call)
                 (("RelocInfo::DEBUG_BREAK") 'debug-break)
                 (("RelocInfo::CELL") 'cell)
                 (("RelocInfo::RUNTIME_ENTRY") 'runtime-entry)
                 (("RelocInfo::JS_RETURN") 'js-return)
                 (("RelocInfo::DEBUG_BREAK_SLOT") 'debug-break-slot)
                 (("RelocInfo::EXTERNAL_REFERENCE") 'external-reference)
                 (("RelocInfo::INTERNAL_REFERENCE") 'internal-reference))
               #f))))))))))

(define (code-source-position code pc)
  (define (stream-fold2 f stream s0 s1)
    (cond
     ((stream-null? stream) (values s0 s1))
     (else
      (call-with-values (lambda () (f (stream-car stream) s0 s1))
        (lambda (s0 s1)
          (stream-fold2 f (stream-cdr stream) s0 s1))))))
  (define (valid-position? reloc-info)
    (and (memq (reloc-info-type reloc-info)
               '(statement-position non-statement-position))
         (value<? (reloc-info-pc reloc-info) pc)))
  (define (find-closest-position reloc-info position distance)
    (let* ((distance* (value-sub pc (reloc-info-pc reloc-info)))
           (position* (value->integer (reloc-info-data reloc-info))))
      (if (or (not distance)
              (value<? distance* distance)
              (and (value=? distance* distance) (> position* position)))
          (values position* distance*)
          (values position distance))))
  (let ((stream (stream-filter valid-position? (reloc-info-stream code))))
    (stream-fold2 find-closest-position stream #f #f)))

(define (shared-function-info-script shared)
  (let ((script (v8-pointer-field shared "SharedFunctionInfo::kScriptOffset"
                                  "Object")))
    (v8-constant-case (instance-type script)
      (("SCRIPT_TYPE") script)
      (else #f))))

(define (script-source script)
  (let ((source (v8-pointer-field script "Script::kSourceOffset" "Object")))
    (and (v8-string? source) (v8-string-value source))))

(define (source-line-number-and-column source pos)
  (let lp ((line 0) (cur -1) (column 0))
    (if (and cur (< cur pos))
        (lp (1+ line) (string-index source #\newline (1+ cur)) (- pos cur))
        (values line (1- column)))))

(define (script-line-number-and-column script pos)
  (let ((source (script-source script)))
    (if source
        (source-line-number-and-column source pos)
        (values #f #f))))

(define (script-name script)
  (let ((name (v8-pointer-field script "Script::kNameOffset" "Object")))
    (and (v8-string? name) (v8-string-value name))))

(define* (v8-frame-function-name frame #:key zealous?)
  (case (v8-frame-type frame)
    ((javascript optimized)
     (let* ((function (js-frame-function frame))
            (shared (js-function-shared-function-info function)))
       (or (shared-function-info-name shared)
           (and zealous?
                (format #f "<anonymous function 0x~x>"
                        (value->integer function))))))
    (else
     (and zealous?
          (format #f "[~a frame]" (v8-frame-type frame))))))

(define (v8-frame-filename frame)
  (case (v8-frame-type frame)
    ((javascript optimized)
     (let* ((function (js-frame-function frame))
            (shared (js-function-shared-function-info function))
            (script (shared-function-info-script shared)))
       (and=> script script-name)))
    (else #f)))

(define (v8-frame-line frame)
  (case (v8-frame-type frame)
    ((javascript optimized)
     (let* ((function (js-frame-function frame))
            (code (js-function-code function))
            (shared (js-function-shared-function-info function))
            (script (shared-function-info-script shared)))
       (and script
            (let ((pos (code-source-position code (v8-frame-pc frame))))
              (and pos (script-line-number-and-column script pos))))))
    (else #f)))

(define* (dump-v8-frame frame #:optional (port (current-output-port)))
  (format port "  type: ~a~%" (v8-frame-type frame))
  (format port "    sp: 0x~x~%" (value->integer (v8-frame-sp frame)))
  (format port "    fp: 0x~x~%" (value->integer (v8-frame-fp frame)))
  (let ((pc (v8-frame-pc frame)))
    (format port "    pc: 0x~x~%" (value->integer pc))
    (case (v8-frame-type frame)
      ;; code offset (pc - code->instruction_start())
      ((javascript optimized)
       (let* ((function (js-frame-function frame))
              (code (js-function-code function))
              (shared (js-function-shared-function-info function))
              (script (shared-function-info-script shared)))
         (format port "    name: ~a~a at ~a:~a~%"
                 (v8-frame-function-name frame #:zealous? #t)
                 (if (code-optimized? code) " (optimized)" "")
                 (or (and=> script script-name) "<unknown>")
                 (or (and script
                          (let ((pos (code-source-position code pc)))
                            (and pos
                                 (script-line-number-and-column script pos))))
                     "<unknown>"))))))
  (values))

(define* (display-v8-frames #:optional (port (current-output-port)))
  "Display the VM frames on PORT."
  (stream-for-each (lambda (frame)
                     (dump-v8-frame frame port))
                   (v8-frames)))


;;;
;;; Frame filters.
;;;

(define-syntax compile-time-cond
  (lambda (x)
    (syntax-case x ()
      ((_ (test body ...) clause ...)
       (if (eval (syntax->datum #'test) (current-module))
           #'(begin body ...)
           #'(compile-time-cond clause ...)))
      ((_) #'(begin)))))

(compile-time-cond
 ((false-if-exception (resolve-interface '(gdb frame-filters)))
  (use-modules (gdb frame-filters))

  (define* (v8-frame-decorator frame)
    (define (decorate-frame gdb-frame v8-frame)
      (redecorate-frame gdb-frame
                        #:function-name (v8-frame-function-name v8-frame
                                                                #:zealous? #t)
                        #:address (value->integer (v8-frame-pc v8-frame))
                        #:filename (v8-frame-filename v8-frame)
                        #:line (v8-frame-line v8-frame)
                        #:arguments '()
                        #:locals '()
                        #:children '()))
    (cond
     ((cached-current-isolate)
      => (lambda (isolate)
           (let* ((inferior-frame (decorated-frame-frame frame))
                  (pc (frame-read-register inferior-frame "rip"))
                  (fp (frame-read-register inferior-frame "rbp"))
                  (sp (frame-read-register inferior-frame "rsp")))
             (cond
              ((lookup-code-for-pc pc isolate)
               => (lambda (code)
                    (let ((v8-frame (build-js-frame sp fp pc isolate)))
                      (decorate-frame frame v8-frame))))
              (else frame)))))
     (else frame)))

  (define* (install-frame-decorators #:optional (scope (current-objfile)))
    (register-frame-filter!
     (make-decorating-frame-filter "guile-v8-frame-decorator"
                                   v8-frame-decorator)
     #:scope scope)))
 (#t
  (define (install-frame-decorators)
    (values))))

(define-syntax-rule (define-command (name kwarg ...) doc clause ...)
  (let ((proc (lambda (self args from-tty?)
                doc
                (match (string->argv args)
                  clause ...
                  (args (format #t "Bad arguments to \"~a\": ~a.
Try \"help ~A\" for documentation on the syntax for this command."
                                name args name))))))
    (register-command!
     (make-command name #:invoke proc #:doc doc kwarg ...))))

(define-command ("v8"
                 #:prefix? #t
                 #:command-class COMMAND_USER
                 #:completer-class COMPLETE_COMMAND)
  "V8 commands."
  (args
   (format #t "Usage: v8 COMMAND

Available commands:

  v8 disassemble [LOCATION]

Try \"help v8 COMMAND\" to get help on a specific COMMAND.
")))

(define (print-info port highlight? addr asm extra source)
  (format port "~@[\n~a:\n~]~:[   ~;==>~] 0x~x  ~a~{~{~47t ;; ~@?~}~^~%~}\n"
          source highlight? addr asm extra))

(define (relocs-for-addr relocs addr)
  (let lp ((relocs relocs)
           (extra '())
           (source #f))
    (cond
     ((stream-null? relocs) (values relocs extra source))
     ((value<=? (reloc-info-pc (stream-car relocs)) addr)
      (let* ((reloc (stream-car relocs))
             (relocs (stream-cdr relocs))
             (type (reloc-info-type reloc))
             (data (reloc-info-data reloc)))
        (case type
          ((statement-position non-statement-position)
           (lp relocs extra (value->integer data)))
          ((comment)
           (let* ((char (arch-char-type (current-arch)))
                  (char* (type-pointer char))
                  (str (value->string (value-cast data char*))))
             (lp relocs
                 (cons (list "~a" str) extra)
                 source)))
          (else
           (lp relocs
               (cons (if data
                         (list "~a=~a" type data)
                         (list "~a" type))
                     extra)
               source)))))
     (else (values relocs extra source)))))

(define* (disassemble-code code #:optional pc #:key function)
  (define (printable-source pos)
    (cond
     ((not pos) #f)
     (function
      (let* ((shared (js-function-shared-function-info function))
             (script (shared-function-info-script shared)))
        (if script
            (call-with-values (lambda ()
                                (script-line-number-and-column script pos))
              (lambda (line column)
                (format #f "~a:~a:~a" (script-name script) line column)))
            (format #f "+~a" pos))))
     (else (format #f "+~a" pos))))
  (let* ((arch (current-arch))
         (start (value->integer (code-instruction-start code)))
         (end (+ start (value->integer (code-instruction-size code)))))
    (let lp ((addr start)
             (relocs (reloc-info-stream code)))
      (when (< addr end)
        (match (arch-disassemble arch addr)
          ((inst)
           (let* ((disasm (assq-ref inst 'asm))
                  (len (assq-ref inst 'length)))
             (call-with-values (lambda () (relocs-for-addr relocs addr))
               (lambda (relocs extra source)
                 (print-info #t (and pc (value=? addr pc)) addr disasm extra
                             (printable-source source))
                 (lp (+ addr len) relocs))))))))))

(define* (v8-disassemble #:key frame
                         (pc (if frame
                                 (frame-read-register frame "pc")
                                 (parse-and-eval "$pc")))
                         (isolate (current-isolate)))
  (cond
   ((not isolate)
    (format #t "No current isolate; don't know how to get to the V8 heap.\n"))
   ((lookup-code-for-pc pc isolate)
    => (lambda (code)
         (disassemble-code code pc
                           #:function
                           (and frame
                                (let ((fp (frame-read-register frame "rbp")))
                                  (js-frame-function-by-fp fp))))))
   (else
    (format #t "PC 0x~x does not appear to be in a V8 function.\n"
            (value->integer pc)))))

(define-command ("v8 disassemble"
                 #:command-class COMMAND_USER
                 #:completer-class COMPLETE_LOCATION)
  "Disassemble a V8 function."
  (()
   (v8-disassemble #:frame (selected-frame)))
  ((location)
   (v8-disassemble #:pc (parse-and-eval location))))

(compile-time-cond
 ((false-if-exception (resolve-interface '(gdb frame-unwinders)))
  (use-modules (gdb frame-unwinders))

  (define (unwind-v8-frame frame)
    (and-let* ((isolate (cached-current-isolate))
               (this-pc (ephemeral-frame-read-register frame "rip"))
               (this-fp (ephemeral-frame-read-register frame "rbp"))
               (code (lookup-code-for-pc this-pc isolate))
               (info (make-unwind-info frame this-fp (code-instruction-start code)))
               (type (if (code-optimized? code) 'javascript 'optimized))
               (prev-pc-address (compute-standard-frame-pc-address this-fp))
               (prev-sp (compute-frame-older-sp this-fp type))
               (prev-fp (compute-standard-frame-older-fp this-fp))
               (prev-pc (value-dereference prev-pc-address)))
      (unwind-info-add-saved-register! info "rsp" prev-sp)
      (unwind-info-add-saved-register! info "rbp" prev-fp)
      (unwind-info-add-saved-register! info "rip" prev-pc)
      info))

  (define* (install-frame-unwinders #:optional (scope (current-objfile)))
    (register-frame-unwinder!
     (make-frame-unwinder "guile-v8-frame-unwinder" unwind-v8-frame)
     #:scope scope)))
 (#t
  (define (install-frame-unwinders)
    (values))))

(install-pretty-printers)
(install-frame-decorators)
(install-frame-unwinders)