urflibs/init/bootstrap/70-replace.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 (* no more!
  11 ALSO COMPILER DEFINITIONS
  12
  13 0 VALUE TRACE-ENTER-EXIT
  14
  15
  16 : (DO-TRACE-ENTER)  ( -- )
  17   ?COMP
  18   TRACE-ENTER-EXIT IF
  19     COMPILE ENDCR
  20     " >>>ENTER: " STRLITERAL COMPILE TYPE
  21     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  22     COMPILE CR
  23     \ COMPILE DEBUG:BACKTRACE
  24   ENDIF
  25 ; (HIDDEN)
  26
  27 ' (DO-TRACE-ENTER) TO (TRACE-COLON)
  28
  29
  30 : (DO-TRACE-EXIT)  ( -- )
  31   ?COMP
  32   TRACE-ENTER-EXIT IF
  33     COMPILE ENDCR
  34     " >>>EXIT: " STRLITERAL COMPILE TYPE
  35     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  36     COMPILE CR
  37     \ COMPILE DEBUG:BACKTRACE
  38   ENDIF
  39 ; (HIDDEN)
  40
  41 ' (DO-TRACE-EXIT) TO (TRACE-SEMI)
  42
  43
  44 : (DO-TRACE-DOES)  ( -- )
  45   ?COMP
  46   TRACE-ENTER-EXIT IF
  47     COMPILE ENDCR
  48     " >>>DOES: " STRLITERAL COMPILE TYPE
  49     LATEST-NFA DUP C@ SWAP CELL+ SWAP STRLITERAL COMPILE XTYPE
  50     "  -- PFA: " STRLITERAL COMPILE TYPE
  51     COMPILE DUP COMPILE .
  52     COMPILE CR
  53     \ COMPILE DEBUG:BACKTRACE
  54   ENDIF
  55 ; (HIDDEN)
  56
  57 ' (DO-TRACE-DOES) TO (TRACE-DOES)
  58
  59
  60 PREVIOUS DEFINITIONS
  61 *)
  62
  63
  64 ALSO DEBUG DEFINITIONS
  65
  66 : (REPLACE)  ( what-cfa with-cfa -- )
  67   COMPILER:(CREATE-NAMELESS) CFA->PFA SWAP
  68   STATE @ >R [COMPILE] ]
  69   COMPILE DROP [COMPILE] CFALITERAL COMPILE EXECUTE-TAIL
  70   R> STATE !
  71   SWAP!
  72 ;
  73
  74 : REPLACE  ( -- )  \ what with
  75   -FIND-REQUIRED -FIND-REQUIRED (REPLACE)
  76 ;
  77
  78 PREVIOUS DEFINITIONS