changeset 361:06dceff348ea

llcompile now has Hacky support for calling C functions using dl to lookup symbols and almost has support string constants
author Michael Pavone <pavone@retrodev.com>
date Thu, 23 Apr 2015 19:24:20 -0700
parents 0b83f15e819d
children 7101ad443081
files cbackend.js modules/bytearray.tp modules/il.tp modules/llcompile.tp modules/x86.tp
diffstat 5 files changed, 192 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/cbackend.js	Tue Apr 21 09:00:56 2015 -0700
+++ b/cbackend.js	Thu Apr 23 19:24:20 2015 -0700
@@ -984,6 +984,14 @@
 			'return (object *)ret;'
 		]
 	});
+	cptr.addMessage('address', {
+		vars: {intret: 'obj_uint64 *'},
+		lines: [
+			'intret = make_object(&obj_uint64_meta, NULL, 0);',
+			'intret->num = (uint64_t)self->val;',
+			'return intret;'
+		]
+	})
 	return cptr;
 }
 
--- a/modules/bytearray.tp	Tue Apr 21 09:00:56 2015 -0700
+++ b/modules/bytearray.tp	Thu Apr 23 19:24:20 2015 -0700
@@ -119,6 +119,15 @@
 				mprotect: buffer bytes (PROT_READ or PROT_WRITE or PROT_EXEC)
 				self
 			}
+			
+			llMessage: _buf_ptr withVars: {
+				ptrret <- cpointer ptr
+			} andCode: {
+				ptrret <- make_object: (addr_of: cpointer_meta) NULL 0
+				ptrret val!: buffer
+				ptrret
+			}
+			
 			llMessage: length withVars: {
 				intret <- obj_int32 ptr
 			} andCode: {
--- a/modules/il.tp	Tue Apr 21 09:00:56 2015 -0700
+++ b/modules/il.tp	Thu Apr 23 19:24:20 2015 -0700
@@ -24,6 +24,8 @@
 	_skipifelse <- 20
 	_save   <- 21
 	_bool   <- 22
+	_label  <- 23
+	_data   <- 24
 
 	_names <- #[
 		"add"
@@ -49,6 +51,8 @@
 		"skipIf:else"
 		"save"
 		"bool"
+		"label"
+		"data"
 	]
 
 	op3:a:b:out:size <- :_opcode :_ina :_inb :_out :_size {
@@ -204,6 +208,8 @@
 	_ule <- condition: 7
 	_ugr <- condition: 8
 	_uls <- condition: 9
+	
+	_curLabel <- 0
 
 	#{
 		b <- { byte }
@@ -555,6 +561,55 @@
 				}
 			}
 		}
+		
+		label <- {
+			_labelNum <- _curLabel
+			_curLabel <- _curLabel + 1
+			#{
+				opcode <- { _label }
+				numops <- { 0 }
+				name <- { _names get: opcode }
+				string <- { name . " " . _labelNum }
+				reference <- {
+					#{
+						isInteger? <- { false }
+						register? <- { false }
+						argument? <- { false }
+						return? <- { false }
+						label? <- { true }
+						num <- { _labelNum }
+						string <- { "label " . _labelNum}
+						
+						recordUsage:at:withSize <- :tracker :address :size {
+						}
+						assign:withSource <- :assignments :regSrc {
+							self
+						}
+					}
+				}
+				recordUsage:at <- :tracker :address {
+					
+				}
+				assignRegs:at:withSource:andUsage <- :assignments :at :regSrc :usage {
+					self
+				}
+			}
+		}
+		data <- :_bytes {
+			#{
+				opcode <- { _data }
+				numops <- { 0 }
+				name <- { _names get: opcode }
+				string <- { name . " " . _bytes }
+				bytes <- { _bytes }
+				recordUsage:at <- :tracker :address {
+					
+				}
+				assignRegs:at:withSource:andUsage <- :assignments :at :regSrc :usage {
+					self
+				}
+			}
+		}
 
 		allocRegs:withSource <- :instarr :regSrc {
 			_regMap <- dict linear
--- a/modules/llcompile.tp	Tue Apr 21 09:00:56 2015 -0700
+++ b/modules/llcompile.tp	Thu Apr 23 19:24:20 2015 -0700
@@ -24,11 +24,20 @@
 
 	_ilFun <- :_name {
 		_buff <- #[]
+		_data <- #[]
 		_blockStack <- []
+		_labelDefs <- dict hash
 		_nextReg <- 0
 		#{
 			name <- { _name }
 			add <- :inst { _buff append: inst }
+			addData <- :data {
+				lbl <- il label
+				dataPos <- _data length
+				_labelDefs set: dataPos lbl
+				_data append: data 
+				lbl reference
+			}
 			getReg <- {
 				r <- il reg: _nextReg
 				_nextReg <- _nextReg + 1
@@ -45,6 +54,12 @@
 				res
 			}
 			buffer <- { _buff }
+			finalize <- {
+				foreach: _data :idx data {
+					_buff append: (_labelDefs get: idx else: { false })
+					_buff append: (il data: data)
+				}
+			}
 		}
 	}
 	
