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 : +LOOP IMMEDIATE
 103
 104         ['] DUP , \ Store copy of increment
 105
 106         ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] R> , ['] SWAP , ['] + , ['] 2DUP , ['] - ,
 107         ['] SWAP , ['] >R , ['] SWAP , ['] >R , ['] SWAP , ['] >R ,
 108
 109         \ Condition differently depending on sign of increment
 110         ['] SWAP , ['] 0>= , [COMPILE] IF
 111             ['] 0<= ,
 112         [COMPILE] ELSE
 113             ['] 0> ,
 114         [COMPILE] THEN
 115
 116         \ Branch back to begining of loop kernel
 117         ['] 0BRANCH , HERE - ,
 118
 119         \ Clean up
 120         ['] RDROP , ['] RDROP , ['] RDROP ,
 121
 122         \ Record address of loop end for any LEAVEs to use
 123         HERE SWAP !
 124
 125         [COMPILE] ELSE
 126             ['] 2DROP , \ Clean up if loop was entirely skipped (?DO)
 127         [COMPILE] THEN
 128 ;
 129
 130 : LOOP IMMEDIATE
 131         ['] LIT , 1 ,
 132         [COMPILE] +LOOP
 133 ;
 134
 135
 136 \ case [of ... endof]+ ... endcase
 137
 138 : CASE IMMEDIATE
 139         0               \ push 0 to mark the bottom of the stack
 140 ;
 141
 142 : OF IMMEDIATE
 143         ['] OVER ,        \ compile OVER
 144         ['] = ,           \ compile =
 145         [COMPILE] IF      \ compile IF
 146         ['] DROP ,        \ compile DROP
 147 ;
 148
 149 : ENDOF IMMEDIATE
 150         [COMPILE] ELSE    \ ENDOF is the same as ELSE
 151 ;
 152
 153 : ENDCASE IMMEDIATE
 154         ['] DROP ,        \ compile DROP
 155
 156         \ keep compiling THEN until we get to our zero marker
 157         BEGIN
 158                 ?DUP
 159         WHILE
 160                 [COMPILE] THEN
 161         REPEAT
 162 ;