From 53d4b9f012b45d7c4f20b63029564a80a46609ec Mon Sep 17 00:00:00 2001 From: "Michael R. Blair" Date: Thu, 13 Jul 1995 01:54:47 +0000 Subject: [PATCH] Initial revision --- v7/src/wabbit/wabbit.scratch | 221 +++++++++++++++++++++++++++++++++++ 1 file changed, 221 insertions(+) create mode 100644 v7/src/wabbit/wabbit.scratch diff --git a/v7/src/wabbit/wabbit.scratch b/v7/src/wabbit/wabbit.scratch new file mode 100644 index 000000000..4df5de358 --- /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) + +|# + +#| 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 + + #(#[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 +|# -- 2.25.1