view modules/string.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 5b830147c1cd
children 32964a4e7a33
line wrap: on
line source

#{
	llProperty: len withType: uint32_t
	llProperty: bytes withType: uint32_t
	llProperty: data withType: (char ptr)

	llMessage: length withVars: {
		intret <- (obj_int32 ptr)
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: len
		intret
	}

	llMessage: byte_length withVars: {
		intret <- (obj_int32 ptr)
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: bytes
		intret
	}

	llMessage: EQ_ withVars: {
		argb <- (string ptr)
	} andCode: :argb {
		if: len = (argb len) && bytes = (argb bytes) && (not: (memcmp: data (argb data) bytes)) {
			true
		}
	}

	llMessage: compareSub withVars: {
		argb <- string ptr
		myoff <- obj_int32 ptr
		boff <- obj_int32 ptr
		clen <- obj_int32 ptr
		intret <- obj_int32 ptr
	} andCode: :argb myoff boff clen {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: (memcmp: data + (myoff num) (argb data) + (boff num) (clen num))
		intret
	}

	llMessage: NEQ_ withVars: {
		argb <- (string ptr)
	} andCode: :argb {
		if: len != (argb len) || bytes != (argb bytes) || (memcmp: data (argb data) bytes) {
			true
		}
	}

	llMessage: print withVars: {} andCode: {
		fwrite: data 1 bytes stdout
		self
	}

	llMessage: string withVars: {} andCode: {
		self
	}

	llMessage: CAT_ withVars: {
		argbo <- (object ptr)
		argb <- (string ptr)
		out <- (string ptr)
	} andCode: :argbo {
		argb <- mcall: string 1 argbo
		out <- make_object: (addr_of: string_meta) NULL 0
		out bytes!: bytes + (argb bytes)
		out len!: len + (argb len)
		out data!: (GC_MALLOC_ATOMIC: (out bytes) + 1)
		memcpy: (out data) data bytes
		memcpy: (out data) + bytes (argb data) (argb bytes) + 1
		out
	}

	llMessage: byte withVars: {
		index <- (obj_int32 ptr)
		intret <- (obj_int32 ptr)
	} andCode: :index {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: (if: (index num) < bytes { data get: (index num) } else: {0})
		intret
	}

	llMessage: int32 withVars: {
		intret <- (obj_int32 ptr)
	} andCode: {
		intret  <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: (atoi: data)
		intret
	}

	parseHex32 <- {
		num <- 0u32
		cur <- 0
		a <- uint32: ("a" byte: 0)
		A <- uint32: ("A" byte: 0)
		f <- uint32: ("f" byte: 0)
		F <- uint32: ("F" byte: 0)
		zero <- "0" byte: 0
		nine <- "9" byte: 0
		while: { cur < byte_length} do: {
			b <- uint32: (byte: cur)
			cur <- cur + 1
			if: b >= zero && b <= nine {
				num <- num * 16 + (b - zero)
			} else: {
				if: b >= a && b <= f {
					num <- num * 16 + (b - a) + 10u32
				} else: {
					if: b >= A && b <= F {
						num <- num * 16 + (b - A) + 10u32
					} else: {
						cur <- byte_length
					}
				}
			}
		}
		num
	}

	parseHex64 <- {
		num <- 0u64
		cur <- 0
		a <- uint64: ("a" byte: 0)
		A <- uint64: ("A" byte: 0)
		f <- uint64: ("f" byte: 0)
		F <- uint64: ("F" byte: 0)
		zero <- "0" byte: 0
		nine <- "9" byte: 0
		while: { cur < byte_length} do: {
			b <- uint64: (byte: cur)
			cur <- cur + 1
			if: b >= zero && b <= nine {
				num <- num * 16 + (b - zero)
			} else: {
				if: b >= a && b <= f {
					num <- num * 16 + (b - a) + 10u64
				} else: {
					if: b >= A && b <= F {
						num <- num * 16 + (b - A) + 10u64
					} else: {
						cur <- byte_length
					}
				}
			}
		}
		num
	}

	llMessage: hash withVars: {
		intret <- (obj_int32 ptr)
		i <- uint32_t
	} andCode: {
		intret <- make_object: (addr_of: obj_int32_meta) NULL 0
		intret num!: 0
		if: bytes {
			intret num!: (data get: 0) * 128
			i <- 0
			while: { i < bytes } do: {
				intret num!: (1000003 * (intret num)) xor (data get: i)
				i <- i + 1
			}
			intret num!: (intret num) xor bytes
		}
		intret
	}

	llMessage: find:startingAt:else withVars: {
		intret <- obj_int32 ptr
		oneedle <- object ptr
		startpos <- obj_int32 ptr
		ifNotFound <- object ptr
		sneedle <- string ptr
		i <- uint32_t
		notFound <- uint32_t
	} andCode: :oneedle :startpos :ifNotFound {
		sneedle <- mcall: string 1 oneedle
		i <- startpos num
		notFound <- 1
		while: { notFound && i + (sneedle bytes) <= bytes} do: {
			if: (memcmp: data + i (sneedle data) (sneedle bytes)) = 0 {
				notFound <- 0
			} else: {
				i <- i + 1
			}
		}
		if: notFound {
			ccall: ifNotFound 0
		} else: {
			intret <- make_object: (addr_of: obj_int32_meta) NULL 0
			intret num!: i
			intret
		}
	}

	find:else <- :toFind :orElse {
		find: toFind startingAt: 0 else: orElse
	}

	llMessage: from:withLength withVars: {
		from <- obj_int32 ptr
		tocopy <- obj_int32 ptr
		ret <- string ptr
		start <- int32_t
		clampedLen <- int32_t
	} andCode: :from :tocopy {
		start <- from num
		if: start < 0 {
			start <- bytes + start
		}
		if: start > bytes {
			start <- bytes
		}
		clampedLen <- tocopy num
		if: start + clampedLen > bytes {
			clampedLen <- bytes - start
		}
		ret <- make_object: (addr_of: string_meta) NULL 0
		ret data!: (GC_MALLOC_ATOMIC: clampedLen + 1)
		memcpy: (ret data) data + start clampedLen
		ret len!: clampedLen
		ret bytes!: clampedLen
		ret
	}

	from <- :start {
		from: start withLength: length
	}

	partitionOn <- :delim {
		pos <- find: delim else: { -1 }
		if: pos >= 0 {
			_before <- from: 0 withLength: pos
			_after <- from: (pos + (delim length))
			#{
				before <- _before
				after <- _after
			}
		} else: {
			_before <- self
			#{
				before <- _before
				after <- ""
			}
		}
	}

	splitOn <- :delim {
		pos <- 0
		pieces <- #[]
		while: {
			pos <- find: delim else: { -1 }
			pos >= 0
		} do: {
			pieces append: (from: 0 withLength: pos)
			self <- from: pos + (delim length)
		}
		pieces append: self
	}

	trim <- {
		l <- length
		start <- 0
		space <- " " byte: 0
		tab <- "\t" byte: 0
		nl <- "\n" byte: 0
		cr <- "\r" byte: 0

		while: {
			if: start < l {
				b <- byte: start
				b = space || b = tab || b = nl || b = cr
			}
		} do: {
			start <- start + 1
		}
		end <- l
		while: {
			if: end > 0 {
				b <- byte: end
				b = space || b = tab || b = nl || b = cr
			}
		} do: {
			end <- end + 1
		}
		from: start withLength: (end - start)
	}

	isInteger? <- { false }
	isString? <- { true }
	isBasicString? <- { true }
}