@@ -159,7 +174,18 @@
 		}
 	}
 	_compileString <- :expr syms ilf assignTo {
-
+		lbl <- ilf addData: (expr val)
+		v <- assignTo value: :asn {
+			asn
+		} none: {
+			lbl
+		}
+		#{
+			val <- v
+			//TODO: Asbstract pointer size
+			size <- il q
+			signed? <- false
+		}
 	}
 	_compileInt <- :expr syms ilf assignTo {
 		sz <- il sizeFromBytes: (expr size)
@@ -441,6 +467,7 @@
 					} none: {
 						ilf add: (il return: 0 (il l))
 					}
+					ilf finalize
 					ilf
 				} else: {
 					argErrors
--- a/modules/x86.tp	Tue Apr 21 09:00:56 2015 -0700
+++ b/modules/x86.tp	Thu Apr 23 19:24:20 2015 -0700
@@ -138,6 +138,11 @@
 	}
 
 	int_op:withTail <- :value size :tail {
+		if: (not: (value isInteger?)) {
+			//label
+			//FIXME: Needs implementation
+			value <- 0
+		}
 		if: size >= dword {
 			tail <- (uint8: (rshift: value by: 16u64)) | (uint8: (rshift: value by: 24u64)) | tail
 		}
@@ -248,11 +253,26 @@
 			}
 		}
 	}
