libs/ufe/zxtrace.f

   1 \ $DEFINE DEBUG-ZX-TRACER
   2
   3 ;; ////////////////////////////////////////////////////////////////////////// //
   4 : (ZX-TRACE-CFA) ( cfa -- )
   5   TOZX
   6
   7     \ ." ***tracing: " DUP UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
   8
   9
  10   ;; do not trace already traced word
  11   DUP UR-ZX-WORD-USED-BY-CFA? IF DROP EXIT ENDIF
  12     \ DUP UR-ZX-WORD-NAME-BY-CFA DROP ." !!! " XTYPE CR
  13
  14   ;; set "traced" mark
  15   DUP UR-ZX-WORD-USED-BY-CFA-1!
  16
  17   \ ."   used: " DUP UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
  18
  19   ;; do not trace non-forth words
  20   DUP UR-ZX-WORD-TYPE-BY-CFA FWT-FORTH <> IF
  21     $IFDEF DEBUG-ZX-TRACER
  22       ." NOTFORTH: " DUP UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
  23     $ENDIF
  24     \ ."    NOTFORTH!\n"
  25
  26     ;; special DEFERed words
  27     UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF
  28     ;; ( addr count )
  29     2DUP " EMIT" STR= IF
  30       " EMIT6" UR-ZX-FIND-WORD IF RECURSE ENDIF
  31       " EMIT8" UR-ZX-FIND-WORD IF RECURSE ENDIF
  32     ENDIF
  33     2DUP " XEMIT" STR= IF
  34       " XEMIT6" UR-ZX-FIND-WORD IF RECURSE ENDIF
  35       " XEMIT8" UR-ZX-FIND-WORD IF RECURSE ENDIF
  36     ENDIF
  37     2DUP " WHEREX" STR= IF
  38       " WHEREX6" UR-ZX-FIND-WORD IF RECURSE ENDIF
  39       " WHEREX8" UR-ZX-FIND-WORD IF RECURSE ENDIF
  40     ENDIF
  41     2DUP " WHEREY" STR= IF
  42       " WHEREY6" UR-ZX-FIND-WORD IF RECURSE ENDIF
  43       " WHEREY8" UR-ZX-FIND-WORD IF RECURSE ENDIF
  44     ENDIF
  45     2DUP " GOTOXY" STR= IF
  46       " GOTOXY6" UR-ZX-FIND-WORD IF RECURSE ENDIF
  47       " GOTOXY8" UR-ZX-FIND-WORD IF RECURSE ENDIF
  48     ENDIF
  49     2DUP " GOTOXY16" STR= IF
  50       " GOTOXY6_16" UR-ZX-FIND-WORD IF RECURSE ENDIF
  51       " GOTOXY8_16" UR-ZX-FIND-WORD IF RECURSE ENDIF
  52     ENDIF
  53     2DUP " WHEREXY16" STR= IF
  54       " WHERE6_16" UR-ZX-FIND-WORD IF RECURSE ENDIF
  55       " WHERE8_16" UR-ZX-FIND-WORD IF RECURSE ENDIF
  56     ENDIF
  57
  58     2DROP
  59     EXIT
  60   ENDIF
  61     \ ." ...\n"
  62     \ DUP UR-ZX-WORD-TYPE-BY-CFA 3 SPACES . CR
  63
  64   ;; move to PFA
  65   DUP >R
  66
  67
  68   $IFDEF DEBUG-ZX-TRACER
  69     ." **tracing: " DUP UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
  70   $ENDIF
  71
  72   ;; to PFA
  73   3+
  74
  75   ;; trace labels (this also determines word end)
  76   DP@ TO ZX-TRACER-SAVED-DP
  77   DUP ZX-TRACE-LABELS
  78   ZX-TRACER-SAVED-DP DP!
  79     \ ." traced\n"
  80
  81   ZX-TRACER-WORD-END SWAP
  82   ;; ( endaddr pfa )
  83   BEGIN
  84     2DUP U>
  85   WHILE
  86     ;; ( endaddr pfa )
  87     DUP @ RECURSE
  88     ;; trace word compiled by (COMPILE) too
  89     DUP @ UR-ZX-WORD-FLAGS-BY-CFA FWF-COMPILE AND IF
  90       DUP 2+ @ RECURSE
  91     ENDIF
  92     ZX-TRACE-SKIP-INSTR
  93   REPEAT
  94   2DROP
  95
  96   R>
  97   $IFDEF DEBUG-ZX-TRACER
  98     ." DONE tracing: " UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
  99   $ELSE
 100     DROP
 101   $ENDIF
 102 ;
 103
 104
 105 ;; ////////////////////////////////////////////////////////////////////////// //
 106 : ZX-TRACE-ALLOWED?  ( -- flag )
 107   UR-PASS? 0= UR-AFTER-TRACE? 0= AND
 108 ;
 109
 110 : ZX-TRACE  ( -- )  \ wordname
 111   \ " ZX word tracer is broken for now" UFE-FATAL
 112
 113   BL WORD COUNT UR-ZX-FIND-WORD IFNOT " NOT FOUND!" UFE-FATAL ENDIF
 114   ;; ( cfa )
 115
 116   ZX-TRACE-ALLOWED? IFNOT
 117     ." tracing zx word: " DUP UR-ZX-WORD-NAME-BY-CFA IFNOT " NOT FOUND!" UFE-FATAL ENDIF XTYPE CR
 118     (ZX-TRACE-CFA)
 119   ELSE
 120     DROP
 121   ENDIF
 122 ;
 123
 124 : ZX-DECOMP ( -- )  \ wordname
 125   BL WORD COUNT UR-ZX-FIND-WORD IFNOT " NOT FOUND!" UFE-FATAL ENDIF
 126   ;; ( cfa )
 127   3+
 128
 129   DP@ TO ZX-TRACER-SAVED-DP
 130   DUP ZX-TRACE-LABELS
 131   (ZX-DECOMP)
 132   ZX-TRACER-SAVED-DP DP!
 133 ;