src/lib_1_basic.4th

   1 \ Basic definitions
   2
   3 : / /MOD SWAP DROP ;
   4 : MOD /MOD DROP ;
   5 : */ -ROT * SWAP / ;
   6
   7 : NEGATE \ ( x -- -x )
   8     0 SWAP - ;
   9
  10 : NIP \ ( x y -- y )
  11     SWAP DROP ;
  12
  13 : TUCK \ ( x y -- y x y )
  14     DUP -ROT ;
  15
  16 : PICK \ ( x_u ... x_1 x_0 u -- x_u ... x_1 x_0 x_u )
  17         1+ PSP@ SWAP - @ ;
  18
  19 : TRUE -1 ;
  20 : FALSE 0 ;
  21 : NOT 0= ;
  22
  23 \ Standard words for manipulating BASE.
  24 : DECIMAL   10 BASE ! ;
  25 : HEX       16 BASE ! ;
  26
  27
  28 \ Translate a number of cells into memory units
  29 \ (in our case 1 cell = 1 memory unit)
  30 : CELLS ;
  31
  32 \ Since the smallest unit of memory in our system is 64 bits and since strings
  33 \ are stored as arrays of 64 bit integers, the character store/fetch words are
  34 \ just aliases of the standard store/fetch words.
  35 : C! ! ;
  36 : C@ @ ;
  37 : C, , ;
  38
  39 \ Retrieve stack depth
  40 : DEPTH PSP@ PSP0 - ;
  41
  42 \ Words for whitespace
  43 : '\n' 10 ;
  44 : BL 32 ;
  45 : CR '\n' emit ;
  46 : SPACE BL emit ;
  47
  48 \ CFA retrieval
  49 : ' BL WORD FIND DROP ;
  50 : ['] IMMEDIATE
  51      LIT LIT , ' , ;
  52
  53 \ Compilation
  54
  55 : [COMPILE] IMMEDIATE ' , ;
  56 : COMPILE IMMEDIATE
  57     LIT LIT , ' , LIT , , ;
  58
  59 : LITERAL IMMEDIATE ['] LIT , , ;
  60
  61 : CHAR BL WORD 1+ @ ;
  62 : [CHAR] IMMEDIATE
  63     CHAR
  64     ['] LIT , ,
  65 ;
  66
  67 \ Address containing LFA of most recent definition
  68 : LATEST
  69     CURRENT @ 1+ ;
  70
  71 \ Compile in recursive call to current word
  72 : RECURSE IMMEDIATE
  73         LATEST @        \ LATEST points to the word being compiled at the moment
  74         LINK>           \ get the codeword
  75         ,               \ compile it
  76 ;
  77