shithub: femtolisp

Download patch

ref: aaa5cd4ca48ace29538f59436063544f3124535e
parent: e4415ad27d5d9730ffa6a6407869d0401f2bfa49
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Nov 10 13:10:07 EST 2024

disassembly: fix off-by-one offset for 1-byte instructions

Also stop disaseembling the whole call chain. Just the last one is
enough for now.

--- a/compiler.lsp
+++ b/compiler.lsp
@@ -688,7 +688,7 @@
                   (princ "@" (hex5 (+ i -4 (ref-int32-LE code i))))
                   (set! i (+ i 4)))
 
-                 (else (print-inst inst i 1))))))))
+                 (else (print-inst inst i 0))))))))
 
 ; From SRFI 89 by Marc Feeley (http://srfi.schemers.org/srfi-89/srfi-89.html)
 ; Copyright (C) Marc Feeley 2006. All Rights Reserved.
--- a/flisp.boot
+++ b/flisp.boot
@@ -159,7 +159,7 @@
   largc lvargc vargc argc compile-in ret values #fn(function) encode-byte-code
   bcode:code const-to-idx-vec)) filter keyword-arg?))
   #fn(length))) #fn(length))) make-code-emitter lastcdr lambda-vars filter #.pair?
-  λ))) #0=#(#:g726 ()))
+  λ))) #0=#(#:g728 ()))
 	    compile-for #fn(":000n57084513X07101O825447101O835447101O845447202362:742561:" #(1arg-lambda?
   compile-in emit for error "for: third form must be a 1-argument lambda") compile-for)
 	    compile-if #fn("<000n420>710517105183T728351738351B3;0748351@60755065:" #(#fn(";000n582DC>070AF9028364:82OC>070AF9028464:70AFO8254471A22053470AF902835449023<071A2352@:071A24153475A052470AF9028454475A162:" #(compile-in
@@ -203,7 +203,7 @@
   >= 1- " >" "  " hex5 ":  " #fn(string) "\t") print-inst)
   #fn("7000n1702161:" #(princ "\t")) #fn(":000n2D01L3E0420>2122>O735351@\x19/:" #(#fn(";000n170Ar4523907150@30D4E920K\x8022~4AKMz00423>061:" #(>
   newline #fn("7000n1702161:" #(princ "\t"))
-  #fn(">000n120021523\\0921A910r45349209327293191052G514910r4Mz10:20023523W0921A910K534920932931910GG514910KMz10:20024523V0921A910K5347526931910G51514910KMz10:20027523[0921A910r45347526729319105251514910r4Mz10:20028523r0921A910r25347526931910G5129524910KMz1047526931910G51514910KMz10:2002:523\xb50921A910r8A2;C70r4@30EM534752672931910525129524910r4Mz1047526729319105251514910r4Mz104A2;CX07529514752672931910525129524910r4Mz10:D:02<c3]0921A910r4534752672931910525129524910r4Mz10:2002=523d0921A910r2534752>7?910r,7@93191052g351524910r2Mz10:2002A523d0921A910r4534752>7?910r,7293191052g351524910r4Mz10:921A910K63:" #(#fn(memq)
+  #fn(">000n120021523\\0921A910r45349209327293191052G514910r4Mz10:20023523W0921A910K534920932931910GG514910KMz10:20024523V0921A910K5347526931910G51514910KMz10:20027523[0921A910r45347526729319105251514910r4Mz10:20028523r0921A910r25347526931910G5129524910KMz1047526931910G51514910KMz10:2002:523\xb50921A910r8A2;C70r4@30EM534752672931910525129524910r4Mz1047526729319105251514910r4Mz104A2;CX07529514752672931910525129524910r4Mz10:D:02<c3]0921A910r4534752672931910525129524910r4Mz10:2002=523d0921A910r2534752>7?910r,7@93191052g351524910r2Mz10:2002A523d0921A910r4534752>7?910r,7293191052g351524910r4Mz10:921A910E63:" #(#fn(memq)
   (loadv.l loadg.l setg.l) ref-int32-LE (loadv loadg setg)
   (loada seta call tcall list + - * / vector argc vargc loadi8 apply tapply)
   princ #fn(number->string) (loada.l seta.l largc lvargc call.l tcall.l) (loadc
@@ -373,7 +373,7 @@
   string-join #fn(map) #fn(string) reverse! "/" λ))
 			    #fn("8000n07021>F524O:" #(for-each #fn("9000n19100Aq63:" #())))
 			    #fn("7000n10B;3B040<20Q;38040T21Q38072061:23061:" #(thrown-value
-  ffound caddr #fn(raise)))) fn-name) #fn("8000n37021>062:" #(for-each #fn("9000n1709110KGF5271051==P51472504730KG0EG524902KMz02:" #(print
+  ffound caddr #fn(raise)))) fn-name) #fn("8000n37021>062:" #(for-each #fn("9000n1709110KGF5271051==P51472504902El3?0730KG0EG52@30O4902KMz02:" #(print
   vector->list newline disassemble)))) reverse! length> list-tail *interactive*
   filter closure? #fn(map) #fn("7000n10Z;380420061:" #(#fn(top-level-value)))
   #fn(environment)))) print-stack-trace)
--- a/system.lsp
+++ b/system.lsp
@@ -944,7 +944,7 @@
        (print (cons (fn-name (aref f 1) e)
                     (cdr (cdr (vector->list f)))))
        (newline)
-       (disassemble (aref f 1) (aref f 0))
+       (when (= n 0) (disassemble (aref f 1) (aref f 0)))
        (set! n (+ n 1)))
      st)))