level0/urforth0_mac_hlconds.asm

   1 ;; Native x86 GNU/Linux Forth System, Direct Threaded Code
   2 ;;
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;;
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, version 3 of the License ONLY.
   8 ;;
   9 ;; This program is distributed in the hope that it will be useful,
  10 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;; GNU General Public License for more details.
  13 ;;
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16
  17
  18 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19 urcond_popval = 0
  20 ;; virtual stack size, in bytes
  21 urcond_stack_size = 256  ;; should be enough for everyone
  22
  23 virtual at 0
  24 urforth_conctl::
  25   dd  urcond_stack_size  ;; this is SP
  26   rb  urcond_stack_size
  27   rd  16                 ;; just in case
  28 end virtual
  29
  30
  31 macro urcond_check_balance {
  32   local csp
  33   load csp dword from urforth_conctl:0
  34   if csp <> urcond_stack_size
  35     display "***",10
  36     display "*** UNBALANCED CONDITIONALS IN WORD: "
  37     display urforth_last_word_name
  38     display 10,"***",10
  39     err "unbalanced conditionals"
  40   end if
  41 }
  42
  43 macro urcond_drop {
  44   local csp
  45   load csp dword from urforth_conctl:0
  46   if csp = urcond_stack_size
  47     err "cond stack underflow"
  48   end if
  49   csp = csp+4
  50   store dword csp at urforth_conctl:0
  51 }
  52
  53 macro urcond_pop {
  54   local csp,vv
  55   load csp dword from urforth_conctl:0
  56   if csp = urcond_stack_size
  57     err "cond stack overflow"
  58   end if
  59   load vv dword from urforth_conctl:csp
  60   csp = csp+4
  61   store dword csp at urforth_conctl:0
  62   urcond_popval = vv
  63 }
  64
  65 macro urcond_push n {
  66   local csp
  67   load csp dword from urforth_conctl:0
  68   if csp = 4
  69     err "cond stack overflow"
  70   end if
  71   csp = csp-4
  72   store dword n at urforth_conctl:csp
  73   store dword csp at urforth_conctl:0
  74 }
  75
  76 macro urcond_swap {
  77   local csp
  78   local v0,v1
  79   load csp dword from urforth_conctl:0
  80   if csp > urcond_stack_size-8
  81     err "cond stack underflow (swap)"
  82   end if
  83   load v0 dword from urforth_conctl:csp
  84   csp = csp+4
  85   load v1 dword from urforth_conctl:csp
  86   store dword v0 at urforth_conctl:csp
  87   csp = csp-4
  88   store dword v1 at urforth_conctl:csp
  89 }
  90
  91 macro urcond_over {
  92   local csp
  93   local v
  94   load csp dword from urforth_conctl:0
  95   if csp+4 = urcond_stack_size
  96     err "cond stack underflow (swap)"
  97   end if
  98   csp = csp+4
  99   load v dword from urforth_conctl:csp
 100   urcond_push v
 101 }
 102
 103 macro urcond_here {
 104   urcond_push $
 105 }
 106
 107 macro urcond_poke {
 108   local addr,value
 109
 110   ;;local csp
 111   ;;load csp dword from urforth_conctl:0
 112   ;;if csp+8 > urcond_stack_size
 113   ;;  err "cond stack underflow (poke)"
 114   ;;end if
 115   ;;load addr dword from urforth_conctl:csp
 116   ;;csp = csp+4
 117   ;;load value dword from urforth_conctl:csp
 118   ;;csp = csp+4
 119   ;;store dword csp at urforth_conctl:0
 120
 121   urcond_pop
 122   addr = urcond_popval
 123   urcond_pop
 124   value = urcond_popval
 125
 126   store dword value at addr
 127 }
 128
 129 macro urcond_comma {
 130   local n
 131   urcond_pop
 132   n = urcond_popval
 133   dd  n
 134 }
 135
 136 macro urcond_add delta {
 137   local n
 138   load csp dword from urforth_conctl:0
 139   if csp = urcond_stack_size
 140     err "cond stack overflow"
 141   end if
 142   load n dword from urforth_conctl:csp
 143   n = n+delta
 144   store dword n at urforth_conctl:csp
 145 }
 146
 147 macro urcond_compback {
 148   local n
 149   urcond_pop
 150   n = urcond_popval
 151   dd  n
 152 }
 153
 154
 155 macro urcond_compfwd {
 156   urcond_here
 157   urcond_swap
 158   urcond_poke
 159 }
 160
 161 macro urcond_pairs pval {
 162   local n
 163   ;load n dword from urfhi_csp
 164   ;urfhi_csp = urfhi_csp+4
 165   urcond_pop
 166   n = urcond_popval
 167   if n <> pval
 168     err "unbalanced UrForth conditionals!"
 169   end if
 170 }
 171
 172
 173 macro ur_begin {
 174   urcond_here
 175   urcond_push 1
 176 }
 177
 178 macro ur_until {
 179   urcond_pairs 1
 180   urcall 0branch
 181   urcond_compback
 182 }
 183
 184 macro ur_again {
 185   urcond_pairs 1
 186   urcall branch
 187   urcond_compback
 188 }
 189
 190 macro ur_endif {
 191   urcond_pairs 2
 192   urcond_compfwd
 193 }
 194
 195 macro ur_then {
 196   urendif
 197 }
 198
 199 macro ur_if {
 200   urcall 0branch
 201   urcond_here
 202   urcond_push 0
 203   urcond_comma
 204   urcond_push 2
 205 }
 206
 207 macro ur_ifnot {
 208   urcall tbranch
 209   urcond_here
 210   urcond_push 0
 211   urcond_comma
 212   urcond_push 2
 213 }
 214
 215 macro ur_else {
 216   urcond_pairs 2
 217   urcall branch
 218   urcond_here
 219   urcond_push 0
 220   urcond_comma
 221   urcond_swap
 222   urcond_push 2
 223   ur_endif
 224   urcond_push 2
 225 }
 226
 227 macro ur_while {
 228   ur_if
 229   urcond_add 2
 230 }
 231
 232 macro ur_not_while {
 233   ur_ifnot
 234   urcond_add 2
 235 }
 236
 237 macro ur_repeat {
 238   local v0,v1
 239   ; >r >r
 240   ;load v0 dword from urfhi_csp
 241   ;urfhi_csp = urfhi_csp+4
 242   ;load v1 dword from urfhi_csp
 243   ;urfhi_csp = urfhi_csp+4
 244   urcond_pop
 245   v0 = urcond_popval
 246   urcond_pop
 247   v1 = urcond_popval
 248   ; again
 249   ur_again
 250   ; r> r>
 251   urcond_push v1
 252   urcond_push v0
 253   urcond_add -2
 254   ur_endif
 255 }
 256
 257 macro ur_do {
 258   urcall  par_do
 259   urcond_here
 260   urcond_push 3
 261 }
 262
 263 macro ur_loop {
 264   urcond_pairs 3
 265   urcall  par_loop
 266   urcond_compback
 267 }
 268
 269 macro ur_ploop {
 270   urcond_pairs 3
 271   urcall  par_ploop
 272   urcond_compback
 273 }
 274
 275
 276 macro ur_cblock {
 277   urcall  cblocklit
 278   urcond_here
 279   urcond_push 0
 280   urcond_comma
 281   urcond_push 69
 282   call fword_par_urforth_nocall_doforth
 283 }
 284
 285 macro ur_cblock_end {
 286   urcall  exit
 287   urcond_pairs 69
 288   urcond_compfwd
 289 }