src/lib_2_control.4th

   1 \ Flow control
   2
   3 \ ... if/unless ... [else ...] then
   4
   5 : IF IMMEDIATE
   6         ['] 0BRANCH ,     \ compile 0BRANCH
   7         HERE          \ save location of the offset on the stack
   8         0 ,             \ compile a dummy offset
   9 ;
  10
  11 : UNLESS IMMEDIATE
  12         ['] NOT ,         \ compile NOT (to reverse the test)
  13         [COMPILE] IF    \ continue by calling the normal IF
  14 ;
  15
  16 : THEN IMMEDIATE
  17         DUP
  18         HERE SWAP -   \ calculate the offset from the address saved on the stack
  19         SWAP !          \ store the offset in the back-filled location
  20 ;
  21
  22 : ELSE IMMEDIATE
  23         ['] BRANCH ,      \ definite branch to just over the false-part
  24         HERE          \ save location of the offset on the stack
  25         0 ,             \ compile a dummy offset
  26         SWAP            \ now back-fill the original (IF) offset
  27         DUP             \ same as for THEN word above
  28         HERE SWAP -
  29         SWAP !
  30 ;
  31
  32
  33 \ begin ... while ... repeat, begin ... until, begin ... repeat
  34
  35 : BEGIN IMMEDIATE
  36         HERE          \ save location on the stack
  37 ;
  38
  39 : UNTIL IMMEDIATE
  40         ['] 0BRANCH ,     \ compile 0BRANCH
  41         HERE -        \ calculate the offset from the address saved on the stack
  42         ,               \ compile the offset here
  43 ;
  44
  45 : AGAIN IMMEDIATE
  46         ['] BRANCH ,      \ compile BRANCH
  47         HERE -        \ calculate the offset back
  48         ,               \ compile the offset here
  49 ;
  50
  51 : WHILE IMMEDIATE
  52         ['] 0BRANCH ,     \ compile 0BRANCH
  53         HERE          \ save location of the offset2 on the stack
  54         0 ,             \ compile a dummy offset2
  55 ;
  56
  57 : REPEAT IMMEDIATE
  58         ['] BRANCH ,      \ compile BRANCH
  59         SWAP            \ get the original offset (from BEGIN)
  60         HERE - ,      \ and compile it after BRANCH
  61         DUP
  62         HERE SWAP -   \ calculate the offset2
  63         SWAP !          \ and back-fill it in the original location
  64 ;
  65
  66
  67 \ [?]do ... [+]loop
  68
  69 : DO IMMEDIATE
  70         ['] LIT , -1 , [COMPILE] IF
  71         ['] >R , ['] >R ,
  72         ['] LIT , HERE 0 , ['] >R ,
  73         HERE
  74 ;
  75
  76 : ?DO IMMEDIATE
  77         ['] 2DUP , ['] - , [COMPILE] IF
  78         ['] >R , ['] >R ,
  79         ['] LIT , HERE 0 , ['] >R ,
  80         HERE
  81 ;
  82
  83 : I RSP@ 3 - @ ;
  84
  85 : J RSP@ 6 - @ ;
  86
  87 : K RSP@ 9 - @ ;
  88
  89 : ?LEAVE IMMEDIATE
  90         ['] 0BRANCH , 13 ,
  91         ['] R> , ['] RDROP , ['] RDROP ,
  92         ['] LIT ,  HERE 7 + , ['] DUP , ['] -ROT , ['] - , ['] SWAP , ['] ! ,
  93         ['] BRANCH ,
  94         0 ,
  95 ;
  96
  97 : LEAVE IMMEDIATE
  98         ['] LIT , -1 ,
  99         [COMPILE] ?LEAVE
 100 ;
 101
 102 \ Clean up return stack
 103 : UNLOOP IMMEDIATE
 104         ['] RDROP , ['] RDROP , ['] RDROP ,
 105 ;
 106
 107 : +LOOP IMMEDIATE
 108
 109         ['] DUP , \ Store copy of increment
 110
 111         ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
 112         ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
 113
 114         \ Condition differently depending on sign of increment
 115         ['] SWAP , ['] 0>= , [COMPILE] IF
 116             ['] 0<= ,
 117         [COMPILE] ELSE
 118             ['] 0> ,
 119         [COMPILE] THEN
 120
 121         \ Branch back to begining of loop kernel
 122         ['] 0BRANCH , HERE - ,
 123
 124         \ Clean up
 125         ['] RDROP , ['] RDROP , ['] RDROP ,
 126
 127         \ Record address of loop end for any LEAVEs to use
 128         HERE SWAP !
 129
 130         [COMPILE] ELSE
 131             ['] 2DROP , \ Clean up if loop was entirely skipped (?DO)
 132         [COMPILE] THEN
 133 ;
 134
 135 : LOOP IMMEDIATE
 136         ['] LIT , 1 ,
 137         [COMPILE] +LOOP
 138 ;
 139
 140
 141 \ case [of ... endof]+ ... endcase
 142
 143 : CASE IMMEDIATE
 144         0               \ push 0 to mark the bottom of the stack
 145 ;
 146
 147 : OF IMMEDIATE
 148         ['] OVER ,        \ compile OVER
 149         ['] = ,           \ compile =
 150         [COMPILE] IF      \ compile IF
 151         ['] DROP ,        \ compile DROP
 152 ;
 153
 154 : ENDOF IMMEDIATE
 155         [COMPILE] ELSE    \ ENDOF is the same as ELSE
 156 ;
 157
 158 : ENDCASE IMMEDIATE
 159         ['] DROP ,        \ compile DROP
 160
 161         \ keep compiling THEN until we get to our zero marker
 162         BEGIN
 163                 ?DUP
 164         WHILE
 165                 [COMPILE] THEN
 166         REPEAT
 167 ;