urflibs/init/bootstrap/70-tracer.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrAsm Forth Engine!
   4 ;; GPLv3 ONLY
   5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6
   7 ;; colon calls defered word "COMPILER:(TRACE-COLON)"
   8 ;; semi calls defered word "COMPILER:(TRACE-SEMI)"
   9
  10 ALSO COMPILER DEFINITIONS
  11
  12 0 VALUE TRACE-ENTER-EXIT
  13
  14
  15 : (DO-TRACE-ENTER)  ( -- )
  16   ?COMP
  17   TRACE-ENTER-EXIT IF
  18     COMPILE ENDCR
  19     " >>>ENTER: " STRLITERAL COMPILE TYPE
  20     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  21     COMPILE CR
  22     \ COMPILE DEBUG:BACKTRACE
  23   ENDIF
  24 ; (HIDDEN)
  25
  26 ' (DO-TRACE-ENTER) TO (TRACE-COLON)
  27
  28
  29 : (DO-TRACE-EXIT)  ( -- )
  30   ?COMP
  31   TRACE-ENTER-EXIT IF
  32     COMPILE ENDCR
  33     " >>>EXIT: " STRLITERAL COMPILE TYPE
  34     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  35     COMPILE CR
  36     \ COMPILE DEBUG:BACKTRACE
  37   ENDIF
  38 ; (HIDDEN)
  39
  40 ' (DO-TRACE-EXIT) TO (TRACE-SEMI)
  41
  42
  43 : (DO-TRACE-DOES)  ( -- )
  44   ?COMP
  45   TRACE-ENTER-EXIT IF
  46     COMPILE ENDCR
  47     " >>>DOES: " STRLITERAL COMPILE TYPE
  48     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  49     "  -- PFA: " STRLITERAL COMPILE TYPE
  50     COMPILE DUP COMPILE .
  51     COMPILE CR
  52     \ COMPILE DEBUG:BACKTRACE
  53   ENDIF
  54 ; (HIDDEN)
  55
  56 ' (DO-TRACE-DOES) TO (TRACE-DOES)
  57
  58
  59 PREVIOUS DEFINITIONS
  60
  61
  62 ALSO DEBUG DEFINITIONS
  63
  64 : (REPLACE)  ( what-cfa with-cfa -- )
  65   COMPILER:(CREATE-NAMELESS) CFA->PFA SWAP
  66   STATE @ >R [COMPILE] ]
  67   COMPILE DROP [COMPILE] CFALITERAL COMPILE EXECUTE-TAIL
  68   R> STATE !
  69   SWAP!
  70 ;
  71
  72 : REPLACE  ( -- )  \ what with
  73   -FIND-REQUIRED -FIND-REQUIRED (REPLACE)
  74 ;
  75
  76 PREVIOUS DEFINITIONS