compiler.s (4483B)
1 # Compiler 2 3 noverb forth here 4 variable 5 endword 6 7 verb forth HERE 8 get here 9 endword 10 11 verb forth modeI "[" immediate 12 set MODE 0 13 endword 14 15 verb forth modeC "]" 16 set MODE -1 17 endword 18 19 verb forth ALLOT 20 do HERE 21 do plus 22 set here 23 endword 24 25 verb forth comma "," immediate 26 do HERE 27 do store 28 const 8 29 do ALLOT 30 endword 31 32 .macro compile value 33 .ifnb \value 34 const \value 35 .endif 36 do comma 37 .endm 38 39 # Compiler Compiling 40 41 verb forth backwardmark "MARK<" immediate # ( -- addr ) 42 do HERE 43 endword 44 45 verb forth backwardresolve "<RESOLVE" immediate # ( addr -- ) 46 compile 47 endword 48 49 verb forth forwardmark "MARK>" immdiate # ( -- addr ) 50 do HERE 51 do FALSE 52 compile 53 endword 54 55 verb forth forwardresolve ">RESOLVE" immediate # ( addr -- ) 56 do HERE 57 do SWAP 58 do store 59 endword 60 61 verb forth markstore ">@MARK" immediate # ( quad -- addr ) 62 do HERE 63 do SWAP 64 compile 65 endword 66 67 # Word Compiling 68 69 verb forth compnew "\x3A" #":" 70 do modeC 71 get LAST 72 do markstore 73 const ' ' 74 do WORD 75 do fetch 76 const 8 77 do plus 78 do ALLOT 79 do HERE 80 set recurse 81 compile enter 82 endword 83 84 verb forth compend "\x3B" immediate #";" 85 compile EXIT 86 do modeI 87 set LAST 88 endword 89 90 verb forth IMMEDIATE 91 get LAST 92 do DUP 93 const 0x8000000000000000 94 do OR 95 do store 96 endword 97 98 noverb forth recurse 99 variable 100 endword 101 102 verb forth RECURSE "RECURSE" immediate # ( {sys} -- {sys} ) 103 get recurse 104 compile 105 endword 106 107 verb forth brackettick "[\x27]" immediate #"'" 108 const ' ' 109 do WORD 110 do FIND 111 if 1f 112 do ABORT 113 1: compile docon 114 compile 115 endword 116 117 verb forth FORGET 118 const ' ' 119 do WORD 120 get LAST 121 2: do dup2 122 const 8 123 do plus 124 do STRCMP 125 unless 1f 126 do DUP 127 set here 128 do fetch 129 set LAST 130 do DROP 131 endword 132 1: do fetch 133 do DUP 134 if 2b 135 do ABORT 136 137 endword 138 139 # Indefinite Loops 140 141 verb forth BEGIN "BEGIN" immediate 142 do backwardmark 143 endword 144 145 verb forth AGAIN "AGAIN" immediate 146 compile dogoto 147 do backwardresolve 148 endword 149 150 verb forth UNTIL "UNTIL" immediate 151 compile iszero 152 compile dobranch 153 do backwardresolve 154 endword 155 156 verb forth WHILE "WHILE" immediate 157 compile iszero 158 compile dobranch 159 do forwardmark 160 endword 161 162 verb forth REPEAT "REPEAT" immediate 163 compile dogoto 164 do SWAP 165 do backwardresolve 166 do forwardresolve 167 endword 168 169 # Finite Loops 170 171 verb forth DO "DO" immediate # ( -- sys ) 172 const pushret 173 const DO 174 do markstore # Loop Counter # (pushret) 175 compile pushret # # Loop End 176 endword # # 177 178 verb forth LEAVE "LEAVE" immediate # ( {sys} -- {sys sys} ) 179 compile popret # # 180 compile popret # 181 # compile drop2 182 compile dogoto 183 do SIFTDO 184 endword 185 186 verb forth loopI "I>" immediate # ( -- uint ) 187 compile popret # # 188 compile popret # 189 compile DUP 190 compile pushret # Loop Counter 191 compile SWAP # 192 compile pushret # # Loop End 193 endword 194 195 verb forth LOOP "LOOP" immediate # ( sys [sys...sys] -- ) 196 compile popret # # 197 compile popret # 198 compile inc 199 compile dup2 200 compile nequal 201 0: compile dobranch 202 2: do DUP 203 do fetch 204 const DO 205 do equal 206 if 1f # Do an 8+ forwardresolve 207 do HERE 208 const 8 209 do plus 210 do SWAP 211 do store 212 goto 2b 213 1: do DUP 214 do backwardresolve 215 do store 216 compile drop2 217 endword 218 219 noverb forth linksapply # ( ptr func -- ) 220 do OVER 221 if 1f 222 do drop2 223 endword 224 1: do OVER 225 do fetch 226 do OVER 227 do linksapply 228 do EXECUTE 229 endword 230 231 verb forth plusloop "+LOOP" immediate 232 compile popret # # 233 compile SWAP # 234 compile popret # 235 compile SWAP 236 compile pushret # Increment 237 compile dup2 # 238 compile lequal # 239 compile popret # 240 compile SWAP 241 compile pushret # Less Before? 242 compile plus # 243 compile dup2 # 244 compile greater # 245 compile popret # 246 compile XOR 247 goto 0b # Can use LOOP logic 248 249 noverb forth SIFTDO # ( {sys} -- {sys sys} ) 250 do DUP 251 do fetch 252 do DUP 253 const DO 254 do equal 255 do SWAP 256 const LEAVE 257 do equal 258 do OR 259 if 1f 260 do pushret # Unrelated stack item 261 do SIFTDO # 262 do popret # 263 endword 264 1: const LEAVE 265 do markstore 266 endword 267 268 # Conditionals 269 270 verb forth IF "IF" immediate 271 compile iszero 272 compile dobranch 273 do forwardmark 274 endword 275 276 verb forth ELSE "ELSE" immediate 277 compile dogoto 278 do forwardmark 279 do SWAP 280 do forwardresolve 281 endword 282 283 verb forth THEN "THEN" immediate 284 do forwardresolve 285 endword 286 287 # Strings 288 289 verb forth echo ".\"" immediate 290 compile dostr 291 const '"' 292 do WORD 293 do fetch 294 const 8 295 do plus 296 do ALLOT 297 compile PRINT 298 endword 299 300 # Compile Literals 301 302 verb forth LITERAL "LITERAL" immediate 303 compile docon 304 compile 305 endword 306 307 verb forth CONSTANT 308 do compnew 309 do SWAP 310 do LITERAL 311 do compend 312 endword 313 314 verb forth VARIABLE 315 do compnew 316 compile dovar 317 compile 0 318 do compend 319 endword