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