view modules/bytearray.tp @ 312:8511aac1ce82

Fix module references in macros
author Michael Pavone <pavone@retrodev.com>
date Fri, 05 Sep 2014 09:56:22 -0700
parents 2a0a88799737
children 4c669942c30d
line wrap: on
line source

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

	normal <- :size {
		#{
			llProperty: bytes withType: uint32_t
			llProperty: buffer withType: (void ptr)
			llMessage: _init_buf withVars: {
				sz <- obj_int32 ptr
			} andCode: :sz {
				bytes <- sz num
				buffer <- GC_MALLOC_ATOMIC: bytes
				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: {
				intret <- make_object: (addr_of: obj_int32_meta) NULL 0
				intret num!: bytes
				intret
			}

			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: shrinkTo withVars: {
				newsize <- obj_int32 ptr
			} andCode: :newsize {
				if: (newsize num) < bytes {
					bytes <- newsize num
				}
				self
			}

			llMessage: stringFrom:to withVars: {
				from <- obj_int32 ptr
				to <- obj_int32 ptr
				str <- string ptr
			} andCode: :from :to {
				//probably should do some UTF-8 validation at some point
				str <- make_object: (addr_of: string_meta) NULL 0
				str bytes!: (to num) - (from num)
				str len!: (str bytes)
				str data!: (GC_MALLOC_ATOMIC: (str bytes) + 1)
				memcpy: (str data) (buffer castTo: (uint8_t ptr)) + (from num) (str bytes)
				(str data) set: (str bytes) 0
				str
			}

			string <- {
				stringFrom: 0 to: length
			}

			findChar:from:else <- :char :start found :else {
				notfound <- true
				n <- length
				i <- start
				while: { notfound && i < n } do: {
					if: (get: i) = char {
						notfound <- false
					} else: {
						i <- i + 1
					}
				}
				if: notfound else else: {
					found: i
				}
			}
		} _init_buf: size
	}

	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: size
	}

	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
	}
}