└── experiments ├── forth-kernel ├── minforth.min.js ├── forth-kernel-preamble-32.ll ├── forth-kernel-preamble-64.ll ├── minforth.js ├── Makefile ├── forth.asm.js ├── forth.ll └── forth-kernel.ll /experiments/forth-kernel: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ephsec/llvm-forth/HEAD/experiments/forth-kernel -------------------------------------------------------------------------------- /experiments/minforth.min.js: -------------------------------------------------------------------------------- 1 | ctx={a:{dup:function(){s.push(s.pop(),s.pop())},rot:function(){s.push(s.shift())},"-rot":function(){s=[s.pop()].concat(s)},swap:function(){s.push(s.pop(),s.pop())},"+":function(){s.push(s.pop()+s.pop())},"-":function(){d.c();s.push(s.pop()-s.pop())},"*":function(){s.push(s.pop()*s.pop())},"/":function(){d.c();s.push(s.pop()/s.pop())},".s":function(){console.log(s)}},b:[]}; 2 | e=function(a){s=this.b;d=this.a;for(a.constructor===String&&(a=a.split(/\s/));a.length;)if(w=a.shift(),w in d)d[w]();else isNaN(w)?""!==w&&s.push(w):s.push(parseFloat(w))};e.apply(ctx,["1 2 3 rot + 1 - 2 * 2 / 1 -rot .s"]); 3 | -------------------------------------------------------------------------------- /experiments/forth-kernel-preamble-32.ll: -------------------------------------------------------------------------------- 1 | %pntr = type i32* 2 | %cell = type i32 3 | %cell.ptr = type i32* 4 | %ret = type i32 5 | %ret.ptr = type i32* 6 | %exec = type i32 7 | %exec.ptr = type i32* 8 | %int = type i32 9 | %addr = type i32 10 | %addr.ptr = type i32* 11 | %fnaddr = type i8* 12 | 13 | ; below needs to be adjusted to the machine architecture as appropriate; wrapper 14 | ; funciton is called from within the Forth code. 15 | declare {i32, i1} @llvm.uadd.with.overflow.i32(i32 %a, i32 %b) 16 | 17 | define {%int, i1} @llvm_ump(%int %first.value, %int %second.value) { 18 | %res = call {%int, i1} @llvm.uadd.with.overflow.i32(%int %first.value, 19 | %int %second.value) 20 | ret {%int, i1} %res 21 | } 22 | -------------------------------------------------------------------------------- /experiments/forth-kernel-preamble-64.ll: -------------------------------------------------------------------------------- 1 | %pntr = type i64* 2 | %cell = type i64 3 | %cell.ptr = type i64* 4 | %ret = type i64 5 | %ret.ptr = type i64* 6 | %exec = type i64 7 | %exec.ptr = type i64* 8 | %int = type i64 9 | %addr = type i64 10 | %addr.ptr = type i64* 11 | %fnaddr = type i8* 12 | 13 | ; below needs to be adjusted to the machine architecture as appropriate; wrapper 14 | ; funciton is called from within the Forth code. 15 | declare {i64, i1} @llvm.uadd.with.overflow.i64(i64 %a, i64 %b) 16 | 17 | define {%int, i1} @llvm_ump(%int %first.value, %int %second.value) { 18 | %res = call {%int, i1} @llvm.uadd.with.overflow.i64(%int %first.value, 19 | %int %second.value) 20 | ret {%int, i1} %res 21 | } 22 | -------------------------------------------------------------------------------- /experiments/minforth.js: -------------------------------------------------------------------------------- 1 | ctx = { 2 | d: { 3 | "dup": function() { 4 | s.push( s.pop(), s.pop() ); 5 | }, 6 | "rot": function() { 7 | s.push( s.shift() ); 8 | }, 9 | "-rot": function() { 10 | s = [ s.pop() ].concat(s); 11 | }, 12 | "swap": function() { 13 | s.push( s.pop(), s.pop() ); 14 | }, 15 | "+": function() { 16 | s.push( ( s.pop() + s.pop() ) ); 17 | }, 18 | "-": function() { 19 | d.swap(); 20 | s.push( s.pop() - s.pop() ); 21 | }, 22 | '*': function() { 23 | s.push( s.pop() * s.pop() ); 24 | }, 25 | '/': function() { 26 | d.swap(); 27 | s.push( s.pop() / s.pop() ); 28 | }, 29 | '.s': function() { 30 | console.log( s ); 31 | } 32 | }, 33 | s: [] 34 | }; 35 | 36 | e = function(t) { 37 | s = this.s; 38 | d = this.d; 39 | 40 | if ( t.constructor === String ) { 41 | t = t.split(/\s/); 42 | } 43 | while ( t.length ) { 44 | w = t.shift(); 45 | if ( w in d ) { 46 | d[w](); 47 | } else if ( !( isNaN( w ) ) ) { 48 | s.push( parseFloat( w ) ); 49 | } else if ( w !== '' ) { 50 | s.push( w ); 51 | }; 52 | } 53 | } 54 | 55 | e.apply(ctx, ['1 2 3 .s rot .s + .s 1 - 2 * 2 / 1 .s -rot .s']); -------------------------------------------------------------------------------- /experiments/Makefile: -------------------------------------------------------------------------------- 1 | ARCH=64 2 | EXECUTABLE=forth-kernel 3 | BUGPOINT=bugpoint-3.3 -run-int 4 | LLVMOPT=opt-3.3 -Oz -S 5 | LLVMAS=llvm-as-3.3 -regalloc=greedy 6 | LLVMC=llc-3.3 7 | #LLVMC=llc-3.3 -regalloc=iterativescan 8 | 9 | all: $(EXECUTABLE).ll 10 | cat $(EXECUTABLE)-preamble-$(ARCH).ll $(EXECUTABLE).ll > $(EXECUTABLE)-$(ARCH).ll 11 | $(LLVMAS) $(EXECUTABLE)-$(ARCH).ll 12 | $(LLVMC) $(EXECUTABLE)-$(ARCH).bc 13 | clang -o $(EXECUTABLE)-$(ARCH) $(EXECUTABLE)-$(ARCH).s 14 | time ./$(EXECUTABLE)-$(ARCH) 15 | 16 | optimize: $(EXECUTABLE).ll 17 | $(LLVMOPT) $(EXECUTABLE).ll > forth-kernel.opt.ll 18 | $(LLVMAS) $(EXECUTABLE).opt.ll 19 | $(LLVMC) $(EXECUTABLE).opt.bc 20 | clang -o $(EXECUTABLE).opt $(EXECUTABLE).opt.s 21 | time ./$(EXECUTABLE).opt 22 | 23 | bugpoint: $(EXECUTABLE).ll 24 | $(LLVMOPT) $(EXECUTABLE).ll > forth.opt.ll 25 | $(LLVMAS) $(EXECUTABLE).opt.ll 26 | $(LLVMC) $(EXECUTABLE).opt.bc 27 | $(BUGPOINT) $(EXECUTABLE).opt.bc 28 | clang -o $(EXECUTABLE).opt $(EXECUTABLE).opt.s 29 | time ./$(EXECUTABLE).opt 30 | 31 | clean: 32 | rm -f $(EXECUTABLE) 33 | rm -f $(EXECUTABLE).s 34 | rm -f $(EXECUTABLE).bc 35 | rm -f $(EXECUTABLE).opt.ll 36 | rm -f $(EXECUTABLE).opt.bc 37 | rm -f $(EXECUTABLE).opt.s 38 | rm -f $(EXECUTABLE).opt 39 | -------------------------------------------------------------------------------- /experiments/forth.asm.js: -------------------------------------------------------------------------------- 1 | if ( typeof global !== 'undefined' ) { 2 | var asm = require('asm.js'); 3 | var context = global; 4 | } else { 5 | var context = window; 6 | } 7 | 8 | function forth(stdlib, foreign, heap) { 9 | "use asm"; 10 | 11 | // Our heap 12 | var HU32 = new stdlib.Int32Array(heap); 13 | 14 | // globals 15 | var log = foreign.consoleDotLog; 16 | var display = foreign.Display; 17 | 18 | // Registers 19 | var eax = 0; 20 | var ebx = 0; 21 | var ecx = 0; 22 | var edx = 0; 23 | var esi = 0; 24 | var edi = 0; 25 | var ebp = 0; 26 | var esp = 0; 27 | var reg = 0; 28 | 29 | function LODSL() { 30 | eax = HU32[(esi<<2)>>2]>>>0; // read memory into accumulator 31 | esi = (esi + 1)>>>0; // increment ESI pointer 32 | return; 33 | }; 34 | 35 | function NEXT() { 36 | LODSL(); // move onto our next instruction in the heap 37 | display(esi|0, eax|0, esp|0); 38 | ftable[(eax|0)](); // execute the instruction pointed at in the heap 39 | return; 40 | }; 41 | 42 | // Push our register passed onto the return stack. 43 | function PUSHRSP(reg) { 44 | reg = reg|0 45 | ebp = ebp|0 - 1; 46 | HU32[(ebp<<2)>>2] = reg; 47 | return; 48 | }; 49 | 50 | // Pop our register from the return stack. 51 | function POPRSP(reg) { 52 | reg = reg|0 53 | reg = HU32[(ebp<<2)>>2]>>>0; 54 | ebp = ebp|0 + 1; 55 | return; 56 | }; 57 | 58 | function DOCOL() { 59 | PUSHRSP(esi|0); // push our current ESI onto the return stack 60 | eax = eax|0 + 4; // eax points to our codeword, so we skip it and 61 | esi = eax; // set esi to +32 bytes -- this means our Forth 62 | // words can be up to 32 bytes long. 63 | NEXT(); // move onto the next codeword 64 | return; 65 | }; 66 | 67 | // END is simply a stub function that doesn't call NEXT(), therby 68 | // ending execution. 69 | function END() {}; 70 | 71 | // Forth words 72 | function POP() { 73 | reg = HU32[(esp<<2)>>2]>>>0; 74 | esp = (esp|0) + 1; 75 | return( reg|0 ); 76 | }; 77 | 78 | function PUSH(reg) { 79 | reg = reg|0 80 | esp = (esp|0) - 1; 81 | HU32[(esp<<2)>>2] = reg|0; 82 | return; 83 | }; 84 | 85 | function DROP() { 86 | eax = POP()|0; 87 | NEXT(); 88 | return; 89 | }; 90 | 91 | function SWAP() { 92 | eax = POP()|0; 93 | ebx = POP()|0; 94 | PUSH(eax|0); 95 | PUSH(ebx|0); 96 | NEXT(); 97 | return; 98 | }; 99 | 100 | function DUP() { 101 | eax = HU32[(esp<<2)>>2]|0; 102 | PUSH(eax|0); 103 | NEXT(); 104 | return; 105 | }; 106 | 107 | function OVER() { 108 | eax = HU32[(((esp|0)+1)<<2)>>2]|0; 109 | PUSH(eax|0); 110 | NEXT(); 111 | return; 112 | }; 113 | 114 | function ROT() { 115 | eax = POP()|0; 116 | ebx = POP()|0; 117 | ecx = POP()|0; 118 | PUSH(eax|0); 119 | PUSH(ebx|0); 120 | PUSH(ecx|0); 121 | NEXT(); 122 | return; 123 | }; 124 | 125 | function MINROT() { 126 | eax = POP()|0; 127 | ebx = POP()|0; 128 | ecx = POP()|0; 129 | PUSH(eax|0); 130 | PUSH(ecx|0); 131 | PUSH(ebx|0); 132 | NEXT(); 133 | return; 134 | }; 135 | 136 | function TWODROP() { 137 | eax = POP()|0; 138 | eax = POP()|0; 139 | NEXT(); 140 | return; 141 | }; 142 | 143 | function TWODUP() { 144 | eax = HU32[(esp<<2)>>2]|0; 145 | ebx = HU32[(((esp|0)+1)<<2)>>2]|0; 146 | PUSH(ebx|0); 147 | PUSH(eax|0); 148 | NEXT(); 149 | return; 150 | }; 151 | 152 | function TWOSWAP() { 153 | eax = POP()|0; 154 | ebx = POP()|0; 155 | ecx = POP()|0; 156 | edx = POP()|0; 157 | PUSH(ebx|0); 158 | PUSH(eax|0); 159 | PUSH(edx|0); 160 | PUSH(ecx|0); 161 | NEXT(); 162 | return; 163 | }; 164 | 165 | function QDUP() { 166 | eax = HU32[(esp<<2)>>2]|0; 167 | if ( (eax|0) != 0 ) { 168 | PUSH(eax|0); 169 | }; 170 | NEXT(); 171 | return; 172 | }; 173 | 174 | function INCR() { 175 | HU32[(esp<<2)>>2] = HU32[(esp<<2)>>2]|0 + 1; 176 | NEXT(); 177 | return; 178 | }; 179 | 180 | function DECR() { 181 | HU32[(esp<<2)>>2] = HU32[(esp<<2)>>2]|0 - 1; 182 | NEXT(); 183 | return; 184 | }; 185 | 186 | function INCR4() { 187 | HU32[(esp<<2)>>2] = HU32[(esp<<2)>>2]|0 + 4; 188 | NEXT(); 189 | return; 190 | }; 191 | 192 | function DECR4() { 193 | HU32[(esp<<2)>>2] = HU32[(esp<<2)>>2]|0 - 4; 194 | NEXT(); 195 | return; 196 | }; 197 | 198 | function ADD() { 199 | eax = POP()|0; 200 | HU32[(esp<<2)>>2] = (HU32[(esp<<2)>>2]|0) + eax|0; 201 | NEXT(); 202 | return; 203 | }; 204 | 205 | function SUB() { 206 | eax = POP()|0; 207 | HU32[(esp<<2)>>2] = (HU32[(esp<<2)>>2]|0) - eax|0; 208 | NEXT(); 209 | return; 210 | }; 211 | 212 | function MUL() { 213 | eax = POP()|0; 214 | ebx = POP()|0; 215 | eax = (ebx|0) * (eax|0); 216 | PUSH(eax|0); 217 | NEXT(); 218 | return; 219 | }; 220 | 221 | function DIV() { 222 | ebx = POP()|0; 223 | eax = POP()|0; 224 | eax = ((ebx>>>0) / (eax>>>0))|0; 225 | PUSH(eax|0); 226 | NEXT(); 227 | return; 228 | }; 229 | 230 | function NIL(){ 231 | } 232 | 233 | function execute(progAddr, endStackAddr) { 234 | progAddr = progAddr|0; 235 | endStackAddr = endStackAddr|0; 236 | esi = progAddr; 237 | esp = endStackAddr; 238 | NEXT(); 239 | return; 240 | } 241 | 242 | // function tables 243 | var calltable = [ POP ]; 244 | var rettable = [ PUSH ]; 245 | var ftable = [ END, DROP, SWAP, DUP, OVER, ROT, MINROT, TWODROP, 246 | TWOSWAP, QDUP, INCR, DECR, INCR4, DECR4, ADD, SUB, MUL, 247 | DIV, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, NIL, 248 | NIL, NIL]; 249 | 250 | // exports declaration 251 | return { execute: execute }; 252 | }; 253 | 254 | var words = [ "END", "DROP", "SWAP", "DUP", "OVER", "ROT", 255 | "-ROT", "2DROP", "2SWAP", "?DUP", "INCR", "DECR", "INCR4", 256 | "DECR4", "+", "-", "*", "/" ]; 257 | 258 | function compile(input) { 259 | var tokenArray = []; 260 | var currIndex = 0; 261 | var tokens = input.split(/\s/); 262 | while (tokens.length) { 263 | var token = tokens.shift(); 264 | if ( words.indexOf( token ) ) { 265 | console.log( token ); 266 | tokenArray[currIndex] = words.indexOf( token ); 267 | currIndex = currIndex + 1; 268 | } 269 | } 270 | 271 | var compiledTokens = ArrayBuffer(currIndex * 4); 272 | var compiledAligned = Uint32Array(compiledTokens); 273 | for (i in tokenArray) { 274 | console.log(i, tokenArray[i]); 275 | compiledAligned[i] = tokenArray[i]; 276 | }; 277 | return( compiledTokens ); 278 | } 279 | 280 | if ( typeof asm !== 'undefined' ) { 281 | var x = asm.validate( forth ); 282 | } 283 | 284 | // Test functions 285 | var ForthHeap = new ArrayBuffer(128); 286 | var ForthHeap32 = new Uint32Array(ForthHeap); 287 | 288 | // Set our initial stack to [3, 2, 1] 289 | ForthHeap32[31] = 1; 290 | ForthHeap32[30] = 2; 291 | ForthHeap32[29] = 3; 292 | 293 | // Get a compiled list of function references 294 | compiled = compile("+ DUP ROT SWAP OVER + DUP *") 295 | compiled32 = new Uint32Array(compiled); 296 | 297 | // Inject our compiled stream into our heap. 298 | for (i in compiled32) { 299 | ForthHeap32[i] = compiled32[i]; 300 | }; 301 | 302 | var instructionPointer = 0; 303 | var endOfStackPointer = 29; 304 | 305 | function createDisplay(heap) { 306 | return( 307 | function Display(esi, eax, esp) { 308 | var viewStack = []; 309 | var stackArray = heap.slice(esp * 4, heap.byteLength); 310 | var currStack = new Int32Array(stackArray); 311 | for (i=0; i %s (%llu) \00" 52 | @newlineString = internal constant [3 x i8] c"\0D\0A\00" 53 | @promptString = internal constant [5 x i8] c" Ok \00" 54 | @stackString = internal constant [14 x i8] c"@%llu: %llu\0D\0A\00" 55 | @SPString = internal constant [23 x i8] c"SP: @%llu SP0: @%llu\0D\0A\00" 56 | @SPValuesString = internal constant [33 x i8] c"SP: @%llu=%llu SP0: @%llu=%llu\0D\0A\00" 57 | @EIPString = internal constant [13 x i8] c"EIP: @%llu\0D\0A\00" 58 | @EIPValueString = internal constant [19 x i8] c"EIP: @%llu: %llu\0D\0A\00" 59 | @pushString = internal constant [17 x i8] c"%llu --> @%llu\0D\0A\00" 60 | @popString = internal constant [17 x i8] c"@%llu --> %llu\0D\0A\00" 61 | 62 | define void @printValue8(i8 %value) { 63 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 64 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i8 %value) 65 | ret void 66 | } 67 | 68 | 69 | define void @printValue32(i32 %value) { 70 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 71 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i32 %value) 72 | ret void 73 | } 74 | 75 | define void @printValue64(i64 %value) { 76 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 77 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i64 %value) 78 | ret void 79 | } 80 | 81 | define void @printValueInt(%int %value) { 82 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 83 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, %int %value) 84 | ret void 85 | } 86 | 87 | define void @printValueCell(%cell %value) { 88 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 89 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, %cell %value) 90 | ret void 91 | } 92 | 93 | define void @printString(i8* %value) { 94 | %string = getelementptr [5 x i8]* @wordString, i32 0, i32 0 95 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i8* %value) 96 | ret void 97 | } 98 | 99 | define void @printTwoString(i8* %value, i8* %value2) { 100 | %string = getelementptr [8 x i8]* @twoWordString, i32 0, i32 0 101 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i8* %value, 102 | i8* %value2) 103 | ret void 104 | } 105 | 106 | define void @outputNewLine() { 107 | %string = getelementptr [3 x i8]* @newlineString, i32 0, i32 0 108 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string) 109 | ret void 110 | } 111 | 112 | define void @printEIPPtr(%cell.ptr* %EIP.ptr.ptr) { 113 | %string = getelementptr [13 x i8]* @EIPString, i32 0, i32 0 114 | ; obtain the heap position that EIP is pointing at 115 | %EIP.ptr = getelementptr %cell.ptr* %EIP.ptr.ptr, i32 0 116 | %EIP.heap.ptr = load %cell.ptr* %EIP.ptr 117 | %EIP.heap.addr.ptr = getelementptr %cell.ptr %EIP.heap.ptr, i32 0 118 | %EIP.heap.addr.int = ptrtoint %cell.ptr %EIP.heap.addr.ptr to %addr 119 | 120 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 121 | %int %EIP.heap.addr.int) 122 | ret void 123 | } 124 | 125 | define void @printEIPPtrValue(%cell.ptr* %EIP.ptr.ptr) { 126 | %string = getelementptr [19 x i8]* @EIPValueString, i32 0, i32 0 127 | ; obtain the heap position that EIP is pointing at 128 | %EIP.ptr = getelementptr %cell.ptr* %EIP.ptr.ptr, i32 0 129 | %EIP.heap.ptr = load %cell.ptr* %EIP.ptr 130 | %EIP.heap.addr.ptr = getelementptr %cell.ptr %EIP.heap.ptr, i32 0 131 | %EIP.heap.addr.int = ptrtoint %cell.ptr %EIP.heap.addr.ptr to %addr 132 | %EIP.heap.addr.value = load %cell.ptr %EIP.heap.addr.ptr 133 | 134 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 135 | %int %EIP.heap.addr.int, 136 | %int %EIP.heap.addr.value) 137 | ret void 138 | } 139 | 140 | define void @printStackPtrs(%cell.ptr* %SP.ptr.ptr) { 141 | %string = getelementptr [23 x i8]* @SPString, i32 0, i32 0 142 | ; obtain the stack position that SP is pointing at 143 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 144 | %SP.stack.ptr = load %cell.ptr* %SP.ptr 145 | %SP.stack.addr.ptr = getelementptr %cell.ptr %SP.stack.ptr, i32 0 146 | %SP.stack.addr.int = ptrtoint %cell.ptr %SP.stack.addr.ptr to %addr 147 | ; obtain the stack position that SP0 is pointing at 148 | %SP0.stack.ptr = load %cell.ptr* @SP0 149 | %SP0.stack.addr.ptr = getelementptr %addr.ptr %SP0.stack.ptr, i32 0 150 | %SP0.stack.addr.int = ptrtoint %addr.ptr %SP0.stack.addr.ptr to %addr 151 | 152 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 153 | %int %SP.stack.addr.int, 154 | %int %SP0.stack.addr.int) 155 | ret void 156 | } 157 | 158 | define void @printStackPtrValues(%cell.ptr* %SP.ptr.ptr) { 159 | %string = getelementptr [33 x i8]* @SPValuesString, i32 0, i32 0 160 | ; obtain the stack position that SP is pointing at 161 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 162 | %SP.stack.ptr = load %cell.ptr* %SP.ptr 163 | %SP.stack.addr.ptr = getelementptr %cell.ptr %SP.stack.ptr, i32 0 164 | %SP.stack.addr.int = ptrtoint %cell.ptr %SP.stack.addr.ptr to %addr 165 | %SP.stack.addr.value = load %cell.ptr %SP.stack.addr.ptr 166 | ; obtain the stack position that SP0 is pointing at 167 | %SP0.stack.ptr = load %cell.ptr* @SP0 168 | %SP0.stack.addr.ptr = getelementptr %addr.ptr %SP0.stack.ptr, i32 0 169 | %SP0.stack.addr.int = ptrtoint %addr.ptr %SP0.stack.addr.ptr to %addr 170 | %SP0.stack.addr.value = load %cell.ptr %SP0.stack.addr.ptr 171 | 172 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 173 | %int %SP.stack.addr.int, 174 | %int %SP.stack.addr.value, 175 | %int %SP0.stack.addr.int, 176 | %int %SP0.stack.addr.value) 177 | ret void 178 | } 179 | 180 | define cc 10 void @printStackPop(%int %addr, %int %value) { 181 | %string = getelementptr [17 x i8]* @popString, i32 0, i32 0 182 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 183 | %int %addr, %int %value) 184 | ret void 185 | } 186 | 187 | define cc 10 void @printStackPush(%int %addr, %int %value) { 188 | %string = getelementptr [17 x i8]* @pushString, i32 0, i32 0 189 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 190 | %int %value, %int %addr) 191 | ret void 192 | } 193 | 194 | ; ***************************************************************************** 195 | ; globals used for Forth heap, execution and stack 196 | ; ***************************************************************************** 197 | 198 | @SP0 = weak global %cell.ptr null 199 | @HEAP = weak global %cell.ptr null 200 | 201 | @dictPtr = weak global %WORD* null ; pointer to the last word in the dict 202 | @heapSize = weak global %int 0 ; size of the heap in i8 bytes 203 | 204 | ; * constants containing strings of Forth words 205 | @str_dispStack = internal constant [ 3 x i8 ] c".s\00" 206 | @str_c_at = internal constant [ 3 x i8 ] c"C@\00" 207 | @str_c_bang = internal constant [ 3 x i8 ] c"C!\00" 208 | @str_sp_at = internal constant [ 4 x i8 ] c"SP@\00" 209 | @str_sp_bang = internal constant [ 4 x i8 ] c"SP!\00" 210 | @str_swap = internal constant [ 5 x i8 ] c"SWAP\00" 211 | @str_dup = internal constant [ 4 x i8 ] c"DUP\00" 212 | @str_drop = internal constant [ 5 x i8 ] c"DROP\00" 213 | @str_over = internal constant [ 5 x i8 ] c"OVER\00" 214 | @str_umplus = internal constant [ 4 x i8 ] c"UM+\00" 215 | @str_add = internal constant [ 2 x i8 ] c"+\00" 216 | @str_sub = internal constant [ 2 x i8 ] c"-\00" 217 | @str_mul = internal constant [ 2 x i8 ] c"*\00" 218 | @str_div = internal constant [ 2 x i8 ] c"/\00" 219 | @str_lit = internal constant [ 5 x i8 ] c"_LIT\00" 220 | @str_char_min = internal constant [ 6 x i8 ] c"CHAR-\00" 221 | @str_char_plus = internal constant [ 6 x i8 ] c"CHAR+\00" 222 | @str_chars = internal constant [ 6 x i8 ] c"CHARS\00" 223 | @str_cell_min = internal constant [ 6 x i8 ] c"CELL-\00" 224 | @str_cell_plus = internal constant [ 6 x i8 ] c"CELL+\00" 225 | @str_cells = internal constant [ 6 x i8 ] c"CELLS\00" 226 | @str_nonzero = internal constant [ 3 x i8 ] c"0<\00" 227 | @str_and = internal constant [ 4 x i8 ] c"AND\00" 228 | @str_or = internal constant [ 3 x i8 ] c"OR\00" 229 | @str_xor = internal constant [ 4 x i8 ] c"XOR\00" 230 | 231 | ; * test forth program 232 | @str_testProgram = internal constant [ 21 x i8 ] c"99 2 3 DUP + SWAP .s\00" 233 | 234 | ; **** heap access and manipulation functions 235 | define fastcc %pntr @getHeap_ptr(%int %index) { 236 | ; load our heap pointer, which is stored as a pointer 237 | %heapPtr = load %pntr* @HEAP 238 | ; retrieve and return our value pointer 239 | %valuePtr = getelementptr %pntr %heapPtr, %int %index 240 | ret %pntr %valuePtr 241 | } 242 | 243 | define fastcc %int @getHeap(%int %index) { 244 | %valuePtr = call fastcc %pntr @getHeap_ptr(%int %index) 245 | %value = load %pntr %valuePtr 246 | ret %int %value 247 | } 248 | 249 | define fastcc void @putHeap(%int %index, %int %value) { 250 | %valuePtr = call fastcc %pntr @getHeap_ptr(%int %index) 251 | store %int %value, %pntr %valuePtr 252 | ret void 253 | } 254 | 255 | define fastcc void @insertToken(%int %index, %FNPTR %token) { 256 | %insPtr = call fastcc %pntr @getHeap_ptr(%int %index) 257 | %tokenPtrInt = ptrtoint %FNPTR %token to %int 258 | call fastcc void @putHeap(%int %index, %int %tokenPtrInt) 259 | ret void 260 | } 261 | 262 | define fastcc void @insertLiteral(%int %index, %int %value) { 263 | %insPtr = call fastcc %pntr @getHeap_ptr(%int %index) 264 | call fastcc void @putHeap(%int %index, %int %value) 265 | ret void 266 | } 267 | 268 | ; **************************************************************************** 269 | ; stack manipulation functions 270 | ; **************************************************************************** 271 | 272 | ; SP! ( n -- ) r4: n 273 | define cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 274 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 275 | 276 | %SP.next.ptr.int.ptr = alloca %addr 277 | ; obtain the stack value that SP is pointing at 278 | call cc 10 void @_SP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 279 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) 280 | ; decrement our stack pointer now that we've obtained our value 281 | call cc 10 void @_SP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 282 | %ret.ptr* %RSP.ptr.ptr, %addr* %SP.next.ptr.int.ptr) 283 | 284 | ; report the pop 285 | %SP.next.ptr.int = load %addr* %SP.next.ptr.int.ptr 286 | %DATA.value = load %cell* %DATA.ptr 287 | ;call cc 10 void @printStackPop(%addr %SP.next.ptr.int, %cell %DATA.value) 288 | 289 | ret void 290 | } 291 | 292 | ; DUP ( n -- n n ) 293 | define cc 10 void @_SP_DUP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 294 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 295 | 296 | %value.ptr = alloca %cell 297 | ; obtain the stack value that SP is pointing at 298 | call cc 10 void @_SP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 299 | %ret.ptr* %RSP.ptr.ptr, %cell* %value.ptr) 300 | ; push a duplicate of the value onto the stack 301 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 302 | %ret.ptr* %RSP.ptr.ptr, %cell* %value.ptr) 303 | 304 | ret void 305 | } 306 | 307 | ; PUSH ( -- n ) 308 | define cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 309 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 310 | 311 | %SP.next.ptr.int.ptr = alloca %addr 312 | %DATA.value = load %cell* %DATA.ptr 313 | 314 | call cc 10 void @_SP_DECR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 315 | %ret.ptr* %RSP.ptr.ptr, %addr* %SP.next.ptr.int.ptr ) 316 | 317 | %SP.next.ptr.int = load %addr* %SP.next.ptr.int.ptr 318 | %SP.next.ptr = inttoptr %addr %SP.next.ptr.int to %addr* 319 | 320 | ; store our value at the new stack position 321 | store %cell %DATA.value, %cell.ptr %SP.next.ptr 322 | 323 | ;call cc 10 void @printStackPush(%addr %SP.next.ptr.int, %cell %DATA.value) 324 | 325 | ret void 326 | } 327 | 328 | ; SP@ ( -- a ) 329 | ; INTERNAL: push the stack position onto the stack 330 | 331 | define cc 10 void @_SP_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 332 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 333 | 334 | ; obtain the stack position that SP is pointing at 335 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 336 | %value.ptr = load %cell.ptr* %SP.ptr 337 | %value.cell.ptr = getelementptr %cell.ptr %value.ptr, i32 0 338 | %SP.ptr.int = ptrtoint %cell.ptr %value.cell.ptr to %addr 339 | store %addr %SP.ptr.int, %addr* %DATA.ptr 340 | 341 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 342 | %ret.ptr* %RSP.ptr.ptr, %addr* %DATA.ptr) 343 | 344 | ret void 345 | } 346 | 347 | ; SWAP ( n1 n2 -- n2 n1 ) 348 | ; INTERNAL: swap the topmost two elements of the stack 349 | define cc 10 void @_SP_SWAP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 350 | %ret.ptr* %RSP.ptr.ptr) { 351 | %first.ptr = alloca %cell 352 | %second.ptr = alloca %cell 353 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 354 | %ret.ptr* %RSP.ptr.ptr, %cell* %first.ptr) 355 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 356 | %ret.ptr* %RSP.ptr.ptr, %cell* %second.ptr) 357 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 358 | %ret.ptr* %RSP.ptr.ptr, %cell* %first.ptr) 359 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 360 | %ret.ptr* %RSP.ptr.ptr, %cell* %second.ptr) 361 | ret void 362 | } 363 | 364 | ; OVER ( n1 n2 -- n1 n2 n1 ) 365 | ; INTERNAL: copy the second value on the stack into the front of the stack 366 | define cc 10 void @_SP_OVER(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 367 | %ret.ptr* %RSP.ptr.ptr) { 368 | %first.ptr = alloca %cell 369 | %second.ptr = alloca %cell 370 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 371 | %ret.ptr* %RSP.ptr.ptr, %cell* %first.ptr) 372 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 373 | %ret.ptr* %RSP.ptr.ptr, %cell* %second.ptr) 374 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 375 | %ret.ptr* %RSP.ptr.ptr, %cell* %second.ptr) 376 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 377 | %ret.ptr* %RSP.ptr.ptr, %cell* %first.ptr) 378 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 379 | %ret.ptr* %RSP.ptr.ptr, %cell* %second.ptr) 380 | ret void 381 | } 382 | 383 | ; PEEK ( n -- n ) r4: n 384 | ; INTERNAL: return the value under the stack pointer in r4 385 | define cc 10 void @_SP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 386 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 387 | ; obtain the stack value that SP is pointing at 388 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 389 | %value.ptr = load %cell.ptr* %SP.ptr 390 | %value.cell.ptr = getelementptr %cell.ptr %value.ptr, i32 0 391 | %value.cell.ptr.int = ptrtoint %cell.ptr %value.cell.ptr to %int 392 | ; grab the current value under the stack pointer 393 | %value.cell = load %cell* %value.cell.ptr 394 | store %cell %value.cell, %cell* %DATA.ptr 395 | 396 | ret void 397 | } 398 | 399 | ; DROP ( n -- ) 400 | ; INTERNAL: increment the stack pointer, which has a side effect of DROP 401 | define cc 10 void @_SP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 402 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 403 | ; obtain the stack position that SP is pointing at 404 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 405 | %value.ptr = load %cell.ptr* %SP.ptr 406 | %value.cell.ptr = getelementptr %cell.ptr %value.ptr, i32 0 407 | 408 | ; increment SP 409 | %SP.ptr.int = ptrtoint %cell.ptr %value.cell.ptr to %addr 410 | %SP.next.ptr.int = add %addr %SP.ptr.int, 8 411 | %SP.next.ptr = inttoptr %addr %SP.next.ptr.int to %cell.ptr 412 | 413 | ; finalize our new state 414 | store %cell %SP.next.ptr.int, %cell* %DATA.ptr 415 | store %cell.ptr %SP.next.ptr, %cell.ptr* %SP.ptr.ptr 416 | 417 | ret void 418 | } 419 | 420 | ; INTERNAL: decrement the stack pointer 421 | define cc 10 void @_SP_DECR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 422 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 423 | ; obtain the stack position that SP is pointing at 424 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 425 | %value.ptr = load %cell.ptr* %SP.ptr 426 | %value.cell.ptr = getelementptr %cell.ptr %value.ptr, i32 0 427 | 428 | ; decrement SP 429 | %SP.ptr.int = ptrtoint %cell.ptr %value.cell.ptr to %addr 430 | %SP.next.ptr.int = sub %addr %SP.ptr.int, 8 431 | %SP.next.ptr = inttoptr %addr %SP.next.ptr.int to %cell.ptr 432 | ;call void @printValueInt( %addr %SP.next.ptr.int ) 433 | 434 | ; finalize our new state 435 | store %cell %SP.next.ptr.int, %cell* %DATA.ptr 436 | store %cell.ptr %SP.next.ptr, %cell.ptr* %SP.ptr.ptr 437 | 438 | ret void 439 | } 440 | 441 | ; **************************************************************************** 442 | ; Memory access functions 443 | ; **************************************************************************** 444 | 445 | ; C! ( c a -- ) 446 | define cc 10 void @_C_BANG(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 447 | %ret.ptr* %RSP.ptr.ptr) { 448 | %address.cell.ptr = alloca %cell 449 | %value.cell.ptr = alloca %cell 450 | 451 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 452 | %ret.ptr* %RSP.ptr.ptr, %cell* %address.cell.ptr) 453 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 454 | %ret.ptr* %RSP.ptr.ptr, %cell* %value.cell.ptr) 455 | 456 | %address.cell = load %cell* %address.cell.ptr 457 | %value.cell = load %cell* %value.cell.ptr 458 | %address.ptr = inttoptr %cell %address.cell to %cell* 459 | store %cell %value.cell, %cell* %address.ptr 460 | 461 | ret void 462 | } 463 | 464 | ; C@ ( a -- c ) 465 | define cc 10 void @_C_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 466 | %ret.ptr* %RSP.ptr.ptr) { 467 | %address.cell.ptr = alloca %cell 468 | %value.cell.ptr = alloca %cell 469 | 470 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 471 | %ret.ptr* %RSP.ptr.ptr, %cell* %address.cell.ptr) 472 | 473 | %address.cell = load %cell* %address.cell.ptr 474 | %address.ptr = inttoptr %cell %address.cell to %addr* 475 | %retrieve.cell = load %cell* %address.ptr 476 | store %cell %retrieve.cell, %cell* %value.cell.ptr 477 | 478 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 479 | %ret.ptr* %RSP.ptr.ptr, %cell* %value.cell.ptr) 480 | 481 | ret void 482 | } 483 | 484 | 485 | ; **************************************************************************** 486 | ; Execution loop functions 487 | ; **************************************************************************** 488 | 489 | define cc 10 void @_EIP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 490 | %ret.ptr* %RSP.ptr.ptr) { 491 | ; resolve our current EIP 492 | %EIP.ptr = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 493 | %EIP.value.ptr = load %exec.ptr* %EIP.ptr 494 | %EIP.exec.ptr = getelementptr %exec.ptr %EIP.value.ptr, i32 0 495 | 496 | ; increment EIP 497 | %EIP.ptr.int = ptrtoint %exec.ptr %EIP.exec.ptr to %addr 498 | %EIP.next.ptr.int = add %addr %EIP.ptr.int, 8 499 | %EIP.next.ptr = inttoptr %addr %EIP.next.ptr.int to %exec.ptr 500 | 501 | ; finalize our new state 502 | store %exec.ptr %EIP.next.ptr, %exec.ptr* %EIP.ptr.ptr 503 | 504 | ret void 505 | } 506 | 507 | define cc 10 void @_EIP_NEXT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 508 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) { 509 | 510 | ; obtain the data that the EIP is pointing at 511 | %EIP.ptr = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 512 | %EIP.ins.ptr.ptr = load %exec.ptr* %EIP.ptr 513 | %EIP.ins.ptr = getelementptr %exec.ptr %EIP.ins.ptr.ptr, i32 0 514 | %EIP.ins = load %exec.ptr %EIP.ins.ptr 515 | 516 | ; increment our EIP now that we've got our data 517 | call cc 10 void @_EIP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 518 | %ret.ptr* %RSP.ptr.ptr) 519 | 520 | ; finalize our state and return our instruction 521 | store %exec %EIP.ins, %int* %DATA.ptr 522 | 523 | ret void 524 | } 525 | 526 | define cc 10 void @_EIP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 527 | %ret.ptr* %RSP.ptr.ptr, %addr* %DATA.ptr) { 528 | ; obtain the data that the EIP is pointing at 529 | %EIP.ptr = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 530 | %EIP.ins.ptr.ptr = load %exec.ptr* %EIP.ptr 531 | %EIP.ins.ptr = getelementptr %exec.ptr %EIP.ins.ptr.ptr, i32 0 532 | %EIP.ins = load %exec.ptr %EIP.ins.ptr 533 | 534 | ; finalize our state and return our instruction 535 | store %exec %EIP.ins, %int* %DATA.ptr 536 | 537 | ret void 538 | } 539 | 540 | define cc 10 void @_EIP_JMP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 541 | %ret.ptr* %RSP.ptr.ptr, %addr* %DATA.ptr) { 542 | %EIP.new = load %addr* %DATA.ptr 543 | %EIP.new.ptr = inttoptr %addr %EIP.new to %exec.ptr 544 | 545 | ; store the new EIP 546 | %EIP.ptr = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 547 | %EIP.ins.ptr.ptr = load %exec.ptr* %EIP.ptr 548 | %EIP.ins.ptr = getelementptr %exec.ptr %EIP.ins.ptr.ptr, i32 0 549 | store %exec.ptr %EIP.new.ptr, %exec.ptr* %EIP.ptr.ptr 550 | 551 | ; execute our new instruction under the EIP 552 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 553 | %ret.ptr* %RSP.ptr.ptr, %addr* %DATA.ptr) noreturn 554 | 555 | ret void 556 | } 557 | 558 | define cc 10 void @_EIP_EXEC(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 559 | %ret.ptr* %RSP.ptr.ptr, %addr* %DATA.ptr) { 560 | ; obtain the data that the EIP is pointing at 561 | %EIP.ptr = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 562 | %EIP.ins.ptr.ptr = load %exec.ptr* %EIP.ptr 563 | %EIP.ins.ptr = getelementptr %exec.ptr %EIP.ins.ptr.ptr, i32 0 564 | %EIP.ins = load %exec.ptr %EIP.ins.ptr 565 | 566 | ; resolve and execute our instruction under the EIP 567 | %functionPtr = inttoptr %int %EIP.ins to void (%cell.ptr*, 568 | %exec.ptr*, %ret.ptr*, %int*)* 569 | call void %functionPtr(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 570 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 571 | 572 | ret void 573 | } 574 | 575 | define cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 576 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) { 577 | ; c"EXEC:" 578 | %execString = getelementptr [6 x i8]* @execString, i32 0, i32 0 579 | %nxtIns.ptr = alloca %int 580 | call cc 10 void @_EIP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 581 | %ret.ptr* %RSP.ptr.ptr, %addr* %nxtIns.ptr) 582 | call cc 10 void @_EIP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 583 | %ret.ptr* %RSP.ptr.ptr) 584 | %nxtIns.value = load %int* %nxtIns.ptr 585 | 586 | %is_done.flag = icmp eq %int %nxtIns.value, 0 587 | br i1 %is_done.flag, label %done, label %execIns 588 | 589 | execIns: 590 | %functionPtr = inttoptr %int %nxtIns.value to void (%cell.ptr*, 591 | %exec.ptr*, %ret.ptr*, %int*)* 592 | call void %functionPtr(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 593 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 594 | ret void 595 | 596 | done: 597 | ret void 598 | } 599 | 600 | ; *** dictionary functions 601 | ; 602 | ; The dictionary is a linked list, where the global dictionary pointer points 603 | ; at the last word in the dictionary. Each dictionary entry %WORD is defined 604 | ; as such: 605 | ; 606 | ; { %WORD*, %FNPTR, i8* } 607 | ; 608 | ; * %WORD* is a pointer to the previous word in the dictionary 609 | ; * %FNPTR* is a pointer to the function associated with this word 610 | ; * i8* is a pointer to a null terminated string that contains the string 611 | ; representation of the word. 612 | ; 613 | ; In other words, it is: 614 | ; +--------------------------+---------------------+-------+ 615 | ; | pointer to previous word | pointer to assembly | name | 616 | ; +--------------------------+---------------------+-------+ 617 | ; 618 | ; So, an example dictionary would look like: 619 | ; 620 | ; null - terminates dictionary 621 | ; ^ 622 | ; | 623 | ; +--------|-------------+--------------------------+-------+ 624 | ; | pointer to null | pointer to @DISPSTACK fn | .s | 625 | ; +----------------------+--------------------------+-------+ 626 | ; ^ 627 | ; | 628 | ; +--------|-------------+--------------------------+-------+ 629 | ; | pointer to DISPSTACK | pointer to @DIV fn | / | 630 | ; +----------------------+--------------------------+-------+ 631 | ; ^ 632 | ; | 633 | ; +--------|-------------+--------------------------+-------+ 634 | ; | pointer to DIV | pointer to @MUL fn | * | 635 | ; +----------------------+--------------------------+-------+ 636 | ; ^ 637 | ; | 638 | ; | 639 | ; @dictPtr* 640 | ; 641 | ; This arrangement allows Forth to redefine a word without overriding an 642 | ; already compiled reference to the word. Once the redefinition is done with, 643 | ; it can then be FORGOT -- restoring the original definition. This allows 644 | ; for some very powerful redefinitions of functions for current contexts. 645 | 646 | define void @registerDictionary(i8* %wordString, %WORD* %newDictEntry, 647 | %FNPTR %wordPtr) { 648 | %dictPtr = load %WORD** @dictPtr 649 | 650 | %newDictEntry.prevEntry = getelementptr %WORD* %newDictEntry, i32 0, i32 0 651 | %newDictEntry.wordPtr = getelementptr %WORD* %newDictEntry, i32 0, i32 1 652 | %newDictEntry.wordString = getelementptr %WORD* %newDictEntry, i32 0, i32 2 653 | store %WORD* %dictPtr, %WORD** %newDictEntry.prevEntry 654 | store %FNPTR %wordPtr, %FNPTR* %newDictEntry.wordPtr 655 | store i8* %wordString, i8** %newDictEntry.wordString 656 | 657 | ; move our dictionary pointer to the newly defined word, the new tail 658 | store %WORD* %newDictEntry, %WORD** @dictPtr 659 | 660 | ret void 661 | } 662 | 663 | define void @printDictionary() { 664 | ; c"--> %s (%llu) \00" 665 | %dictNavString.ptr = getelementptr [15 x i8]* @dictNavString, i32 0, i32 0 666 | 667 | ; load the last word that the dictionary pointer references into %currWord 668 | %dict.ptr = load %WORD** @dictPtr 669 | %dictWord.ptr = getelementptr %WORD* %dict.ptr, i32 0 670 | %dictWord.value = load %WORD* %dictWord.ptr 671 | %currWord.ptr = alloca %WORD 672 | store %WORD %dictWord.value, %WORD* %currWord.ptr 673 | 674 | br label %begin 675 | begin: 676 | ; check if we've hit a null pointer; if we have, we're done. 677 | %is_null.flag = icmp eq %WORD* %currWord.ptr, null 678 | br i1 %is_null.flag, label %done, label %printWord 679 | printWord: 680 | ; derefernce our current word pointer and then our string 681 | %currWord.wordString.ptr.ptr = getelementptr %WORD* %currWord.ptr, 682 | i32 0, i32 2 683 | %currWord.wordString.ptr = load i8** %currWord.wordString.ptr.ptr 684 | 685 | ; obtain our function pointer, dereference it, and conver the pointer to 686 | ; an int for human representation 687 | %forthFn.ptr.ptr = getelementptr %WORD* %currWord.ptr, i32 0, i32 1 688 | %forthFn.ptr = load %FNPTR* %forthFn.ptr.ptr 689 | %forthFn.ptr.int = ptrtoint %FNPTR %forthFn.ptr to %int 690 | 691 | ; print our pretty dictionary order 692 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %dictNavString.ptr, 693 | i8* %currWord.wordString.ptr, 694 | i64 %forthFn.ptr.int) 695 | 696 | ; advance to the next definition 697 | %nextWord.ptr.ptr = getelementptr %WORD* %currWord.ptr, i32 0, i32 0 698 | %nextWord.ptr = load %WORD** %nextWord.ptr.ptr 699 | 700 | ; check if we've hit the end of our dictionary 701 | %is_next_null.flag = icmp eq %WORD* %nextWord.ptr, null 702 | br i1 %is_next_null.flag, label %done, label %continueSetup 703 | continueSetup: 704 | ; store our next dictionary word into our current working word 705 | %nextWord = load %WORD* %nextWord.ptr 706 | store %WORD %nextWord, %WORD* %currWord.ptr 707 | br label %begin 708 | done: 709 | ; clean up by outputting a new line before returning 710 | call void @outputNewLine() 711 | ret void 712 | 713 | } 714 | 715 | define %strbuf @lookupFn(%int %fnPntr.value) { 716 | ; setup with the tail end of our dictionary 717 | %tailDictPtr.ptr = load %WORD** @dictPtr 718 | %dictWord.ptr = getelementptr %WORD* %tailDictPtr.ptr, i32 0 719 | %dictWord.value = load %WORD* %dictWord.ptr 720 | 721 | ; copy our current dictWord into a local working space 722 | %currDictWord.ptr = alloca %WORD 723 | store %WORD %dictWord.value, %WORD* %currDictWord.ptr 724 | 725 | br label %begin 726 | 727 | begin: 728 | ; first, we check if we've reached the end of our dictionary chain, which 729 | ; would be a null pointer at the first definition 730 | %is_null = icmp eq %WORD* %currDictWord.ptr, null 731 | br i1 %is_null, label %notFound, label %checkWord 732 | checkWord: 733 | %currFn.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, i32 0, i32 1 734 | %currFn.ptr = load %FNPTR* %currFn.ptr.ptr 735 | %currFn.ptr.value = ptrtoint %FNPTR %currFn.ptr to %int 736 | 737 | %is_fn.flag = icmp eq %int %fnPntr.value, %currFn.ptr.value 738 | br i1 %is_fn.flag, label %returnFnString, label %nextFn 739 | nextFn: 740 | ; advance to the next word by looking up the current word's pointer to 741 | ; the next 742 | %nextDictWord.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 743 | i32 0, i32 0 744 | %nextDictWord.ptr = load %WORD** %nextDictWord.ptr.ptr 745 | 746 | ; we check if the next word's pointer is null -- if it is, we've reached 747 | ; the end of the dictionary with no match 748 | %is_next_null.flag = icmp eq %WORD* %nextDictWord.ptr, null 749 | br i1 %is_next_null.flag, label %notFound, label %finishNextFn 750 | finishNextFn: 751 | ; grab the next word and copy it into our current working word 752 | %nextDictWord.value = load %WORD* %nextDictWord.ptr 753 | store %WORD %nextDictWord.value, %WORD* %currDictWord.ptr 754 | ; begin the loop all over again 755 | br label %begin 756 | returnFnString: 757 | ; derefernce our current word pointer and then our string 758 | %currDictWord.wordString.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 759 | i32 0, i32 2 760 | %currDictWord.wordString.ptr = load i8** %currDictWord.wordString.ptr.ptr 761 | 762 | ret %strbuf %currDictWord.wordString.ptr 763 | notFound: 764 | ret %strbuf null 765 | } 766 | 767 | define %FNPTR @lookupDictionary(i8* %wordString) { 768 | ; c"TOKEN:\00" 769 | %tokenString.ptr = getelementptr [ 7 x i8 ]* @tokenString, i32 0 770 | %tokenString.i8.ptr = bitcast [ 7 x i8 ]* %tokenString.ptr to i8* 771 | ; c"DICT:\00" 772 | %dictString.ptr = getelementptr [ 6 x i8 ]* @dictString, i32 0 773 | %dictString.i8.ptr = bitcast [ 6 x i8 ]* %dictString.ptr to i8* 774 | 775 | ; allocate our current index in the two words that we compare 776 | %charIdx.ptr = alloca i32 777 | 778 | ; setup with the tail end of our dictionary 779 | %tailDictPtr.ptr = load %WORD** @dictPtr 780 | %dictWord.ptr = getelementptr %WORD* %tailDictPtr.ptr, i32 0 781 | %dictWord.value = load %WORD* %dictWord.ptr 782 | 783 | ; copy our current dictWord into a local working space 784 | %currDictWord.ptr = alloca %WORD 785 | store %WORD %dictWord.value, %WORD* %currDictWord.ptr 786 | 787 | br label %begin 788 | 789 | begin: 790 | ; first, we check if we've reached the end of our dictionary chain, which 791 | ; would be a null pointer at the first definition 792 | %is_null = icmp eq %WORD* %currDictWord.ptr, null 793 | br i1 %is_null, label %notFound, label %checkWord 794 | checkWord: 795 | ; reset our word character index to 0 as we're checking a new definition 796 | store i32 0, i32* %charIdx.ptr 797 | 798 | ; grab the pointer to the string representation of our current dict entry 799 | %dictWord.wordString.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 800 | i32 0, i32 2 801 | %dictWord.wordString.ptr = load i8** %dictWord.wordString.ptr.ptr 802 | 803 | ; begin our string comparison block 804 | br label %compChar 805 | compChar: 806 | %charIdx.value = load i32* %charIdx.ptr 807 | ; set up our current character from the dictionary word string 808 | %dict.char.ptr = getelementptr i8* %dictWord.wordString.ptr, 809 | i32 %charIdx.value 810 | %dict.char = load i8* %dict.char.ptr 811 | ; set up our current character from the target string we're working with 812 | %wstr.char.ptr = getelementptr i8* %wordString, 813 | i32 %charIdx.value 814 | %wstr.char = load i8* %wstr.char.ptr 815 | 816 | ; show the user the current characters we're looking at 817 | ;call void @printTwoString( i8* %dictString.i8.ptr, i8* %dict.charPtr ) 818 | ;call void @printTwoString( i8* %tokenString.i8.ptr, i8* %wstr.charPtr ) 819 | 820 | ; check if we're looking at a null terminator in either case 821 | %dict.is_null.flag = icmp eq i8 %dict.char, 0 822 | %wstr.is_null.flag = icmp eq i8 %wstr.char, 0 823 | 824 | ; if both are null characters, we've hit the end of both strings without 825 | ; a mismatch and have successfully found a match 826 | %is_match.flag = and i1 %dict.is_null.flag, %wstr.is_null.flag 827 | br i1 %is_match.flag, label %foundDefn, label %checkNull 828 | checkNull: 829 | ; if either and not both are null characters, we've reached the end of one 830 | ; string -- the beginning is a substring of the other, but it's not a match 831 | %hit_null.flag = or i1 %dict.is_null.flag, %wstr.is_null.flag 832 | br i1 %hit_null.flag, label %nextWord, label %checkChar 833 | checkChar: 834 | ; then finally, we check if the two characters are the same; if not, we 835 | ; abandon the current definition, and advance to the next word in the 836 | ; dictionary. if they are the same, we move on to the next character 837 | %is_same.flag = icmp eq i8 %wstr.char, %dict.char 838 | br i1 %is_same.flag, label %nextChar, label %nextWord 839 | nextChar: 840 | ; increment the character index and start our loop again 841 | %newCharIdx.value = add i32 %charIdx.value, 1 842 | store i32 %newCharIdx.value, i32* %charIdx.ptr 843 | br label %compChar 844 | nextWord: 845 | ; advance to the next word by looking up the current word's pointer to 846 | ; the next 847 | %nextDictWord.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 848 | i32 0, i32 0 849 | %nextDictWord.ptr = load %WORD** %nextDictWord.ptr.ptr 850 | 851 | ; we check if the next word's pointer is null -- if it is, we've reached 852 | ; the end of the dictionary with no match 853 | %is_next_null.flag = icmp eq %WORD* %nextDictWord.ptr, null 854 | br i1 %is_next_null.flag, label %notFound, label %finishNextWord 855 | finishNextWord: 856 | ; grab the next word and copy it into our current working word 857 | %nextDictWord.value = load %WORD* %nextDictWord.ptr 858 | store %WORD %nextDictWord.value, %WORD* %currDictWord.ptr 859 | ; begin the loop all over again 860 | br label %begin 861 | foundDefn: 862 | ; get the pointer to our function and return it to the caller 863 | %forthFn.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, i32 0, i32 1 864 | %forthFn.ptr = load %FNPTR* %forthFn.ptr.ptr 865 | ret %FNPTR %forthFn.ptr 866 | notFound: 867 | ; we didn't find anything, so we return null 868 | ret %FNPTR null 869 | } 870 | 871 | ; *** compiler functions 872 | define void @compile(i8* %programString.ptr, %int %heapIdx.value) { 873 | ; c"PROGRAM:\00" 874 | %progOutString.ptr = getelementptr [9 x i8]* @progOutString, i32 0, i32 0 875 | ; c"COMPILED:\00" 876 | %compiledString.ptr = getelementptr [10 x i8]* @compiledString, i32 0, i32 0 877 | ; c"CHAR:\00" 878 | %charString.ptr = getelementptr [6 x i8]* @charString, i32 0, i32 0 879 | ; c"LITERAL:\00" 880 | %literalString.ptr = getelementptr [9 x i8]* @literalString, i32 0, i32 0 881 | 882 | %progStrIdx.ptr = alloca i32 ; where we are in the program string 883 | %beginCurrToken.ptr = alloca i32 ; where the current token begins 884 | %currChr.ptr = alloca i8 ; a pointer to the current character 885 | %currHeapIdx.ptr = alloca %int ; where in the heap we insert our token 886 | 887 | ; we start at the beginning of the program string 888 | store i32 0, i32* %progStrIdx.ptr 889 | ; initialize our local heap pointer to the value passed into the function 890 | store %int %heapIdx.value, %int* %currHeapIdx.ptr 891 | 892 | ; show the user what we're working with 893 | call void @printTwoString(i8* %progOutString.ptr, i8* %programString.ptr) 894 | 895 | ; begin the whole process 896 | br label %beginToken 897 | 898 | beginToken: 899 | ; grab our current program string index to work with 900 | %progStrIdx.value = load i32* %progStrIdx.ptr 901 | 902 | ; mark this as the beginning of our new token 903 | store i32 %progStrIdx.value, i32* %beginCurrToken.ptr 904 | 905 | ; resolve the programString pointer and index, and obtain our current char 906 | %currChr.ptr.beginToken = getelementptr i8* %programString.ptr, 907 | i32 %progStrIdx.value 908 | %currChr.value.beginToken = load i8* %currChr.ptr.beginToken 909 | store i8 %currChr.value.beginToken, i8* %currChr.ptr 910 | 911 | ; check if we're a null byte and branch accordingly; null byte terminates 912 | %is_null.flag = icmp eq i8 %currChr.value.beginToken, 0 913 | br i1 %is_null.flag, label %done, label %scanSpace 914 | 915 | scanSpace: 916 | ; debug call to show what character we're looking at 917 | ;call void @printTwoString(i8* %charString.ptr, i8* %currChr.ptr) 918 | 919 | %currChr.value = load i8* %currChr.ptr 920 | ; check if we're a space 921 | %is_space.flag = icmp eq i8 %currChr.value, 32 922 | ; also check if we're a null character 923 | %is_null.flag.scanSpace = icmp eq i8 %currChr.value, 0 924 | ; if we're a null character or a space, we terminate our token 925 | %is_token.flag = or i1 %is_space.flag, %is_null.flag.scanSpace 926 | br i1 %is_token.flag, label %handleToken, label %nextChr 927 | 928 | nextChr: 929 | ; advance the program pointer and set up the character for the next pass 930 | %progStrIdx.value.nextChr = load i32* %progStrIdx.ptr 931 | %nextProgStrIdx.value = add i32 %progStrIdx.value.nextChr, 1 932 | store i32 %nextProgStrIdx.value, i32* %progStrIdx.ptr 933 | ; grab our current character from programString and store it 934 | %currChr.ptr.nextChr = getelementptr i8* %programString.ptr, 935 | i32 %nextProgStrIdx.value 936 | %currChr.value.nextChr = load i8* %currChr.ptr.nextChr 937 | store i8 %currChr.value.nextChr, i8* %currChr.ptr 938 | ; evaluate our new current character 939 | br label %scanSpace 940 | 941 | handleToken: 942 | ; compute and acquire the beginning and the end of the token 943 | %progStrIdx.value.handleToken = load i32* %progStrIdx.ptr 944 | ; the end of our current token is our current program string index 945 | %endCurrToken.ptr = alloca i32 946 | store i32 %progStrIdx.value.handleToken, i32* %endCurrToken.ptr 947 | %endCurrToken.value = load i32* %endCurrToken.ptr 948 | %beginCurrToken.value = load i32* %beginCurrToken.ptr 949 | %tokenLength.value = sub i32 %endCurrToken.value, %beginCurrToken.value 950 | ; we include the null byte for our new token string 951 | %tokenLengthPad.value = add i32 %tokenLength.value, 1 952 | ; get pointer to beginning of our token in the program string 953 | %currTokenBegin.ptr = getelementptr i8* %programString.ptr, 954 | i32 %beginCurrToken.value 955 | 956 | ; copy the token string in question from the program string source 957 | %currToken.ptr = alloca i8, i32 %tokenLengthPad.value 958 | call void @llvm.memcpy.p0i8.p0i8.i32(i8* %currToken.ptr, 959 | i8* %currTokenBegin.ptr, 960 | i32 %tokenLength.value, i32 0, i1 0) 961 | 962 | 963 | ; add a null byte at the end to make it a null terminated string 964 | %nullLocation.ptr = getelementptr i8* %currToken.ptr, 965 | i32 %tokenLength.value 966 | store i8 00, i8* %nullLocation.ptr 967 | 968 | ; call void @printTwoString(i8* %charString.ptr, i8* %currToken.ptr) 969 | 970 | ; lookup our token in the dictionary 971 | %forthFn.ptr = call %FNPTR (i8*)* @lookupDictionary(i8* %currToken.ptr) 972 | 973 | ; load our current heap index for inserting a pointer or a literal 974 | %currHeapIdx.value = load %int* %currHeapIdx.ptr 975 | 976 | ; check if we have a function pointer, or a null pointer 977 | %is_fnPtr_null = icmp eq %FNPTR %forthFn.ptr, null 978 | br i1 %is_fnPtr_null, label %checkLiteral, label %insertFn 979 | 980 | insertFn: 981 | ; insert our function pointer into our heap 982 | call fastcc void @insertToken(%int %currHeapIdx.value, %FNPTR %forthFn.ptr) 983 | 984 | ; advance our local heap index now that we've inserted a token 985 | %newHeapIdx.value = add %int %currHeapIdx.value, 1 986 | store %int %newHeapIdx.value, %int* %currHeapIdx.ptr 987 | 988 | ; show that we've 'compiled' a token 989 | call void @printTwoString(i8* %compiledString.ptr, i8* %currToken.ptr) 990 | 991 | ; all done with the token, let's move on 992 | br label %checkTokenEndNull 993 | 994 | checkLiteral: 995 | ; our current token was not found on the dictionary, so we interpret it 996 | ; as a literal, insert LIT pointer into our execution stream and then 997 | ; insert the literal there 998 | 999 | ; set up values for our literal parser 1000 | %literalInt.ptr = alloca %int 1001 | store %int 0, %pntr %literalInt.ptr 1002 | %tokenIdx.ptr = alloca %int 1003 | %currDigit.ptr = alloca %int 1004 | store %int 0, %pntr %currDigit.ptr 1005 | 1006 | ; initialize our positional multiplier with 1, the first rightmost digit 1007 | %posMultiplier.ptr = alloca %int 1008 | store %int 1, %pntr %posMultiplier.ptr 1009 | 1010 | ; we scan our literal right to left, so set our pointer to the end 1011 | %tokenLength.value.int = zext i32 %tokenLength.value to %int 1012 | %newTokenIdx.value = sub %int %tokenLength.value.int, 1 1013 | store %int %newTokenIdx.value, %pntr %tokenIdx.ptr 1014 | 1015 | br label %literalLoop 1016 | 1017 | literalLoop: 1018 | %tokenIdx.value = load %pntr %tokenIdx.ptr 1019 | %litChr.ptr = getelementptr i8* %currToken.ptr, %int %tokenIdx.value 1020 | %litChr.value = load i8* %litChr.ptr 1021 | 1022 | ; 0-9 is ASCII 48-57 -- check if we are within this 1023 | %is_less.flag = icmp ult i8 %litChr.value, 48 1024 | %is_more.flag = icmp ugt i8 %litChr.value, 57 1025 | %is_outside.flag = or i1 %is_less.flag, %is_more.flag 1026 | br i1 %is_outside.flag, label %invalidLiteral, label %validChar 1027 | 1028 | validChar: 1029 | ; we're within ASCII range 48-57, so subtract 48 to get our digit 1030 | %digit.value = sub i8 %litChr.value, 48 1031 | %digit.value.int = zext i8 %digit.value to %int 1032 | 1033 | ; get our current positional multiplier and multiply our digit by that 1034 | %posMultiplier.value = load %pntr %posMultiplier.ptr 1035 | %posValue.value = mul %int %digit.value.int, %posMultiplier.value 1036 | 1037 | ; add our positioned digit to our current running total 1038 | %literalInt.value = load %pntr %literalInt.ptr 1039 | %newLiteralInt.value = add %int %literalInt.value, %posValue.value 1040 | store %int %newLiteralInt.value, %pntr %literalInt.ptr 1041 | 1042 | ; if we're at the leftmost digit, we're done 1043 | %is_done.flag = icmp eq %int %tokenIdx.value, 0 1044 | br i1 %is_done.flag, label %insertLiteral, label %nextLitChr 1045 | 1046 | nextLitChr: 1047 | ; increase our multiplier with the new digit, multiplying by 10 1048 | %newPosMultiplier.value = mul %int %posMultiplier.value, 10 1049 | store %int %newPosMultiplier.value, %pntr %posMultiplier.ptr 1050 | 1051 | %nextLiteralIdx.value = sub %int %tokenIdx.value, 1 1052 | store %int %nextLiteralIdx.value, %pntr %tokenIdx.ptr 1053 | br label %literalLoop 1054 | 1055 | insertLiteral: 1056 | ; insert our _LIT function into the heap 1057 | call fastcc void @insertToken(%int %currHeapIdx.value, %FNPTR @_LIT) 1058 | %newHeapIdx.value.insertLiteral = add %int %currHeapIdx.value, 1 1059 | 1060 | ; Now that we have our constructed literal, insert it into the heap 1061 | call fastcc void @insertLiteral(%int %newHeapIdx.value.insertLiteral, 1062 | %int %newLiteralInt.value) 1063 | 1064 | ; report our new literal to the user 1065 | call void @printTwoString(i8* %literalString.ptr, i8* %currToken.ptr) 1066 | 1067 | ; Finally, increment and store our current heap pointer. 1068 | %storeHeapIdx.value = add %int %newHeapIdx.value.insertLiteral, 1 1069 | store %int %storeHeapIdx.value, %pntr %currHeapIdx.ptr 1070 | 1071 | br label %checkTokenEndNull 1072 | 1073 | checkTokenEndNull: 1074 | ; we check if the terminator on our current token is null, as that'stack 1075 | ; a string and compilation ending moment as well 1076 | %endTokenChr.ptr = getelementptr i8* %programString.ptr, 1077 | i32 %progStrIdx.value.handleToken 1078 | %endTokenChr.value = load i8* %endTokenChr.ptr 1079 | %is_chr_null.flag = icmp eq i8 %endTokenChr.value, 0 1080 | 1081 | br i1 %is_chr_null.flag, label %done, label %advanceIdx 1082 | 1083 | advanceIdx: 1084 | ; advance past the space we're hovering over at present 1085 | %nextProgStrIdx.value.advanceIdx = add i32 %progStrIdx.value.handleToken, 1 1086 | store i32 %nextProgStrIdx.value.advanceIdx, i32* %progStrIdx.ptr 1087 | 1088 | ; begin all over again 1089 | br label %beginToken 1090 | 1091 | invalidLiteral: 1092 | br label %done 1093 | 1094 | done: 1095 | %currHeapIdx.value.done = load %pntr %currHeapIdx.ptr 1096 | ;call void @printValueInt( %int %currHeapIdx.value.done ) 1097 | 1098 | ; clean up by terminating our compiled output with a null byte 1099 | call fastcc void @insertLiteral(%int %currHeapIdx.value.done, 1100 | %int 00) 1101 | 1102 | ret void 1103 | } 1104 | 1105 | ; ***************************************************************************** 1106 | ; utility routine to show the current contents of our stack 1107 | ; ***************************************************************************** 1108 | 1109 | define cc 10 void @showStack(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1110 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) { 1111 | %stack_string = getelementptr [14 x i8]* @stackString, i64 0, i64 0 1112 | 1113 | ; obtain the address of the bottom of our stack 1114 | %SP0.stack.ptr = load %cell.ptr* @SP0 1115 | %SP0.stack.addr.ptr = getelementptr %addr.ptr %SP0.stack.ptr, i32 0 1116 | %SP0.addr = ptrtoint %addr.ptr %SP0.stack.addr.ptr to %addr 1117 | 1118 | %null.ptr = alloca %cell 1119 | %SSP.addr.ptr = alloca %addr 1120 | %cell.value.ptr = alloca %cell 1121 | 1122 | ; obtain the stack position that SP is pointing at 1123 | ; SP@ -> stack 1124 | call cc 10 void @_SP_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1125 | %ret.ptr* %RSP.ptr.ptr, %int* %null.ptr) 1126 | 1127 | ; POP -> %SP.addr 1128 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1129 | %ret.ptr* %RSP.ptr.ptr, %int* %SSP.addr.ptr) 1130 | 1131 | ; kick off the loop 1132 | br label %loop 1133 | 1134 | loop: 1135 | %SSP.addr = load %addr* %SSP.addr.ptr 1136 | %is_done.flag = icmp eq %int %SSP.addr, %SP0.addr 1137 | br i1 %is_done.flag, label %done, label %continue_loop 1138 | 1139 | continue_loop: 1140 | ; push our current show stack address onto the stack 1141 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1142 | %ret.ptr* %RSP.ptr.ptr, %int* %SSP.addr.ptr) 1143 | 1144 | ; resolve the memory location and retrieve the item onto the stack 1145 | call cc 10 void @_C_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1146 | %ret.ptr* %RSP.ptr.ptr) 1147 | 1148 | ; pop the memory cell we just retrieved into our cell value pointer 1149 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1150 | %ret.ptr* %RSP.ptr.ptr, %int* %cell.value.ptr) 1151 | 1152 | ; report our current stack address and item 1153 | %cell.value = load %cell* %cell.value.ptr 1154 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %stack_string, 1155 | %int %SSP.addr, 1156 | %int %cell.value) 1157 | 1158 | ; increment and store our new stack location, starting the loop again 1159 | %SSP.new.value = add %int %SSP.addr, 8 1160 | store %int %SSP.new.value, %addr.ptr %SSP.addr.ptr 1161 | br label %loop 1162 | 1163 | done: 1164 | ret void 1165 | } 1166 | 1167 | ; ***************************************************************************** 1168 | ; here be FORTH words now 1169 | ; ***************************************************************************** 1170 | 1171 | define cc 10 void @_LIT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1172 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1173 | ; get the value under our EIP 1174 | %nullValue.ptr = alloca %cell 1175 | %litValue.ptr = alloca %cell 1176 | call cc 10 void @_EIP_PEEK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1177 | %ret.ptr* %RSP.ptr.ptr, %addr* %litValue.ptr) 1178 | ; push it onto our stack 1179 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1180 | %ret.ptr* %RSP.ptr.ptr, %int* %litValue.ptr) 1181 | ; advance our EIP now 1182 | call cc 10 void @_EIP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1183 | %ret.ptr* %RSP.ptr.ptr) 1184 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1185 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1186 | 1187 | ret void 1188 | } 1189 | 1190 | define cc 10 void @SWAP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1191 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1192 | ; call the intrinsic SWAP 1193 | call cc 10 void @_SP_SWAP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1194 | %ret.ptr* %RSP.ptr.ptr) 1195 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1196 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1197 | 1198 | ret void 1199 | } 1200 | 1201 | define cc 10 void @DUP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1202 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1203 | ; call the intrinsic DUP 1204 | call cc 10 void @_SP_DUP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1205 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1206 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1207 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1208 | 1209 | ret void 1210 | } 1211 | 1212 | define cc 10 void @DROP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1213 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1214 | ; call the intrinsic increment stack operator, to 'drop' the current item 1215 | call cc 10 void @_SP_INCR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1216 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1217 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1218 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1219 | 1220 | ret void 1221 | } 1222 | 1223 | define cc 10 void @C_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1224 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1225 | ; call the intrinsic operator 1226 | call cc 10 void @_C_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1227 | %ret.ptr* %RSP.ptr.ptr) 1228 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1229 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1230 | 1231 | ret void 1232 | } 1233 | 1234 | define cc 10 void @C_BANG(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1235 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1236 | ; call the intrinsic operator 1237 | call cc 10 void @_C_BANG(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1238 | %ret.ptr* %RSP.ptr.ptr) 1239 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1240 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1241 | 1242 | ret void 1243 | } 1244 | 1245 | define cc 10 void @SP_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1246 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1247 | ; call the intrinsic operator 1248 | call cc 10 void @_SP_AT(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1249 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1250 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1251 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1252 | 1253 | ret void 1254 | } 1255 | 1256 | define cc 10 void @SP_BANG(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1257 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1258 | ; call the intrinsic operator 1259 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1260 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1261 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1262 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1263 | 1264 | ret void 1265 | } 1266 | 1267 | ; **************************************************************************** 1268 | ; ALU stuff 1269 | ; **************************************************************************** 1270 | 1271 | define cc 10 void @CHAR_MIN(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1272 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1273 | %charSize.ptr = alloca %cell 1274 | store %cell 1, %cell* %charSize.ptr 1275 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1276 | %ret.ptr* %RSP.ptr.ptr, %int* %charSize.ptr) 1277 | call cc 10 void @SUB(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1278 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1279 | ret void 1280 | } 1281 | 1282 | define cc 10 void @CHAR_PLUS(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1283 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1284 | %charSize.ptr = alloca %cell 1285 | store %cell 1, %cell* %charSize.ptr 1286 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1287 | %ret.ptr* %RSP.ptr.ptr, %int* %charSize.ptr) 1288 | call cc 10 void @ADD(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1289 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1290 | ret void 1291 | } 1292 | 1293 | ; chars is a no-op as our addressing and indexing is int8 1294 | define cc 10 void @CHARS(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1295 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1296 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1297 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1298 | ret void 1299 | } 1300 | 1301 | define cc 10 void @CELL_MIN(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1302 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1303 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1304 | %ret.ptr* %RSP.ptr.ptr, %int* @CELLSIZE) 1305 | call cc 10 void @SUB(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1306 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1307 | ret void 1308 | } 1309 | 1310 | define cc 10 void @CELL_PLUS(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1311 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1312 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1313 | %ret.ptr* %RSP.ptr.ptr, %int* @CELLSIZE) 1314 | call cc 10 void @ADD(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1315 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1316 | ret void 1317 | } 1318 | 1319 | define cc 10 void @CELLS(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1320 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1321 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1322 | %ret.ptr* %RSP.ptr.ptr, %int* @CELLSIZE) 1323 | call cc 10 void @MUL(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1324 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1325 | ret void 1326 | } 1327 | 1328 | define cc 10 void @NONZERO(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1329 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1330 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1331 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1332 | %DATA.value = load %int* %DATA.ptr 1333 | %result.flag = icmp ugt %int %DATA.value, 0 1334 | %result.int = zext i1 %result.flag to %int 1335 | store %int %result.int, %int* %DATA.ptr 1336 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1337 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1338 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1339 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1340 | ret void 1341 | } 1342 | 1343 | define cc 10 void @AND(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1344 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1345 | %first.ptr = alloca %int 1346 | %second.ptr = alloca %int 1347 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1348 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1349 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1350 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1351 | %first.value = load %int* %first.ptr 1352 | %second.value = load %int* %second.ptr 1353 | %DATA.value = and %int %first.value, %second.value 1354 | store %int %DATA.value, %int* %DATA.ptr 1355 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1356 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1357 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1358 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1359 | ret void 1360 | } 1361 | 1362 | define cc 10 void @OR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1363 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1364 | %first.ptr = alloca %int 1365 | %second.ptr = alloca %int 1366 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1367 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1368 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1369 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1370 | %first.value = load %int* %first.ptr 1371 | %second.value = load %int* %second.ptr 1372 | %DATA.value = or %int %first.value, %second.value 1373 | store %int %DATA.value, %int* %DATA.ptr 1374 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1375 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1376 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1377 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1378 | ret void 1379 | } 1380 | 1381 | define cc 10 void @XOR(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1382 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1383 | %first.ptr = alloca %int 1384 | %second.ptr = alloca %int 1385 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1386 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1387 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1388 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1389 | %first.value = load %int* %first.ptr 1390 | %second.value = load %int* %second.ptr 1391 | %DATA.value = xor %int %first.value, %second.value 1392 | store %int %DATA.value, %int* %DATA.ptr 1393 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1394 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1395 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1396 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1397 | ret void 1398 | } 1399 | 1400 | define cc 10 void @UMPLUS(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1401 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1402 | %first.ptr = alloca %cell 1403 | %second.ptr = alloca %cell 1404 | %result.ptr = alloca %cell 1405 | %carry.ptr = alloca %cell 1406 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1407 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1408 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1409 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1410 | %first.value = load %cell* %first.ptr 1411 | %second.value = load %cell* %second.ptr 1412 | %result = call {%int, i1} @llvm_ump(%int %first.value, %int %second.value) 1413 | %sum.int = extractvalue {%int, i1} %result, 0 1414 | %carry.flag = extractvalue {%int, i1} %result, 1 1415 | %carry.int = zext i1 %carry.flag to %int 1416 | store %int %sum.int, %cell* %result.ptr 1417 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1418 | %ret.ptr* %RSP.ptr.ptr, %int* %result.ptr) 1419 | store %int %carry.int, %cell* %carry.ptr 1420 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1421 | %ret.ptr* %RSP.ptr.ptr, %int* %carry.ptr) 1422 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1423 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1424 | ret void 1425 | } 1426 | 1427 | define cc 10 void @ADD(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1428 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1429 | %first.ptr = alloca %cell 1430 | %second.ptr = alloca %cell 1431 | %result.ptr = alloca %cell 1432 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1433 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1434 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1435 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1436 | %first.value = load %cell* %first.ptr 1437 | %second.value = load %cell* %second.ptr 1438 | %result.value = add %cell %first.value, %second.value 1439 | store %cell %result.value, %cell* %result.ptr 1440 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1441 | %ret.ptr* %RSP.ptr.ptr, %int* %result.ptr) 1442 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1443 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1444 | ret void 1445 | } 1446 | 1447 | define cc 10 void @SUB(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1448 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1449 | %first.ptr = alloca %cell 1450 | %second.ptr = alloca %cell 1451 | %result.ptr = alloca %cell 1452 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1453 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1454 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1455 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1456 | %first.value = load %cell* %first.ptr 1457 | %second.value = load %cell* %second.ptr 1458 | %result.value = sub %cell %second.value, %first.value 1459 | store %cell %result.value, %cell* %result.ptr 1460 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1461 | %ret.ptr* %RSP.ptr.ptr, %int* %result.ptr) 1462 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1463 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1464 | ret void 1465 | } 1466 | 1467 | define cc 10 void @MUL(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1468 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1469 | %first.ptr = alloca %cell 1470 | %second.ptr = alloca %cell 1471 | %result.ptr = alloca %cell 1472 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1473 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1474 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1475 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1476 | %first.value = load %cell* %first.ptr 1477 | %second.value = load %cell* %second.ptr 1478 | %result.value = mul %cell %first.value, %second.value 1479 | store %cell %result.value, %cell* %result.ptr 1480 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1481 | %ret.ptr* %RSP.ptr.ptr, %int* %result.ptr) 1482 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1483 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1484 | ret void 1485 | } 1486 | 1487 | define cc 10 void @DIV(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1488 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1489 | %first.ptr = alloca %cell 1490 | %second.ptr = alloca %cell 1491 | %result.ptr = alloca %cell 1492 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1493 | %ret.ptr* %RSP.ptr.ptr, %int* %first.ptr) 1494 | call cc 10 void @_SP_POP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1495 | %ret.ptr* %RSP.ptr.ptr, %int* %second.ptr) 1496 | %first.value = load %cell* %first.ptr 1497 | %second.value = load %cell* %second.ptr 1498 | %result.value = udiv %cell %second.value, %first.value 1499 | store %cell %result.value, %cell* %result.ptr 1500 | call cc 10 void @_SP_PUSH(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1501 | %ret.ptr* %RSP.ptr.ptr, %int* %result.ptr) 1502 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1503 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1504 | ret void 1505 | } 1506 | 1507 | define cc 10 void @DISPSTACK(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1508 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn { 1509 | call cc 10 void @showStack(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1510 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1511 | call cc 10 void @next(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1512 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) noreturn 1513 | 1514 | ret void 1515 | } 1516 | 1517 | ; ***************************************************************************** 1518 | ; user interaction 1519 | ; ***************************************************************************** 1520 | 1521 | define cc 10 void @repl(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1522 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) { 1523 | %promptString.ptr = getelementptr [5 x i8]* @promptString, i32 0, i32 0 1524 | 1525 | %currChr.ptr = alloca i8 1526 | %inputBuffer.ptr = alloca i8, i16 1024 1527 | %inputBufferIdx.ptr = alloca i16 1528 | store i8 0, i8* %currChr.ptr 1529 | store i16 0, i16* %inputBufferIdx.ptr 1530 | 1531 | br label %prompt 1532 | 1533 | prompt: 1534 | call void @printString( i8* %promptString.ptr ) 1535 | br label %inputLoop 1536 | 1537 | inputLoop: 1538 | %inputBufferIdx.value = load i16* %inputBufferIdx.ptr 1539 | %inChr.value = call i8 @getchar() 1540 | 1541 | ; check for carriage return to decide if we execute or get another char 1542 | %is_cr = icmp eq i8 %inChr.value, 10 1543 | br i1 %is_cr, label %execBuffer, label %addBuffer 1544 | 1545 | addBuffer: 1546 | %inputBufferWindow.ptr = getelementptr i8* %inputBuffer.ptr, 1547 | i16 %inputBufferIdx.value 1548 | store i8 %inChr.value, i8* %inputBufferWindow.ptr 1549 | %newInputBufferIdx.value = add i16 %inputBufferIdx.value, 1 1550 | store i16 %newInputBufferIdx.value, i16* %inputBufferIdx.ptr 1551 | 1552 | br label %inputLoop 1553 | 1554 | execBuffer: 1555 | ; add a null byte at the end to make it a null terminated string 1556 | %nullLocation.ptr = getelementptr i8* %inputBuffer.ptr, 1557 | i16 %inputBufferIdx.value 1558 | store i8 00, i8* %nullLocation.ptr 1559 | 1560 | ; compile our input into the beginning of our heap 1561 | call void @compile(i8* %inputBuffer.ptr, %int 0) 1562 | 1563 | ; kick off our compiled program 1564 | %jmp.addr.ptr = alloca %exec 1565 | ; load our heap pointer, which is stored as a pointer 1566 | %heap.ptr = load %pntr* @HEAP 1567 | %heap.value.ptr = getelementptr %pntr %heap.ptr, %int 0 1568 | %jmp.addr = ptrtoint %pntr %heap.value.ptr to %int 1569 | store %int %jmp.addr, %exec* %jmp.addr.ptr 1570 | 1571 | call cc 10 void @_EIP_JMP(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1572 | %ret.ptr* %RSP.ptr.ptr, %int* %jmp.addr.ptr) 1573 | 1574 | ; reset our input buffer pointer to 0 1575 | store i16 0, i16* %inputBufferIdx.ptr 1576 | 1577 | br label %prompt 1578 | 1579 | ret void 1580 | } 1581 | 1582 | ; ***************************************************************************** 1583 | ; main function 1584 | ; ***************************************************************************** 1585 | 1586 | define %int @main() { 1587 | ; our registers that we pass to every Forth function using Haskell CC 1588 | %SP = alloca %cell.ptr 1589 | %EIP = alloca %cell.ptr 1590 | %RSP = alloca %cell.ptr 1591 | %DATA = alloca %cell 1592 | 1593 | ; local reference to the @SP0 global 1594 | %SP0 = alloca %cell.ptr 1595 | 1596 | ; allocate our heap - 8MB 1597 | %heap.ptr = alloca %cell, i32 1048576 1598 | %heap.addr = ptrtoint %cell* %heap.ptr to %int 1599 | ; set up our stack at the end of the heap 1600 | %SP.ptr = getelementptr %cell.ptr %heap.ptr, i32 1048575 1601 | %SP0.ptr = getelementptr %cell.ptr %heap.ptr, i32 1048575 1602 | store %cell.ptr %SP.ptr, %cell.ptr* %SP 1603 | store %cell.ptr %SP0.ptr, %cell.ptr* @SP0 1604 | store %cell 0, %cell.ptr %SP.ptr 1605 | 1606 | ; set our EIP at the beginning 1607 | %EIP.ptr = getelementptr %cell.ptr %heap.ptr, i32 0 1608 | store %cell.ptr %EIP.ptr, %cell.ptr* %EIP 1609 | store %cell 0, %cell.ptr %EIP.ptr 1610 | 1611 | call void @printEIPPtr( %cell.ptr* %EIP ) 1612 | call void @printStackPtrValues( %cell.ptr* %SP ) 1613 | 1614 | ; RSP isn't used yet, but we set it anyway 1615 | %RSP.ptr = getelementptr %cell.ptr %heap.ptr, i32 511 1616 | store %cell.ptr %RSP.ptr, %cell.ptr* %RSP 1617 | 1618 | ; store the pointer to our heap in a global value 1619 | store %pntr %heap.ptr, %pntr* @HEAP 1620 | 1621 | ; ************************************************************************* 1622 | ; register our Forth functions in the dictionary 1623 | ; ************************************************************************* 1624 | 1625 | ; _lit - @LIT 1626 | %ptr_lit = getelementptr [ 5 x i8 ]* @str_lit, i32 0 1627 | %i8_lit = bitcast [ 5 x i8 ]* %ptr_lit to i8* 1628 | %dictEntry.lit = alloca %WORD 1629 | call void @registerDictionary( i8* %i8_lit, 1630 | %WORD* %dictEntry.lit, 1631 | %FNPTR @_LIT ) 1632 | 1633 | ; .s - @DISPSTACK 1634 | %ptr_dispStack = getelementptr [ 3 x i8 ]* @str_dispStack, i32 0 1635 | %i8_dispStack = bitcast [ 3 x i8 ]* %ptr_dispStack to i8* 1636 | %dictEntry.dispStack = alloca %WORD 1637 | call void @registerDictionary( i8* %i8_dispStack, 1638 | %WORD* %dictEntry.dispStack, 1639 | %FNPTR @DISPSTACK ) 1640 | 1641 | ; / - @DIV 1642 | %ptr_div = getelementptr [ 2 x i8 ]* @str_div, i32 0 1643 | %i8_div = bitcast [ 2 x i8 ]* %ptr_div to i8* 1644 | %dictEntry.div = alloca %WORD 1645 | call void @registerDictionary( i8* %i8_div, 1646 | %WORD* %dictEntry.div, 1647 | %FNPTR @DIV ) 1648 | 1649 | ; * - @MUL 1650 | %ptr_mul = getelementptr [ 2 x i8 ]* @str_mul, i32 0 1651 | %i8_mul = bitcast [ 2 x i8 ]* %ptr_mul to i8* 1652 | %dictEntry.mul = alloca %WORD 1653 | call void @registerDictionary( i8* %i8_mul, 1654 | %WORD* %dictEntry.mul, 1655 | %FNPTR @MUL ) 1656 | 1657 | ; - - @SUB 1658 | %ptr_sub = getelementptr [ 2 x i8 ]* @str_sub, i32 0 1659 | %i8_sub = bitcast [ 2 x i8 ]* %ptr_sub to i8* 1660 | %dictEntry.sub = alloca %WORD 1661 | call void @registerDictionary( i8* %i8_sub, 1662 | %WORD* %dictEntry.sub, 1663 | %FNPTR @SUB ) 1664 | 1665 | ; + - @ADD 1666 | %ptr_add = getelementptr [ 2 x i8 ]* @str_add, i32 0 1667 | %i8_add = bitcast [ 2 x i8 ]* %ptr_add to i8* 1668 | %dictEntry.add = alloca %WORD 1669 | call void @registerDictionary( i8* %i8_add, 1670 | %WORD* %dictEntry.add, 1671 | %FNPTR @ADD ) 1672 | 1673 | ; UM+ - @UMPLUS 1674 | %ptr_umplus = getelementptr [ 4 x i8 ]* @str_umplus, i32 0 1675 | %i8_umplus = bitcast [ 4 x i8 ]* %ptr_umplus to i8* 1676 | %dictEntry.umplus = alloca %WORD 1677 | call void @registerDictionary( i8* %i8_umplus, 1678 | %WORD* %dictEntry.umplus, 1679 | %FNPTR @UMPLUS ) 1680 | 1681 | ; swap - @SWAP 1682 | %ptr_swap = getelementptr [ 5 x i8 ]* @str_swap, i32 0 1683 | %i8_swap = bitcast [ 5 x i8 ]* %ptr_swap to i8* 1684 | %dictEntry.swap = alloca %WORD 1685 | call void @registerDictionary( i8* %i8_swap, 1686 | %WORD* %dictEntry.swap, 1687 | %FNPTR @SWAP ) 1688 | 1689 | ; dup - @DUP 1690 | %ptr_dup = getelementptr [ 4 x i8 ]* @str_dup, i32 0 1691 | %i8_dup = bitcast [ 4 x i8 ]* %ptr_dup to i8* 1692 | %dictEntry.dup = alloca %WORD 1693 | call void @registerDictionary( i8* %i8_dup, 1694 | %WORD* %dictEntry.dup, 1695 | %FNPTR @DUP ) 1696 | 1697 | ; drop - @DROP 1698 | %ptr_drop = getelementptr [ 5 x i8 ]* @str_drop, i32 0 1699 | %i8_drop = bitcast [ 5 x i8 ]* %ptr_drop to i8* 1700 | %dictEntry.drop = alloca %WORD 1701 | call void @registerDictionary( i8* %i8_drop, 1702 | %WORD* %dictEntry.drop, 1703 | %FNPTR @DROP ) 1704 | 1705 | ; SP@ -- @C_BANG 1706 | %ptr_sp_at = getelementptr [ 4 x i8 ]* @str_sp_at, i32 0 1707 | %i8_sp_at = bitcast [ 4 x i8 ]* %ptr_sp_at to i8* 1708 | %dictEntry.sp_at = alloca %WORD 1709 | call void @registerDictionary( i8* %i8_sp_at, 1710 | %WORD* %dictEntry.sp_at, 1711 | %FNPTR @SP_AT ) 1712 | 1713 | ; SP! -- @SP_BANG 1714 | %ptr_sp_bang = getelementptr [ 4 x i8 ]* @str_sp_bang, i32 0 1715 | %i8_sp_bang = bitcast [ 4 x i8 ]* %ptr_sp_bang to i8* 1716 | %dictEntry.sp_bang = alloca %WORD 1717 | call void @registerDictionary( i8* %i8_sp_bang, 1718 | %WORD* %dictEntry.sp_bang, 1719 | %FNPTR @C_AT ) 1720 | 1721 | ; C@ -- @C_AT 1722 | %ptr_c_at = getelementptr [ 3 x i8 ]* @str_c_at, i32 0 1723 | %i8_c_at = bitcast [ 3 x i8 ]* %ptr_c_at to i8* 1724 | %dictEntry.c_at = alloca %WORD 1725 | call void @registerDictionary( i8* %i8_c_at, 1726 | %WORD* %dictEntry.c_at, 1727 | %FNPTR @C_AT ) 1728 | 1729 | ; C! -- @C_BANG 1730 | %ptr_c_bang = getelementptr [ 3 x i8 ]* @str_c_bang, i32 0 1731 | %i8_c_bang = bitcast [ 3 x i8 ]* %ptr_c_bang to i8* 1732 | %dictEntry.c_bang = alloca %WORD 1733 | call void @registerDictionary( i8* %i8_c_bang, 1734 | %WORD* %dictEntry.c_bang, 1735 | %FNPTR @C_BANG ) 1736 | 1737 | ; CHAR- - @CHAR_MIN 1738 | %ptr_char_min = getelementptr [ 6 x i8 ]* @str_char_min, i32 0 1739 | %i8_char_min = bitcast [ 6 x i8 ]* %ptr_char_min to i8* 1740 | %dictEntry.char_min = alloca %WORD 1741 | call void @registerDictionary( i8* %i8_char_min, 1742 | %WORD* %dictEntry.char_min, 1743 | %FNPTR @CHAR_MIN ) 1744 | 1745 | ; CHAR+ - @CHAR_PLUS 1746 | %ptr_char_plus = getelementptr [ 6 x i8 ]* @str_char_plus, i32 0 1747 | %i8_char_plus = bitcast [ 6 x i8 ]* %ptr_char_plus to i8* 1748 | %dictEntry.char_plus = alloca %WORD 1749 | call void @registerDictionary( i8* %i8_char_plus, 1750 | %WORD* %dictEntry.char_plus, 1751 | %FNPTR @CHAR_PLUS ) 1752 | 1753 | ; CHARS - @CHARS 1754 | %ptr_chars = getelementptr [ 6 x i8 ]* @str_chars, i32 0 1755 | %i8_chars = bitcast [ 6 x i8 ]* %ptr_chars to i8* 1756 | %dictEntry.chars = alloca %WORD 1757 | call void @registerDictionary( i8* %i8_chars, 1758 | %WORD* %dictEntry.chars, 1759 | %FNPTR @CHARS ) 1760 | 1761 | ; CELL- - @CELL_MIN 1762 | %ptr_cell_min = getelementptr [ 6 x i8 ]* @str_cell_min, i32 0 1763 | %i8_cell_min = bitcast [ 6 x i8 ]* %ptr_cell_min to i8* 1764 | %dictEntry.cell_min = alloca %WORD 1765 | call void @registerDictionary( i8* %i8_cell_min, 1766 | %WORD* %dictEntry.cell_min, 1767 | %FNPTR @CELL_MIN ) 1768 | 1769 | ; CELL+ - @CELL_PLUS 1770 | %ptr_cell_plus = getelementptr [ 6 x i8 ]* @str_cell_plus, i32 0 1771 | %i8_cell_plus = bitcast [ 6 x i8 ]* %ptr_cell_plus to i8* 1772 | %dictEntry.cell_plus = alloca %WORD 1773 | call void @registerDictionary( i8* %i8_cell_plus, 1774 | %WORD* %dictEntry.cell_plus, 1775 | %FNPTR @CELL_PLUS ) 1776 | 1777 | ; CELLS - @CELLS 1778 | %ptr_cells = getelementptr [ 6 x i8 ]* @str_cells, i32 0 1779 | %i8_cells = bitcast [ 6 x i8 ]* %ptr_cells to i8* 1780 | %dictEntry.cells = alloca %WORD 1781 | call void @registerDictionary( i8* %i8_cells, 1782 | %WORD* %dictEntry.cells, 1783 | %FNPTR @CELLS ) 1784 | 1785 | ; 0< - @NONZERO 1786 | %ptr_nonzero = getelementptr [ 3 x i8 ]* @str_nonzero, i32 0 1787 | %i8_nonzero = bitcast [ 3 x i8 ]* %ptr_nonzero to i8* 1788 | %dictEntry.nonzero = alloca %WORD 1789 | call void @registerDictionary( i8* %i8_nonzero, 1790 | %WORD* %dictEntry.nonzero, 1791 | %FNPTR @NONZERO ) 1792 | 1793 | ; AND - @AND 1794 | %ptr_and = getelementptr [ 4 x i8 ]* @str_and, i32 0 1795 | %i8_and = bitcast [ 4 x i8 ]* %ptr_and to i8* 1796 | %dictEntry.and = alloca %WORD 1797 | call void @registerDictionary( i8* %i8_and, 1798 | %WORD* %dictEntry.and, 1799 | %FNPTR @AND ) 1800 | 1801 | ; OR - @OR 1802 | %ptr_or = getelementptr [ 3 x i8 ]* @str_or, i32 0 1803 | %i8_or = bitcast [ 3 x i8 ]* %ptr_or to i8* 1804 | %dictEntry.or = alloca %WORD 1805 | call void @registerDictionary( i8* %i8_or, 1806 | %WORD* %dictEntry.or, 1807 | %FNPTR @OR ) 1808 | 1809 | ; XOR - @XOR 1810 | %ptr_xor = getelementptr [ 4 x i8 ]* @str_xor, i32 0 1811 | %i8_xor = bitcast [ 4 x i8 ]* %ptr_xor to i8* 1812 | %dictEntry.xor = alloca %WORD 1813 | call void @registerDictionary( i8* %i8_xor, 1814 | %WORD* %dictEntry.xor, 1815 | %FNPTR @XOR ) 1816 | 1817 | ; ** test our dictionary navigation 1818 | call void @printDictionary() 1819 | 1820 | ; ** compile our forth program 1821 | %ptr_testProgram = getelementptr[ 21 x i8 ]* @str_testProgram, i32 0 1822 | %i8_testProgram = bitcast [ 21 x i8 ]* %ptr_testProgram to i8* 1823 | call void @compile(i8* %i8_testProgram, %int 0) 1824 | 1825 | ; ** and finally, execute our program 1826 | call cc 10 void @next(%cell.ptr* %SP, %cell.ptr* %EIP, 1827 | %cell.ptr* %RSP, %cell* %DATA) 1828 | 1829 | call cc 10 void @repl(%cell.ptr* %SP, %cell.ptr* %EIP, 1830 | %cell.ptr* %RSP, %cell* %DATA) 1831 | 1832 | ret %int 0 1833 | } -------------------------------------------------------------------------------- /experiments/forth-kernel.ll: -------------------------------------------------------------------------------- 1 | %WORD = type { %WORD*, %int, i1, i8* } 2 | %WORD.fntype = type { %addr*, i1 } 3 | 4 | @DOCOL.flag = internal constant i1 0 5 | @CODEWORD.flag = internal constant i1 1 6 | @IMMEDIATE.flag = internal constant i1 0 7 | @COMPILE.flag = internal constant i1 1 8 | 9 | ; * test forth program 10 | @str_testProgram = internal constant [ 18 x i8 ] c"99 2 3 DUP + SWAP\00" 11 | 12 | ; * constants containing strings of Forth words 13 | @str_dispStack = internal constant [ 3 x i8 ] c".s\00" 14 | @str_c_at = internal constant [ 3 x i8 ] c"C@\00" 15 | @str_c_bang = internal constant [ 3 x i8 ] c"C!\00" 16 | @str_sp_at = internal constant [ 4 x i8 ] c"SP@\00" 17 | @str_sp_bang = internal constant [ 4 x i8 ] c"SP!\00" 18 | @str_swap = internal constant [ 5 x i8 ] c"SWAP\00" 19 | @str_2swap = internal constant [ 6 x i8 ] c"2SWAP\00" 20 | @str_dup = internal constant [ 4 x i8 ] c"DUP\00" 21 | @str_2dup = internal constant [ 5 x i8 ] c"2DUP\00" 22 | @str_drop = internal constant [ 5 x i8 ] c"DROP\00" 23 | @str_2drop = internal constant [ 6 x i8 ] c"2DROP\00" 24 | @str_over = internal constant [ 5 x i8 ] c"OVER\00" 25 | @str_rot = internal constant [ 4 x i8 ] c"ROT\00" 26 | @str_nrot = internal constant [ 5 x i8 ] c"-ROT\00" 27 | @str_umplus = internal constant [ 4 x i8 ] c"UM+\00" 28 | @str_add = internal constant [ 2 x i8 ] c"+\00" 29 | @str_sub = internal constant [ 2 x i8 ] c"-\00" 30 | @str_mul = internal constant [ 2 x i8 ] c"*\00" 31 | @str_div = internal constant [ 2 x i8 ] c"/\00" 32 | @str_lit = internal constant [ 6 x i8 ] c"DOLIT\00" 33 | @str_incr = internal constant [ 5 x i8 ] c"INCR\00" 34 | @str_decr = internal constant [ 5 x i8 ] c"DECR\00" 35 | @str_incr8 = internal constant [ 6 x i8 ] c"INCR8\00" 36 | @str_decr8 = internal constant [ 6 x i8 ] c"DECR8\00" 37 | @str_char_min = internal constant [ 6 x i8 ] c"CHAR-\00" 38 | @str_char_plus = internal constant [ 6 x i8 ] c"CHAR+\00" 39 | @str_chars = internal constant [ 6 x i8 ] c"CHARS\00" 40 | @str_cell_min = internal constant [ 6 x i8 ] c"CELL-\00" 41 | @str_cell_plus = internal constant [ 6 x i8 ] c"CELL+\00" 42 | @str_cells = internal constant [ 6 x i8 ] c"CELLS\00" 43 | @str_nonzero = internal constant [ 3 x i8 ] c"0<\00" 44 | @str_and = internal constant [ 4 x i8 ] c"AND\00" 45 | @str_or = internal constant [ 3 x i8 ] c"OR\00" 46 | @str_xor = internal constant [ 4 x i8 ] c"XOR\00" 47 | @str_done = internal constant [ 5 x i8 ] c"DONE\00" 48 | 49 | 50 | @kernel.NEXT.addr = internal constant i8* 51 | blockaddress(@kernel, %kernel.NEXT) 52 | @kernel.EXEC_DOCOL.addr = internal constant i8* 53 | blockaddress(@kernel, %kernel.EXEC_DOCOL) 54 | @kernel.EXEC_DOLIT.addr = internal constant i8* 55 | blockaddress(@kernel, %kernel.EXEC_DOLIT) 56 | @kernel.M_AT.addr = internal constant i8* 57 | blockaddress(@kernel, %kernel.M_AT) 58 | @kernel.M_BANG.addr = internal constant i8* 59 | blockaddress(@kernel, %kernel.M_BANG) 60 | @kernel.SP_AT.addr = internal constant i8* 61 | blockaddress(@kernel, %kernel.SP_AT) 62 | @kernel.SP_POP.addr = internal constant i8* 63 | blockaddress(@kernel, %kernel.SP_POP) 64 | @kernel.SP_PUSH.addr = internal constant i8* 65 | blockaddress(@kernel, %kernel.SP_PUSH) 66 | @kernel.SP_SWAP.addr = internal constant i8* 67 | blockaddress(@kernel, %kernel.SP_SWAP) 68 | @kernel.SP_2SWAP.addr = internal constant i8* 69 | blockaddress(@kernel, %kernel.SP_2SWAP) 70 | @kernel.SP_DUP.addr = internal constant i8* 71 | blockaddress(@kernel, %kernel.SP_DUP) 72 | @kernel.SP_2DUP.addr = internal constant i8* 73 | blockaddress(@kernel, %kernel.SP_2DUP) 74 | @kernel.SP_DROP.addr = internal constant i8* 75 | blockaddress(@kernel, %kernel.SP_DROP) 76 | @kernel.SP_2DROP.addr = internal constant i8* 77 | blockaddress(@kernel, %kernel.SP_2DROP) 78 | @kernel.SP_OVER.addr = internal constant i8* 79 | blockaddress(@kernel, %kernel.SP_OVER) 80 | @kernel.SP_ROT.addr = internal constant i8* 81 | blockaddress(@kernel, %kernel.SP_ROT) 82 | @kernel.SP_NROT.addr = internal constant i8* 83 | blockaddress(@kernel, %kernel.SP_NROT) 84 | @kernel.ALU_UM_ADD.addr = internal constant i8* 85 | blockaddress(@kernel, %kernel.ALU_UM_ADD) 86 | @kernel.ALU_ADD.addr = internal constant i8* 87 | blockaddress(@kernel, %kernel.ALU_ADD) 88 | @kernel.ALU_SUB.addr = internal constant i8* 89 | blockaddress(@kernel, %kernel.ALU_SUB) 90 | @kernel.ALU_MUL.addr = internal constant i8* 91 | blockaddress(@kernel, %kernel.ALU_MUL) 92 | @kernel.ALU_DIV.addr = internal constant i8* 93 | blockaddress(@kernel, %kernel.ALU_DIV) 94 | @kernel.ALU_CHAR_SUB.addr = internal constant i8* 95 | blockaddress(@kernel, %kernel.ALU_CHAR_SUB) 96 | @kernel.ALU_CHAR_PLUS.addr = internal constant i8* 97 | blockaddress(@kernel, %kernel.ALU_CHAR_PLUS) 98 | @kernel.ALU_CHARS.addr = internal constant i8* 99 | blockaddress(@kernel, %kernel.ALU_CHARS) 100 | @kernel.ALU_CELL_SUB.addr = internal constant i8* 101 | blockaddress(@kernel, %kernel.ALU_CELL_SUB) 102 | @kernel.ALU_CELL_PLUS.addr = internal constant i8* 103 | blockaddress(@kernel, %kernel.ALU_CELL_PLUS) 104 | @kernel.ALU_CELLS.addr = internal constant i8* 105 | blockaddress(@kernel, %kernel.ALU_CELLS) 106 | @kernel.ALU_GTZ.addr = internal constant i8* 107 | blockaddress(@kernel, %kernel.ALU_GTZ) 108 | @kernel.ALU_AND.addr = internal constant i8* 109 | blockaddress(@kernel, %kernel.ALU_AND) 110 | @kernel.ALU_OR.addr = internal constant i8* 111 | blockaddress(@kernel, %kernel.ALU_OR) 112 | @kernel.ALU_XOR.addr = internal constant i8* 113 | blockaddress(@kernel, %kernel.ALU_XOR) 114 | @kernel.DONE.addr = internal constant i8* 115 | blockaddress(@kernel, %kernel.DONE) 116 | 117 | declare i8 @getchar() 118 | declare i32 @printf(i8*, ... ) 119 | declare void @llvm.memcpy.p0i8.p0i8.i32(i8*, i8*, i32, i32, i1) 120 | 121 | ; ***************************************************************************** 122 | ; for ease of debugging, allows us to print a value to stdout 123 | ; ***************************************************************************** 124 | 125 | @promptString = internal constant [5 x i8] c" Ok \00" 126 | @wordString = internal constant [5 x i8] c"%s\0D\0A\00" 127 | @valueString = internal constant [7 x i8] c"%llu\0D\0A\00" 128 | @SPValuesString = internal constant [33 x i8] c"SP: @%llu=%llu SP0: @%llu=%llu\0D\0A\00" 129 | @charString = internal constant [6 x i8] c"CHAR:\00" 130 | @executedString = internal constant [10 x i8] c"EXECUTED:\00" 131 | @execLitString = internal constant [18 x i8] c"EXECUTED: LITERAL\00" 132 | @compiledString = internal constant [10 x i8] c"COMPILED:\00" 133 | @compLitString = internal constant [18 x i8] c"COMPILED: LITERAL\00" 134 | 135 | 136 | @dictString = internal constant [6 x i8] c"DICT:\00" 137 | @literalString = internal constant [9 x i8] c"LITERAL:\00" 138 | @progOutString = internal constant [7 x i8] c"INPUT:\00" 139 | @tokenString = internal constant [7 x i8] c"TOKEN:\00" 140 | @twoWordString = internal constant [8 x i8] c"%s %s\0D\0A\00" 141 | @dictNavString = internal constant [15 x i8] c"--> %s (%llu) \00" 142 | @newlineString = internal constant [3 x i8] c"\0D\0A\00" 143 | @EIPString = internal constant [13 x i8] c"EIP: @%llu\0D\0A\00" 144 | @EIPValueString = internal constant [19 x i8] c"EIP: @%llu: %llu\0D\0A\00" 145 | 146 | define void @printString(i8* %value) { 147 | %string = getelementptr [5 x i8]* @wordString, i32 0, i32 0 148 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i8* %value) 149 | ret void 150 | } 151 | 152 | define void @printTwoString(i8* %value, i8* %value2) { 153 | %string = getelementptr [8 x i8]* @twoWordString, i32 0, i32 0 154 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, i8* %value, 155 | i8* %value2) 156 | ret void 157 | } 158 | 159 | define void @printValueInt(%int %value) { 160 | %string = getelementptr [7 x i8]* @valueString, i32 0, i32 0 161 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, %int %value) 162 | ret void 163 | } 164 | 165 | define void @printStackPtrValues(%cell.ptr* %SP.ptr.ptr) { 166 | %string = getelementptr [33 x i8]* @SPValuesString, i32 0, i32 0 167 | ; obtain the stack position that SP is pointing at 168 | %SP.ptr = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 169 | %SP.stack.ptr = load %cell.ptr* %SP.ptr 170 | %SP.stack.addr.ptr = getelementptr %cell.ptr %SP.stack.ptr, i32 0 171 | %SP.stack.addr.int = ptrtoint %cell.ptr %SP.stack.addr.ptr to %addr 172 | %SP.stack.addr.value = load %cell.ptr %SP.stack.addr.ptr 173 | ; obtain the stack position that SP0 is pointing at 174 | %SP0.stack.ptr = load %cell.ptr* @SP0 175 | %SP0.stack.addr.ptr = getelementptr %addr.ptr %SP0.stack.ptr, i32 0 176 | %SP0.stack.addr.int = ptrtoint %addr.ptr %SP0.stack.addr.ptr to %addr 177 | %SP0.stack.addr.value = load %cell.ptr %SP0.stack.addr.ptr 178 | 179 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 180 | %int %SP.stack.addr.int, 181 | %int %SP.stack.addr.value, 182 | %int %SP0.stack.addr.int, 183 | %int %SP0.stack.addr.value) 184 | ret void 185 | } 186 | 187 | define void @outputNewLine() { 188 | %string = getelementptr [3 x i8]* @newlineString, i32 0, i32 0 189 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string) 190 | ret void 191 | } 192 | 193 | define void @printEIPPtr(%cell.ptr* %EIP.ptr.ptr) { 194 | %string = getelementptr [13 x i8]* @EIPString, i32 0, i32 0 195 | ; obtain the heap position that EIP is pointing at 196 | %EIP.ptr = getelementptr %cell.ptr* %EIP.ptr.ptr, i32 0 197 | %EIP.heap.ptr = load %cell.ptr* %EIP.ptr 198 | %EIP.heap.addr.ptr = getelementptr %cell.ptr %EIP.heap.ptr, i32 0 199 | %EIP.heap.addr.int = ptrtoint %cell.ptr %EIP.heap.addr.ptr to %addr 200 | 201 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 202 | %int %EIP.heap.addr.int) 203 | ret void 204 | } 205 | 206 | define void @printEIPPtrValue(%cell.ptr* %EIP.ptr.ptr) { 207 | %string = getelementptr [19 x i8]* @EIPValueString, i32 0, i32 0 208 | ; obtain the heap position that EIP is pointing at 209 | %EIP.ptr = getelementptr %cell.ptr* %EIP.ptr.ptr, i32 0 210 | %EIP.heap.ptr = load %cell.ptr* %EIP.ptr 211 | %EIP.heap.addr.ptr = getelementptr %cell.ptr %EIP.heap.ptr, i32 0 212 | %EIP.heap.addr.int = ptrtoint %cell.ptr %EIP.heap.addr.ptr to %addr 213 | %EIP.heap.addr.value = load %cell.ptr %EIP.heap.addr.ptr 214 | 215 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %string, 216 | %int %EIP.heap.addr.int, 217 | %int %EIP.heap.addr.value) 218 | ret void 219 | } 220 | 221 | ; **** heap access and manipulation functions 222 | define fastcc void @insertToken(%addr %heapAddr, %int* %token) { 223 | %tokenPtr.int = ptrtoint %int* %token to %addr 224 | %heap.ptr = inttoptr %addr %heapAddr to %cell* 225 | store %addr %tokenPtr.int, %cell* %heap.ptr 226 | ret void 227 | } 228 | 229 | define fastcc void @insertLiteral(%addr %heapAddr, %int %value) { 230 | %heap.ptr = inttoptr %addr %heapAddr to %cell* 231 | store %addr %value, %cell* %heap.ptr 232 | ret void 233 | } 234 | 235 | ; ***************************************************************************** 236 | ; globals used by Forth 237 | ; ***************************************************************************** 238 | 239 | 240 | @SP0 = weak global %cell.ptr null ; pointer to the beginning of the stack 241 | @HEAP = weak global %cell.ptr null ; pointer to the beginning of the heap 242 | @HERE = weak global %cell.ptr null ; pointer to the next (theoretic) free 243 | @STATE = weak global i1 0 ; compile/immediate state 244 | @dictPtr = weak global %WORD* null ; pointer to the last word in the dict 245 | @heapSize = weak global %int 0 ; size of the heap in i8 bytes 246 | 247 | define void @kernel(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 248 | %ret.ptr* %RSP.ptr.ptr, %cell* %DATA.ptr) { 249 | 250 | br label %kernel.NEXT 251 | 252 | ; ***************************************************************************** 253 | ; the core nucleus 254 | ; ***************************************************************************** 255 | 256 | kernel.NEXT: 257 | ; load the memory address that %EIP.ptr.ptr resolves to 258 | %EIP.ptr.NEXT = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 259 | %EIP.ptr.int.NEXT = ptrtoint %exec.ptr* %EIP.ptr.NEXT to %int 260 | %EIP.NEXT = load %exec.ptr* %EIP.ptr.NEXT 261 | %EIP.addr.ptr.NEXT = getelementptr %cell.ptr %EIP.NEXT, i32 0 262 | %EIP.addr.int.NEXT = ptrtoint %cell.ptr %EIP.addr.ptr.NEXT to %addr 263 | 264 | call void @printEIPPtrValue( %cell.ptr* %EIP.ptr.ptr ) 265 | call void @printStackPtrValues( %cell.ptr* %SP.ptr.ptr ) 266 | 267 | ; increment and store our EIP 268 | %EIP.addr.incr.int.NEXT = add %addr %EIP.addr.int.NEXT, 8 269 | %EIP.addr.incr.ptr.NEXT = inttoptr %addr %EIP.addr.incr.int.NEXT 270 | to %cell.ptr 271 | store %cell.ptr %EIP.addr.incr.ptr.NEXT, %cell.ptr* %EIP.ptr.ptr 272 | 273 | ; load our instruction value 274 | %INS.int.NEXT = load %exec* %EIP.addr.ptr.NEXT 275 | %INS.ptr.NEXT = inttoptr %exec %INS.int.NEXT to %exec* 276 | 277 | ; branch to where our instruction says to go 278 | indirectbr %exec* %INS.ptr.NEXT, [ label %kernel.NEXT, 279 | label %kernel.EXEC_DOCOL, 280 | label %kernel.EXEC_DOLIT, 281 | label %kernel.M_AT, 282 | label %kernel.M_BANG, 283 | label %kernel.SP_AT, 284 | label %kernel.SP_POP, 285 | label %kernel.SP_PUSH, 286 | label %kernel.SP_SWAP, 287 | label %kernel.SP_2SWAP, 288 | label %kernel.SP_DUP, 289 | label %kernel.SP_2DUP, 290 | label %kernel.SP_DROP, 291 | label %kernel.SP_2DROP, 292 | label %kernel.SP_OVER, 293 | label %kernel.SP_ROT, 294 | label %kernel.SP_NROT, 295 | label %kernel.ALU_UM_ADD, 296 | label %kernel.ALU_ADD, 297 | label %kernel.ALU_SUB, 298 | label %kernel.ALU_MUL, 299 | label %kernel.ALU_DIV, 300 | label %kernel.ALU_CHAR_SUB, 301 | label %kernel.ALU_CHAR_PLUS, 302 | label %kernel.ALU_CHARS, 303 | label %kernel.ALU_CELL_SUB, 304 | label %kernel.ALU_CELL_PLUS, 305 | label %kernel.ALU_CELLS, 306 | label %kernel.ALU_GTZ, 307 | label %kernel.ALU_AND, 308 | label %kernel.ALU_OR, 309 | label %kernel.ALU_XOR, 310 | label %kernel.DONE ] 311 | 312 | ; ***************************************************************************** 313 | ; kernel RSP/execution operations 314 | ; ***************************************************************************** 315 | 316 | kernel.EXEC_RET: 317 | ; load the memory address that %EIP.ptr.ptr resolves to 318 | %EIP.ptr.EXEC_RET = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 319 | %EIP.EXEC_RET = load %exec.ptr* %EIP.ptr.EXEC_RET 320 | %EIP.addr.ptr.EXEC_RET = getelementptr %cell.ptr %EIP.EXEC_RET, i32 0 321 | 322 | ; load the memory address that %RSP.ptr.ptr resolves to 323 | %RSP.ptr.EXEC_RET = getelementptr %exec.ptr* %RSP.ptr.ptr, i32 0 324 | %RSP.EXEC_RET = load %exec.ptr* %RSP.ptr.EXEC_RET 325 | %RSP.addr.ptr.EXEC_RET = getelementptr %cell.ptr %RSP.EXEC_RET, i32 0 326 | %RSP.addr.int.EXEC_RET = ptrtoint %cell.ptr %RSP.addr.ptr.EXEC_RET 327 | to %addr 328 | 329 | ; load the value under RSP and store it as EIP 330 | %JUMP.int.EXEC_RET = load %exec* %RSP.addr.ptr.EXEC_RET 331 | %JUMP.ptr.EXEC_RET = inttoptr %exec %JUMP.int.EXEC_RET to %exec.ptr 332 | store %exec* %JUMP.ptr.EXEC_RET, %exec.ptr* %EIP.ptr.ptr 333 | 334 | ; increment the RSP, and store it 335 | %RSP.addr.incr.int.EXEC_RET = add %addr %RSP.addr.int.EXEC_RET, 8 336 | %RSP.addr.incr.ptr.EXEC_RET = inttoptr %addr %RSP.addr.incr.int.EXEC_RET 337 | to %cell.ptr 338 | store %cell.ptr %RSP.addr.incr.ptr.EXEC_RET, %cell.ptr* %RSP.ptr.ptr 339 | 340 | br label %kernel.NEXT 341 | 342 | kernel.EXEC_DOCOL: 343 | ; load the memory address that %EIP.ptr.ptr resolves to 344 | %EIP.ptr.EXEC_DOCOL = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 345 | %EIP.EXEC_DOCOL = load %exec.ptr* %EIP.ptr.EXEC_DOCOL 346 | %EIP.addr.ptr.EXEC_DOCOL = getelementptr %cell.ptr %EIP.EXEC_DOCOL, i32 0 347 | %EIP.addr.int.EXEC_DOCOL = ptrtoint %cell.ptr %EIP.addr.ptr.EXEC_DOCOL 348 | to %addr 349 | 350 | ; load the memory address that %RSP.ptr.ptr resolves to 351 | %RSP.ptr.EXEC_DOCOL = getelementptr %exec.ptr* %RSP.ptr.ptr, i32 0 352 | %RSP.EXEC_DOCOL = load %exec.ptr* %RSP.ptr.EXEC_DOCOL 353 | %RSP.addr.ptr.EXEC_DOCOL = getelementptr %cell.ptr %RSP.EXEC_DOCOL, i32 0 354 | %RSP.addr.int.EXEC_DOCOL = ptrtoint %cell.ptr %RSP.addr.ptr.EXEC_DOCOL 355 | to %addr 356 | 357 | ; load the value under EIP and store it as EIP 358 | %JUMP.int.EXEC_DOCOL= load %exec* %EIP.addr.ptr.EXEC_DOCOL 359 | %JUMP.ptr.EXEC_DOCOL = inttoptr %exec %JUMP.int.EXEC_DOCOL to %exec.ptr 360 | store %exec* %JUMP.ptr.EXEC_DOCOL, %exec.ptr* %EIP.ptr.ptr 361 | 362 | ; increment our old EIP value, which will be the return address 363 | %EIP.addr.decr.int.EXEC_DOCOL = add %addr %EIP.addr.int.EXEC_DOCOL, 8 364 | 365 | ; decrement the RSP and store the old EIP value there 366 | %RSP.addr.decr.int.EXEC_DOCOL = sub %addr %RSP.addr.int.EXEC_DOCOL, 8 367 | %RSP.addr.decr.ptr.EXEC_DOCOL = inttoptr %addr %RSP.addr.decr.int.EXEC_DOCOL 368 | to %cell.ptr 369 | store %cell.ptr %RSP.addr.decr.ptr.EXEC_DOCOL, %cell.ptr* %RSP.ptr.ptr 370 | store %cell %EIP.addr.decr.int.EXEC_DOCOL, 371 | %cell* %RSP.addr.decr.ptr.EXEC_DOCOL 372 | 373 | br label %kernel.NEXT 374 | 375 | 376 | kernel.EXEC_DOLIT: 377 | ; load the memory address that %EIP.ptr.ptr resolves to 378 | %EIP.ptr.EXEC_DOLIT = getelementptr %exec.ptr* %EIP.ptr.ptr, i32 0 379 | %EIP.EXEC_DOLIT = load %exec.ptr* %EIP.ptr.EXEC_DOLIT 380 | %EIP.addr.ptr.EXEC_DOLIT = getelementptr %cell.ptr %EIP.EXEC_DOLIT, i32 0 381 | %EIP.addr.int.EXEC_DOLIT = ptrtoint %cell.ptr %EIP.addr.ptr.EXEC_DOLIT 382 | to %addr 383 | 384 | ; load the value under EIP 385 | %LITERAL.int.EXEC_DOLIT = load %cell* %EIP.addr.ptr.EXEC_DOLIT 386 | 387 | ; increment and store our EIP 388 | %EIP.addr.incr.int.EXEC_DOLIT = add %addr %EIP.addr.int.EXEC_DOLIT, 8 389 | %EIP.addr.incr.ptr.EXEC_DOLIT = inttoptr %addr %EIP.addr.incr.int.EXEC_DOLIT 390 | to %cell.ptr 391 | store %cell.ptr %EIP.addr.incr.ptr.EXEC_DOLIT, %cell.ptr* %EIP.ptr.ptr 392 | 393 | ; load the memory address that %SP.ptr.ptr resolves to 394 | %SP.ptr.EXEC_DOLIT = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 395 | %SP.EXEC_DOLIT = load %cell.ptr* %SP.ptr.EXEC_DOLIT 396 | %SP.addr.ptr.EXEC_DOLIT = getelementptr %cell.ptr %SP.EXEC_DOLIT, i32 0 397 | %SP.addr.int.EXEC_DOLIT = ptrtoint %cell.ptr %SP.addr.ptr.EXEC_DOLIT 398 | to %addr 399 | 400 | ; decrement our stack pointer and store the literal at the new address 401 | %SP.addr.decr.int.EXEC_DOLIT = sub %addr %SP.addr.int.EXEC_DOLIT, 8 402 | %SP.addr.decr.ptr.EXEC_DOLIT = inttoptr %addr %SP.addr.decr.int.EXEC_DOLIT 403 | to %cell.ptr 404 | store %cell.ptr %SP.addr.decr.ptr.EXEC_DOLIT, %cell.ptr* %SP.ptr.ptr 405 | store %cell %LITERAL.int.EXEC_DOLIT, %cell* %SP.addr.decr.ptr.EXEC_DOLIT 406 | 407 | br label %kernel.NEXT 408 | 409 | ; ***************************************************************************** 410 | ; kernel memory operations 411 | ; ***************************************************************************** 412 | 413 | kernel.M_AT: 414 | ; load the number located at the address on the stack onto the stack 415 | ; bx SP_POP 416 | ; D# 0 bx [] push 417 | 418 | ; load the memory address that %SP.ptr.ptr resolves to 419 | %SP.ptr.M_AT = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 420 | %SP.M_AT = load %cell.ptr* %SP.ptr.M_AT 421 | %SP.addr.ptr.M_AT = getelementptr %cell.ptr %SP.M_AT, i32 0 422 | %SP.addr.int.M_AT = ptrtoint %cell.ptr %SP.addr.ptr.M_AT to %addr 423 | 424 | ; retrieve the address value at SP 425 | %SOURCE.addr.int.M_AT = load %cell* %SP.addr.ptr.M_AT 426 | 427 | ; convert it to a pointer 428 | %SOURCE.addr.ptr.M_AT = inttoptr %cell %SOURCE.addr.int.M_AT to %cell* 429 | 430 | ; load the memory at the address pointed at 431 | %SOURCE.int.M_AT = load %cell* %SOURCE.addr.ptr.M_AT 432 | 433 | ; replace the address on the stack with the number loaded, avoiding any 434 | ; arithmetic on the stack pointer 435 | store %cell %SOURCE.int.M_AT, %cell* %SP.addr.ptr.M_AT 436 | 437 | br label %kernel.NEXT 438 | 439 | 440 | kernel.M_BANG: 441 | ; pop the number and the address off the stack, and place number at address 442 | ; bx pop 443 | ; ax pop 444 | ; al D# 0 bx [] mov 445 | 446 | ; load the memory address that %SP.ptr.ptr resolves to 447 | %SP.ptr.M_BANG = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 448 | %SP.M_BANG = load %cell.ptr* %SP.ptr.M_BANG 449 | %SP.addr.ptr.M_BANG = getelementptr %cell.ptr %SP.M_BANG, i32 0 450 | %SP.addr.int.M_BANG = ptrtoint %cell.ptr %SP.addr.ptr.M_BANG to %addr 451 | 452 | ; retrieve the value at the memory address 453 | %TARGET.addr.int.M_BANG = load %cell* %SP.addr.ptr.M_BANG 454 | 455 | ; convert it to a pointer 456 | %TARGET.addr.ptr.M_BANG = inttoptr %cell %TARGET.addr.int.M_BANG 457 | to %cell.ptr 458 | 459 | ; increment our local stack pointer to get the number 460 | %SP.addr.incr.int.M_BANG = add %addr %SP.addr.int.M_BANG, 8 461 | %SP.addr.incr.ptr.M_BANG = inttoptr %addr %SP.addr.incr.int.M_BANG 462 | to %cell.ptr 463 | %DATA.int.M_BANG = load %cell* %SP.addr.incr.ptr.M_BANG 464 | 465 | ; increment our local stack pointer and store it in the SP register now that 466 | ; we've retrieved the data we need to 467 | %SP.addr.final.int.M_BANG = add %addr %SP.addr.int.M_BANG, 8 468 | %SP.addr.final.ptr.M_BANG = inttoptr %addr %SP.addr.final.int.M_BANG 469 | to %cell.ptr 470 | store %cell.ptr %SP.addr.final.ptr.M_BANG, %cell.ptr* %SP.ptr.ptr 471 | 472 | ; finally, store our number at the target 473 | store %cell %DATA.int.M_BANG, %cell* %TARGET.addr.ptr.M_BANG 474 | 475 | br label %kernel.NEXT 476 | 477 | ; ***************************************************************************** 478 | ; kernel stack operations 479 | ; ***************************************************************************** 480 | 481 | kernel.SP_AT: 482 | ; sp bx mov 483 | ; bx push 484 | ; next 485 | 486 | ; load the memory address that %SP.ptr.ptr resolves to 487 | %SP.ptr.SP_AT = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 488 | %SP.SP_AT = load %cell.ptr* %SP.ptr.SP_AT 489 | %SP.addr.ptr.SP_AT = getelementptr %cell.ptr %SP.SP_AT, i32 0 490 | %SP.addr.int.SP_AT = ptrtoint %cell.ptr %SP.addr.ptr.SP_AT to %addr 491 | 492 | ; decrement our integer pointer 493 | %SP.addr.decr.int.SP_AT = sub %addr %SP.addr.int.SP_AT, 8 494 | 495 | ; resolve our new address as a new pointer 496 | %SP.addr.decr.ptr.SP_AT = inttoptr %addr %SP.addr.decr.int.SP_AT 497 | to %cell.ptr 498 | 499 | ; store it before we go on 500 | store %cell.ptr %SP.addr.decr.ptr.SP_AT, %cell.ptr* %SP.ptr.ptr 501 | 502 | ; store our memory address at the new location in the stack 503 | store %addr %SP.addr.int.SP_AT, %addr* %SP.addr.decr.ptr.SP_AT 504 | 505 | br label %kernel.NEXT 506 | 507 | 508 | kernel.SP_POP: 509 | ; load the memory address that %SP.ptr.ptr resolves to 510 | %SP.ptr.SP_POP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 511 | %SP.SP_POP = load %cell.ptr* %SP.ptr.SP_POP 512 | %SP.addr.ptr.SP_POP = getelementptr %cell.ptr %SP.SP_POP, i32 0 513 | %SP.addr.int.SP_POP = ptrtoint %cell.ptr %SP.addr.ptr.SP_POP to %addr 514 | 515 | ; store the value at the memory address in the DATA register 516 | %DATA.int.SP_POP = load %cell* %SP.addr.ptr.SP_POP 517 | store %cell %DATA.int.SP_POP, %cell* %DATA.ptr 518 | 519 | ; increment our stack integer pointer, and store it in the register 520 | %SP.addr.incr.int.SP_POP = add %addr %SP.addr.int.SP_POP, 8 521 | %SP.addr.incr.ptr.SP_POP = inttoptr %addr %SP.addr.incr.int.SP_POP 522 | to %cell.ptr 523 | store %cell.ptr %SP.addr.incr.ptr.SP_POP, %cell.ptr* %SP.ptr.ptr 524 | 525 | br label %kernel.NEXT 526 | 527 | 528 | kernel.SP_PUSH: 529 | ; load the memory address that %SP.ptr.ptr resolves to 530 | %SP.ptr.SP_PUSH = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 531 | %SP.SP_PUSH = load %cell.ptr* %SP.ptr.SP_PUSH 532 | %SP.addr.ptr.SP_PUSH = getelementptr %cell.ptr %SP.SP_PUSH, i32 0 533 | %SP.addr.int.SP_PUSH = ptrtoint %cell.ptr %SP.addr.ptr.SP_PUSH to %addr 534 | 535 | ; decrement our stack integer pointer, and store it in the register 536 | %SP.addr.decr.int.SP_PUSH = sub %addr %SP.addr.int.SP_PUSH, 8 537 | %SP.addr.decr.ptr.SP_PUSH = inttoptr %addr %SP.addr.decr.int.SP_PUSH 538 | to %cell.ptr 539 | store %cell.ptr %SP.addr.decr.ptr.SP_PUSH, %cell.ptr* %SP.ptr.ptr 540 | 541 | ; store the value in the DATA register at the new memory address 542 | %DATA.int.SP_PUSH = load %cell* %DATA.ptr 543 | store %cell %DATA.int.SP_PUSH, %addr* %SP.addr.decr.ptr.SP_PUSH 544 | 545 | br label %kernel.NEXT 546 | 547 | 548 | kernel.SP_SWAP: 549 | ; swap top two elements of the stack 550 | ; bx pop 551 | ; ax pop 552 | ; bx push 553 | ; ax push 554 | %SP.ptr.SP_SWAP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 555 | %SP.SP_SWAP = load %cell.ptr* %SP.ptr.SP_SWAP 556 | %SP.addr.ptr.SP_SWAP = getelementptr %cell.ptr %SP.SP_SWAP, i32 0 557 | %SP.addr.int.SP_SWAP = ptrtoint %cell.ptr %SP.addr.ptr.SP_SWAP to %addr 558 | 559 | %A.cell = load %cell* %SP.addr.ptr.SP_SWAP 560 | 561 | %SP.addr.incr.int.SP_SWAP = add %addr %SP.addr.int.SP_SWAP, 8 562 | %SP.addr.incr.ptr.SP_SWAP = inttoptr %addr %SP.addr.incr.int.SP_SWAP 563 | to %cell.ptr 564 | 565 | %B.cell = load %cell* %SP.addr.incr.ptr.SP_SWAP 566 | 567 | store %cell %B.cell, %cell.ptr %SP.addr.ptr.SP_SWAP 568 | store %cell %A.cell, %cell.ptr %SP.addr.incr.ptr.SP_SWAP 569 | 570 | br label %kernel.NEXT 571 | 572 | kernel.SP_2SWAP: 573 | ; swap top two pairs of elements on the stack 574 | ; pop %eax 575 | ; pop %ebx 576 | ; pop %ecx 577 | ; pop %edx 578 | ; push %ebx 579 | ; push %eax 580 | ; push %edx 581 | ; push %ecx 582 | %SP.ptr.SP_2SWAP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 583 | %SP.SP_2SWAP = load %cell.ptr* %SP.ptr.SP_2SWAP 584 | 585 | %A.addr.ptr.SP_2SWAP = getelementptr %cell.ptr %SP.SP_2SWAP, i32 0 586 | %A.addr.int.SP_2SWAP = ptrtoint %cell.ptr %A.addr.ptr.SP_2SWAP to %addr 587 | %A.cell.SP_2SWAP = load %cell* %A.addr.ptr.SP_2SWAP 588 | 589 | %B.addr.int.SP_2SWAP = add %addr %A.addr.int.SP_2SWAP, 8 590 | %B.addr.ptr.SP_2SWAP = inttoptr %addr %B.addr.int.SP_2SWAP to %cell* 591 | %B.cell.SP_2SWAP = load %cell* %B.addr.ptr.SP_2SWAP 592 | 593 | %C.addr.int.SP_2SWAP = add %addr %B.addr.int.SP_2SWAP, 8 594 | %C.addr.ptr.SP_2SWAP = inttoptr %addr %C.addr.int.SP_2SWAP to %cell* 595 | %C.cell.SP_2SWAP = load %cell* %C.addr.ptr.SP_2SWAP 596 | 597 | %D.addr.int.SP_2SWAP = add %addr %C.addr.int.SP_2SWAP, 8 598 | %D.addr.ptr.SP_2SWAP = inttoptr %addr %D.addr.int.SP_2SWAP to %cell* 599 | %D.cell.SP_2SWAP = load %cell* %D.addr.ptr.SP_2SWAP 600 | 601 | store %cell %B.cell.SP_2SWAP, %cell* %D.addr.ptr.SP_2SWAP ; %(edx) 602 | store %cell %A.cell.SP_2SWAP, %cell* %C.addr.ptr.SP_2SWAP ; %(ecx) 603 | store %cell %D.cell.SP_2SWAP, %cell* %B.addr.ptr.SP_2SWAP ; %(ebx) 604 | store %cell %C.cell.SP_2SWAP, %cell* %A.addr.ptr.SP_2SWAP ; %(eax) 605 | 606 | br label %kernel.NEXT 607 | 608 | kernel.SP_DUP: 609 | ; copy the number at the top of the stack onto the top of the stack 610 | ; bx pop 611 | ; bx push 612 | ; bx push 613 | 614 | ; load the memory address that %SP.ptr.ptr resolves to 615 | %SP.ptr.SP_DUP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 616 | %SP.SP_DUP = load %cell.ptr* %SP.ptr.SP_DUP 617 | %SP.addr.ptr.SP_DUP = getelementptr %cell.ptr %SP.SP_DUP, i32 0 618 | %SP.addr.int.SP_DUP = ptrtoint %cell.ptr %SP.addr.ptr.SP_DUP to %addr 619 | 620 | ; retrieve the value at SP 621 | %DATA.int.SP_DUP = load %cell* %SP.addr.ptr.SP_DUP 622 | 623 | ; decrement our stack integer pointer, and store it in the register 624 | %SP.addr.decr.int.SP_DUP = sub %addr %SP.addr.int.SP_DUP, 8 625 | %SP.addr.decr.ptr.SP_DUP = inttoptr %addr %SP.addr.decr.int.SP_DUP 626 | to %cell.ptr 627 | store %cell.ptr %SP.addr.decr.ptr.SP_DUP, %cell.ptr* %SP.ptr.ptr 628 | 629 | ; store the value at the new memory address 630 | store %cell %DATA.int.SP_DUP, %addr* %SP.addr.decr.ptr.SP_DUP 631 | 632 | br label %kernel.NEXT 633 | 634 | kernel.SP_2DUP: 635 | ; copy the top two elements of the stack 636 | ; mov (%esp),%eax 637 | ; mov 4(%esp),%ebx 638 | ; push %ebx 639 | ; push %eax 640 | 641 | ; load the memory address that %SP.ptr.ptr resolves to 642 | %SP.ptr.SP_2DUP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 643 | %SP.SP_2DUP = load %cell.ptr* %SP.ptr.SP_2DUP 644 | 645 | ; load %eax 646 | %A.addr.ptr.SP_2DUP = getelementptr %cell.ptr %SP.SP_2DUP, i32 0 647 | %A.addr.int.SP_2DUP = ptrtoint %cell.ptr %A.addr.ptr.SP_2DUP to %addr 648 | %A.cell.SP_2DUP = load %cell* %A.addr.ptr.SP_2DUP 649 | 650 | ; load %ebx 651 | %B.addr.int.SP_2DUP = add %addr %A.addr.int.SP_2DUP, 8 652 | %B.addr.ptr.SP_2DUP = inttoptr %addr %B.addr.int.SP_2DUP to %cell* 653 | %B.cell.SP_2DUP = load %cell* %B.addr.ptr.SP_2DUP 654 | 655 | ; push %ebx 656 | %SP.addr.decr.int.SP_2DUP = sub %addr %A.addr.int.SP_2DUP, 8 657 | %SP.addr.decr.ptr.SP_2DUP = inttoptr %addr %SP.addr.decr.int.SP_2DUP 658 | to %cell* 659 | store %cell %B.cell.SP_2DUP, %cell* %SP.addr.decr.ptr.SP_2DUP 660 | 661 | ; push %eax 662 | %SP.addr.decr.decr.int.SP_2DUP = sub %addr %SP.addr.decr.int.SP_2DUP, 8 663 | %SP.addr.decr.decr.ptr.SP_2DUP = inttoptr %addr %SP.addr.decr.decr.int.SP_2DUP 664 | to %cell* 665 | store %cell %A.cell.SP_2DUP, %cell* %SP.addr.decr.decr.ptr.SP_2DUP 666 | 667 | ; store our new stack pointer 668 | store %cell* %SP.addr.decr.decr.ptr.SP_2DUP, %cell.ptr* %SP.ptr.ptr 669 | 670 | br label %kernel.NEXT 671 | 672 | kernel.SP_DROP: 673 | ; move the stack pointer to the right, forgetting an element 674 | ; bx pop 675 | 676 | ; load the memory address that %SP.ptr.ptr resolves to 677 | %SP.ptr.SP_DROP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 678 | %SP.SP_DROP = load %cell.ptr* %SP.ptr.SP_DROP 679 | %SP.addr.ptr.SP_DROP = getelementptr %cell.ptr %SP.SP_DROP, i32 0 680 | %SP.addr.int.SP_DROP = ptrtoint %cell.ptr %SP.addr.ptr.SP_DROP to %addr 681 | 682 | ; increment our stack integer pointer, and store it in the register 683 | %SP.addr.incr.int.SP_DROP = add %addr %SP.addr.int.SP_DROP, 8 684 | %SP.addr.incr.ptr.SP_DROP = inttoptr %addr %SP.addr.incr.int.SP_DROP 685 | to %cell.ptr 686 | store %cell.ptr %SP.addr.incr.ptr.SP_DROP, %cell.ptr* %SP.ptr.ptr 687 | 688 | br label %kernel.NEXT 689 | 690 | kernel.SP_2DROP: 691 | ; move the stack pointer two cells to the right, forgetting two elements 692 | ; bx pop 693 | ; bx pop 694 | 695 | ; load the memory address that %SP.ptr.ptr resolves to 696 | %SP.ptr.SP_2DROP = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 697 | %SP.SP_2DROP = load %cell.ptr* %SP.ptr.SP_2DROP 698 | %SP.addr.ptr.SP_2DROP = getelementptr %cell.ptr %SP.SP_2DROP, i32 0 699 | %SP.addr.int.SP_2DROP = ptrtoint %cell.ptr %SP.addr.ptr.SP_2DROP to %addr 700 | 701 | ; increment our stack integer pointer, and store it in the register 702 | %SP.addr.incr.int.SP_2DROP = add %addr %SP.addr.int.SP_2DROP, 16 703 | %SP.addr.incr.ptr.SP_2DROP = inttoptr %addr %SP.addr.incr.int.SP_2DROP 704 | to %cell.ptr 705 | store %cell.ptr %SP.addr.incr.ptr.SP_2DROP, %cell.ptr* %SP.ptr.ptr 706 | 707 | br label %kernel.NEXT 708 | 709 | 710 | kernel.SP_OVER: 711 | ; copy the number at the top of the stack onto the top of the stack 712 | ; bx pop 713 | ; ax pop 714 | ; ax push 715 | ; bx push 716 | ; ax push 717 | 718 | ; load the memory address that %SP.ptr.ptr resolves to 719 | %SP.ptr.SP_OVER = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 720 | %SP.SP_OVER = load %cell.ptr* %SP.ptr.SP_OVER 721 | %SP.addr.ptr.SP_OVER = getelementptr %cell.ptr %SP.SP_OVER, i32 0 722 | %SP.addr.int.SP_OVER = ptrtoint %cell.ptr %SP.addr.ptr.SP_OVER 723 | to %addr 724 | 725 | ; increment our local SP pointer to grab the value to copy over 726 | %SP.addr.incr.int.SP_OVER = add %addr %SP.addr.int.SP_OVER, 8 727 | %SP.addr.incr.ptr.SP_OVER = inttoptr %addr %SP.addr.incr.int.SP_OVER 728 | to %cell.ptr 729 | 730 | ; grab the value now 731 | %DATA.int.SP_OVER = load %cell* %SP.addr.incr.ptr.SP_OVER 732 | 733 | ; now that we've grabbed our value, increment our SP pointer over the SP 734 | %SP.addr.decr.int.SP_OVER = sub %addr %SP.addr.incr.int.SP_OVER, 16 735 | %SP.addr.decr.ptr.SP_OVER = inttoptr %addr %SP.addr.decr.int.SP_OVER 736 | to %cell.ptr 737 | 738 | ; store the value at the new target 739 | store %cell %DATA.int.SP_OVER, %cell.ptr %SP.addr.decr.ptr.SP_OVER 740 | 741 | ; store our final local stack pointer 742 | store %cell.ptr %SP.addr.decr.ptr.SP_OVER, %cell.ptr* %SP.ptr.ptr 743 | 744 | br label %kernel.NEXT 745 | 746 | kernel.SP_ROT: 747 | ; rotate the first three elements at the top of the stack 748 | ; pop %eax 749 | ; pop %ebx 750 | ; pop %ecx 751 | ; push %ebx 752 | ; push %eax 753 | ; push %ecx 754 | 755 | ; load the memory address that %SP.ptr.ptr resolves to 756 | %SP.ptr.SP_ROT = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 757 | %SP.SP_ROT = load %cell.ptr* %SP.ptr.SP_ROT 758 | %SP.addr.ptr.SP_ROT = getelementptr %cell.ptr %SP.SP_ROT, i32 0 759 | %SP.addr.int.SP_ROT = ptrtoint %cell.ptr %SP.addr.ptr.SP_ROT 760 | to %addr 761 | 762 | ; load %eax 763 | %A.int.SP_ROT = load %cell* %SP.addr.ptr.SP_ROT 764 | 765 | ; load %ebx 766 | %SP.addr.incr.int.SP_ROT = add %addr %SP.addr.int.SP_ROT, 8 767 | %SP.addr.incr.ptr.SP_ROT = inttoptr %addr %SP.addr.incr.int.SP_ROT 768 | to %cell.ptr 769 | 770 | %B.int.SP_ROT = load %cell* %SP.addr.incr.ptr.SP_ROT 771 | 772 | ; load %ecx 773 | %SP.addr.incr.incr.int.SP_ROT = add %addr %SP.addr.incr.int.SP_ROT, 8 774 | %SP.addr.incr.incr.ptr.SP_ROT = inttoptr %addr %SP.addr.incr.incr.int.SP_ROT 775 | to %cell.ptr 776 | 777 | %C.int.SP_ROT = load %cell* %SP.addr.incr.incr.ptr.SP_ROT 778 | 779 | ; directly store %eax, %ebx, and %ecx in the appropriate pointers 780 | store %cell %B.int.SP_ROT, %cell* %SP.addr.incr.incr.ptr.SP_ROT ; %(ecx) 781 | store %cell %A.int.SP_ROT, %cell* %SP.addr.incr.ptr.SP_ROT ; %(ebx) 782 | store %cell %C.int.SP_ROT, %cell* %SP.addr.ptr.SP_ROT ; %(eax) 783 | 784 | br label %kernel.NEXT 785 | 786 | kernel.SP_NROT: 787 | ; rotate the first three elements at the top of the stack 788 | ; pop %eax 789 | ; pop %ebx 790 | ; pop %ecx 791 | ; push %eax 792 | ; push %ecx 793 | ; push %ebx 794 | 795 | ; load the memory address that %SP.ptr.ptr resolves to 796 | %SP.ptr.SP_NROT = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 797 | %SP.SP_NROT = load %cell.ptr* %SP.ptr.SP_NROT 798 | %SP.addr.ptr.SP_NROT = getelementptr %cell.ptr %SP.SP_NROT, i32 0 799 | %SP.addr.int.SP_NROT = ptrtoint %cell.ptr %SP.addr.ptr.SP_NROT 800 | to %addr 801 | 802 | ; load %eax 803 | %A.int.SP_NROT = load %cell* %SP.addr.ptr.SP_NROT 804 | 805 | ; load %ebx 806 | %SP.addr.incr.int.SP_NROT = add %addr %SP.addr.int.SP_NROT, 8 807 | %SP.addr.incr.ptr.SP_NROT = inttoptr %addr %SP.addr.incr.int.SP_NROT 808 | to %cell.ptr 809 | 810 | %B.int.SP_NROT = load %cell* %SP.addr.incr.ptr.SP_NROT 811 | 812 | ; load %ecx 813 | %SP.addr.incr.incr.int.SP_NROT = add %addr %SP.addr.incr.int.SP_NROT, 8 814 | %SP.addr.incr.incr.ptr.SP_NROT = inttoptr %addr %SP.addr.incr.incr.int.SP_NROT 815 | to %cell.ptr 816 | 817 | %C.int.SP_NROT = load %cell* %SP.addr.incr.incr.ptr.SP_NROT 818 | 819 | ; directly store %eax, %ebx, and %ecx in the appropriate pointers 820 | store %cell %A.int.SP_NROT, %cell* %SP.addr.incr.incr.ptr.SP_NROT ; %(ecx) 821 | store %cell %C.int.SP_NROT, %cell* %SP.addr.incr.ptr.SP_NROT ; %(ebx) 822 | store %cell %B.int.SP_NROT, %cell* %SP.addr.ptr.SP_NROT ; %(eax) 823 | 824 | br label %kernel.NEXT 825 | 826 | 827 | 828 | 829 | ; ***************************************************************************** 830 | ; kernel ALU operations 831 | ; ***************************************************************************** 832 | 833 | kernel.ALU_UM_ADD: 834 | %SP.ptr.ALU_UM_ADD = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 835 | %SP.ALU_UM_ADD = load %cell.ptr* %SP.ptr.ALU_UM_ADD 836 | %SP.addr.ptr.ALU_UM_ADD = getelementptr %cell.ptr %SP.ALU_UM_ADD, i32 0 837 | %SP.addr.int.ALU_UM_ADD = ptrtoint %cell.ptr %SP.addr.ptr.ALU_UM_ADD 838 | to %addr 839 | 840 | %A.cell.ALU_UM_ADD = load %cell* %SP.addr.ptr.ALU_UM_ADD 841 | 842 | %SP.addr.incr.int.ALU_UM_ADD = add %addr %SP.addr.int.ALU_UM_ADD, 8 843 | %SP.addr.incr.ptr.ALU_UM_ADD = inttoptr %addr %SP.addr.incr.int.ALU_UM_ADD 844 | to %cell.ptr 845 | 846 | %B.cell.ALU_UM_ADD = load %cell* %SP.addr.incr.ptr.ALU_UM_ADD 847 | 848 | ; do our actual operation, calling the LLVM intrinsic 849 | %result.ALU_UM_ADD = call {%int, i1} @llvm_ump(%int %A.cell.ALU_UM_ADD, 850 | %int %B.cell.ALU_UM_ADD ) 851 | ; store the sum at SP-1 852 | %sum.int.ALU_UM_ADD = extractvalue {%int, i1} %result.ALU_UM_ADD, 0 853 | store %cell %sum.int.ALU_UM_ADD, %cell* %SP.addr.ptr.ALU_UM_ADD 854 | %carry.flag.ALU_UM_ADD = extractvalue {%int, i1} %result.ALU_UM_ADD, 1 855 | %carry.int.ALU_UM_ADD = zext i1 %carry.flag.ALU_UM_ADD to %int 856 | store %int %carry.int.ALU_UM_ADD, %cell* %SP.addr.incr.ptr.ALU_UM_ADD 857 | 858 | br label %kernel.NEXT 859 | 860 | 861 | kernel.ALU_ADD: 862 | ; load the memory address that %SP.ptr.ptr resolves to 863 | ; bx pop 864 | ; ax pop 865 | ; bx push 866 | ; ax push 867 | %SP.ptr.ALU_ADD = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 868 | %SP.ALU_ADD = load %cell.ptr* %SP.ptr.ALU_ADD 869 | %SP.addr.ptr.ALU_ADD = getelementptr %cell.ptr %SP.ALU_ADD, i32 0 870 | %SP.addr.int.ALU_ADD = ptrtoint %cell.ptr %SP.addr.ptr.ALU_ADD to %addr 871 | 872 | %A.cell.ALU_ADD = load %cell* %SP.addr.ptr.ALU_ADD 873 | 874 | %SP.addr.incr.int.ALU_ADD = add %addr %SP.addr.int.ALU_ADD, 8 875 | %SP.addr.incr.ptr.ALU_ADD = inttoptr %addr %SP.addr.incr.int.ALU_ADD 876 | to %cell.ptr 877 | 878 | %B.cell.ALU_ADD = load %cell* %SP.addr.incr.ptr.ALU_ADD 879 | 880 | ; do our actual operation and store it at the stack position for %B 881 | %DATA.cell.ALU_ADD = add %cell %A.cell.ALU_ADD, %B.cell.ALU_ADD 882 | store %cell %DATA.cell.ALU_ADD, %cell* %SP.addr.incr.ptr.ALU_ADD 883 | 884 | ; move the stack pointer to %B 885 | store %cell.ptr %SP.addr.incr.ptr.ALU_ADD, %cell.ptr* %SP.ptr.ptr 886 | 887 | br label %kernel.NEXT 888 | 889 | kernel.ALU_SUB: 890 | ; load the memory address that %SP.ptr.ptr resolves to 891 | ; bx pop 892 | ; ax pop 893 | ; bx push 894 | ; ax push 895 | %SP.ptr.ALU_SUB = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 896 | %SP.ALU_SUB = load %cell.ptr* %SP.ptr.ALU_SUB 897 | %SP.addr.ptr.ALU_SUB = getelementptr %cell.ptr %SP.ALU_SUB, i32 0 898 | %SP.addr.int.ALU_SUB = ptrtoint %cell.ptr %SP.addr.ptr.ALU_SUB to %addr 899 | 900 | %A.cell.ALU_SUB = load %cell* %SP.addr.ptr.ALU_SUB 901 | 902 | %SP.addr.incr.int.ALU_SUB = add %addr %SP.addr.int.ALU_SUB, 8 903 | %SP.addr.incr.ptr.ALU_SUB = inttoptr %addr %SP.addr.incr.int.ALU_SUB 904 | to %cell.ptr 905 | 906 | %B.cell.ALU_SUB = load %cell* %SP.addr.incr.ptr.ALU_SUB 907 | 908 | ; do our actual operation and store it at the stack position for %B 909 | %DATA.cell.ALU_SUB = sub %cell %B.cell.ALU_SUB, %A.cell.ALU_SUB 910 | store %cell %DATA.cell.ALU_SUB, %cell* %SP.addr.incr.ptr.ALU_SUB 911 | 912 | ; move the stack pointer to %B 913 | store %cell.ptr %SP.addr.incr.ptr.ALU_SUB, %cell.ptr* %SP.ptr.ptr 914 | 915 | br label %kernel.NEXT 916 | 917 | 918 | kernel.ALU_MUL: 919 | ; load the memory address that %SP.ptr.ptr resolves to 920 | ; bx pop 921 | ; ax pop 922 | ; bx push 923 | ; ax push 924 | %SP.ptr.ALU_MUL = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 925 | %SP.ALU_MUL = load %cell.ptr* %SP.ptr.ALU_MUL 926 | %SP.addr.ptr.ALU_MUL = getelementptr %cell.ptr %SP.ALU_MUL, i32 0 927 | %SP.addr.int.ALU_MUL = ptrtoint %cell.ptr %SP.addr.ptr.ALU_MUL to %addr 928 | 929 | %A.cell.ALU_MUL = load %cell* %SP.addr.ptr.ALU_MUL 930 | 931 | %SP.addr.incr.int.ALU_MUL = add %addr %SP.addr.int.ALU_MUL, 8 932 | %SP.addr.incr.ptr.ALU_MUL = inttoptr %addr %SP.addr.incr.int.ALU_MUL 933 | to %cell.ptr 934 | 935 | %B.cell.ALU_MUL = load %cell* %SP.addr.incr.ptr.ALU_MUL 936 | 937 | ; do our actual operation and store it at the stack position for %B 938 | %DATA.cell.ALU_MUL = mul %cell %A.cell.ALU_MUL, %B.cell.ALU_MUL 939 | store %cell %DATA.cell.ALU_MUL, %cell* %SP.addr.incr.ptr.ALU_MUL 940 | 941 | ; move the stack pointer to %B 942 | store %cell.ptr %SP.addr.incr.ptr.ALU_MUL, %cell.ptr* %SP.ptr.ptr 943 | 944 | br label %kernel.NEXT 945 | 946 | 947 | kernel.ALU_DIV: 948 | ; load the memory address that %SP.ptr.ptr resolves to 949 | ; bx pop 950 | ; ax pop 951 | ; bx push 952 | ; ax push 953 | %SP.ptr.ALU_DIV = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 954 | %SP.ALU_DIV = load %cell.ptr* %SP.ptr.ALU_DIV 955 | %SP.addr.ptr.ALU_DIV = getelementptr %cell.ptr %SP.ALU_DIV, i32 0 956 | %SP.addr.int.ALU_DIV = ptrtoint %cell.ptr %SP.addr.ptr.ALU_DIV to %addr 957 | 958 | %A.cell.ALU_DIV = load %cell* %SP.addr.ptr.ALU_DIV 959 | 960 | %SP.addr.incr.int.ALU_DIV = add %addr %SP.addr.int.ALU_DIV, 8 961 | %SP.addr.incr.ptr.ALU_DIV = inttoptr %addr %SP.addr.incr.int.ALU_DIV 962 | to %cell.ptr 963 | 964 | %B.cell.ALU_DIV = load %cell* %SP.addr.incr.ptr.ALU_DIV 965 | 966 | ; do our actual operation and store it at the stack position for %B 967 | %DATA.cell.ALU_DIV = sdiv %cell %B.cell.ALU_DIV, %A.cell.ALU_DIV 968 | store %cell %DATA.cell.ALU_DIV, %cell* %SP.addr.incr.ptr.ALU_DIV 969 | 970 | ; move the stack pointer to %B 971 | store %cell.ptr %SP.addr.incr.ptr.ALU_DIV, %cell.ptr* %SP.ptr.ptr 972 | 973 | br label %kernel.NEXT 974 | 975 | 976 | kernel.ALU_CHAR_SUB: 977 | ; decrement the number at the top of the stack by the width of a cell 978 | %SP.ptr.ALU_CHAR_SUB = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 979 | %SP.ALU_CHAR_SUB = load %cell.ptr* %SP.ptr.ALU_CHAR_SUB 980 | %SP.addr.ptr.ALU_CHAR_SUB = getelementptr %cell.ptr %SP.ALU_CHAR_SUB, i32 0 981 | %SP.addr.int.ALU_CHAR_SUB = ptrtoint %cell.ptr %SP.addr.ptr.ALU_CHAR_SUB 982 | to %addr 983 | 984 | %A.cell.ALU_CHAR_SUB = load %cell* %SP.addr.ptr.ALU_CHAR_SUB 985 | %DATA.cell.ALU_CHAR_SUB = sub %cell %A.cell.ALU_CHAR_SUB, 1 986 | store %cell %DATA.cell.ALU_CHAR_SUB, %cell* %SP.addr.ptr.ALU_CHAR_SUB 987 | 988 | br label %kernel.NEXT 989 | 990 | 991 | kernel.ALU_CHAR_PLUS: 992 | ; decrement the number at the top of the stack by the width of a cell 993 | %SP.ptr.ALU_CHAR_PLUS = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 994 | %SP.ALU_CHAR_PLUS = load %cell.ptr* %SP.ptr.ALU_CHAR_PLUS 995 | %SP.addr.ptr.ALU_CHAR_PLUS = getelementptr %cell.ptr %SP.ALU_CHAR_PLUS, i32 0 996 | %SP.addr.int.ALU_CHAR_PLUS = ptrtoint %cell.ptr %SP.addr.ptr.ALU_CHAR_PLUS 997 | to %addr 998 | 999 | %A.cell.ALU_CHAR_PLUS = load %cell* %SP.addr.ptr.ALU_CHAR_PLUS 1000 | %DATA.cell.ALU_CHAR_PLUS = add %cell %A.cell.ALU_CHAR_PLUS, 1 1001 | store %cell %DATA.cell.ALU_CHAR_PLUS, %cell* %SP.addr.ptr.ALU_CHAR_PLUS 1002 | 1003 | br label %kernel.NEXT 1004 | 1005 | 1006 | kernel.ALU_CHARS: 1007 | ; no-op at present, as multiplying by 1 does nothing 1008 | 1009 | br label %kernel.NEXT 1010 | 1011 | 1012 | kernel.ALU_CELL_SUB: 1013 | ; decrement the number at the top of the stack by the width of a cell 1014 | %SP.ptr.ALU_CELL_SUB = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1015 | %SP.ALU_CELL_SUB = load %cell.ptr* %SP.ptr.ALU_CELL_SUB 1016 | %SP.addr.ptr.ALU_CELL_SUB = getelementptr %cell.ptr %SP.ALU_CELL_SUB, i32 0 1017 | %SP.addr.int.ALU_CELL_SUB = ptrtoint %cell.ptr %SP.addr.ptr.ALU_CELL_SUB 1018 | to %addr 1019 | 1020 | %A.cell.ALU_CELL_SUB = load %cell* %SP.addr.ptr.ALU_CELL_SUB 1021 | %DATA.cell.ALU_CELL_SUB = sub %cell %A.cell.ALU_CELL_SUB, 8 1022 | store %cell %DATA.cell.ALU_CELL_SUB, %cell* %SP.addr.ptr.ALU_CELL_SUB 1023 | 1024 | br label %kernel.NEXT 1025 | 1026 | 1027 | kernel.ALU_CELL_PLUS: 1028 | ; decrement the number at the top of the stack by the width of a cell 1029 | %SP.ptr.ALU_CELL_PLUS = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1030 | %SP.ALU_CELL_PLUS = load %cell.ptr* %SP.ptr.ALU_CELL_PLUS 1031 | %SP.addr.ptr.ALU_CELL_PLUS = getelementptr %cell.ptr %SP.ALU_CELL_PLUS, 1032 | i32 0 1033 | %SP.addr.int.ALU_CELL_PLUS = ptrtoint %cell.ptr %SP.addr.ptr.ALU_CELL_PLUS 1034 | to %addr 1035 | 1036 | %A.cell.ALU_CELL_PLUS = load %cell* %SP.addr.ptr.ALU_CELL_PLUS 1037 | %DATA.cell.ALU_CELL_PLUS = add %cell %A.cell.ALU_CELL_PLUS, 8 1038 | store %cell %DATA.cell.ALU_CELL_PLUS, %cell* %SP.addr.ptr.ALU_CELL_PLUS 1039 | 1040 | br label %kernel.NEXT 1041 | 1042 | 1043 | kernel.ALU_CELLS: 1044 | ; decrement the number at the top of the stack by the width of a cell 1045 | %SP.ptr.ALU_CELLS = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1046 | %SP.ALU_CELLS = load %cell.ptr* %SP.ptr.ALU_CELLS 1047 | %SP.addr.ptr.ALU_CELLS = getelementptr %cell.ptr %SP.ALU_CELLS, i32 0 1048 | %SP.addr.int.ALU_CELLS = ptrtoint %cell.ptr %SP.addr.ptr.ALU_CELLS 1049 | to %addr 1050 | 1051 | %A.cell.ALU_CELLS = load %cell* %SP.addr.ptr.ALU_CELLS 1052 | %DATA.cell.ALU_CELLS = mul %cell %A.cell.ALU_CELLS, 8 1053 | store %cell %DATA.cell.ALU_CELLS, %cell* %SP.addr.ptr.ALU_CELLS 1054 | 1055 | br label %kernel.NEXT 1056 | 1057 | 1058 | kernel.ALU_GTZ: 1059 | ; decrement the number at the top of the stack by the width of a cell 1060 | %SP.ptr.ALU_GTZ = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1061 | %SP.ALU_GTZ = load %cell.ptr* %SP.ptr.ALU_GTZ 1062 | %SP.addr.ptr.ALU_GTZ = getelementptr %cell.ptr %SP.ALU_GTZ, i32 0 1063 | %SP.addr.int.ALU_GTZ = ptrtoint %cell.ptr %SP.addr.ptr.ALU_GTZ 1064 | to %addr 1065 | 1066 | %A.cell.ALU_GTZ = load %cell* %SP.addr.ptr.ALU_GTZ 1067 | %DATA.flag.ALU_GTZ = icmp sgt %cell %A.cell.ALU_GTZ, 0 1068 | %DATA.int.ALU_GTZ = zext i1 %DATA.flag.ALU_GTZ to %int 1069 | 1070 | store %cell %DATA.int.ALU_GTZ, %cell* %SP.addr.ptr.ALU_GTZ 1071 | 1072 | br label %kernel.NEXT 1073 | 1074 | 1075 | kernel.ALU_AND: 1076 | ; load the memory address that %SP.ptr.ptr resolves to 1077 | %SP.ptr.ALU_AND = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1078 | %SP.ALU_AND = load %cell.ptr* %SP.ptr.ALU_AND 1079 | %SP.addr.ptr.ALU_AND = getelementptr %cell.ptr %SP.ALU_AND, i32 0 1080 | %SP.addr.int.ALU_AND = ptrtoint %cell.ptr %SP.addr.ptr.ALU_AND to %addr 1081 | 1082 | %A.cell.ALU_AND = load %cell* %SP.addr.ptr.ALU_AND 1083 | 1084 | %SP.addr.incr.int.ALU_AND = add %addr %SP.addr.int.ALU_AND, 8 1085 | %SP.addr.incr.ptr.ALU_AND = inttoptr %addr %SP.addr.incr.int.ALU_AND 1086 | to %cell.ptr 1087 | 1088 | %B.cell.ALU_AND = load %cell* %SP.addr.incr.ptr.ALU_AND 1089 | 1090 | ; do our actual operation and store it at the stack position for %B 1091 | %DATA.cell.ALU_AND = and %cell %A.cell.ALU_AND, %B.cell.ALU_AND 1092 | store %cell %DATA.cell.ALU_AND, %cell* %SP.addr.incr.ptr.ALU_AND 1093 | 1094 | ; move the stack pointer to %B 1095 | store %cell.ptr %SP.addr.incr.ptr.ALU_AND, %cell.ptr* %SP.ptr.ptr 1096 | 1097 | br label %kernel.NEXT 1098 | 1099 | 1100 | kernel.ALU_OR: 1101 | ; load the memory address that %SP.ptr.ptr resolves to 1102 | ; bx pop 1103 | ; ax pop 1104 | ; bx push 1105 | ; ax push 1106 | %SP.ptr.ALU_OR = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1107 | %SP.ALU_OR = load %cell.ptr* %SP.ptr.ALU_OR 1108 | %SP.addr.ptr.ALU_OR = getelementptr %cell.ptr %SP.ALU_OR, i32 0 1109 | %SP.addr.int.ALU_OR = ptrtoint %cell.ptr %SP.addr.ptr.ALU_OR to %addr 1110 | 1111 | %A.cell.ALU_OR = load %cell* %SP.addr.ptr.ALU_OR 1112 | 1113 | %SP.addr.incr.int.ALU_OR = add %addr %SP.addr.int.ALU_OR, 8 1114 | %SP.addr.incr.ptr.ALU_OR = inttoptr %addr %SP.addr.incr.int.ALU_OR 1115 | to %cell.ptr 1116 | 1117 | %B.cell.ALU_OR = load %cell* %SP.addr.incr.ptr.ALU_OR 1118 | 1119 | ; do our actual operation and store it at the stack position for %B 1120 | %DATA.cell.ALU_OR = or %cell %A.cell.ALU_OR, %B.cell.ALU_OR 1121 | store %cell %DATA.cell.ALU_OR, %cell* %SP.addr.incr.ptr.ALU_OR 1122 | 1123 | ; move the stack pointer to %B 1124 | store %cell.ptr %SP.addr.incr.ptr.ALU_OR, %cell.ptr* %SP.ptr.ptr 1125 | 1126 | br label %kernel.NEXT 1127 | 1128 | 1129 | kernel.ALU_XOR: 1130 | ; load the memory address that %SP.ptr.ptr resolves to 1131 | ; bx pop 1132 | ; ax pop 1133 | ; bx push 1134 | ; ax push 1135 | %SP.ptr.ALU_XOR = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1136 | %SP.ALU_XOR = load %cell.ptr* %SP.ptr.ALU_XOR 1137 | %SP.addr.ptr.ALU_XOR = getelementptr %cell.ptr %SP.ALU_XOR, i32 0 1138 | %SP.addr.int.ALU_XOR = ptrtoint %cell.ptr %SP.addr.ptr.ALU_XOR to %addr 1139 | 1140 | %A.cell.ALU_XOR = load %cell* %SP.addr.ptr.ALU_XOR 1141 | 1142 | %SP.addr.incr.int.ALU_XOR = add %addr %SP.addr.int.ALU_XOR, 8 1143 | %SP.addr.incr.ptr.ALU_XOR = inttoptr %addr %SP.addr.incr.int.ALU_XOR 1144 | to %cell.ptr 1145 | 1146 | %B.cell.ALU_XOR = load %cell* %SP.addr.incr.ptr.ALU_XOR 1147 | 1148 | ; do our actual operation and store it at the stack position for %B 1149 | %DATA.cell.ALU_XOR = xor %cell %A.cell.ALU_XOR, %B.cell.ALU_XOR 1150 | store %cell %DATA.cell.ALU_XOR, %cell* %SP.addr.incr.ptr.ALU_XOR 1151 | 1152 | ; move the stack pointer to %B 1153 | store %cell.ptr %SP.addr.incr.ptr.ALU_XOR, %cell.ptr* %SP.ptr.ptr 1154 | 1155 | br label %kernel.NEXT 1156 | 1157 | kernel.DONE: 1158 | ret void 1159 | } 1160 | 1161 | ; *** dictionary functions 1162 | ; 1163 | ; The dictionary is a linked list, where the global dictionary pointer points 1164 | ; at the last word in the dictionary. Each dictionary entry %WORD is defined 1165 | ; as such: 1166 | ; 1167 | ; { %WORD*, %FNPTR, i1, i8* } 1168 | ; 1169 | ; * %WORD* is a pointer to the previous word in the dictionary 1170 | ; * %FNPTR* is a pointer to the function associated with this word 1171 | ; * i1 is a flag as to if this is a CODEWORD or a DOCOL word 1172 | ; * i8* is a pointer to a null terminated string that contains the string 1173 | ; representation of the word. 1174 | ; 1175 | ; In other words, it is: 1176 | ; +--------------------------+---------------------+---+--------+ 1177 | ; | pointer to previous word | pointer to assembly | F | name | 1178 | ; +--------------------------+---------------------+---+--------+ 1179 | ; 1180 | ; So, an example dictionary would look like: 1181 | ; 1182 | ; null - terminates dictionary 1183 | ; ^ 1184 | ; | 1185 | ; +--------|-------------+--------------------------+---+------+ 1186 | ; | pointer to null | pointer to .S DOCOL | 0 | .s | 1187 | ; +----------------------+--------------------------+---+------+ 1188 | ; ^ 1189 | ; | 1190 | ; +--------|-------------+--------------------------+---+------+ 1191 | ; | pointer to DISPSTACK | pointer to @DIV fn | 1 | / | 1192 | ; +----------------------+--------------------------+---+------+ 1193 | ; ^ 1194 | ; | 1195 | ; +--------|-------------+--------------------------+---+------+ 1196 | ; | pointer to DIV | pointer to @MUL fn | 1 | * | 1197 | ; +----------------------+--------------------------+---+------+ 1198 | ; ^ 1199 | ; | 1200 | ; | 1201 | ; @dictPtr* 1202 | ; 1203 | ; This arrangement allows Forth to redefine a word without overriding an 1204 | ; already compiled reference to the word. Once the redefinition is done with, 1205 | ; it can then be FORGOT -- restoring the original definition. This allows 1206 | ; for some very powerful redefinitions of functions for current contexts. 1207 | 1208 | define void @registerDictionary(i8* %wordString, %WORD* %newDictEntry, 1209 | i1 %wordType, i8** %wordPtr) { 1210 | %dictPtr = load %WORD** @dictPtr 1211 | 1212 | %newDictEntry.prevEntry = getelementptr %WORD* %newDictEntry, i32 0, i32 0 1213 | %newDictEntry.wordPtr = getelementptr %WORD* %newDictEntry, i32 0, i32 1 1214 | %newDictEntry.wordType = getelementptr %WORD* %newDictEntry, i32 0, i32 2 1215 | %newDictEntry.wordString = getelementptr %WORD* %newDictEntry, i32 0, i32 3 1216 | %wordPtr.int.ptr = load i8** %wordPtr 1217 | %wordPtr.int = ptrtoint i8* %wordPtr.int.ptr to %int 1218 | 1219 | store %WORD* %dictPtr, %WORD** %newDictEntry.prevEntry 1220 | store %int %wordPtr.int, %int* %newDictEntry.wordPtr 1221 | store i1 %wordType, i1* %newDictEntry.wordType 1222 | store i8* %wordString, i8** %newDictEntry.wordString 1223 | 1224 | ; move our dictionary pointer to the newly defined word, the new tail 1225 | store %WORD* %newDictEntry, %WORD** @dictPtr 1226 | 1227 | ret void 1228 | } 1229 | 1230 | define void @printDictionary() { 1231 | ; c"--> %s (%llu) \00" 1232 | %dictNavString.ptr = getelementptr [15 x i8]* @dictNavString, i32 0, i32 0 1233 | 1234 | ; load the last word that the dictionary pointer references into %currWord 1235 | %dict.ptr = load %WORD** @dictPtr 1236 | %dictWord.ptr = getelementptr %WORD* %dict.ptr, i32 0 1237 | %dictWord.value = load %WORD* %dictWord.ptr 1238 | %currWord.ptr = alloca %WORD 1239 | store %WORD %dictWord.value, %WORD* %currWord.ptr 1240 | 1241 | br label %begin 1242 | begin: 1243 | ; check if we've hit a null pointer; if we have, we're done. 1244 | %is_null.flag = icmp eq %WORD* %currWord.ptr, null 1245 | br i1 %is_null.flag, label %done, label %printWord 1246 | printWord: 1247 | ; derefernce our current word pointer and then our string 1248 | %currWord.wordString.ptr.ptr = getelementptr %WORD* %currWord.ptr, 1249 | i32 0, i32 3 1250 | %currWord.wordString.ptr = load i8** %currWord.wordString.ptr.ptr 1251 | 1252 | ; obtain our function pointer, dereference it, and conver the pointer to 1253 | ; an int for human representation 1254 | %forthFn.ptr.ptr = getelementptr %WORD* %currWord.ptr, i32 0, i32 1 1255 | %forthFn.ptr.int = load %int* %forthFn.ptr.ptr 1256 | ;%forthFn.ptr.int = ptrtoint %FNPTR %forthFn.ptr to %int 1257 | 1258 | ; print our pretty dictionary order 1259 | %printf_ret = call i32 (i8*, ... )* @printf(i8* %dictNavString.ptr, 1260 | i8* %currWord.wordString.ptr, 1261 | %cell %forthFn.ptr.int) 1262 | 1263 | ; advance to the next definition 1264 | %nextWord.ptr.ptr = getelementptr %WORD* %currWord.ptr, i32 0, i32 0 1265 | %nextWord.ptr = load %WORD** %nextWord.ptr.ptr 1266 | 1267 | ; check if we've hit the end of our dictionary 1268 | %is_next_null.flag = icmp eq %WORD* %nextWord.ptr, null 1269 | br i1 %is_next_null.flag, label %done, label %continueSetup 1270 | continueSetup: 1271 | ; store our next dictionary word into our current working word 1272 | %nextWord = load %WORD* %nextWord.ptr 1273 | store %WORD %nextWord, %WORD* %currWord.ptr 1274 | br label %begin 1275 | done: 1276 | ; clean up by outputting a new line before returning 1277 | call void @outputNewLine() 1278 | ret void 1279 | 1280 | } 1281 | 1282 | define %WORD.fntype @lookupDictionary(i8* %wordString) { 1283 | ; c"TOKEN:\00" 1284 | %tokenString.ptr = getelementptr [ 7 x i8 ]* @tokenString, i32 0 1285 | %tokenString.i8.ptr = bitcast [ 7 x i8 ]* %tokenString.ptr to i8* 1286 | ; c"DICT:\00" 1287 | %dictString.ptr = getelementptr [ 6 x i8 ]* @dictString, i32 0 1288 | %dictString.i8.ptr = bitcast [ 6 x i8 ]* %dictString.ptr to i8* 1289 | 1290 | ; allocate our current index in the two words that we compare 1291 | %charIdx.ptr = alloca i32 1292 | 1293 | ; setup with the tail end of our dictionary 1294 | %tailDictPtr.ptr = load %WORD** @dictPtr 1295 | %dictWord.ptr = getelementptr %WORD* %tailDictPtr.ptr, i32 0 1296 | %dictWord.value = load %WORD* %dictWord.ptr 1297 | 1298 | ; copy our current dictWord into a local working space 1299 | %currDictWord.ptr = alloca %WORD 1300 | store %WORD %dictWord.value, %WORD* %currDictWord.ptr 1301 | 1302 | br label %begin 1303 | 1304 | begin: 1305 | ; first, we check if we've reached the end of our dictionary chain, which 1306 | ; would be a null pointer at the first definition 1307 | %is_null = icmp eq %WORD* %currDictWord.ptr, null 1308 | br i1 %is_null, label %notFound, label %checkWord 1309 | checkWord: 1310 | ; reset our word character index to 0 as we're checking a new definition 1311 | store i32 0, i32* %charIdx.ptr 1312 | 1313 | ; grab the pointer to the string representation of our current dict entry 1314 | %dictWord.wordString.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 1315 | i32 0, i32 3 1316 | %dictWord.wordString.ptr = load i8** %dictWord.wordString.ptr.ptr 1317 | 1318 | ; begin our string comparison block 1319 | br label %compChar 1320 | compChar: 1321 | %charIdx.value = load i32* %charIdx.ptr 1322 | ; set up our current character from the dictionary word string 1323 | %dict.char.ptr = getelementptr i8* %dictWord.wordString.ptr, 1324 | i32 %charIdx.value 1325 | %dict.char = load i8* %dict.char.ptr 1326 | ; set up our current character from the target string we're working with 1327 | %wstr.char.ptr = getelementptr i8* %wordString, 1328 | i32 %charIdx.value 1329 | %wstr.char = load i8* %wstr.char.ptr 1330 | 1331 | ; show the user the current characters we're looking at 1332 | ;call void @printTwoString( i8* %dictString.i8.ptr, i8* %dict.charPtr ) 1333 | ;call void @printTwoString( i8* %tokenString.i8.ptr, i8* %wstr.charPtr ) 1334 | 1335 | ; check if we're looking at a null terminator in either case 1336 | %dict.is_null.flag = icmp eq i8 %dict.char, 0 1337 | %wstr.is_null.flag = icmp eq i8 %wstr.char, 0 1338 | 1339 | ; if both are null characters, we've hit the end of both strings without 1340 | ; a mismatch and have successfully found a match 1341 | %is_match.flag = and i1 %dict.is_null.flag, %wstr.is_null.flag 1342 | br i1 %is_match.flag, label %foundDefn, label %checkNull 1343 | checkNull: 1344 | ; if either and not both are null characters, we've reached the end of one 1345 | ; string -- the beginning is a substring of the other, but it's not a match 1346 | %hit_null.flag = or i1 %dict.is_null.flag, %wstr.is_null.flag 1347 | br i1 %hit_null.flag, label %nextWord, label %checkChar 1348 | checkChar: 1349 | ; then finally, we check if the two characters are the same; if not, we 1350 | ; abandon the current definition, and advance to the next word in the 1351 | ; dictionary. if they are the same, we move on to the next character 1352 | %is_same.flag = icmp eq i8 %wstr.char, %dict.char 1353 | br i1 %is_same.flag, label %nextChar, label %nextWord 1354 | nextChar: 1355 | ; increment the character index and start our loop again 1356 | %newCharIdx.value = add i32 %charIdx.value, 1 1357 | store i32 %newCharIdx.value, i32* %charIdx.ptr 1358 | br label %compChar 1359 | nextWord: 1360 | ; advance to the next word by looking up the current word's pointer to 1361 | ; the next 1362 | %nextDictWord.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, 1363 | i32 0, i32 0 1364 | %nextDictWord.ptr = load %WORD** %nextDictWord.ptr.ptr 1365 | 1366 | ; we check if the next word's pointer is null -- if it is, we've reached 1367 | ; the end of the dictionary with no match 1368 | %is_next_null.flag = icmp eq %WORD* %nextDictWord.ptr, null 1369 | br i1 %is_next_null.flag, label %notFound, label %finishNextWord 1370 | finishNextWord: 1371 | ; grab the next word and copy it into our current working word 1372 | %nextDictWord.value = load %WORD* %nextDictWord.ptr 1373 | store %WORD %nextDictWord.value, %WORD* %currDictWord.ptr 1374 | ; begin the loop all over again 1375 | br label %begin 1376 | foundDefn: 1377 | ; get the pointer to our function and return it to the caller 1378 | %forthFn.ptr.ptr = getelementptr %WORD* %currDictWord.ptr, i32 0, i32 1 1379 | %forthFn.ptr.int = load %cell* %forthFn.ptr.ptr 1380 | %forthKernel.ptr = inttoptr %cell %forthFn.ptr.int to %cell* 1381 | 1382 | ; whether we're a codeword or a docol word 1383 | %codewordFlag.ptr = getelementptr %WORD* %currDictWord.ptr, i32 0, i32 2 1384 | %codewordFlag.int = load i1* %codewordFlag.ptr 1385 | 1386 | %returnValue = alloca %WORD.fntype 1387 | %returnValue.addr.ptr = getelementptr %WORD.fntype* %returnValue, 1388 | i32 0, i32 0 1389 | %returnValue.flag.ptr.ptr = getelementptr %WORD.fntype* %returnValue, 1390 | i32 0, i32 1 1391 | %returnValue.flag.ptr = getelementptr i1* %returnValue.flag.ptr.ptr, 1392 | i32 0 1393 | store %cell.ptr %forthKernel.ptr, %cell.ptr* %returnValue.addr.ptr 1394 | store i1 %codewordFlag.int, i1* %returnValue.flag.ptr 1395 | %returnValue.value = load %WORD.fntype* %returnValue 1396 | ret %WORD.fntype %returnValue.value 1397 | 1398 | notFound: 1399 | ; we didn't find anything, so we return null 1400 | %returnValue.nf = alloca %WORD.fntype 1401 | %returnValue.addr.ptr.nf = getelementptr %WORD.fntype* %returnValue.nf, 1402 | i32 0, i32 0 1403 | store %cell.ptr null, %cell.ptr* %returnValue.addr.ptr.nf 1404 | %returnValue.value.nf = load %WORD.fntype* %returnValue.nf 1405 | ret %WORD.fntype %returnValue.value.nf 1406 | } 1407 | 1408 | ; **************************************************************************** 1409 | ; interpreter/compiler -- written in LLVM IR for now until we get enough Forth 1410 | ; implemented to write it in Forth 1411 | ; **************************************************************************** 1412 | 1413 | define void @interpret(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1414 | %ret.ptr* %RSP.ptr.ptr, %int* %progStr.addr.ptr) { 1415 | ; c"PROGRAM:\00" 1416 | %progOutString.ptr = getelementptr [7 x i8]* @progOutString, i32 0, i32 0 1417 | ; c"COMPILED:\00" 1418 | %compiledString.ptr = getelementptr [10 x i8]* @compiledString, i32 0, i32 0 1419 | ; c"COMPILED: LITERAL\00" 1420 | %compLitString.ptr = getelementptr [18 x i8]* @compLitString, i32 0, i32 0 1421 | ; c"EXECUTED:\00" 1422 | %executedString.ptr = getelementptr [10 x i8]* @executedString, i32 0, i32 0 1423 | ; c"EXECUTED: LITERAL\00" 1424 | %execLitString.ptr = getelementptr [18 x i8]* @execLitString, i32 0, i32 0 1425 | 1426 | ; c"CHAR:\00" 1427 | %charString.ptr = getelementptr [6 x i8]* @charString, i32 0, i32 0 1428 | 1429 | %progStrIdx.ptr = alloca i32 ; where we are in the program string 1430 | %beginCurrToken.ptr = alloca i32 ; where the current token begins 1431 | %currChr.ptr = alloca i8 ; a pointer to the current character 1432 | %currHeapIdx.ptr = alloca %int ; where in the heap we insert our token 1433 | %iHeap.ptr = alloca %cell*, i32 256 ; our interpret/compile buffer 1434 | %DATA.ptr = alloca %cell ; our local data register 1435 | 1436 | ; obtain and compute our program address 1437 | %progStrIdx.int = load %int* %progStr.addr.ptr 1438 | %programString.ptr = inttoptr %int %progStrIdx.int to i8* 1439 | 1440 | ; we start at the beginning of the program string 1441 | store i32 0, i32* %progStrIdx.ptr 1442 | ; initialize our local heap index pointer 1443 | %currHeapIdx.int = ptrtoint %cell.ptr* %iHeap.ptr to %cell 1444 | store %int %currHeapIdx.int, %int* %currHeapIdx.ptr 1445 | 1446 | ; show the user what we're working with 1447 | call void @printTwoString(i8* %progOutString.ptr, i8* %programString.ptr) 1448 | 1449 | ; begin the whole process 1450 | br label %beginToken 1451 | 1452 | beginToken: 1453 | ; load our current compile/immediate state 1454 | %STATE = load i1* @STATE 1455 | 1456 | ; grab our current program string index to work with 1457 | %progStrIdx.value = load i32* %progStrIdx.ptr 1458 | 1459 | ; mark this as the beginning of our new token 1460 | store i32 %progStrIdx.value, i32* %beginCurrToken.ptr 1461 | 1462 | ; resolve the programString pointer and index, and obtain our current char 1463 | %currChr.ptr.beginToken = getelementptr i8* %programString.ptr, 1464 | i32 %progStrIdx.value 1465 | %currChr.value.beginToken = load i8* %currChr.ptr.beginToken 1466 | store i8 %currChr.value.beginToken, i8* %currChr.ptr 1467 | 1468 | ; check if we're a null byte and branch accordingly; null byte terminates 1469 | %is_null.flag = icmp eq i8 %currChr.value.beginToken, 0 1470 | br i1 %is_null.flag, label %done, label %scanSpace 1471 | 1472 | scanSpace: 1473 | ; debug call to show what character we're looking at 1474 | ;call void @printTwoString(i8* %charString.ptr, i8* %currChr.ptr) 1475 | 1476 | %currChr.value = load i8* %currChr.ptr 1477 | ; check if we're a space 1478 | %is_space.flag = icmp eq i8 %currChr.value, 32 1479 | ; also check if we're a null character 1480 | %is_null.flag.scanSpace = icmp eq i8 %currChr.value, 0 1481 | ; if we're a null character or a space, we terminate our token 1482 | %is_token.flag = or i1 %is_space.flag, %is_null.flag.scanSpace 1483 | br i1 %is_token.flag, label %handleToken, label %nextChr 1484 | 1485 | nextChr: 1486 | ; advance the program pointer and set up the character for the next pass 1487 | %progStrIdx.value.nextChr = load i32* %progStrIdx.ptr 1488 | %nextProgStrIdx.value = add i32 %progStrIdx.value.nextChr, 1 1489 | store i32 %nextProgStrIdx.value, i32* %progStrIdx.ptr 1490 | ; grab our current character from programString and store it 1491 | %currChr.ptr.nextChr = getelementptr i8* %programString.ptr, 1492 | i32 %nextProgStrIdx.value 1493 | %currChr.value.nextChr = load i8* %currChr.ptr.nextChr 1494 | store i8 %currChr.value.nextChr, i8* %currChr.ptr 1495 | ; evaluate our new current character 1496 | br label %scanSpace 1497 | 1498 | handleToken: 1499 | ; compute and acquire the beginning and the end of the token 1500 | %progStrIdx.value.handleToken = load i32* %progStrIdx.ptr 1501 | ; the end of our current token is our current program string index 1502 | %endCurrToken.ptr = alloca i32 1503 | store i32 %progStrIdx.value.handleToken, i32* %endCurrToken.ptr 1504 | %endCurrToken.value = load i32* %endCurrToken.ptr 1505 | %beginCurrToken.value = load i32* %beginCurrToken.ptr 1506 | %tokenLength.value = sub i32 %endCurrToken.value, %beginCurrToken.value 1507 | ; we include the null byte for our new token string 1508 | %tokenLengthPad.value = add i32 %tokenLength.value, 1 1509 | ; get pointer to beginning of our token in the program string 1510 | %currTokenBegin.ptr = getelementptr i8* %programString.ptr, 1511 | i32 %beginCurrToken.value 1512 | 1513 | ; copy the token string in question from the program string source 1514 | %currToken.ptr = alloca i8, i32 %tokenLengthPad.value 1515 | call void @llvm.memcpy.p0i8.p0i8.i32(i8* %currToken.ptr, 1516 | i8* %currTokenBegin.ptr, 1517 | i32 %tokenLength.value, i32 0, i1 0) 1518 | 1519 | 1520 | ; add a null byte at the end to make it a null terminated string 1521 | %nullLocation.ptr = getelementptr i8* %currToken.ptr, 1522 | i32 %tokenLength.value 1523 | store i8 00, i8* %nullLocation.ptr 1524 | 1525 | ; call void @printTwoString(i8* %charString.ptr, i8* %currToken.ptr) 1526 | 1527 | ; lookup our token in the dictionary 1528 | %forthFn = call %WORD.fntype @lookupDictionary(i8* %currToken.ptr) 1529 | %forthFn.ptr = extractvalue %WORD.fntype %forthFn, 0 1530 | %forthFn.flag = extractvalue %WORD.fntype %forthFn, 1 1531 | 1532 | ; load our current heap index for inserting a pointer or a literal 1533 | %currHeapIdx.value = load %int* %currHeapIdx.ptr 1534 | 1535 | ; check if we have a function pointer, or a null pointer 1536 | %is_fnPtr_null = icmp eq %cell.ptr %forthFn.ptr, null 1537 | br i1 %is_fnPtr_null, label %checkLiteral, label %handleFn 1538 | 1539 | handleFn: 1540 | br i1 %STATE, label %compileFn, label %immediateFn 1541 | 1542 | compileFn: 1543 | ; insert our function pointer into our heap 1544 | call fastcc void @insertToken(%int %currHeapIdx.value, %cell.ptr %forthFn.ptr) 1545 | 1546 | ; advance our local heap index now that we've inserted a token 1547 | %newHeapIdx.value = add %int %currHeapIdx.value, 8 1548 | store %int %newHeapIdx.value, %int* %currHeapIdx.ptr 1549 | 1550 | ; show that we've 'compiled' a token 1551 | call void @printTwoString(i8* %compiledString.ptr, i8* %currToken.ptr) 1552 | 1553 | ; all done with the token, let's move on 1554 | br label %checkTokenEndNull 1555 | 1556 | immediateFn: 1557 | ; insert our token to immediately evaluate 1558 | call fastcc void @insertToken(%int %currHeapIdx.value, %cell.ptr %forthFn.ptr) 1559 | 1560 | ; terminate our token with DONE 1561 | %currHeapIdx.value.immediate = add %addr %currHeapIdx.value, 8 1562 | %DONE.addr.ptr.immediate = load i8** @kernel.DONE.addr 1563 | %DONE.addr.int.immediate = ptrtoint i8* %DONE.addr.ptr.immediate to %addr 1564 | call fastcc void @insertLiteral(%int %currHeapIdx.value.immediate, 1565 | %addr %DONE.addr.int.immediate) 1566 | 1567 | ; show that we've 'executed' a token 1568 | call void @printTwoString(i8* %executedString.ptr, i8* %currToken.ptr) 1569 | 1570 | ; set up and call the kernel on our token 1571 | %EIP.immediate.ptr = inttoptr %int %currHeapIdx.value to %addr* 1572 | store %addr* %EIP.immediate.ptr, %addr.ptr* %EIP.ptr.ptr 1573 | call void @kernel(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1574 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1575 | 1576 | br label %advanceIdx 1577 | 1578 | checkLiteral: 1579 | ; our current token was not found on the dictionary, so we interpret it 1580 | ; as a literal, insert LIT pointer into our execution stream and then 1581 | ; insert the literal there 1582 | 1583 | ; set up values for our literal parser 1584 | %literalInt.ptr = alloca %int 1585 | store %int 0, %pntr %literalInt.ptr 1586 | %tokenIdx.ptr = alloca %int 1587 | %currDigit.ptr = alloca %int 1588 | store %int 0, %pntr %currDigit.ptr 1589 | 1590 | ; initialize our positional multiplier with 1, the first rightmost digit 1591 | %posMultiplier.ptr = alloca %int 1592 | store %int 1, %pntr %posMultiplier.ptr 1593 | 1594 | ; we scan our literal right to left, so set our pointer to the end 1595 | %tokenLength.value.int = zext i32 %tokenLength.value to %int 1596 | %newTokenIdx.value = sub %int %tokenLength.value.int, 1 1597 | store %int %newTokenIdx.value, %pntr %tokenIdx.ptr 1598 | 1599 | br label %literalLoop 1600 | 1601 | literalLoop: 1602 | %tokenIdx.value = load %pntr %tokenIdx.ptr 1603 | %litChr.ptr = getelementptr i8* %currToken.ptr, %int %tokenIdx.value 1604 | %litChr.value = load i8* %litChr.ptr 1605 | 1606 | ; 0-9 is ASCII 48-57 -- check if we are within this 1607 | %is_less.flag = icmp ult i8 %litChr.value, 48 1608 | %is_more.flag = icmp ugt i8 %litChr.value, 57 1609 | %is_outside.flag = or i1 %is_less.flag, %is_more.flag 1610 | br i1 %is_outside.flag, label %invalidLiteral, label %validChar 1611 | 1612 | validChar: 1613 | ; we're within ASCII range 48-57, so subtract 48 to get our digit 1614 | %digit.value = sub i8 %litChr.value, 48 1615 | %digit.value.int = zext i8 %digit.value to %int 1616 | 1617 | ; get our current positional multiplier and multiply our digit by that 1618 | %posMultiplier.value = load %pntr %posMultiplier.ptr 1619 | %posValue.value = mul %int %digit.value.int, %posMultiplier.value 1620 | 1621 | ; add our positioned digit to our current running total 1622 | %literalInt.value = load %pntr %literalInt.ptr 1623 | %newLiteralInt.value = add %int %literalInt.value, %posValue.value 1624 | store %int %newLiteralInt.value, %pntr %literalInt.ptr 1625 | 1626 | ; if we're at the leftmost digit, we're done 1627 | %is_done.flag = icmp eq %int %tokenIdx.value, 0 1628 | br i1 %is_done.flag, label %insertLiteral, label %nextLitChr 1629 | 1630 | nextLitChr: 1631 | ; increase our multiplier with the new digit, multiplying by 10 1632 | %newPosMultiplier.value = mul %int %posMultiplier.value, 10 1633 | store %int %newPosMultiplier.value, %pntr %posMultiplier.ptr 1634 | 1635 | %nextLiteralIdx.value = sub %int %tokenIdx.value, 1 1636 | store %int %nextLiteralIdx.value, %pntr %tokenIdx.ptr 1637 | br label %literalLoop 1638 | 1639 | insertLiteral: 1640 | br i1 %STATE, label %insertLiteralHeap, label %insertLiteralStack 1641 | 1642 | insertLiteralStack: 1643 | ; copied from our @kernel.PUSH routine 1644 | ; load the memory address that %SP.ptr.ptr resolves to 1645 | %SP.ptr.SP_PUSH = getelementptr %cell.ptr* %SP.ptr.ptr, i32 0 1646 | %SP.SP_PUSH = load %cell.ptr* %SP.ptr.SP_PUSH 1647 | %SP.addr.ptr.SP_PUSH = getelementptr %cell.ptr %SP.SP_PUSH, i32 0 1648 | %SP.addr.int.SP_PUSH = ptrtoint %cell.ptr %SP.addr.ptr.SP_PUSH to %addr 1649 | 1650 | ; decrement our stack integer pointer, and store it in the register 1651 | %SP.addr.decr.int.SP_PUSH = sub %addr %SP.addr.int.SP_PUSH, 8 1652 | %SP.addr.decr.ptr.SP_PUSH = inttoptr %addr %SP.addr.decr.int.SP_PUSH 1653 | to %cell.ptr 1654 | store %cell.ptr %SP.addr.decr.ptr.SP_PUSH, %cell.ptr* %SP.ptr.ptr 1655 | 1656 | ; store our literal on the stack 1657 | store %cell %newLiteralInt.value, %addr* %SP.addr.decr.ptr.SP_PUSH 1658 | 1659 | ; report our new literal to the user 1660 | call void @printTwoString(i8* %execLitString.ptr, i8* %currToken.ptr) 1661 | 1662 | br label %checkTokenEndNull 1663 | 1664 | insertLiteralHeap: 1665 | ; insert our _LIT function into the heap 1666 | %_LIT.addr.ptr = load i8** @kernel.EXEC_DOLIT.addr 1667 | %_LIT.addr.int = ptrtoint i8* %_LIT.addr.ptr to %int 1668 | call fastcc void @insertLiteral(%int %currHeapIdx.value, 1669 | %int %_LIT.addr.int) 1670 | %newHeapIdx.value.insertLiteral = add %int %currHeapIdx.value, 8 1671 | 1672 | ; Now that we have our constructed literal, insert it into the heap 1673 | call fastcc void @insertLiteral(%int %newHeapIdx.value.insertLiteral, 1674 | %int %newLiteralInt.value) 1675 | 1676 | ; report our new literal to the user 1677 | call void @printTwoString(i8* %compLitString.ptr, i8* %currToken.ptr) 1678 | 1679 | ; Finally, increment and store our current heap pointer. 1680 | %storeHeapIdx.value = add %int %newHeapIdx.value.insertLiteral, 8 1681 | store %int %storeHeapIdx.value, %pntr %currHeapIdx.ptr 1682 | 1683 | br label %checkTokenEndNull 1684 | 1685 | checkTokenEndNull: 1686 | ; we check if the terminator on our current token is null, as that'stack 1687 | ; a string and compilation ending moment as well 1688 | %endTokenChr.ptr = getelementptr i8* %programString.ptr, 1689 | i32 %progStrIdx.value.handleToken 1690 | %endTokenChr.value = load i8* %endTokenChr.ptr 1691 | %is_chr_null.flag = icmp eq i8 %endTokenChr.value, 0 1692 | 1693 | br i1 %is_chr_null.flag, label %done, label %advanceIdx 1694 | 1695 | advanceIdx: 1696 | ; advance past the space we're hovering over at present 1697 | %nextProgStrIdx.value.advanceIdx = add i32 %progStrIdx.value.handleToken, 1 1698 | store i32 %nextProgStrIdx.value.advanceIdx, i32* %progStrIdx.ptr 1699 | 1700 | ; begin all over again 1701 | br label %beginToken 1702 | 1703 | invalidLiteral: 1704 | br label %done 1705 | 1706 | done: 1707 | %currHeapIdx.value.done = load %pntr %currHeapIdx.ptr 1708 | ;call void @printValueInt( %int %currHeapIdx.value.done ) 1709 | 1710 | ; clean up by terminating our compiled output with DONE 1711 | %DONE.addr.ptr = load i8** @kernel.DONE.addr 1712 | %DONE.addr.int = ptrtoint i8* %DONE.addr.ptr to %int 1713 | 1714 | call fastcc void @insertLiteral(%int %currHeapIdx.value.done, 1715 | %int %DONE.addr.int) 1716 | 1717 | ret void 1718 | } 1719 | 1720 | ; **************************************************************************** 1721 | ; our REPL -- written in LLVM IR for now until we get enough Forth implemented 1722 | ; to write it in Forth 1723 | ; **************************************************************************** 1724 | 1725 | define void @repl(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1726 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) { 1727 | %promptString.ptr = getelementptr [5 x i8]* @promptString, i32 0, i32 0 1728 | 1729 | %currChr.ptr = alloca i8 1730 | %inputBuffer.ptr = alloca i8, i16 1024 1731 | %inputBufferIdx.ptr = alloca i16 1732 | store i8 0, i8* %currChr.ptr 1733 | store i16 0, i16* %inputBufferIdx.ptr 1734 | 1735 | br label %prompt 1736 | 1737 | prompt: 1738 | call void @printString( i8* %promptString.ptr ) 1739 | br label %inputLoop 1740 | 1741 | inputLoop: 1742 | %inputBufferIdx.value = load i16* %inputBufferIdx.ptr 1743 | %inChr.value = call i8 @getchar() 1744 | 1745 | ; check for carriage return to decide if we execute or get another char 1746 | %is_cr = icmp eq i8 %inChr.value, 10 1747 | br i1 %is_cr, label %execBuffer, label %addBuffer 1748 | 1749 | addBuffer: 1750 | %inputBufferWindow.ptr = getelementptr i8* %inputBuffer.ptr, 1751 | i16 %inputBufferIdx.value 1752 | store i8 %inChr.value, i8* %inputBufferWindow.ptr 1753 | %newInputBufferIdx.value = add i16 %inputBufferIdx.value, 1 1754 | store i16 %newInputBufferIdx.value, i16* %inputBufferIdx.ptr 1755 | 1756 | br label %inputLoop 1757 | 1758 | execBuffer: 1759 | ; add a null byte at the end to make it a null terminated string 1760 | %nullLocation.ptr = getelementptr i8* %inputBuffer.ptr, 1761 | i16 %inputBufferIdx.value 1762 | store i8 00, i8* %nullLocation.ptr 1763 | 1764 | ; set up to pass our input buffer to the interpreter 1765 | %inputBuffer.ptr.int = ptrtoint i8* %inputBuffer.ptr to %int 1766 | store %int %inputBuffer.ptr.int, %int* %DATA.ptr 1767 | 1768 | ; invoke the interpreter on our input buffer 1769 | call void @interpret(%cell.ptr* %SP.ptr.ptr, %exec.ptr* %EIP.ptr.ptr, 1770 | %ret.ptr* %RSP.ptr.ptr, %int* %DATA.ptr) 1771 | 1772 | ; reset our input buffer pointer to 0 1773 | store i16 0, i16* %inputBufferIdx.ptr 1774 | 1775 | br label %prompt 1776 | 1777 | ret void 1778 | } 1779 | 1780 | define %addr @allocate(%int %cells) { 1781 | %HERE = load %pntr* @HERE 1782 | %HERE.addr = ptrtoint %cell* %HERE to %addr 1783 | %HERE.incr = mul %addr %cells, 8 1784 | %HERE.new = add %addr %HERE.addr, %HERE.incr 1785 | %HERE.new.ptr = inttoptr %addr %HERE.new to %cell* 1786 | store %cell* %HERE.new.ptr, %pntr* @HERE 1787 | ret %addr %HERE.addr 1788 | } 1789 | 1790 | define %WORD* @allocateDict() { 1791 | %allocEntry = call %addr @allocate(%int 4) ; allocate 4 cells for our entry 1792 | %retWordAlloc = inttoptr %cell %allocEntry to %WORD* 1793 | ret %WORD* %retWordAlloc 1794 | } 1795 | 1796 | define %int @main() { 1797 | %SP = alloca %cell.ptr 1798 | %SP0 = alloca %cell.ptr 1799 | %EIP = alloca %cell.ptr 1800 | %RSP = alloca %cell.ptr 1801 | %DATA = alloca %cell 1802 | 1803 | %STACK.ptr = alloca %cell, i32 256 1804 | %RSTACK.ptr = alloca %cell, i32 256 1805 | %heap.ptr = alloca %cell, i32 1024 1806 | 1807 | %SP.ptr = getelementptr %cell.ptr %STACK.ptr, i32 255 1808 | %SP0.ptr = getelementptr %cell.ptr %STACK.ptr, i32 255 1809 | store %cell.ptr %SP.ptr, %cell.ptr* %SP 1810 | store %cell.ptr %SP0.ptr, %cell.ptr* @SP0 1811 | store %cell 0, %cell.ptr %SP.ptr 1812 | 1813 | %RSP.ptr = getelementptr %cell.ptr %RSTACK.ptr, i32 255 1814 | store %cell.ptr %RSP.ptr, %cell.ptr* %RSP 1815 | 1816 | %heap.addr = ptrtoint %cell* %heap.ptr to %int 1817 | store %pntr %heap.ptr, %pntr* @HEAP 1818 | store %pntr %heap.ptr, %pntr* @HERE 1819 | 1820 | %dictEntry.addr = inttoptr %cell %heap.addr to %WORD* 1821 | 1822 | %EIP.ptr = getelementptr %cell.ptr %heap.ptr, i32 0 1823 | store %cell.ptr %EIP.ptr, %cell.ptr* %EIP 1824 | 1825 | %CODEWORD.flag = load i1* @CODEWORD.flag 1826 | %DOCOL.flag = load i1* @DOCOL.flag 1827 | 1828 | ; DOLIT - @DOLIT 1829 | %ptr_lit = getelementptr [ 6 x i8 ]* @str_lit, i32 0 1830 | %i8_lit = bitcast [ 6 x i8 ]* %ptr_lit to i8* 1831 | %dictEntry.lit = call %WORD* @allocateDict() 1832 | call void @registerDictionary( i8* %i8_lit, 1833 | %WORD* %dictEntry.lit, 1834 | i1 %CODEWORD.flag, 1835 | i8** @kernel.EXEC_DOLIT.addr ) 1836 | 1837 | ; .s - @DISPSTACK 1838 | ; %ptr_dispStack = getelementptr [ 3 x i8 ]* @str_dispStack, i32 0 1839 | ; %i8_dispStack = bitcast [ 3 x i8 ]* %ptr_dispStack to i8* 1840 | ; %dictEntry.dispStack = call %WORD* @allocateDict() 1841 | ;call void @registerDictionary( i8* %i8_dispStack, 1842 | ; %WORD* %dictEntry.dispStack, 1843 | ; %FNPTR @DISPSTACK ) 1844 | 1845 | ; / - @DIV 1846 | %ptr_div = getelementptr [ 2 x i8 ]* @str_div, i32 0 1847 | %i8_div = bitcast [ 2 x i8 ]* %ptr_div to i8* 1848 | %dictEntry.div = call %WORD* @allocateDict() 1849 | call void @registerDictionary( i8* %i8_div, 1850 | %WORD* %dictEntry.div, 1851 | i1 %CODEWORD.flag, 1852 | i8** @kernel.ALU_DIV.addr ) 1853 | 1854 | ; * - @MUL 1855 | %ptr_mul = getelementptr [ 2 x i8 ]* @str_mul, i32 0 1856 | %i8_mul = bitcast [ 2 x i8 ]* %ptr_mul to i8* 1857 | %dictEntry.mul = call %WORD* @allocateDict() 1858 | call void @registerDictionary( i8* %i8_mul, 1859 | %WORD* %dictEntry.mul, 1860 | i1 %CODEWORD.flag, 1861 | i8** @kernel.ALU_MUL.addr ) 1862 | 1863 | ; - - @SUB 1864 | %ptr_sub = getelementptr [ 2 x i8 ]* @str_sub, i32 0 1865 | %i8_sub = bitcast [ 2 x i8 ]* %ptr_sub to i8* 1866 | %dictEntry.sub = call %WORD* @allocateDict() 1867 | call void @registerDictionary( i8* %i8_sub, 1868 | %WORD* %dictEntry.sub, 1869 | i1 %CODEWORD.flag, 1870 | i8** @kernel.ALU_SUB.addr ) 1871 | 1872 | ; + - @ADD 1873 | %ptr_add = getelementptr [ 2 x i8 ]* @str_add, i32 0 1874 | %i8_add = bitcast [ 2 x i8 ]* %ptr_add to i8* 1875 | %dictEntry.add = call %WORD* @allocateDict() 1876 | call void @registerDictionary( i8* %i8_add, 1877 | %WORD* %dictEntry.add, 1878 | i1 %CODEWORD.flag, 1879 | i8** @kernel.ALU_ADD.addr ) 1880 | 1881 | ; UM+ - @UMPLUS 1882 | %ptr_umplus = getelementptr [ 4 x i8 ]* @str_umplus, i32 0 1883 | %i8_umplus = bitcast [ 4 x i8 ]* %ptr_umplus to i8* 1884 | %dictEntry.umplus = call %WORD* @allocateDict() 1885 | call void @registerDictionary( i8* %i8_umplus, 1886 | %WORD* %dictEntry.umplus, 1887 | i1 %CODEWORD.flag, 1888 | i8** @kernel.ALU_UM_ADD.addr ) 1889 | 1890 | ; swap - @SWAP 1891 | %ptr_swap = getelementptr [ 5 x i8 ]* @str_swap, i32 0 1892 | %i8_swap = bitcast [ 5 x i8 ]* %ptr_swap to i8* 1893 | %dictEntry.swap = call %WORD* @allocateDict() 1894 | call void @registerDictionary( i8* %i8_swap, 1895 | %WORD* %dictEntry.swap, 1896 | i1 %CODEWORD.flag, 1897 | i8** @kernel.SP_SWAP.addr ) 1898 | 1899 | ; 2swap - @2SWAP 1900 | %ptr_2swap = getelementptr [ 6 x i8 ]* @str_2swap, i32 0 1901 | %i8_2swap = bitcast [ 6 x i8 ]* %ptr_2swap to i8* 1902 | %dictEntry.2swap = call %WORD* @allocateDict() 1903 | call void @registerDictionary( i8* %i8_2swap, 1904 | %WORD* %dictEntry.2swap, 1905 | i1 %CODEWORD.flag, 1906 | i8** @kernel.SP_2SWAP.addr ) 1907 | 1908 | ; dup - @DUP 1909 | %ptr_dup = getelementptr [ 4 x i8 ]* @str_dup, i32 0 1910 | %i8_dup = bitcast [ 4 x i8 ]* %ptr_dup to i8* 1911 | %dictEntry.dup = call %WORD* @allocateDict() 1912 | call void @registerDictionary( i8* %i8_dup, 1913 | %WORD* %dictEntry.dup, 1914 | i1 %CODEWORD.flag, 1915 | i8** @kernel.SP_DUP.addr ) 1916 | 1917 | ; 2dup - @2DUP 1918 | %ptr_2dup = getelementptr [ 5 x i8 ]* @str_2dup, i32 0 1919 | %i8_2dup = bitcast [ 5 x i8 ]* %ptr_2dup to i8* 1920 | %dictEntry.2dup = call %WORD* @allocateDict() 1921 | call void @registerDictionary( i8* %i8_2dup, 1922 | %WORD* %dictEntry.2dup, 1923 | i1 %CODEWORD.flag, 1924 | i8** @kernel.SP_2DUP.addr ) 1925 | 1926 | ; drop - @DROP 1927 | %ptr_drop = getelementptr [ 5 x i8 ]* @str_drop, i32 0 1928 | %i8_drop = bitcast [ 5 x i8 ]* %ptr_drop to i8* 1929 | %dictEntry.drop = call %WORD* @allocateDict() 1930 | call void @registerDictionary( i8* %i8_drop, 1931 | %WORD* %dictEntry.drop, 1932 | i1 %CODEWORD.flag, 1933 | i8** @kernel.SP_DROP.addr ) 1934 | 1935 | ; 2drop - @2DROP 1936 | %ptr_2drop = getelementptr [ 6 x i8 ]* @str_2drop, i32 0 1937 | %i8_2drop = bitcast [ 6 x i8 ]* %ptr_2drop to i8* 1938 | %dictEntry.2drop = call %WORD* @allocateDict() 1939 | call void @registerDictionary( i8* %i8_2drop, 1940 | %WORD* %dictEntry.2drop, 1941 | i1 %CODEWORD.flag, 1942 | i8** @kernel.SP_2DROP.addr ) 1943 | 1944 | ; rot - @ROT 1945 | %ptr_rot = getelementptr [ 4 x i8 ]* @str_rot, i32 0 1946 | %i8_rot = bitcast [ 4 x i8 ]* %ptr_rot to i8* 1947 | %dictEntry.rot = call %WORD* @allocateDict() 1948 | call void @registerDictionary( i8* %i8_rot, 1949 | %WORD* %dictEntry.rot, 1950 | i1 %CODEWORD.flag, 1951 | i8** @kernel.SP_ROT.addr ) 1952 | 1953 | ; -rot - @NROT 1954 | %ptr_nrot = getelementptr [ 5 x i8 ]* @str_nrot, i32 0 1955 | %i8_nrot = bitcast [ 5 x i8 ]* %ptr_nrot to i8* 1956 | %dictEntry.nrot = call %WORD* @allocateDict() 1957 | call void @registerDictionary( i8* %i8_nrot, 1958 | %WORD* %dictEntry.nrot, 1959 | i1 %CODEWORD.flag, 1960 | i8** @kernel.SP_NROT.addr ) 1961 | 1962 | ; SP@ -- @SP_AT 1963 | %ptr_sp_at = getelementptr [ 4 x i8 ]* @str_sp_at, i32 0 1964 | %i8_sp_at = bitcast [ 4 x i8 ]* %ptr_sp_at to i8* 1965 | %dictEntry.sp_at = call %WORD* @allocateDict() 1966 | call void @registerDictionary( i8* %i8_sp_at, 1967 | %WORD* %dictEntry.sp_at, 1968 | i1 %CODEWORD.flag, 1969 | i8** @kernel.SP_AT.addr ) 1970 | 1971 | ; SP! -- @SP_POP 1972 | %ptr_sp_bang = getelementptr [ 4 x i8 ]* @str_sp_bang, i32 0 1973 | %i8_sp_bang = bitcast [ 4 x i8 ]* %ptr_sp_bang to i8* 1974 | %dictEntry.sp_bang = call %WORD* @allocateDict() 1975 | call void @registerDictionary( i8* %i8_sp_bang, 1976 | %WORD* %dictEntry.sp_bang, 1977 | i1 %CODEWORD.flag, 1978 | i8** @kernel.SP_POP.addr ) 1979 | 1980 | ; C@ -- @C_AT 1981 | %ptr_c_at = getelementptr [ 3 x i8 ]* @str_c_at, i32 0 1982 | %i8_c_at = bitcast [ 3 x i8 ]* %ptr_c_at to i8* 1983 | %dictEntry.c_at = call %WORD* @allocateDict() 1984 | call void @registerDictionary( i8* %i8_c_at, 1985 | %WORD* %dictEntry.c_at, 1986 | i1 %CODEWORD.flag, 1987 | i8** @kernel.M_AT.addr ) 1988 | 1989 | ; C! -- @C_BANG 1990 | %ptr_c_bang = getelementptr [ 3 x i8 ]* @str_c_bang, i32 0 1991 | %i8_c_bang = bitcast [ 3 x i8 ]* %ptr_c_bang to i8* 1992 | %dictEntry.c_bang = call %WORD* @allocateDict() 1993 | call void @registerDictionary( i8* %i8_c_bang, 1994 | %WORD* %dictEntry.c_bang, 1995 | i1 %CODEWORD.flag, 1996 | i8** @kernel.M_BANG.addr ) 1997 | 1998 | ; CHAR- - @CHAR_MIN 1999 | %ptr_char_min = getelementptr [ 6 x i8 ]* @str_char_min, i32 0 2000 | %i8_char_min = bitcast [ 6 x i8 ]* %ptr_char_min to i8* 2001 | %dictEntry.char_min = call %WORD* @allocateDict() 2002 | call void @registerDictionary( i8* %i8_char_min, 2003 | %WORD* %dictEntry.char_min, 2004 | i1 %CODEWORD.flag, 2005 | i8** @kernel.ALU_CHAR_SUB.addr ) 2006 | 2007 | ; DECR - alias for %CHAR_MIN 2008 | %ptr_decr = getelementptr [ 5 x i8 ]* @str_decr, i32 0 2009 | %i8_decr = bitcast [ 5 x i8 ]* %ptr_decr to i8* 2010 | %dictEntry.decr = call %WORD* @allocateDict() 2011 | call void @registerDictionary( i8* %i8_decr, 2012 | %WORD* %dictEntry.decr, 2013 | i1 %CODEWORD.flag, 2014 | i8** @kernel.ALU_CHAR_SUB.addr ) 2015 | 2016 | ; CHAR+ - @CHAR_PLUS 2017 | %ptr_char_plus = getelementptr [ 6 x i8 ]* @str_char_plus, i32 0 2018 | %i8_char_plus = bitcast [ 6 x i8 ]* %ptr_char_plus to i8* 2019 | %dictEntry.char_plus = call %WORD* @allocateDict() 2020 | call void @registerDictionary( i8* %i8_char_plus, 2021 | %WORD* %dictEntry.char_plus, 2022 | i1 %CODEWORD.flag, 2023 | i8** @kernel.ALU_CHAR_PLUS.addr ) 2024 | 2025 | ; INCR - alias for %CHAR_PLUS 2026 | %ptr_incr = getelementptr [ 5 x i8 ]* @str_incr, i32 0 2027 | %i8_incr = bitcast [ 5 x i8 ]* %ptr_incr to i8* 2028 | %dictEntry.incr = call %WORD* @allocateDict() 2029 | call void @registerDictionary( i8* %i8_incr, 2030 | %WORD* %dictEntry.incr, 2031 | i1 %CODEWORD.flag, 2032 | i8** @kernel.ALU_CHAR_PLUS.addr ) 2033 | 2034 | ; CHARS - @CHARS 2035 | %ptr_chars = getelementptr [ 6 x i8 ]* @str_chars, i32 0 2036 | %i8_chars = bitcast [ 6 x i8 ]* %ptr_chars to i8* 2037 | %dictEntry.chars = call %WORD* @allocateDict() 2038 | call void @registerDictionary( i8* %i8_chars, 2039 | %WORD* %dictEntry.chars, 2040 | i1 %CODEWORD.flag, 2041 | i8** @kernel.ALU_CHARS.addr ) 2042 | 2043 | ; CELL- - @CELL_MIN 2044 | %ptr_cell_min = getelementptr [ 6 x i8 ]* @str_cell_min, i32 0 2045 | %i8_cell_min = bitcast [ 6 x i8 ]* %ptr_cell_min to i8* 2046 | %dictEntry.cell_min = call %WORD* @allocateDict() 2047 | call void @registerDictionary( i8* %i8_cell_min, 2048 | %WORD* %dictEntry.cell_min, 2049 | i1 %CODEWORD.flag, 2050 | i8** @kernel.ALU_CELL_SUB.addr ) 2051 | 2052 | ; CELL+ - @CELL_PLUS 2053 | %ptr_cell_plus = getelementptr [ 6 x i8 ]* @str_cell_plus, i32 0 2054 | %i8_cell_plus = bitcast [ 6 x i8 ]* %ptr_cell_plus to i8* 2055 | %dictEntry.cell_plus = call %WORD* @allocateDict() 2056 | call void @registerDictionary( i8* %i8_cell_plus, 2057 | %WORD* %dictEntry.cell_plus, 2058 | i1 %CODEWORD.flag, 2059 | i8** @kernel.ALU_CELL_PLUS.addr ) 2060 | 2061 | ; CELLS - @CELLS 2062 | %ptr_cells = getelementptr [ 6 x i8 ]* @str_cells, i32 0 2063 | %i8_cells = bitcast [ 6 x i8 ]* %ptr_cells to i8* 2064 | %dictEntry.cells = call %WORD* @allocateDict() 2065 | call void @registerDictionary( i8* %i8_cells, 2066 | %WORD* %dictEntry.cells, 2067 | i1 %CODEWORD.flag, 2068 | i8** @kernel.ALU_CELLS.addr ) 2069 | 2070 | ; 0< - @GTZ 2071 | %ptr_nonzero = getelementptr [ 3 x i8 ]* @str_nonzero, i32 0 2072 | %i8_nonzero = bitcast [ 3 x i8 ]* %ptr_nonzero to i8* 2073 | %dictEntry.nonzero = call %WORD* @allocateDict() 2074 | call void @registerDictionary( i8* %i8_nonzero, 2075 | %WORD* %dictEntry.nonzero, 2076 | i1 %CODEWORD.flag, 2077 | i8** @kernel.ALU_GTZ.addr ) 2078 | 2079 | ; AND - @AND 2080 | %ptr_and = getelementptr [ 4 x i8 ]* @str_and, i32 0 2081 | %i8_and = bitcast [ 4 x i8 ]* %ptr_and to i8* 2082 | %dictEntry.and = call %WORD* @allocateDict() 2083 | call void @registerDictionary( i8* %i8_and, 2084 | %WORD* %dictEntry.and, 2085 | i1 %CODEWORD.flag, 2086 | i8** @kernel.ALU_AND.addr ) 2087 | 2088 | ; OR - @OR 2089 | %ptr_or = getelementptr [ 3 x i8 ]* @str_or, i32 0 2090 | %i8_or = bitcast [ 3 x i8 ]* %ptr_or to i8* 2091 | %dictEntry.or = call %WORD* @allocateDict() 2092 | call void @registerDictionary( i8* %i8_or, 2093 | %WORD* %dictEntry.or, 2094 | i1 %CODEWORD.flag, 2095 | i8** @kernel.ALU_OR.addr ) 2096 | 2097 | ; XOR - @XOR 2098 | %ptr_xor = getelementptr [ 4 x i8 ]* @str_xor, i32 0 2099 | %i8_xor = bitcast [ 4 x i8 ]* %ptr_xor to i8* 2100 | %dictEntry.xor = call %WORD* @allocateDict() 2101 | call void @registerDictionary( i8* %i8_xor, 2102 | %WORD* %dictEntry.xor, 2103 | i1 %CODEWORD.flag, 2104 | i8** @kernel.ALU_XOR.addr ) 2105 | 2106 | ; ** test our dictionary navigation 2107 | call void @printDictionary() 2108 | 2109 | ; set the pointer for our compiled program to after the allocated dict 2110 | %BEGIN = call %addr @allocate(%cell 0) 2111 | 2112 | ; ** compile our forth program 2113 | %ptr_testProgram = getelementptr[ 18 x i8 ]* @str_testProgram, i32 0 2114 | %i8_testProgram = bitcast [ 18 x i8 ]* %ptr_testProgram to i8* 2115 | %i8_testProgram.addr = ptrtoint i8* %i8_testProgram to %int 2116 | store %int %i8_testProgram.addr, %int* %DATA 2117 | 2118 | ; set our EIP to the new compiled program 2119 | %EIP.new = inttoptr %cell %BEGIN to %exec.ptr 2120 | store %exec.ptr %EIP.new, %exec.ptr* %EIP 2121 | 2122 | call void @interpret( %cell.ptr* %SP, %exec.ptr* %EIP, 2123 | %ret.ptr* %RSP, %cell* %DATA) 2124 | 2125 | call void @printStackPtrValues( %cell.ptr* %SP ) 2126 | 2127 | call void @repl( %cell.ptr* %SP, %exec.ptr* %EIP, 2128 | %ret.ptr* %RSP, %cell* %DATA) 2129 | 2130 | ret %int 0 2131 | } --------------------------------------------------------------------------------