home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / wabbit / wabbit.scratch < prev    next >
Text File  |  2000-03-20  |  6KB  |  222 lines
  1. ;;; -*- Scheme -*-
  2.  
  3. (DECLARE (USUAL-INTEGRATIONS))    ; MIT Scheme-ism: promise not to redefine prims
  4.  
  5. ;;; $Id: wabbit.scratch,v 1.2 2000/03/21 04:37:32 cph Exp $
  6.  
  7. ;;
  8. ;; Serious monkey-ing around with the Wabbit hunting / Headhunting facility...
  9. ;;
  10.  
  11. (define (wabbit-setup)
  12.   (begin
  13.  
  14.     (ge '(pc-sample code-blocks))    ; for losing imports
  15.  
  16.     (load-option 'wabbit)
  17.     (load-option 'pc-sample)
  18.  
  19.     )
  20.   )
  21.  
  22. ;; handy utils
  23.  
  24. (define   dbg-procedure/source-code
  25.   (access dbg-procedure/source-code (->environment '(runtime compiler-info))))
  26.  
  27. (define (code-block/lambda cobl)
  28.   (dbg-procedure/source-code
  29.    (vector-ref (dbg-info/procedures (compiled-code-block/dbg-info cobl
  30.                                   'load))
  31.            0)))
  32.  
  33. #| Hunt a wascally wabbit... [used to generate null refs... now some constants]
  34.   -----------------------
  35.  
  36. (wabbit-setup)
  37.  
  38. (define lnda
  39.   (access lambda/name/display-acate (->environment '(pc-sample display))))
  40.  
  41. (begin
  42.   (wabbit-season!
  43.    (make-wabbit-descwiptor false             ; punt flag
  44.                (vector lnda)              ; wabbit vector
  45.                (make-vector 100 false)    ; wabbit buffer
  46.                false                  ; headhunt flag
  47.                ))
  48.   'be-careful!)
  49.  
  50. (gc-flip)
  51.  
  52. (define done (duck-season!))
  53.  
  54. (pp (vector-ref done 0))
  55. (pp (vector-ref done 1))
  56.  
  57. (define xx (vector-ref done 2))
  58.  
  59. |#
  60.  
  61. #| Frob the result ...
  62.  
  63. (vector-ref xx 0)
  64. (vector-ref xx 1)
  65. (vector-ref xx 2)
  66. (vector-ref xx 3)
  67. (vector-ref xx 4)
  68. (vector-ref xx 5)
  69.  
  70. |#
  71.  
  72. #| was this ......
  73.  
  74. lnda
  75. ;Value 31: #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678]
  76.  
  77. (pp xx)
  78. #(#t
  79.   22
  80.   #[compiled-code-block 32]        ; [ref is in linkage section]
  81.   212
  82.   #[compiled-code-block 33]        ; [ref is in linkage section] >>>-----.
  83.   346
  84.   #\M-S-T-DC4
  85.   0
  86.   #\C-H-DC4
  87.   0
  88.   #\C-H-<
  89.   0
  90.   #(#[compiled-code-block 116]
  91.     #[compiled-code-block 115]
  92.     #[compiled-code-block 114]
  93.     #[compiled-code-block 113]
  94.     #[compiled-code-block 112]
  95.     #[compiled-code-block 111]
  96.     #[compiled-code-block 110]
  97.     #[compiled-code-block 109]
  98.     #[compiled-code-block 108]
  99.     #[compiled-code-block 107]
  100.     #[compiled-code-block 106]
  101.     #[compiled-code-block 105]
  102.     #[compiled-code-block 104]
  103.     #[compiled-code-block 103]
  104.     #[compiled-code-block 102]
  105.     #[compiled-code-block 101]
  106.     #[compiled-code-block 100]
  107.     #[compiled-code-block 99]
  108.     #[compiled-code-block 98]
  109.     #[compiled-code-block 97]
  110.     #[compiled-code-block 96]
  111.     #[compiled-code-block 95]
  112.     #[compiled-code-block 94]
  113.     #[compiled-code-block 93]
  114.     #[compiled-code-block 33]        ; [ref is in linkage section] <<<-----'
  115.     #[compiled-code-block 92]
  116.     #[compiled-code-block 91]
  117.     #[compiled-code-block 90]
  118.     #[compiled-code-block 89]
  119.     #[compiled-code-block 88]
  120.     #[compiled-code-block 87]
  121.     #[compiled-code-block 32]
  122.     #[compiled-code-block 86]
  123.     #[compiled-code-block 85]
  124.     #[compiled-code-block 84]
  125.     #[compiled-code-block 83]
  126.     #[compiled-code-block 82]
  127.     #[compiled-code-block 81]
  128.     #[compiled-code-block 80]
  129.     #[compiled-code-block 79]
  130.     #[compiled-code-block 78]
  131.     #[compiled-code-block 77]
  132.     #[compiled-code-block 76]
  133.     #[compiled-code-block 75]
  134.     #[compiled-code-block 74]
  135.     #[compiled-code-block 73]
  136.     #[compiled-code-block 72]
  137.     #[compiled-code-block 71]
  138.     #[compiled-code-block 70]
  139.     #[compiled-code-block 69]
  140.     #[compiled-code-block 68]
  141.     #[compiled-code-block 67])
  142.   24
  143.  
  144.   #(#[compiled-procedure 66 ("pcsdisp" #x1) #x14 #x5587C8]
  145.     get-primitive-name
  146.     #[compiled-procedure 65 ("pcsdisp" #x2) #x14 #x558800]
  147.     #[reference-trap #x0]
  148.     #[reference-trap #x0]
  149.     #[reference-trap #x0]
  150.     #[reference-trap #x0]
  151.     #[reference-trap #x0]
  152.     #[reference-trap #x0]
  153.     #[reference-trap #x0]
  154.     #[compiled-procedure 64 ("pcsdisp" #x3) #x14 #x558B08]
  155.     #[compiled-procedure 63 ("pcsdisp" #x4) #x14 #x558D10]
  156.     #[compiled-procedure 62 ("pcsdisp" #x5) #x14 #x558D58]
  157.     #[compiled-procedure 61 ("pcsdisp" #x6) #x14 #x558DA0]
  158.     #[compiled-procedure 60 ("pcsdisp" #x7) #x14 #x558DE8]
  159.     #[compiled-procedure 59 ("pcsdisp" #x8) #x14 #x558F10]
  160.     #[compiled-procedure 58 ("pcsdisp" #x9) #x14 #x558FE0]
  161.     #[reference-trap #x0]
  162.     #[reference-trap #x0]
  163.     #[reference-trap #x0]
  164.     #[reference-trap #x0]
  165.     #[reference-trap #x0]
  166.     #[reference-trap #x0]
  167.     #[reference-trap #x0]
  168.     #[compiled-procedure 57 ("pcsdisp" #xA) #x14 #x559578]
  169.     #[compiled-procedure 56 ("pcsdisp" #xB) #x14 #x559708]
  170.     #[compiled-procedure 55 ("pcsdisp" #xC) #x14 #x559A40]
  171.     ()
  172.     #[compiled-procedure 54 ("pcsdisp" #xD) #x14 #x559F68]
  173.     #[compiled-procedure 53 ("pcsdisp" #xE) #x14 #x55A290]
  174.     #[compiled-procedure 52 ("pcsdisp" #xF) #x14 #x55A3A8]
  175.     #[compiled-procedure 51 ("pcsdisp" #x10) #x14 #x55A4C0]
  176.     #[compiled-procedure 50 ("pcsdisp" #x11) #x14 #x55A5A8]
  177.     #[compiled-procedure 49 ("pcsdisp" #x12) #x14 #x55AA50]
  178.     #[compiled-procedure 48 ("pcsdisp" #x13) #x14 #x55BB58]
  179.     #[compiled-procedure 47 ("pcsdisp" #x14) #x14 #x55BC48]
  180.     #[compiled-procedure 46 ("pcsdisp" #x15) #x14 #x55BD88]
  181.     #[compiled-procedure 45 ("pcsdisp" #x16) #x14 #x55C158]
  182.     #[compiled-procedure 44 ("pcsdisp" #x17) #x14 #x55C2D8]
  183.     #[compiled-procedure 43 ("pcsdisp" #x18) #x14 #x55C6B0]
  184.     #[compiled-procedure 42 ("pcsdisp" #x19) #x14 #x55CA88]
  185.     #[compiled-procedure 41 ("pcsdisp" #x1A) #x14 #x55CEE0]
  186.     #[compiled-procedure 40 ("pcsdisp" #x1B) #x14 #x55CFB8]
  187.     #[compiled-procedure 39 ("pcsdisp" #x1C) #x14 #x55D020]
  188.     #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678] ; <<<<
  189.     #[compiled-procedure 38 ("pcsdisp" #x1E) #x14 #x55D818]
  190.     #[compiled-procedure 37 ("pcsdisp" #x1F) #x14 #x55D960]
  191.     #[compiled-procedure 36 ("pcsdisp" #x20) #x14 #x55DD78])
  192.   45
  193.   (lnda . #[compiled-procedure 31 ("pcsdisp" #x1D) #x14 #x55D678])
  194.   1
  195.   #[weak-cons 35]
  196.   0
  197.   #[weak-cons 34]
  198.   0
  199.   ()                    ; 23rd elt [@ index 22]
  200.   ()
  201.   ()
  202.   ()
  203.   ()
  204.   ()
  205.   ()
  206.   ()
  207.   ()
  208.   ()
  209.   ()
  210.   ()
  211.   ()
  212.   ()
  213.   ()
  214.   ()
  215.   ()
  216.   .
  217.   .
  218.   .
  219.   ())
  220. ;No value
  221. |#
  222.