dsforth/main_ctrl.zas

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; control structures
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4
   5 $FORTH_WORD EXIT
   6 ;; AberSoft
   7 ;; ( -- )
   8   RDROP ;S
   9 $FORTH_END_WORD EXIT
  10
  11
  12 $FORTH_CONST (REL-BRANCHES)  USE_REL_BRANCH
  13
  14
  15   IF USE_REL_BRANCH
  16 $FORTH_WORD COMP-BACK
  17 ;; AberSoft
  18 ;; ( addr -- )
  19 ;; calculate the backward branch offset from HERE to addr
  20 ;; and compile into the next available dictionary memory address
  21   HERE - , ;S
  22 $FORTH_END_WORD COMP-BACK
  23
  24 $FORTH_WORD COMP-FWD
  25 ;; k8
  26 ;; ( addr -- )
  27 ;; calculate the backward branch offset from addr to HERE and put
  28 ;; it into the addr
  29   HERE OVER - SWAP ! ;S
  30 $FORTH_END_WORD COMP-FWD
  31
  32   ELSE
  33
  34 $FORTH_WORD COMP-BACK
  35 ;; k8
  36 ;; ( addr -- )
  37 ;; calculate the backward branch offset from HERE to addr
  38 ;; and compile into the next available dictionary memory address
  39   , ;S
  40 $FORTH_END_WORD COMP-BACK
  41
  42 $FORTH_WORD COMP-FWD
  43 ;; k8
  44 ;; ( addr -- )
  45 ;; calculate the backward branch offset from addr to HERE and put
  46 ;; it into the addr
  47   HERE SWAP ! ;S
  48 $FORTH_END_WORD COMP-FWD
  49   ENDIF
  50
  51
  52 $FORTH_WORD BEGIN IMM
  53 ;; AberSoft
  54   ?COMP HERE 1 ;S
  55 $FORTH_END_WORD BEGIN
  56
  57 $FORTH_WORD ENDIF IMM
  58 ;; AberSoft
  59   ?COMP 2 ?PAIRS COMP-FWD ;S
  60 $FORTH_END_WORD ENDIF
  61
  62 $FORTH_WORD THEN IMM
  63 ;; AberSoft
  64   ENDIF ;S
  65 $FORTH_END_WORD THEN
  66
  67 $FORTH_WORD DO IMM
  68 ;; AberSoft
  69   COMPILE (DO)
  70   HERE 3 ;S
  71 $FORTH_END_WORD DO
  72
  73 $FORTH_WORD LOOP IMM
  74 ;; AberSoft
  75   3 ?PAIRS COMPILE (LOOP)
  76   COMP-BACK ;S
  77 $FORTH_END_WORD LOOP
  78
  79 $FORTH_WORD +LOOP IMM
  80 ;; AberSoft
  81   3 ?PAIRS COMPILE (+LOOP)
  82   COMP-BACK ;S
  83 $FORTH_END_WORD +LOOP
  84
  85 $FORTH_WORD UNTIL IMM
  86 ;; AberSoft
  87   1 ?PAIRS COMPILE 0BRANCH
  88   COMP-BACK ;S
  89 $FORTH_END_WORD UNTIL
  90
  91 $FORTH_WORD END IMM
  92 ;; AberSoft
  93   UNTIL ;S
  94 $FORTH_END_WORD END
  95
  96 $FORTH_WORD AGAIN IMM
  97 ;; AberSoft
  98   1 ?PAIRS COMPILE BRANCH
  99   COMP-BACK ;S
 100 $FORTH_END_WORD AGAIN
 101
 102 $FORTH_WORD REPEAT IMM
 103 ;; AberSoft
 104   >R >R AGAIN R> R> 2- ENDIF ;S
 105 $FORTH_END_WORD REPEAT
 106
 107 $FORTH_WORD IF IMM
 108 ;; AberSoft
 109   COMPILE 0BRANCH
 110   HERE 0 , 2 ;S
 111 $FORTH_END_WORD IF
 112
 113 $FORTH_WORD IFNOT IMM
 114 ;; k8
 115   COMPILE TBRANCH
 116   HERE 0 , 2 ;S
 117 $FORTH_END_WORD IFNOT
 118
 119 $FORTH_WORD ELSE IMM
 120 ;; AberSoft
 121   2 ?PAIRS COMPILE BRANCH
 122   HERE 0 , SWAP 2 ENDIF 2 ;S
 123 $FORTH_END_WORD ELSE
 124
 125 $FORTH_WORD WHILE IMM
 126 ;; AberSoft
 127   IF 2+ ;S
 128 $FORTH_END_WORD WHILE
 129
 130
 131 $FORTH_WORD CASE IMM
 132 ;; AberSoft
 133   ?COMP CSP @ !CSP 4 ;S
 134 $FORTH_END_WORD CASE
 135
 136 $FORTH_WORD OF IMM
 137 ;; AberSoft
 138   4 ?PAIRS COMPILE OVER
 139   COMPILE =
 140   COMPILE 0BRANCH
 141   HERE 0 , COMPILE DROP
 142   LIT 5 ;S
 143 $FORTH_END_WORD OF
 144
 145 $FORTH_WORD ENDOF IMM
 146 ;; AberSoft
 147   LIT 5 ?PAIRS COMPILE BRANCH
 148   HERE 0 , SWAP 2 ENDIF 4 ;S
 149 $FORTH_END_WORD ENDOF
 150
 151 $FORTH_WORD OTHERWISE IMM
 152 ;; k8
 153 ;; part of CASE: OTHERWISE ( val ) ... ENDOF
 154   4 ?PAIRS
 155   COMPILE 0BRANCH
 156   HERE 0 ,
 157   LIT 5 ;S
 158 $FORTH_END_WORD OTHERWISE
 159
 160 $FORTH_WORD ENDCASE IMM
 161 ;; AberSoft
 162   4 ?PAIRS
 163   COMPILE DROP
 164 endcase0:
 165   SP@ CSP @ = 0=
 166   0BRANCH endcase1
 167   2 ENDIF
 168   BRANCH endcase0
 169 endcase1:
 170   CSP !
 171   ;S
 172 $FORTH_END_WORD ENDCASE