home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / clisp / src / archive / clisp.faslsp.lha / trace.fas < prev    next >
Text File  |  1996-06-17  |  9KB  |  188 lines
  1. (SYSTEM::VERSION '(SYSTEM::CLISP2 13. LISP:T 130695.))
  2. #Y(#:TOP-LEVEL-FORM-1 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "LISP")
  3. #Y(#:TOP-LEVEL-FORM-2 #13Y(00 00 00 00 00 01 D8 37 01 30 DA 19 01)
  4.    (TRACE UNTRACE *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  5.   )
  6. #Y(#:TOP-LEVEL-FORM-3 #13Y(00 00 00 00 00 01 D8 37 02 30 E3 19 01) "SYSTEM")
  7. #Y(#:TOP-LEVEL-FORM-4 #11Y(00 00 00 00 00 01 D8 30 5D 19 01)
  8.    (SPECIAL *TRACE-FUNCTION* *TRACE-ARGS* *TRACE-FORM* *TRACE-VALUES*)
  9.   )
  10. #Y(#:TOP-LEVEL-FORM-5
  11.    #20Y(00 00 00 00 00 01 D8 30 5D D9 8B 52 04 D9 62 30 55 C4 19 01)
  12.    (SPECIAL *TRACED-FUNCTIONS*) *TRACED-FUNCTIONS*
  13.   )
  14. #Y(#:TOP-LEVEL-FORM-6
  15.    #20Y(00 00 00 00 00 01 D8 30 5D D9 8B 52 04 D9 DA 30 55 C4 19 01)
  16.    (SPECIAL *TRACE-LEVEL*) *TRACE-LEVEL* 0.
  17.   )
  18. #Y(#:TOP-LEVEL-FORM-7
  19.    #18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) TRACE
  20.    REMOVE-OLD-DEFINITIONS MACRO
  21.    #Y(TRACE
  22.       #58Y(00 01 00 01 00 08 94 02 92 00 05 D9 62 AC 1A 1D C3 19 04 AA 2E 03 1A
  23.            0E 93 00 9B 1F 76 AA 87 02 72 98 03 9C 36 00 14 83 02 16 01 82 00 9B
  24.            20 68 16 01 AA 30 A7 16 01 5C 19 04
  25.           )
  26.       *TRACED-FUNCTIONS* APPEND FUNCTION-NAME-P TRACE1
  27.   )  )
  28. #Y(#:TOP-LEVEL-FORM-8 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  29.    TRACE1 REMOVE-OLD-DEFINITIONS
  30.    #Y(TRACE1
  31.       #528Y(00 01 00 00 80 1C 00 09 00 00 3C 09 3C 08 3C 07 3C 06 3C 05 3C 04
  32.             3C 03 3C 02 3C 01 37 01 71 90 37 01 71 90 B6 88 09 81 82 A7 1F 81
  33.             8A E9 EA E8 04 0F 5B 77 7A 02 60 02 14 7A 02 EB 62 EC ED AE 7A 02
  34.             EE EF F0 E8 BF 7A 02 7A 04 03 19 7B 03 F2 F3 AF 7A 02 EE F4 F5 E8
  35.             C0 7A 02 7A 04 03 1E 7B 03 64 1F B1 64 20 B1 7A 02 7A 02 B1 64 21
  36.             B4 7A 02 7A 02 7A 02 EC 64 22 B4 64 23 B4 03 24 7B 02 7A 03 64 25
  37.             64 23 B4 03 26 7B 02 B6 7A 03 64 27 E8 C2 7A 02 03 28 7B 02 7A 04
  38.             64 29 63 64 2A B5 E8 65 19 7A 02 7A 05 64 2B 64 23 B4 03 2C 7B 02
  39.             E8 C2 7A 02 B7 64 25 64 23 B8 03 2D 7B 02 64 25 64 20 BA 7A 02 64
  40.             2E 65 1E 6E 2F 6F 30 64 31 64 32 64 33 EB 62 EC 65 23 03 34 7B 02
  41.             91 1D 80 DC 00 14 91 1C 80 E5 00 14 65 23 91 22 80 EC 00 14 64 32
  42.             64 38 64 36 64 39 65 2A 03 3A 7B 02 7A 02 7A 02 7A 01 91 24 80 DE
  43.             00 14 65 27 91 23 80 E2 00 14 91 25 80 EB 00 14 EC 65 2E 03 3C 7B
  44.             02 03 3D 79 32 03 23 79 32 02 23 7B 02 7A 01 32 02 23 79 32 03 23
  45.             7B 03 7A 03 7A 02 64 39 64 3E BF 7A 02 64 3F AE 64 40 64 41 64 42
  46.             64 43 64 44 64 45 E8 65 2A 7A 02 03 46 7B 02 7A 02 64 47 64 48 65
  47.             1D 7A 02 7A 02 7A 05 A1 7B 02 7A 03 64 49 64 4A 64 3F B1 64 40 64
  48.             41 64 42 64 43 64 4B 64 47 64 4C 64 48 65 21 7A 02 7A 02 7A 02 7A
  49.             05 A4 7B 02 7A 03 7A 03 60 04 16 01 F6 7A 03 7A 03 7A 05 7A 05 E8
  50.             BD 7A 01 7A 02 60 06 19 0E E2 E3 E4 E5 6D 03 0E E7 B9 32 02 1F E8
  51.             A8 1A FE 7C 64 35 64 36 65 1F 7A 02 7A 02 60 01 1A FF 16 64 35 64
  52.             36 65 1E 7A 02 7A 02 60 01 1A FF 0D F2 65 23 03 37 7B 02 60 01 1A
  53.             FF 09 F2 65 25 03 3B 7B 02 60 01 1A FF 17 64 35 64 36 65 25 7A 02
  54.             7A 02 60 01 1A FF 10 64 35 64 36 65 27 7A 02 7A 02 60 01 1A FF 07
  55.            )
  56.       :SUPPRESS-IF :STEP-IF :PRE :POST :PRE-BREAK-IF :POST-BREAK-IF :PRE-PRINT
  57.       :POST-PRINT :PRINT FUNCTION-NAME-P PROGRAM-ERROR
  58.       "~S: function name should be a symbol, not ~S"
  59.       "~S: Funktionsname sollte ein Symbol sein, nicht ~S"
  60.       "~S : Le nom de la fonction doit être un symbole et non ~S" LANGUAGE
  61.       TRACE QUOTE LOAD-TIME-VALUE GET-SETF-SYMBOL BLOCK UNLESS FBOUNDP WARN
  62.       (LANGUAGE "~S: undefined function ~S"
  63.         "~S: Funktion ~S ist nicht definiert."
  64.         "~S : La fonction ~S n'est pas définie."
  65.       )
  66.       'TRACE ((RETURN NIL)) WHEN SPECIAL-FORM-P
  67.       (LANGUAGE "~S: cannot trace special form ~S"
  68.         "~S: Special-Form ~S kann nicht getraced werden."
  69.         "~S : La forme spéciale ~S ne peut pas être tracée."
  70.       )
  71.       'TRACE ((RETURN NIL)) LET* SYMBOL-FUNCTION CONSP EQ GET
  72.       ('TRACING-DEFINITION) SETF ('TRACED-DEFINITION) PUSHNEW
  73.       (*TRACED-FUNCTIONS* :TEST #'EQUAL) FORMAT
  74.       (LANGUAGE "~&;; Tracing ~:[function~;macro~] ~S."
  75.         "~&;; ~:[Funktion~;Macro~] ~S wird getraced."
  76.         "~&;; Traçage ~:[de la fonction~;du macro~] ~S."
  77.       )
  78.       REPLACE-IN-FENV ('TRACED-DEFINITION) ('TRACING-DEFINITION) "TRACED-"
  79.       GET-FUNNAME-SYMBOL CONCAT-PNAMES
  80.       (DECLARE (COMPILE) (INLINE CAR CDR CONS APPLY VALUES-LIST)) LET
  81.       ((*TRACE-LEVEL* (TRACE-LEVEL-INC))) ((TRACE-PRE-OUTPUT)) TRACE-PRINT
  82.       MULTIPLE-VALUE-LIST ((BREAK-LOOP T)) *TRACE-VALUES* IF
  83.       ((TRACE-STEP-APPLY) (APPLY *TRACE-FUNCTION* *TRACE-ARGS*))
  84.       ((BREAK-LOOP T)) ((TRACE-POST-OUTPUT)) ((VALUES-LIST *TRACE-VALUES*)) NOT
  85.       FUNCTION LAMBDA &REST *TRACE-ARGS* &AUX *TRACE-FORM* MAKE-APPLY-FORM
  86.       (*TRACE-ARGS*) *TRACE-FUNCTION* GET-TRACED-DEFINITION CONS 'MACRO
  87.       (*TRACE-FORM* (CAR *TRACE-ARGS*)) CDR
  88.   )  )
  89. #Y(#:TOP-LEVEL-FORM-9 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  90.    REPLACE-IN-FENV REMOVE-OLD-DEFINITIONS
  91.    #Y(REPLACE-IN-FENV
  92.       #68Y(00 04 00 00 00 05 AE 8E 0C 04 AE 8E 0B 2C 00 19 05 14 71 48 D9 1A 1B
  93.            AC AB 31 98 5E 14 B1 8E 04 0B AC 9C 5E 14 A1 22 04 AE AD 9D 5F DA AB
  94.            81 02 35 00 AA AC 8E 03 60 00 19 08 AE D8 71 2E 91 00 50 00 19 06
  95.           )
  96.       5. 1. 2.
  97.   )  )
  98. #Y(#:TOP-LEVEL-FORM-10 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  99.    TRACE-LEVEL-INC REMOVE-OLD-DEFINITIONS
  100.    #Y(TRACE-LEVEL-INC #13Y(00 00 00 00 00 01 D8 6A 01 35 01 19 01) #.#'1+
  101.       *TRACE-LEVEL*
  102.   )  )
  103. #Y(#:TOP-LEVEL-FORM-11 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  104.    GET-TRACED-DEFINITION REMOVE-OLD-DEFINITIONS
  105.    #Y(GET-TRACED-DEFINITION #13Y(00 01 00 00 00 02 D8 AC D9 35 02 19 02)
  106.       #.#'GET TRACED-DEFINITION
  107.   )  )
  108. #Y(#:TOP-LEVEL-FORM-12 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  109.    TRACE-STEP-APPLY REMOVE-OLD-DEFINITIONS
  110.    #Y(TRACE-STEP-APPLY
  111.       #32Y(00 00 00 00 00 01 D8 D9 DA DB 6A 04 00 5C 79 DB 6A 05 00 5C 79 00 5C
  112.            5C 79 00 5C 79 35 01 19 01
  113.           )
  114.       #.#'EVAL STEP APPLY QUOTE *TRACE-FUNCTION* *TRACE-ARGS*
  115.   )  )
  116. #Y(#:TOP-LEVEL-FORM-13 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  117.    MAKE-APPLY-FORM REMOVE-OLD-DEFINITIONS
  118.    #Y(MAKE-APPLY-FORM
  119.       #37Y(00 02 00 00 00 03 AC 62 AD 1A 0D 93 00 D8 AB 00 5C 79 83 02 16 01 82
  120.            00 9B 20 70 16 01 AA 30 A7 16 01 5C 19 03
  121.           )
  122.       QUOTE
  123.   )  )
  124. #Y(#:TOP-LEVEL-FORM-14 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  125.    TRACE-PRE-OUTPUT REMOVE-OLD-DEFINITIONS
  126.    #Y(TRACE-PRE-OUTPUT
  127.       #38Y(00 00 00 00 00 01 D8 6A 01 35 01 DA 6A 03 DC 6A 01 DD DE DF 63 35 07
  128.            E0 E1 6A 01 35 02 E2 6A 0B 6A 01 35 02 19 01
  129.           )
  130.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  131.       :RADIX #.#'WRITE-STRING " Trace: " #.#'PRIN1 *TRACE-FORM*
  132.   )  )
  133. #Y(#:TOP-LEVEL-FORM-15 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  134.    TRACE-POST-OUTPUT REMOVE-OLD-DEFINITIONS
  135.    #Y(TRACE-POST-OUTPUT
  136.       #51Y(00 00 00 00 00 01 D8 6A 01 35 01 DA 6A 03 DC 6A 01 DD DE DF 63 35 07
  137.            E0 E1 6A 01 35 02 E2 0E 0B 77 DC 6A 01 35 03 E4 E5 6A 01 35 02 6A 0E
  138.            62 2F 0F 19 01
  139.           )
  140.       #.#'TERPRI *TRACE-OUTPUT* #.#'WRITE *TRACE-LEVEL* :STREAM :BASE 10.
  141.       :RADIX #.#'WRITE-STRING " Trace: " #.#'WRITE *TRACE-FORM*
  142.       #.#'WRITE-STRING " ==> " *TRACE-VALUES* TRACE-PRINT
  143.   )  )
  144. #Y(#:TOP-LEVEL-FORM-16 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  145.    TRACE-PRINT REMOVE-OLD-DEFINITIONS
  146.    #Y(TRACE-PRINT
  147.       #52Y(00 01 00 01 00 08 3A 01 07 7D 01 92 01 0A 1A 03 92 01 05 D8 6A 01 35
  148.            01 9D 1F 16 1A 06 DB DC 6A 01 35 02 93 02 DA AB 6A 01 35 02 16 01 82
  149.            02 20 6C 00 19 03
  150.           )
  151.       #.#'TERPRI *TRACE-OUTPUT* #.#'PRIN1 #.#'WRITE-STRING ", "
  152.   )  )
  153. #Y(#:TOP-LEVEL-FORM-17
  154.    #18Y(00 00 00 00 00 01 D8 2E 01 D8 DA C6 79 31 82 C3 19 01) UNTRACE
  155.    REMOVE-OLD-DEFINITIONS MACRO
  156.    #Y(UNTRACE
  157.       #25Y(00 01 00 01 00 08 94 02 D8 D9 92 02 09 DB AD 60 02 14 60 03 19 04 C5
  158.            1A 78
  159.           )
  160.       MAPCAN #'UNTRACE1 (COPY-LIST *TRACED-FUNCTIONS*) QUOTE
  161.   )  )
  162. #Y(#:TOP-LEVEL-FORM-18 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  163.    UNTRACE1 REMOVE-OLD-DEFINITIONS
  164.    #Y(UNTRACE1
  165.       #89Y(00 01 00 00 00 02 AB 88 00 14 AB 6E 07 AA E0 37 01 71 84 91 00 23 00
  166.            14 AE 2E 0F 15 19 04 D9 DA DB DC 6D 03 05 DE AE 32 02 1F AA AE 9E 5D
  167.            14 AD 2C 04 0A AB AB 31 82 1A 1A AB 8C 53 0B 9C 5D 14 AC E1 37 01 31
  168.            84 21 62 E3 E4 E5 6D 03 05 DE AF 2C 03 0E AD 60 01 1A FF BE
  169.           )
  170.       FUNCTION-NAME-P PROGRAM-ERROR
  171.       "~S: function name should be a symbol, not ~S"
  172.       "~S: Funktionsname sollte ein Symbol sein, nicht ~S"
  173.       "~S : Le nom de la fonction doit être un symbole et non ~S" LANGUAGE
  174.       UNTRACE GET-FUNNAME-SYMBOL TRACED-DEFINITION TRACING-DEFINITION
  175.       REPLACE-IN-FENV "~S: ~S was traced and has been redefined!"
  176.       "~S: ~S war getraced und wurde umdefiniert!"
  177.       "~S : ~S était tracée et a été redéfinie!" WARN UNTRACE2
  178.   )  )
  179. #Y(#:TOP-LEVEL-FORM-19 #16Y(00 00 00 00 00 01 D8 2E 01 D8 DA 31 82 C3 19 01)
  180.    UNTRACE2 REMOVE-OLD-DEFINITIONS
  181.    #Y(UNTRACE2
  182.       #32Y(00 01 00 00 00 02 AB 6E 00 AA D9 31 89 AA DA 31 89 16 01 AB 6A 03 37
  183.            07 C7 F8 31 52 0F 03 19 02
  184.           )
  185.       GET-FUNNAME-SYMBOL TRACED-DEFINITION TRACING-DEFINITION
  186.       *TRACED-FUNCTIONS* #.#'EQUAL
  187.   )  )
  188.