dsforth/main_ctrl.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; control structures
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_WORD COMP-BACK NOTURNKEY
   6 ;; k8
   7 ;; ( addr -- )
   8 ;; calculate the backward branch offset from HERE to addr
   9 ;; and compile into the next available dictionary memory address
  10   , ;S
  11 $FORTH_END_WORD COMP-BACK
  12
  13 $FORTH_WORD COMP-FWD NOTURNKEY
  14 ;; k8
  15 ;; ( addr -- )
  16 ;; calculate the forward branch offset from addr to HERE and put
  17 ;; it into the addr
  18   HERE SWAP ! ;S
  19 $FORTH_END_WORD COMP-FWD
  20
  21
  22 $FORTH_WORD BEGIN IMM NOTURNKEY
  23 ;; AberSoft
  24   ?COMP HERE 1 ;S
  25 $FORTH_END_WORD BEGIN
  26
  27 $FORTH_WORD ENDIF IMM NOTURNKEY
  28 ;; AberSoft
  29   ?COMP 2 ?PAIRS COMP-FWD ;S
  30 $FORTH_END_WORD ENDIF
  31
  32 $FORTH_WORD THEN IMM NOTURNKEY
  33 ;; AberSoft
  34   ENDIF ;S
  35 $FORTH_END_WORD THEN
  36
  37 $FORTH_WORD DO IMM NOTURNKEY
  38 ;; AberSoft
  39   ?COMP
  40   COMPILE (DO)
  41   HERE 3 ;S
  42 $FORTH_END_WORD DO
  43
  44 $FORTH_WORD LOOP IMM NOTURNKEY
  45 ;; AberSoft
  46   ?COMP 3 ?PAIRS COMPILE (LOOP)
  47   COMP-BACK ;S
  48 $FORTH_END_WORD LOOP
  49
  50 $FORTH_WORD +LOOP IMM NOTURNKEY
  51 ;; AberSoft
  52   ?COMP 3 ?PAIRS COMPILE (+LOOP)
  53   COMP-BACK ;S
  54 $FORTH_END_WORD +LOOP
  55
  56 $FORTH_WORD UNTIL IMM NOTURNKEY
  57 ;; AberSoft
  58   ?COMP 1 ?PAIRS COMPILE 0BRANCH
  59   COMP-BACK ;S
  60 $FORTH_END_WORD UNTIL
  61
  62 ;;;;$FORTH_WORD END IMM
  63 ;;;;;; AberSoft
  64 ;;;;  UNTIL ;S
  65 ;;;;$FORTH_END_WORD END
  66
  67 $FORTH_WORD AGAIN IMM NOTURNKEY
  68 ;; AberSoft
  69   ?COMP 1 ?PAIRS COMPILE BRANCH
  70   COMP-BACK ;S
  71 $FORTH_END_WORD AGAIN
  72
  73 $FORTH_WORD REPEAT IMM NOTURNKEY
  74 ;; AberSoft
  75   ?COMP >R >R AGAIN R> R> 2- ENDIF ;S
  76 $FORTH_END_WORD REPEAT
  77
  78 $FORTH_WORD IF IMM NOTURNKEY
  79 ;; AberSoft
  80   ?COMP
  81   COMPILE 0BRANCH
  82   HERE 0 , 2 ;S
  83 $FORTH_END_WORD IF
  84
  85 $FORTH_WORD IFNOT IMM NOTURNKEY
  86 ;; k8
  87   ?COMP
  88   COMPILE TBRANCH
  89   HERE 0 , 2 ;S
  90 $FORTH_END_WORD IFNOT
  91
  92 $FORTH_WORD ELSE IMM NOTURNKEY
  93 ;; AberSoft
  94   ?COMP 2 ?PAIRS COMPILE BRANCH
  95   HERE 0 , SWAP 2 ENDIF 2 ;S
  96 $FORTH_END_WORD ELSE
  97
  98 $FORTH_WORD WHILE IMM NOTURNKEY
  99 ;; AberSoft
 100   IF 2+ ;S
 101 $FORTH_END_WORD WHILE
 102
 103
 104 $FORTH_WORD CASE IMM NOTURNKEY
 105 ;; AberSoft
 106   ?COMP CSP @ !CSP 4 ;S
 107 $FORTH_END_WORD CASE
 108
 109 $FORTH_WORD (X-OF) NOTURNKEY
 110 ;; AberSoft, k8
 111 ;; ( ... doswap word-to-compare )
 112   ?COMP
 113   >R >R 4 ?PAIRS
 114   COMPILE OVER
 115   ;;COMPILE =
 116   R> 0BRANCH .skipit
 117     COMPILE SWAP
 118 .skipit:
 119   R> , ;; this compiles comparator
 120   COMPILE 0BRANCH
 121   HERE 0 , COMPILE DROP
 122   LIT 5 ;S
 123 $FORTH_END_WORD (X-OF)
 124
 125 $FORTH_WORD OF IMM NOTURNKEY
 126 ;; k8
 127   0 ['] = (X-OF) ;S
 128 $FORTH_END_WORD OF
 129
 130 $FORTH_WORD &OF IMM NOTURNKEY
 131 ;; k8
 132   1 ['] AND (X-OF) ;S
 133 $FORTH_END_WORD &OF
 134
 135 $FORTH_WORD ENDOF IMM NOTURNKEY
 136 ;; AberSoft
 137   ?COMP
 138   LIT 5 ?PAIRS COMPILE BRANCH
 139   HERE 0 , SWAP 2 ENDIF 4 ;S
 140 $FORTH_END_WORD ENDOF
 141
 142 $FORTH_WORD OTHERWISE IMM NOTURNKEY
 143 ;; k8
 144   ?COMP
 145   4 ?PAIRS
 146   LIT 6  ;; flag for ENDCASE
 147   ;S
 148 $FORTH_END_WORD OTHERWISE
 149
 150 $FORTH_WORD ENDCASE IMM NOTURNKEY
 151 ;; AberSoft
 152   ?COMP
 153   DUP LIT 6 = TBRANCH endcase6
 154   4 ?PAIRS
 155   COMPILE DROP
 156   BRANCH endcase0
 157 endcase6:
 158   LIT 6 ?PAIRS
 159 endcase0:
 160   SP@ CSP @ = 0=
 161   0BRANCH endcase1
 162   2 ENDIF
 163   BRANCH endcase0
 164 endcase1:
 165   CSP !
 166   ;S
 167 $FORTH_END_WORD ENDCASE
 168
 169
 170 $FORTH_WORD RECURSE IMM NOTURNKEY
 171 ;; k8
 172   ?COMP
 173   LATEST NFA->CFA ,
 174   ;S
 175 $FORTH_END_WORD RECURSE
 176
 177
 178 ;; code words
 179 $FORTH_WORD [: IMM NOTURNKEY
 180 ;; k8
 181   ?COMP
 182   COMPILE (CODEBLOCK)
 183   HERE 0 , ;; branch over
 184   ;; put forth word CFA
 185   LIT 0xCD C,    ;; call
 186   LIT _doforth ,
 187   LIT 666 ;S
 188 $FORTH_END_WORD [:
 189
 190 $FORTH_WORD ;] IMM NOTURNKEY
 191 ;; k8
 192   ?COMP
 193   LIT 666 ?PAIRS
 194   COMPILE EXIT
 195   COMP-FWD
 196   ;S
 197 $FORTH_END_WORD ;]