view modules/bytearray.tp @ 251:2557ce4e671f

Fix a couple of compiler bugs. topenv was getting initialized in multiple places. This resulted in multiple copies of modules getting created which caused problems for macro expansion. Additionally, arguments were not being marked as declared during code generation so assigning to an argument that was not closed over generated invalid C code.
author Michael Pavone <pavone@retrodev.com>
date Fri, 11 Apr 2014 22:29:32 -0700
parents 270d31c6c4cd
children fb922651db29
line wrap: on
line source

#{
	includeSystemHeader: "unistd.h"
	includeSystemHeader: "sys/mman.h"

	executable <- :size {
		buf <- #{
			llProperty: bytes withType: uint32_t
			llProperty: buffer withType: (void ptr)
			llMessage: _init withVars: {
				sz <- obj_int32 ptr
			} andCode: :sz {
				bytes <- sz num
				buffer <- sbrk: bytes
				mprotect: buffer bytes (PROT_READ or PROT_WRITE or PROT_EXEC)
				self
			}
			llMessage: set withVars: {
				offset <- obj_int32 ptr
				newval <- obj_uint8 ptr
			} andCode: :offset newval {
				(buffer castTo: (uint8_t ptr)) set: (offset num) (newval num)
				self
			}
			llMessage: get withVars: {
				offset <- obj_int32 ptr
				ret <- obj_uint8 ptr
			} andCode: :offset {
				ret <- make_object: (addr_of: obj_uint8_meta) NULL 0
				ret num!: ((buffer castTo: (uint8_t ptr)) get: (offset num))
				ret
			}
			llMessage: run withVars: {
				fun <- uint64_t funptr
				funret <- obj_uint64 ptr
			} andCode: {
				funret <- make_object: (addr_of: obj_uint64_meta) NULL 0
				fun <- buffer
				funret num!: ( fun: )
				funret
			}

			llMessage: runWithArg withVars: {
				fun <- uint64_t funptr: uint64_t
				funret <- obj_uint64 ptr
				arg <- obj_uint64 ptr
			} andCode: :arg {
				fun <- buffer
				funret <- make_object: (addr_of: obj_uint64_meta) NULL 0
				funret num!: ( fun: (arg num) )
				funret
			}
		}
		buf _init
	}

	executableFromBytes <- :bytes {
		totalSize <- bytes fold: 0 with: :acc el {
			acc + (el length)
		}
		ba <- executable: totalSize
		bytes fold: 0 with: :idx el {
			el flattenTo: ba at: idx
		}
		ba
	}
}