src/lib_2_control.4th

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