Initial revision

diff --git a/v7/src/wabbit/wabbit.scratch b/v7/src/wabbit/wabbit.scratch
new file mode 100644 (file)
index 0000000..4df5de3
--- /dev/null
+++ b/v7/src/wabbit/wabbit.scratch
@@ -0,0 +1,221 @@
+;;; -*- Scheme -*-
+
+(DECLARE (USUAL-INTEGRATIONS)) ; MIT Scheme-ism: promise not to redefine prims
+
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/wabbit/wabbit.scratch,v 1.1 1995/07/13 01:54:47 ziggy Exp $
+
+;;
+;; Serious monkey-ing around with the Wabbit hunting / Headhunting facility...
+;;
+
+(define (wabbit-setup)
+  (begin
+
+    (ge '(pc-sample code-blocks))      ; for losing imports
+
+    (load-option 'wabbit)
+    (load-option 'pc-sample)
+
+    )
+  )
+
+;; handy utils
+
+(define   dbg-procedure/source-code
+  (access dbg-procedure/source-code (->environment '(runtime compiler-info))))
+
+(define (code-block/lambda cobl)
+  (dbg-procedure/source-code
+   (vector-ref (dbg-info/procedures (compiled-code-block/dbg-info cobl
+                                                                 'load))
+              0)))
+
+#| Hunt a wascally wabbit... [used to generate null refs... now some constants]
+  -----------------------
+
+(wabbit-setup)
+
+(define lnda
+  (access lambda/name/display-acate (->environment '(pc-sample display))))
+
+(begin
+  (wabbit-season!
+   (make-wabbit-descwiptor false                       ; punt flag
+                          (vector lnda)                ; wabbit vector
+                          (make-vector 100 false)      ; wabbit buffer
+                          false                        ; headhunt flag
+                          ))
+  'be-careful!)
+
+(gc-flip)
+
+(define done (duck-season!))
+
+(pp (vector-ref done 0))
+(pp (vector-ref done 1))
+
+(define xx (vector-ref done 2))
+
+|#
+
+#| Frob the result ...
+
+(vector-ref xx 0)
+(vector-ref xx 1)
+(vector-ref xx 2)
+(vector-ref xx 3)
+(vector-ref xx 4)
+(vector-ref xx 5)
+
+|#
+\f
+#| was this ......
+
+lnda
+;Value 31: #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678]
+
+(pp xx)
+#(#t
+  22
+  #[compiled-code-block 32]            ; [ref is in linkage section]
+  212
+  #[compiled-code-block 33]            ; [ref is in linkage section] >>>-----.
+  346
+  #\M-S-T-DC4
+  0
+  #\C-H-DC4
+  0
+  #\C-H-<
+  0
+  #(#[compiled-code-block 116]
+    #[compiled-code-block 115]
+    #[compiled-code-block 114]
+    #[compiled-code-block 113]
+    #[compiled-code-block 112]
+    #[compiled-code-block 111]
+    #[compiled-code-block 110]
+    #[compiled-code-block 109]
+    #[compiled-code-block 108]
+    #[compiled-code-block 107]
+    #[compiled-code-block 106]
+    #[compiled-code-block 105]
+    #[compiled-code-block 104]
+    #[compiled-code-block 103]
+    #[compiled-code-block 102]
+    #[compiled-code-block 101]
+    #[compiled-code-block 100]
+    #[compiled-code-block 99]
+    #[compiled-code-block 98]
+    #[compiled-code-block 97]
+    #[compiled-code-block 96]
+    #[compiled-code-block 95]
+    #[compiled-code-block 94]
+    #[compiled-code-block 93]
+    #[compiled-code-block 33]          ; [ref is in linkage section] <<<-----'
+    #[compiled-code-block 92]
+    #[compiled-code-block 91]
+    #[compiled-code-block 90]
+    #[compiled-code-block 89]
+    #[compiled-code-block 88]
+    #[compiled-code-block 87]
+    #[compiled-code-block 32]
+    #[compiled-code-block 86]
+    #[compiled-code-block 85]
+    #[compiled-code-block 84]
+    #[compiled-code-block 83]
+    #[compiled-code-block 82]
+    #[compiled-code-block 81]
+    #[compiled-code-block 80]
+    #[compiled-code-block 79]
+    #[compiled-code-block 78]
+    #[compiled-code-block 77]
+    #[compiled-code-block 76]
+    #[compiled-code-block 75]
+    #[compiled-code-block 74]
+    #[compiled-code-block 73]
+    #[compiled-code-block 72]
+    #[compiled-code-block 71]
+    #[compiled-code-block 70]
+    #[compiled-code-block 69]
+    #[compiled-code-block 68]
+    #[compiled-code-block 67])
+  24
+\f
+  #(#[compiled-procedure 66 ("pcsdisp" #x1) #x14 #x5587C8]
+    get-primitive-name
+    #[compiled-procedure 65 ("pcsdisp" #x2) #x14 #x558800]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[compiled-procedure 64 ("pcsdisp" #x3) #x14 #x558B08]
+    #[compiled-procedure 63 ("pcsdisp" #x4) #x14 #x558D10]
+    #[compiled-procedure 62 ("pcsdisp" #x5) #x14 #x558D58]
+    #[compiled-procedure 61 ("pcsdisp" #x6) #x14 #x558DA0]
+    #[compiled-procedure 60 ("pcsdisp" #x7) #x14 #x558DE8]
+    #[compiled-procedure 59 ("pcsdisp" #x8) #x14 #x558F10]
+    #[compiled-procedure 58 ("pcsdisp" #x9) #x14 #x558FE0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[reference-trap #x0]
+    #[compiled-procedure 57 ("pcsdisp" #xA) #x14 #x559578]
+    #[compiled-procedure 56 ("pcsdisp" #xB) #x14 #x559708]
+    #[compiled-procedure 55 ("pcsdisp" #xC) #x14 #x559A40]
+    ()
+    #[compiled-procedure 54 ("pcsdisp" #xD) #x14 #x559F68]
+    #[compiled-procedure 53 ("pcsdisp" #xE) #x14 #x55A290]
+    #[compiled-procedure 52 ("pcsdisp" #xF) #x14 #x55A3A8]
+    #[compiled-procedure 51 ("pcsdisp" #x10) #x14 #x55A4C0]
+    #[compiled-procedure 50 ("pcsdisp" #x11) #x14 #x55A5A8]
+    #[compiled-procedure 49 ("pcsdisp" #x12) #x14 #x55AA50]
+    #[compiled-procedure 48 ("pcsdisp" #x13) #x14 #x55BB58]
+    #[compiled-procedure 47 ("pcsdisp" #x14) #x14 #x55BC48]
+    #[compiled-procedure 46 ("pcsdisp" #x15) #x14 #x55BD88]
+    #[compiled-procedure 45 ("pcsdisp" #x16) #x14 #x55C158]
+    #[compiled-procedure 44 ("pcsdisp" #x17) #x14 #x55C2D8]
+    #[compiled-procedure 43 ("pcsdisp" #x18) #x14 #x55C6B0]
+    #[compiled-procedure 42 ("pcsdisp" #x19) #x14 #x55CA88]
+    #[compiled-procedure 41 ("pcsdisp" #x1A) #x14 #x55CEE0]
+    #[compiled-procedure 40 ("pcsdisp" #x1B) #x14 #x55CFB8]
+    #[compiled-procedure 39 ("pcsdisp" #x1C) #x14 #x55D020]
+    #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678] ; <<<<
+    #[compiled-procedure 38 ("pcsdisp" #x1E) #x14 #x55D818]
+    #[compiled-procedure 37 ("pcsdisp" #x1F) #x14 #x55D960]
+    #[compiled-procedure 36 ("pcsdisp" #x20) #x14 #x55DD78])
+  45
+  (lnda . #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678])
+  1
+  #[weak-cons 35]
+  0
+  #[weak-cons 34]
+  0
+  ()                                   ; 23rd elt [@ index 22]
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  ()
+  .
+  .
+  .
+  ())
+;No value
+|#