samples/tscp/fcp_tscp_compat.f

   1 require char+ !libs/ans/crap.f
   2
   3 (*
   4 S" [UNDEFINED]" PAD C! PAD CHAR+ PAD C@ CMOVE
   5 PAD FIND NIP 0= [IF]
   6 : [UNDEFINED] ( "word" -- tf ) BL WORD FIND NIP 0= ; IMMEDIATE
   7 [THEN]
   8 [UNDEFINED] [DEFINED] [IF]
   9 : [DEFINED] ( "word" -- tf ) BL WORD FIND NIP ; IMMEDIATE
  10 [THEN]
  11 *)
  12
  13 [UNDEFINED] CELL [IF]
  14 1 CELLS CONSTANT CELL
  15 [THEN]
  16 [UNDEFINED] CELL- [IF]
  17 : CELL- POSTPONE CELL POSTPONE - ; IMMEDIATE
  18 [THEN]
  19
  20 [UNDEFINED] KEY? [IF]
  21 : KEY?  ( -- flag ) false ;
  22 [ENDIF]
  23
  24 \ Wil Baden implements wbMACRO for portably inlining code
  25 : wbMACRO  ( "name <char> ccc<char>" -- )
  26   :
  27   parse-name 1 <> err-char-expected ?error c@ \ CHAR
  28   PARSE  POSTPONE SLITERAL  POSTPONE EVALUATE
  29   POSTPONE ; IMMEDIATE
  30 ;
  31 (*
  32 : wbMACRO  ( "name <char> ccc<char>" -- )
  33   create [compile] immediate
  34   parse-name 1 = not-?abort" fuck?"
  35   c@ parse dup cell+ n-allot c4s:copy-counted
  36  does>
  37   count evaluate
  38 ;
  39 *)
  40 \ ' MACRO ALIAS wbMACRO \ if line-profiling on Win32Forth
  41
  42 [UNDEFINED] tolower [IF]
  43 \ : tolower ( C -- c ) $20 OR ;
  44 alias locase-char tolower
  45 [THEN]