dsforth/main_ctrl.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; control structures
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_WORD EXIT
   6 ;; AberSoft
   7   RDROP ;S
   8 $FORTH_END_WORD EXIT
   9
  10
  11 $FORTH_WORD BACK
  12 ;; AberSoft
  13   HERE - , ;S
  14 $FORTH_END_WORD BACK
  15
  16 $FORTH_WORD BEGIN IMM
  17 ;; AberSoft
  18   ?COMP HERE 1 ;S
  19 $FORTH_END_WORD BEGIN
  20
  21 $FORTH_WORD ENDIF IMM
  22 ;; AberSoft
  23   ?COMP 2 ?PAIRS HERE OVER - SWAP ! ;S
  24 $FORTH_END_WORD ENDIF
  25
  26 $FORTH_WORD THEN IMM
  27 ;; AberSoft
  28   ENDIF ;S
  29 $FORTH_END_WORD THEN
  30
  31 $FORTH_WORD DO IMM
  32 ;; AberSoft
  33   COMPILE (DO)
  34   HERE 3 ;S
  35 $FORTH_END_WORD DO
  36
  37 $FORTH_WORD LOOP IMM
  38 ;; AberSoft
  39   3 ?PAIRS COMPILE (LOOP)
  40   BACK ;S
  41 $FORTH_END_WORD LOOP
  42
  43 $FORTH_WORD +LOOP IMM
  44 ;; AberSoft
  45   3 ?PAIRS COMPILE (+LOOP)
  46   BACK ;S
  47 $FORTH_END_WORD +LOOP
  48
  49 $FORTH_WORD UNTIL IMM
  50 ;; AberSoft
  51   1 ?PAIRS COMPILE 0BRANCH
  52   BACK ;S
  53 $FORTH_END_WORD UNTIL
  54
  55 $FORTH_WORD END IMM
  56 ;; AberSoft
  57   UNTIL ;S
  58 $FORTH_END_WORD END
  59
  60 $FORTH_WORD AGAIN IMM
  61 ;; AberSoft
  62   1 ?PAIRS COMPILE BRANCH
  63   BACK ;S
  64 $FORTH_END_WORD AGAIN
  65
  66 $FORTH_WORD REPEAT IMM
  67 ;; AberSoft
  68   >R >R AGAIN R> R> 2- ENDIF ;S
  69 $FORTH_END_WORD REPEAT
  70
  71 $FORTH_WORD IF IMM
  72 ;; AberSoft
  73   COMPILE 0BRANCH
  74   HERE 0 , 2 ;S
  75 $FORTH_END_WORD IF
  76
  77 $FORTH_WORD IFNOT IMM
  78 ;; k8
  79   COMPILE TBRANCH
  80   HERE 0 , 2 ;S
  81 $FORTH_END_WORD IFNOT
  82
  83 $FORTH_WORD ELSE IMM
  84 ;; AberSoft
  85   2 ?PAIRS COMPILE BRANCH
  86   HERE 0 , SWAP 2 ENDIF 2 ;S
  87 $FORTH_END_WORD ELSE
  88
  89 $FORTH_WORD WHILE IMM
  90 ;; AberSoft
  91   IF 2+ ;S
  92 $FORTH_END_WORD WHILE
  93
  94
  95 $FORTH_WORD CASE IMM
  96 ;; AberSoft
  97   ?COMP CSP @ !CSP 4 ;S
  98 $FORTH_END_WORD CASE
  99
 100 $FORTH_WORD OF IMM
 101 ;; AberSoft
 102   4 ?PAIRS COMPILE OVER
 103   COMPILE =
 104   COMPILE 0BRANCH
 105   HERE 0 , COMPILE DROP
 106   LIT 5 ;S
 107 $FORTH_END_WORD OF
 108
 109 $FORTH_WORD ENDOF IMM
 110 ;; AberSoft
 111   LIT 5 ?PAIRS COMPILE BRANCH
 112   HERE 0 , SWAP 2 ENDIF 4 ;S
 113 $FORTH_END_WORD ENDOF
 114
 115 $FORTH_WORD OTHERWISE IMM
 116 ;; k8
 117 ;; part of CASE: OTHERWISE ( val ) ... ENDOF
 118   4 ?PAIRS
 119   COMPILE 0BRANCH
 120   HERE 0 ,
 121   LIT 5 ;S
 122 $FORTH_END_WORD OTHERWISE
 123
 124 $FORTH_WORD ENDCASE IMM
 125 ;; AberSoft
 126   4 ?PAIRS
 127   COMPILE DROP
 128 endcase0:
 129   SP@ CSP @ = 0=
 130   0BRANCH endcase1
 131   2 ENDIF
 132   BRANCH endcase0
 133 endcase1:
 134   CSP !
 135   ;S
 136 $FORTH_END_WORD ENDCASE