bootstrap.fs (12108B)
1 : exit exit, ; immediate 2 3 : test type ; 4 5 : ahead here 0 , ; 6 : if postpone ?branch ahead ; immediate 7 : then here swap ! ; immediate 8 : else postpone branch ahead swap postpone then ; immediate 9 10 : begin here ; immediate 11 : while postpone if swap ; immediate 12 : again postpone branch , ; immediate 13 : repeat postpone again postpone then ; immediate 14 15 : test-if if type then ; 16 17 : literal postpone lit , ; immediate 18 19 : char parse-word if c@ else 0 then ; 20 : [char] char postpone literal ; immediate 21 22 : bl 32 ; 23 24 : ')' [char] ) ; 25 : '"' [char] " ; 26 : '\' [char] \ ; 27 : 'n' [char] n ; 28 : 'r' [char] r ; 29 : 'z' [char] z ; 30 31 : parse-until 32 delimiter ! 33 source source-offset @ apply-offset 34 over >r 35 skip-until 36 2dup parse-offset source-offset ! 37 drop r> tuck - ; 38 39 : \ 0 parse-until 2drop ; immediate 40 : ( ')' parse-until 2drop ; immediate 41 42 : cmove 43 ( addr1 addr2 u -- ) 44 swap >r 45 begin 46 dup 47 while 48 over c@ 49 r> tuck c! 1 + >r 50 1 apply-offset 51 repeat 52 2drop r> drop ; 53 54 : translate-escape-code 55 ( char -- char ) 56 dup 'n' = if drop 10 else 57 dup 'r' = if drop 13 else 58 dup 'z' = if drop 0 else 59 dup '"' = if else 60 dup '\' = if else 61 then then then then then ; 62 63 : translate-escape-string 64 ( addr len -- len-diff ) 65 over >r 66 begin 67 dup 68 while 69 over c@ 70 dup '\' = if 71 drop 1 apply-offset over c@ 72 translate-escape-code 73 then 74 r> tuck c! 1 + >r 75 1 apply-offset 76 repeat 77 drop r> - ; 78 79 : parse-string 80 '"' parse-until 81 here swap 2dup 2>r cmove 2r> 82 2dup translate-escape-string - ; 83 84 : " 85 compiling? if 86 postpone lit-string ahead 87 then 88 parse-string 89 compiling? if 90 swap over + dp ! align 91 swap ! 92 then ; immediate 93 94 : depth sp@ sp0 swap - ; 95 96 variable depth-start 97 variable depth-actual 98 create stack-actual 32 cells allot 99 100 : cr 10 emit ; 101 : space 32 emit ; 102 103 : error type space source type cr ; 104 105 : reset-stack 106 begin 107 depth depth-start @ - 108 while 109 drop 110 repeat ; 111 112 : t{ depth depth-start ! ; 113 114 : -> 115 depth depth-actual ! 116 begin 117 depth depth-start @ - 118 dup 119 while 120 1 cells - 121 stack-actual + ! 122 repeat 123 drop ; 124 125 : }t 126 depth depth-actual @ <> if 127 " stack depths not equal:" error 128 reset-stack exit 129 then 130 begin 131 depth depth-start @ - 132 dup 133 while 134 1 cells - 135 stack-actual + @ <> if 136 " stack elements not equal:" error 137 reset-stack exit 138 then 139 repeat 140 drop ; 141 142 t{ 1 1 + -> 2 }t 143 144 : words 145 latest 146 begin 147 @ ?dup 148 while 149 dup 2 cells + @ 150 ?dup if 151 dup 1 + swap c@ 152 type cr 153 then 154 repeat ; 155 156 : decimal 10 base ! ; immediate 157 : hex 16 base ! ; immediate 158 159 : true -1 ; 160 : false 0 ; 161 162 : next= 163 \ is 'next' stored at 'addr'? 164 ( addr -- flag ) 165 dup @ hex 0004A503 = if 166 1 cells + dup @ hex 00052583 = if 167 1 cells + dup @ hex 00448493 = if 168 1 cells + dup @ hex 00058067 = if 169 drop true exit 170 then then then then 171 drop false exit ; 172 173 : opcode@ @ hex 7F and ; 174 : jal= opcode@ hex 6F = ; 175 176 : decode-immed-j 177 ( instr -- n ) 178 dup hex 80000000 and 179 over hex 000FF000 and decimal 11 lshift + 180 over hex 00100000 and decimal 2 lshift + 181 over hex 7FE00000 and decimal 9 rshift + 182 11 ashift nip ; 183 184 : encode-immed-j 185 ( n -- immed ) 186 hex 800FFFFF and \ clear imm[10:1], imm[11] destination 187 dup hex 7FE and decimal 20 lshift + \ imm[10:1] 188 dup hex 800 and decimal 9 lshift + \ imm[11] 189 hex FFFFF000 and ; \ clear junk from rd, opcode 190 191 : reloc-jal 192 \ relocate a 'jal' instruction from 'addr' to 'here' 193 ( addr -- instr ) 194 dup @ 195 decode-immed-j 196 over + here - 197 encode-immed-j 198 over @ hex 0FFF and + 199 nip ; 200 201 : :code 202 create 203 here -1 cells allot , 204 latest @ hidden 205 ] ; 206 207 : ;code 208 hex 0004A503 , 209 hex 00052583 , 210 hex 00448493 , 211 hex 00058067 , 212 latest @ hidden 213 postpone [ ; immediate 214 215 : inline 216 parse-word find >cfa @ 217 begin 218 dup next= 0= 219 while 220 dup jal= if dup reloc-jal else 221 dup @ 222 then 223 , 1 cells + 224 repeat 225 drop ; immediate 226 227 \ begin: assembler 228 229 \ encode stack values into proper instruction locations. all encoding sequences 230 \ must begin with 'opcode'. 231 : opcode hex 7F and ; 232 : funct3 swap hex 7 and decimal 12 lshift + ; 233 : funct7 swap hex 7F and decimal 25 lshift + ; 234 : i-immed swap hex FFF and decimal 20 lshift + ; 235 : i-immed-shamt swap hex 1F and decimal 20 lshift + ; 236 : u-immed swap hex FFFFF and decimal 12 lshift + ; 237 : s-immed over hex FE0 and decimal 20 lshift + 238 swap hex 1F and decimal 7 lshift + ; 239 : j-immed over hex 100000 and decimal 11 lshift + 240 over hex FF000 and + 241 over hex 800 and decimal 9 lshift + 242 swap hex 7FE and decimal 20 lshift + ; 243 : b-immed over hex 1000 and decimal 19 lshift + 244 over hex 800 and decimal 4 rshift + 245 over hex 7E0 and decimal 20 lshift + 246 swap hex 1E and decimal 7 lshift + ; 247 : rd swap hex 1F and decimal 7 lshift + ; 248 : rs1 swap hex 1F and decimal 15 lshift + ; 249 : rs2 swap hex 1F and decimal 20 lshift + ; 250 251 \ instruction types. all instruction values should be pushed on the stack with 252 \ the opcode last before calling. 253 : r-type opcode funct3 funct7 rs2 rs1 rd , ; 254 : i-type opcode funct3 i-immed rs1 rd , ; 255 : i-type-shamt opcode funct3 funct7 i-immed-shamt rs1 rd , ; 256 : s-type opcode funct3 s-immed rs2 rs1 , ; 257 : b-type opcode funct3 b-immed rs2 rs1 , ; 258 : u-type opcode u-immed rd , ; 259 : j-type opcode j-immed rd , ; 260 261 \ instructions. these are just simple encodings, no assembler niceties yet. 262 \ 263 \ funct7 funct3 opcode encoding 264 : addi, hex 0 13 i-type ; 265 : andi, hex 7 13 i-type ; 266 : ori, hex 6 13 i-type ; 267 : xori, hex 4 13 i-type ; 268 : slli, hex 00 1 13 i-type-shamt ; 269 : srli, hex 00 5 13 i-type-shamt ; 270 : srai, hex 20 5 13 i-type-shamt ; 271 : slti, hex 2 13 i-type ; 272 : sltiu, hex 3 13 i-type ; 273 : lui, hex 37 u-type ; 274 : auipc, hex 17 u-type ; 275 : add, hex 00 0 33 r-type ; 276 : sub, hex 20 0 33 r-type ; 277 : and, hex 00 7 33 r-type ; 278 : or, hex 00 6 33 r-type ; 279 : xor, hex 00 4 33 r-type ; 280 : sll, hex 00 1 33 r-type ; 281 : srl, hex 00 5 33 r-type ; 282 : sra, hex 20 5 33 r-type ; 283 : slt, hex 00 2 33 r-type ; 284 : sltu, hex 00 3 33 r-type ; 285 : jal, hex 6F j-type ; 286 : jalr, hex 0 67 i-type ; 287 : beq, hex 0 63 b-type ; 288 : bne, hex 1 63 b-type ; 289 : blt, hex 4 63 b-type ; 290 : bltu, hex 6 63 b-type ; 291 : bge, hex 5 63 b-type ; 292 : bgeu, hex 7 63 b-type ; 293 : lw, hex 2 03 i-type ; 294 : lh, hex 1 03 i-type ; 295 : lhu, hex 5 03 i-type ; 296 : lb, hex 0 03 i-type ; 297 : sw, hex 2 23 s-type ; 298 : sh, hex 1 23 s-type ; 299 : sb, hex 0 23 s-type ; 300 : fence, hex 0 0F i-type ; 301 : ecall, hex 0 73 i-type ; 302 : ebreak, hex 0 73 i-type ; 303 304 \ some instructions, with nicer usage. 305 : sw, >r swap r> sw, ; 306 : sh, >r swap r> sh, ; 307 : sb, >r swap r> sb, ; 308 : ecall, 0 0 0 ecall, ; \ usage: ecall, 309 : ebreak, 0 0 1 ebreak, ; \ usage: ebreak, 310 : fence, >r 0 0 r> fence, ; \ usage: imm fence, (this one could be better) 311 312 \ registers 313 decimal 314 0 constant x0 1 constant x1 2 constant x2 3 constant x3 315 4 constant x4 5 constant x5 6 constant x6 7 constant x7 316 8 constant x8 9 constant x9 10 constant x10 11 constant x11 317 12 constant x12 13 constant x13 14 constant x14 15 constant x15 318 16 constant x16 17 constant x17 18 constant x18 19 constant x19 319 20 constant x20 21 constant x21 22 constant x22 23 constant x23 320 24 constant x24 25 constant x25 26 constant x26 27 constant x27 321 28 constant x28 29 constant x29 30 constant x30 31 constant x31 322 323 \ registers (calling convention) 324 x0 constant zero \ zero constant 325 x1 constant ra \ return address 326 x2 constant sp \ stack pointer 327 x3 constant gp \ global pointer 328 x4 constant tp \ thread pointer 329 x8 constant fp \ frame pointer 330 \ function arguments / return values (a0, a1) 331 x10 constant a0 x11 constant a1 x12 constant a2 x13 constant a3 332 x14 constant a4 x15 constant a5 x16 constant a6 x17 constant a7 333 \ saved registers 334 x8 constant s0 x9 constant s1 x18 constant s2 x19 constant s3 335 x20 constant s4 x21 constant s5 x22 constant s6 x23 constant s7 336 x24 constant s8 x25 constant s9 x26 constant s10 x27 constant s11 337 \ temporaries 338 x5 constant t0 x6 constant t1 x7 constant t2 x28 constant t3 339 x29 constant t4 x30 constant t5 x31 constant t6 340 341 : undo, -1 cells allot here @ ; 342 t{ a0 a1 hex FF addi, undo, -> hex 0FF58513 }t 343 t{ a0 a1 hex FF andi, undo, -> hex 0FF5F513 }t 344 t{ a0 a1 hex FF ori, undo, -> hex 0FF5E513 }t 345 t{ a0 a1 hex FF xori, undo, -> hex 0FF5C513 }t 346 t{ a0 a1 hex F slli, undo, -> hex 00F59513 }t 347 t{ a0 a1 hex F srli, undo, -> hex 00F5D513 }t 348 t{ a0 a1 hex F srai, undo, -> hex 40F5D513 }t 349 t{ t0 hex FFFF lui, undo, -> hex 0FFFF2B7 }t 350 t{ t0 hex FFFF auipc, undo, -> hex 0FFFF297 }t 351 t{ a0 a1 hex FF slti, undo, -> hex 0FF5A513 }t 352 t{ a0 a1 hex FF sltiu, undo, -> hex 0FF5B513 }t 353 t{ a0 a1 a2 add, undo, -> hex 00C58533 }t 354 t{ a0 a1 a2 sub, undo, -> hex 40C58533 }t 355 t{ a0 a1 a2 and, undo, -> hex 00C5F533 }t 356 t{ a0 a1 a2 or, undo, -> hex 00C5E533 }t 357 t{ a0 a1 a2 xor, undo, -> hex 00C5C533 }t 358 t{ a0 a1 a2 sll, undo, -> hex 00C59533 }t 359 t{ a0 a1 a2 srl, undo, -> hex 00C5D533 }t 360 t{ a0 a1 a2 sra, undo, -> hex 40C5D533 }t 361 t{ a0 a1 a2 slt, undo, -> hex 00C5A533 }t 362 t{ a0 a1 a2 sltu, undo, -> hex 00C5B533 }t 363 t{ ra hex FFFF jal, undo, -> hex 7FF0F0EF }t 364 t{ ra a0 hex FF jalr, undo, -> hex 0FF500E7 }t 365 t{ a0 a1 hex F beq, undo, -> hex 00B50763 }t 366 t{ a0 a1 hex F bne, undo, -> hex 00B51763 }t 367 t{ a0 a1 hex F blt, undo, -> hex 00B54763 }t 368 t{ a0 a1 hex F bltu, undo, -> hex 00B56763 }t 369 t{ a0 a1 hex F bge, undo, -> hex 00B55763 }t 370 t{ a0 a1 hex F bgeu, undo, -> hex 00B57763 }t 371 t{ a0 a1 hex F lw, undo, -> hex 00F5A503 }t 372 t{ a0 a1 hex F lh, undo, -> hex 00F59503 }t 373 t{ a0 a1 hex F lhu, undo, -> hex 00F5D503 }t 374 t{ a0 a1 hex F lb, undo, -> hex 00F58503 }t 375 t{ a0 a1 hex F sw, undo, -> hex 00A5A7A3 }t 376 t{ a0 a1 hex F sh, undo, -> hex 00A597A3 }t 377 t{ a0 a1 hex F sb, undo, -> hex 00A587A3 }t 378 t{ hex 0FF fence, undo, -> hex 0FF0000F }t 379 t{ ecall, undo, -> hex 00000073 }t 380 t{ ebreak, undo, -> hex 00100073 }t 381 382 \ end: assembler