urflibs/init/bootstrap/00-main-loader.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7
   8 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9 ;; define some standard words
  10 ;; note that UFO starts without colon, conditionals and loops!
  11 ;;
  12 GET-MSECS
  13 $INCLUDE-ONCE <01-colon-semicolon.f>
  14 $INCLUDE-ONCE <10-mem-utils.f>
  15 $INCLUDE-ONCE <20-base-creatori.f>
  16 $INCLUDE-ONCE <25-scolon.f>
  17 $INCLUDE-ONCE <30-ifthen.f>
  18 $INCLUDE-ONCE <35-num-print.f>
  19 $INCLUDE-ONCE <40-voc-creatori.f>
  20 $INCLUDE-ONCE <50-defer_value.f>
  21 $INCLUDE-ONCE <70-replace.f>
  22 \ $INCLUDE-ONCE <80-locals.f>
  23 $INCLUDE-ONCE <90-cond-comp.f>
  24 $INCLUDE-ONCE <92-cond-if.f>
  25 <PUBLIC-WORDS>
  26 <UNPROTECTED-WORDS>
  27 $IF $UFO-DEBUG-STARTUP-TIMES
  28 GET-MSECS SWAP - .( UrForth bootstrap time: ) . .( msecs\n)
  29 $ELSE
  30 DROP
  31 $ENDIF
  32
  33
  34 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  35 $IF $UFO-BOOTSTRAP-TESTS
  36 .( >>> CASE TEST <<<\n)
  37 : BBB
  38   CASE
  39      8 OF ." This is 8" CR ENDOF
  40     12 OF ." This is 12" CR ENDOF
  41     99 OF ." This is 99" CR ENDOF
  42     ( note that you *HAVE* to DUP it )
  43     ( ENDCASE will call DROP )
  44     ( so if you want to leave something on the stack, )
  45     ( make sure that TOS is garbage to be dropped )
  46     \ DUP
  47     OTHERWISE
  48     ." The number is: " . CR
  49   ENDCASE
  50 ;
  51 \ DEBUG:DECOMPILE BBB
  52
  53 42
  54 1 BBB
  55 12 BBB
  56 8 BBB
  57 666 BBB
  58 . CR
  59 .( >>> CASE TEST COMPLETE <<<\n)
  60
  61 .( >>> FOR TEST <<<\n)
  62 : testfor
  63   10 FOR
  64     I 2 = IF CONTINUE ENDIF
  65     I . cr
  66     I 5 = IF BREAK ENDIF
  67   ENDFOR
  68 ;
  69 DEBUG:DECOMPILE testfor
  70 testfor
  71 .( >>> FOR TEST COMPLETE <<<\n)
  72
  73 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  74 .( testing CELLS\n)
  75 : aa  3 cells " 3 cells: " TYPE . cr ;
  76 \ DEBUG:DECOMPILE aa
  77 aa
  78
  79 : test02 ( -- )
  80   ENDCR
  81   0 10 DO I . CR -1 +LOOP CR
  82 ;
  83 \ DEBUG:DECOMPILE test02
  84 test02
  85
  86 : test01 ( -- )
  87   ENDCR
  88   11 1 DO I . CR LOOP CR
  89   -11 -1 DO I . CR -1 +LOOP CR
  90   CR ." ---" CR
  91   0 -10 DO I . CR LOOP CR
  92   CR ." ---" CR
  93 ;
  94 \ DEBUG:DECOMPILE test01
  95 test01
  96
  97 : e2  ." E2!\n" 69 ;
  98 : e1  ." E1!\n" ['] e2 execute ." after EXEC! num: " . cr ;
  99 : e0  ." E0!\n" ['] e2 execute-tail ." ERROR: after EXEC! num: " . cr ;
 100 \ DEBUG:DECOMPILE e1
 101 .( === E1 ===\n)
 102 e1
 103 .( === E0 ===\n)
 104 e0 .( NUM: ) . cr
 105 .( === EXEC NATIVE ===\n)
 106 60 9 ' + EXECUTE . cr
 107 : e3  60 9 ['] + EXECUTE-TAIL ." ERROR: after EXEC! num: " . cr ;
 108 .( === E3 ===\n)
 109 e3 .( NUM: ) . cr
 110
 111 $ENDIF