+	
+	data <- :bytes {
+		#{
+			length <- { bytes byte_length }
+			flattenTo:at <- :dest :idx {
+				foreach: (range from: 0 to: length) :_ cidx {
+					dest set: idx + cidx (bytes byte: cidx)
+				}
+				idx + length
+			}
+			string <- {
+				"data: " . bytes
+			}
+		}
+	}
 
 	op:withCode:withImmed:withOpEx <- :src dst size :normal :immed :myopex {
 		reg <- src
 		rm <- dst
-		base <- if: (src isInteger?) {
+		base <- if: (src isInteger?) || (src label?) {
 			reg <- fakesrc
 			(size_bit: immed size) | (mod_rm: (opex: myopex) dst withTail: (int_op: src size))
 		} else: {
@@ -323,6 +343,14 @@
 			myinst
 		}
 	}
+	_dlHandle <- option none
+	_getDLHandle <- {
+		_dlHandle value: :handle { handle } none: {
+			handle <- dl open: "" withFlags: (dl NOW)
+			_dlHandle <- option value: handle
+			handle
+		}
+	}
 
 	_jmprel <- :op jmpDest {
 	}
@@ -557,27 +585,65 @@
 		}
 
 		call <- :callDest {
-			if: (callDest label?) {
+			if: (callDest isInteger?) {
 				#{
-					length <- { 5 }
+					length <- { 12 } //worst case
 					flattenTo:at <- :dest :idx {
-						dest set: idx 0xE8u8
-						callDest withOffset: :off {
-							rel <- off - (idx + 5)
+						base <- (dest _buf_ptr) address
+						rel <- (callDest uint64) - (base + (idx uint64) + 5u64)
+						if: rel < 0x80000000u64 || rel >= 0xFFFFFFFF80000000u64 {
+							rel <- rel int64
+							dest set: idx 0xE8u8
 							dest set: (idx + 1) (uint8: rel)
 							dest set: (idx + 2) (uint8: (rshift: rel by: 8))
 							dest set: (idx + 3) (uint8: (rshift: rel by: 16))
 							dest set: (idx + 4) (uint8: (rshift: rel by: 24))
+							idx + 5
 						} else: {
+							dst <- callDest uint64
+							dest set: idx 0x48u8 //REX size=quad
+							dest set: idx + 1 0xB8 //mov immed rax
+							dest set: idx + 2 (uint8: dst)
+							dest set: idx + 3 (uint8: (rshift: dst by: 8))
+							dest set: idx + 4 (uint8: (rshift: dst by: 16))
+							dest set: idx + 5 (uint8: (rshift: dst by: 24))
+							dest set: idx + 6 (uint8: (rshift: dst by: 32))
+							dest set: idx + 7 (uint8: (rshift: dst by: 40))
+							dest set: idx + 8 (uint8: (rshift: dst by: 48))
+							dest set: idx + 9 (uint8: (rshift: dst by: 56))
+							dest set: idx + 10 0xFFu8 //single EA op
+							dest set: idx + 11 0xd0u8 //call reg direct
+							idx + 12
 						}
-						idx + 5
+						
 					}
 					string <- {
 						"call " . callDest
 					}
 				}
 			} else: {
-				inst: 0xFFu8 | (mod_rm: (opex: 2u8) callDest)
+				if: (callDest label?) {
+					#{
+						length <- { 5 }
+						flattenTo:at <- :dest :idx {
+							dest set: idx 0xE8u8
+							callDest withOffset: :off {
+								rel <- off - (idx + 5)
+								dest set: (idx + 1) (uint8: rel)
+								dest set: (idx + 2) (uint8: (rshift: rel by: 8))
+								dest set: (idx + 3) (uint8: (rshift: rel by: 16))
+								dest set: (idx + 4) (uint8: (rshift: rel by: 24))
+							} else: {
+							}
+							idx + 5
+						}
+						string <- {
+							"call " . callDest
+						}
+					}
+				} else: {
+					inst: 0xFFu8 | (mod_rm: (opex: 2u8) callDest)
+				}
 			}
 		}
 		
@@ -789,12 +855,18 @@
 					toCall <- inst target
 					if: (toCall isString?) {
 						//TODO: Handle call to undefined label
-						toCall <- labels get: toCall else: { 
-							print: "Could not find label " . toCall . "\nDefined labels:\n"
-							foreach: labels :key _ {
-								print: "\t" . key . "\n"
+						toCall <- labels get: toCall else: {
+							handle <- _getDLHandle:
+							address <- dl sym: toCall from: handle
+							if: address != 0u64 {
+								address
+							} else: {
+								print: "Could not find label " . toCall . "\nDefined labels:\n"
+								foreach: labels :key _ {
+									print: "\t" . key . "\n"
+								}
+								false
 							}
-							false 
 						}
 					}
 					outarr append: (call: toCall)
@@ -853,6 +925,13 @@
 				{
 					outarr append: (setcc: (mapcond: (inst cond)) (inst out))
 				}
+				//label
+				{
+				}
+				//data
+				{
+					outarr append: (data: (inst bytes))
+				}
 			]
 			print: "Opcode: " . (inst opcode) . "\n"
 			fun <- opmap get: (inst opcode)