avoid use of Double as transfer type

avoid use of Double as transfer type

' Blue Moon
' an implementation of Lua in pure BlitzMax

SuperStrict

'Framework Brl.Blitz
'Import Brl.LinkedList
'Import Brl.Map
'Import Brl.Reflection

Import "bluecompiler.bmx"
Import "blueallocator.bmx"
Rem
Import "blueasm.o"
Extern
Function ADD:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "ADD2"
Function EQ:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "EQ2"
Function GETUPV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "GETUPV2"
Function JIF:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "JIF2"
Function LOADBOOL:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADBOOL2"
Function LOADK:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADK2"
Function LOADNIL:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADNIL2"
Function LOADSI:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADSI2"
Function MOV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "MOV2"
Function NEWUPV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "NEWUPV2"
Function SETLC:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "SETLC2"
End Extern
End Rem
'Const file:String = "tests/checktable.lua"
'Const file:String = "tests/mandelbrot.lua"
'Const file:String = "tests/sieve.lua"
'Const file:String = "tests/attrib.lua"
Const file:String = "test.lua"

Const outFile:String = "out.lua.so"

Print BlueCompiler.ShowBytecode(file)

Rem
BlueJIT.InitOpTbl()
'BlueJIT.opTbl[BlueJIT.opc.ADD] = ADD
'BlueJIT.opTbl[BlueJIT.opc.EQ] = EQ
'BlueJIT.opTbl[BlueJIT.opc.GETUPV] = GETUPV
'BlueJIT.opTbl[BlueJIT.opc.JIF] = JIF
'BlueJIT.opTbl[BlueJIT.opc.LOADBOOL] = LOADBOOL
'BlueJIT.opTbl[BlueJIT.opc.LOADK] = LOADK
'BlueJIT.opTbl[BlueJIT.opc.LOADNIL] = LOADNIL
'BlueJIT.opTbl[BlueJIT.opc.LOADSI] = LOADSI
BlueJIT.opTbl[BlueJIT.opc.MOV] = MOV
'BlueJIT.opTbl[BlueJIT.opc.NEWUPV] = NEWUPV
'BlueJIT.opTbl[BlueJIT.opc.SETLC] = SETLC
End Rem

Local code:BlueBinary = BlueCompiler.CompileFileForLoad(file)
Local vm:BlueVM = New BlueVM
Local tl:BlueLuaVal = vm.LoadObjectCode(code)
'tl.Call()

Local stk:Stack = BlueJIT.BPtoS(vm.mem.stack)
stk.retIP = Null ; stk.prevBase = Null
Local vc:Int = 10, upvars:Int = 1
stk.varp = Long Ptr(Byte Ptr(stk) + BlueJIT.STACKFRAME_INC) + upvars
stk.func = vm.funIndex[0]
'stk.IP = 0
stk.argv = Null	'may want to add space?
stk.retv = Null
stk.argc = 0
stk.retc = 0

Print "running..."
Local t:Int = MilliSecs()
Local test:Int(_:Byte Ptr) = stk.func.mcode - BlueJIT.PROLOGUESZ ; test(stk)
t = MilliSecs() - t
Print t
Print "run complete"

Print "done."
End

' notes:
' - string constants and bytecode are loaded directly into oldSpc, since they'll be needed often
' - the structure of a bytecode object is:
'    [ machine code ptr ][ id-offset ][ #k ][ #param ][ #upvar ][ frame sz ][ #instrs ][ vm ][ instructions... ][ upvar table... ][ k table... ]
'   initial fields are all 32b; instructions are each 64b; upvar table is pairs of 32b values (level, pos); k table is NaN-box values

' - the structure of a closure object (actual Lua value representing a function) is:
'    [ bytecode ptr ][ upvar values... ]

Type BlueVM
	Field mem:BlueVMMemory, _ENV:BlueLuaVal
	Field idMod:Int, funIndex:Bytecode Ptr, _fiSz:Int

	Method New()
		mem = New BlueVMMemory
	End Method

	' Load the procedures and constants of a compiled binary into the VM, returning the function representing the program toplevel
	Method LoadObjectCode:BlueLuaVal(code:BlueBinary)
		Local buf:Int[] = code.buf
		Local fcount:Int = buf[0], kcount:Int = buf[1], ktblpos:Int = buf[2], ktbl:Long[kcount]
		Local convert:Byte Ptr(o:Object) = Byte Ptr(BlueJIT.Identity)

		For Local k:Int = 0 Until kcount
			Local koff:Int = buf[ktblpos + k], sz:Int = buf[ktblpos + k + 1] - koff
			If sz > 2	'strings have size > 2
				Local length:Double, lp:Int Ptr = Int Ptr(Varptr(length))
				lp[0] = buf[koff] ; lp[1] = buf[koff + 1]
				Local s:Byte Ptr = mem.AllocString(length, Short Ptr(Varptr(buf[koff + 2])))
				ktbl[k] = mem.PtrToVal(s, BlueTypeTag.STR)
			Else
				Local d:Double, dp:Int Ptr = Int Ptr(Varptr(d))
				dp[0] = buf[koff] ; dp[1] = buf[koff + 1]
				Double Ptr(Varptr(ktbl[k]))[0] = d
			EndIf
		Next

		ExtendFunIndex(idMod + fcount)
		For Local f:Int = 0 Until fcount
			Local foff:Int = buf[3 + f]
			Local ic:Int = buf[foff + 1], kc:Int = buf[foff + 2], pc:Int = buf[foff + 3], uc:Int = buf[foff + 5], fsz:Int = buf[foff + 6]

			Local b:Bytecode = BPtoBC(mem.AllocObjectOldSpace(mem.oldStrSpace, (8 + 2 * (uc + uc Mod 2) + 2 * kc + 2 * ic) * 4, BlueTypeTag.BCODE))
			b.idMod = idMod ; b.kcount = kc ; b.pcount = pc ; b.upvars = uc + (uc Mod 2)	'round up for alignment
			b.frameSz = BlueJIT.STACKFRAMESZ + b.upvars * 8 + fsz * 8 ; b.icount = ic ; b.vm = convert(Self)

			Local ib:Int Ptr = Int Ptr(Byte Ptr(b) + 4) + 8 + 2 * ic
			For Local u:Int = 0 Until uc
				Local uoff:Int = 7 + u * 2
				ib[u * 2] = buf[foff + uoff] ; ib[u * 2 + 1] = buf[foff + uoff + 1]
			Next
			If uc <> b.upvars	'ensure padding is safe by copying the first one
				ib[uc * 2] = buf[foff + 7] ; ib[uc * 2 + 1] = buf[foff + 7 + 1]
			EndIf

			Local db:Long Ptr = Long Ptr(ib + 2 * b.upvars)
			For Local k:Int = 0 Until kc
				db[k] = ktbl[buf[foff + 7 + uc * 2 + k]]
			Next

			Local ioff:Int = 7 + 2 * uc + kc ; ib = Int Ptr(Byte Ptr(b) + BlueJIT.BYTECODE_INC)

			For Local i:Int = 0 Until ic * 2
				ib[i] = buf[foff + ioff + i]
			Next

			b.mcode = BlueJIT.Compile(Self, ib, ic, b) + BlueJIT.PROLOGUESZ
			funIndex[idMod + f] = b
		Next

		idMod :+ fcount
		Return New BlueLuaVal
	End Method

	Method ExtendFunIndex(sz:Int)	'hack: BlitzMax has a bug with arrays of extern types! so we need to use C-style arrays for now
		Local newFI:Bytecode Ptr = Bytecode Ptr(MemAlloc(sz * 4))
		If _fiSz
			For Local b:Int = 0 Until _fiSz
				newFI[b] = funIndex[b]
			Next
			MemFree(funIndex)
			For Local b:Int = _fiSz Until sz
				newFI[b] = Null
			Next
		EndIf
		funIndex = newFI ; _fiSz = sz
	End Method

	Method CallToLua()
	End Method

	Global BPtoBC:Bytecode(p:Byte Ptr) = Byte Ptr(BlueJIT.PointerToExtType)
End Type

Private
Extern
	Type Stack
		Field retIP:Byte Ptr, prevBase:Stack, varp:Long Ptr, func:Bytecode, _IP:Int, argv:Long Ptr, retv:Long Ptr, argc:Short, retc:Short
	End Type
	Type Bytecode
		Field mcode:Byte Ptr, idMod:Int, kcount:Int, pcount:Int, upvars:Int, frameSz:Int, icount:Int, vm:Byte Ptr
	End Type
End Extern
Public

Type BlueJIT Final
	Const PROLOGUESZ:Int = 25, ISIZE:Int = 5

	Global opTbl:Int(s:Stack, b:Bytecode, r:Byte Ptr)[], opc:BlueOpcode
	Global Prologue:Int[] = [ ..
		$90, $90, ..
		$8b, $44, $24, $04, ..                     'mov 4(%esp), %eax
		$89, $44, $24, $f4, ..                     'mov %eax, -12(%esp)
		$c7, $44, $24, $f8, $FF, $FF, $FF, $FF, .. 'movl ########, -8(%esp)
		$89, $64, $24, $fc, ..                     'mov %esp, -4(%esp)
		$83, $ec, $0c..                            'sub $12, %esp
	]

	Function Compile:Byte Ptr(vm:BlueVM, ins:Byte Ptr, icount:Int, bytecode:Bytecode)
		?Not x86
		RuntimeError "The Blue Moon JIT does not support your platform (x86-32 only at this time)"
		?
		Assert SizeOf(0:Long) = SizeOf(0:Double) And SizeOf(0:Int) = 4 And SizeOf(0:Long) = 8 And SizeOf(Byte Ptr(0)) = 4, ..
			"assumptions about platform datatype sizes are invalid"

		If opTbl = Null Then InitOpTbl()

		Local sz:Int = PROLOGUESZ + icount * ISIZE

		' allocate executable space
		Local blocks:Int[] = vm.mem.AllocCodeBlock(PROLOGUESZ + icount * ISIZE)
		Local code:Byte Ptr = Byte Ptr(blocks[0]), rsize:Int = blocks[1] - (blocks[1] Mod ISIZE)

		For Local p:Int = 0 Until PROLOGUESZ	'emplace prologue (used for calling in from native only)
			code[p] = Prologue[p]
		Next
		Byte Ptr Ptr(code + 14)[0] = Byte Ptr(bytecode)	'replace the ########
		code :+ PROLOGUESZ ; rsize :- PROLOGUESZ	'easier to not have to take this into account below

		Local codePage:Int Ptr = Int Ptr(Int(code) & ((Int(2^12)-1) Shl 20))	'return-to-native for the page
		codePage[1] = $c30cc483	'add $12, %esp ; ret  - i.e. restore the stack to normal

		' generate machine code!
		Repeat

			For Local i:Int = 0 Until rsize / ISIZE	'emplace opcode calls and supporting bytecode data
				Local codep:Byte Ptr = code + i * ISIZE, bytecodep:Byte Ptr = Byte Ptr(Int(codep) + vm.mem.PAGESZ)
				codep[0] = $e8	'call
				Local bi:Int = i * 8, op:Int = ins[bi], ip:Int Ptr = Int Ptr(ins + bi), func:Byte Ptr = opTbl[op]
				Byte Ptr Ptr(codep + 1)[0] = func - Int(codep + ISIZE)

				Select op
					Case opc.LOADSI, opc.CLOSURE, opc.RET, opc.POSTCALL
						bytecodep[0] = ins[bi + 1] ; Int Ptr(bytecodep + 1)[0] = Int Ptr(ins + bi)[1]

					Case opc.LOADK
						Local kp:Double Ptr = Double Ptr(ins + 8 * bytecode.icount + 8 * bytecode.upvars) + ip[1]
						bytecodep[0] = ins[bi + 1] ; Double Ptr Ptr(bytecodep + 1)[0] = kp

					Case opc.CALL
						bytecodep[0] = ins[bi + 1] ; bytecodep[1] = ins[bi + 2]
						Short Ptr(bytecodep)[1] = Int Ptr(ins + bi)[1]

					Case opc.JIF, opc.JNOT
						bytecodep[0] = ins[bi + 1]
						Int Ptr(bytecodep + 1)[0] = Int(codep) + ISIZE * Int Ptr(ins + bi)[1]

					Case opc.JMP
						codep[0] = $e9	'use a true jump
						Int Ptr(codep + 1)[0] = ISIZE * (Int Ptr(ins + bi)[1] - 1)

					Default	'binary operations A = B op C
						bytecodep[0] = ins[bi + 1] ; bytecodep[1] = ins[bi + 2] ; bytecodep[2] = Int Ptr(ins + bi)[1]
				End Select
			Next

			Exit	'deal with overflowing code sections here
		Forever

		Return code - PROLOGUESZ
	End Function

	Const STACKFRAMESZ:Int = 8 * 4, BYTECODESZ:Int = 8 * 4, STACKFRAME_INC:Int = STACKFRAMESZ + 4, BYTECODE_INC:Int = BYTECODESZ + 4
	Const IP_OFFSET:Int = BlueVMMemory.PAGESZ - ISIZE

	'note: extern vars must take into account the vtbl offset, so that converting from a typed pointer can be a simple cast (faster)

	Function MOV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "MOV      //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		varp[rp[0]] = varp[rp[1]]	'assigning through Double is unsafe as it can corrupt the bit pattern
	End Function
	Function GETLC(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETLC(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "SETLC    //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Long Ptr Ptr(varp + rp[0])[0][0] = varp[rp[1]]
	End Function
	Function LOADK(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADK    //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, varp:Long Ptr = stk.varp + rp[0], kp:Long Ptr = Long Ptr Ptr(rp + 1)[0]
		varp[0] = kp[0]
	End Function
	Function LOADSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADSI   //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local val:Int = Int Ptr(rp + 1)[0]
		Double Ptr(stk.varp)[rp[0]] = Double(val)
	End Function
	Function LOADBOOL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADBOOL //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, vp:Int Ptr = Int Ptr(stk.varp + rp[0])
		vp[1] = BlueTypeTag.NANBOX | BlueTypeTag.BOOL
		vp[0] = Int Ptr(rp + 1)[0]
	End Function
	Function LOADNIL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADNIL  //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Int Ptr(stk.varp + rp[0])[1] = BlueTypeTag.NANBOX | BlueTypeTag.NIL
	End Function

	Function GETTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETTABSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTABSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETTABI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTABI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "GETUPV   //"
		Local varp:Long Ptr = stk.varp, upvp:Byte Ptr Ptr = Byte Ptr Ptr(Byte Ptr(stk) + STACKFRAME_INC)
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, valp:Long Ptr = Long Ptr(upvp[rp[1]])
		varp[rp[0]] = valp[0]
	End Function
	Function SETUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function NEWTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "NEWTAB   //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local tab:Byte Ptr = vm.mem.AllocTable(Null)
		Local d:Int Ptr = Int Ptr(varp + rp[0])
		d[0] = Int(tab) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.TBL
	End Function
	Function CLOSURE(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "CLOSURE  //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local d:Int Ptr = Int Ptr(varp + rp[0])
		Local cbytecode:Bytecode = vm.funIndex[Int Ptr(rp + 1)[0]], upvp:Int Ptr = Int Ptr(Byte Ptr(cbytecode) + BYTECODE_INC + 8 * cbytecode.icount)
		Local closure:Byte Ptr = vm.mem.AllocClosure(cbytecode, cbytecode.upvars)	'upvars is always even (alignment)

		'get upvalues off the stack
		For Local u:Int = 0 Until cbytecode.upvars
			If upvp[2 * u]
				Byte Ptr Ptr(closure)[2 + u] = Byte Ptr Ptr(Byte Ptr(stk) + STACKFRAME_INC)[upvp[2 * u + 1]]
			Else
				Byte Ptr Ptr(closure)[2 + u] = Byte Ptr Ptr(varp + upvp[2 * u + 1])[0]
			EndIf
		Next

		d[0] = Int(closure) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.FUN
	End Function
	Function NEWUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "NEWUPV   //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local upv:Byte Ptr = vm.mem.AllocObject(8, BlueTypeTag.UPV), d:Int Ptr = Int Ptr(stk.varp + rp[0])
		Long Ptr(upv)[0] = Long Ptr(d)[0]	'promote a value if it existed (useful for parameters)
		d[0] = Int(upv) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.UPV
	End Function

	Function ADD(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "ADD      //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local d:Double Ptr = Double Ptr(varp + rp[0])
		Local r:Int Ptr = Int Ptr(varp + rp[1]), l:Int Ptr = Int Ptr(varp + rp[2])
		If l[1] & BlueTypeTag.NANBOX_CHK = BlueTypeTag.NANBOX Or r[1] & BlueTypeTag.NANBOX_CHK = BlueTypeTag.NANBOX
			DebugStop
		Else
			d[0] = Double Ptr(l)[0] + Double Ptr(r)[0]
		EndIf
	End Function
	Function SUB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function MUL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function DIV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function NMOD(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function POW(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CAT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function IDIV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BAND(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BOR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BXOR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BSHL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BSHR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function UNM(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function LNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function ALEN(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function UNP(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function EQ(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "EQ       //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = (Byte Ptr Ptr(retptr) - 4)[0] + IP_OFFSET
		Local r:Double = Double Ptr(varp)[rp[1]]
		Local l:Double = Double Ptr(varp)[rp[2]]
		Int Ptr(varp + rp[0])[0] = l = r
	End Function
	Function LT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function LEQ(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function

	Function JMP(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
		Print "wait, why are we here?"
	End Function
	Function JIF(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "JIF      //"
		Local rp:Byte Ptr = (Byte Ptr Ptr(retptr) - 4)[0] + IP_OFFSET
		If Int Ptr(stk.varp + rp[0])[0]
			Local target:Int = Int Ptr(rp + 1)[0]
			Int Ptr(retptr)[-4] = target
		EndIf
	End Function
	Function JNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "CALL     //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local fp:Int Ptr = Int Ptr(varp + rp[0])
		If Not PrepareCall(fp, stk, rp, varp, retptr)	'PrepareCall sets everything up so there's nothing else to do to make the call happen
			'__call metamethod
		EndIf
	End Function
	Function TCALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function RET:Byte Ptr(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "RET      //"
		Local varp:Long Ptr = stk.varp
		Local rp0:Byte Ptr = Byte Ptr Ptr(retptr)[-4], rp:Byte Ptr = rp0 + IP_OFFSET

		Local oldStk:Stack = stk.prevBase
		Local retv:Long Ptr = varp + rp[0]
		If oldStk
			oldStk.retv = retv
			oldStk.retc = Int Ptr(rp + 1)[0]
			Byte Ptr Ptr(retptr)[-4] = stk.retIP
			Byte Ptr Ptr(retptr)[-3] = Byte Ptr(oldStk)
			Byte Ptr Ptr(retptr)[-2] = Byte Ptr(oldStk.func) + BYTECODE_INC
		Else	'return to native code
			Local codePage:Byte Ptr = Byte Ptr(Int(rp0) & ((Int(2^12)-1) Shl 20))
			Byte Ptr Ptr(retptr)[-4] = codePage + 4
			Return retv
		EndIf
	End Function
	Function RETVA(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function POSTCALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "POSTCALL //"
		Local varp:Long Ptr = stk.varp
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET

		For Local r:Int = 0 Until Min(Int Ptr(rp + 1)[0], stk.retc)
			(varp + rp[0])[r] = stk.retv[r]
		'	Print "  return " + r + ": " + Double Ptr(stk.retv)[r]
		Next
	End Function
	Function VARARG(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function VAINIT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CALLINIT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function

	Function PrepareCall:Int(fp:Int Ptr, stk:Stack, rp:Byte Ptr, varp:Long Ptr, retptr:Byte Ptr)
		If fp[1] = BlueTypeTag.NANBOX | BlueTypeTag.FUN
			Local newStk0:Stack ; Byte Ptr Ptr(Varptr(newStk0))[0] = Byte Ptr(stk) + stk.func.frameSz
			Local newStk:Stack = newStk0	'micro-opt: newStk0 can't be a register because of the unwieldy conversion

			newStk.retIP = Byte Ptr Ptr(retptr)[-4]
			newStk.prevBase = stk
			Local closure:Byte Ptr = Byte Ptr(fp[0])
			Local newBC:Bytecode = Bytecode Ptr(closure)[0]
			Local voff:Int = STACKFRAME_INC + 4 * newBC.upvars
			newStk.varp = Long Ptr(Byte Ptr(newStk) + voff)
			newStk.func = newBC
		'	newStk._IP = 0

			Local argc_actual:Int = Short Ptr(rp)[1], argc_required:Int = newBC.pcount
		'	Local argc_min:Int ; If argc_actual < argc_required Then argc_min = argc_actual Else argc_min = argc_required
			Local argc_min:Int = argc_actual - argc_required ; argc_min = (argc_min & (argc_min Shr 31)) + argc_required 'branchless 32-bit Min

			Local argv:Long Ptr = varp + rp[1], destv:Long Ptr = newStk.varp
			For Local a:Int = 0 Until argc_min
				destv[a] = argv[a]
			'	Print "  arg " + a + ": " + argv[a]
			Next
			For Local a:Int = argc_min Until argc_required	'nil any unfilled parameters
				Int Ptr(destv + a)[1] = BlueTypeTag.NANBOX | BlueTypeTag.NIL
			Next
			newStk.argv = argv + argc_min	'argv should be to the varargs (if any)
			newStk.argc = argc_actual - argc_min	'argc is the number of varargs

			Local destup:Byte Ptr Ptr = Byte Ptr Ptr(Byte Ptr(newStk) + STACKFRAME_INC)
			Local upv:Byte Ptr Ptr = Byte Ptr Ptr(closure + 8)
			For Local up:Int = 0 Until newBC.upvars	'emplace upvars
				destup[up] = upv[up]
			'	Print "  upv " + up + ": " + destv[up]
			'	Print "  val: " + Double Ptr Ptr(Byte Ptr Ptr(closure) + 2 + up)[0][0]
			Next

			'note that the following OVERWRITE THE PARAMETERS (in release mode), so no touching stk from here on
			Byte Ptr Ptr(retptr)[-4] = newBC.mcode
			Byte Ptr Ptr(retptr)[-3] = Byte Ptr(newStk)
			Byte Ptr Ptr(retptr)[-2] = Byte Ptr(newBC) + BYTECODE_INC

		ElseIf fp[1] = BlueTypeTag.NANBOX | BlueTypeTag.NATFUN
			'native call
		Else
			Return False	'not a function; take appropriate action
		EndIf
		Return True	'all good and will auto-call when the caller returns
	End Function

	Function InitOpTbl()
		opc = New BlueOpcode
		opTbl = [MOV, GETLC, SETLC, LOADK, LOADSI, LOADBOOL, LOADNIL, ..
			GETTAB, GETTABSI, SETTAB, SETTABSI, GETTABI, SETTABI, GETUPV, SETUPV, ..
			NEWTAB, CLOSURE, NEWUPV, ..
			ADD, SUB, MUL, DIV, NMOD, POW, CAT, ..
			IDIV, BAND, BOR, BXOR, BSHL, BSHR, ..
			UNM, LNOT, ALEN, BNOT, UNP, ..
			EQ, LT, LEQ, ..
			JMP, JIF, JNOT, CALL, TCALL, RETVA, RETVA, ..	'not a mistake: RET doesn't fit but we need the spacer
			POSTCALL, VARARG, VAINIT, CALLINIT]

		opTbl[opc.RET] = Byte Ptr(RET)
	End Function

	Function Identity:Byte Ptr(b:Byte Ptr)
		Return b
	End Function
	Function PointerToExtType:Byte Ptr(p:Byte Ptr)	'horrible pointer abuse (increment down so we can ignore the nonexistent vtbl)
		Return p - 4'sizeof(Byte Ptr)
	End Function
	Global BPtoS:Stack(p:Byte Ptr) = Byte Ptr(BlueJIT.PointerToExtType)
End Type

Type BlueLuaVal
	Field _obj:BlueGCNode

	Method Call()
	End Method
End Type

Rem
Local files:TList = CreateList()
Local as:String, ld:String, showHelp:Int, output:String = "a.out", doAssemble:Int = 1
Local keepAsm:Int, makeExe:Int = 1, asOpts:String, ldOpts:String, showAST:Int, showVersion:Int

?MacOS
as = "clang -m32 -c " ; ld = "clang -Wl,-no_pie -m32 -read_only_relocs suppress "
?Not MacOS
as = "gcc -m32 -c " ; ld = "gcc -m32 "
?

For Local a:Int = 1 Until AppArgs.Length
	Select AppArgs[a]
		Case "-?", "--help"
			showHelp = 1
		Case "-v"
			showVersion = 1
		Case "-o"
			If makeExe = 0
				Print "warning: -c and -o are mutually exclusive; -c is overruling -o"
			Else
				a :+ 1 ; output = AppArgs[a] ; makeExe = 2
			EndIf
		Case "-c"
			If makeExe = 2
				Print "warning: -o and -c are mutually exclusive; -o is overruling -c"
			Else
				doAssemble = 1 ; makeExe = 0
			EndIf
		Case "-s"
			keepAsm = 1
		Case "-S"
			keepAsm = 1 ; doAssemble = 0 ; makeExe = 0
		Case "--as"
			a :+ 1 ; as = AppArgs[a] + " "
		Case "--ld"
			a :+ 1 ; ld = AppArgs[a] + " "
		Case "--as-opt"
			a :+ 1 ; asOpts :+ AppArgs[a] + " "
		Case "--ld-opt"
			a :+ 1 ; ldOpts :+ AppArgs[a] + " "
		Case "--tree"
			showAST = 1 ; makeExe = 0
		Case "-w"     ; YBCodeGen.SetWarningLevel 0
		Case "--werr" ; YBCodeGen.SetWarningLevel 2
		Case "--warn" ; YBCodeGen.SetWarningLevel 1
		Default
			files.AddLast AppArgs[a]
	End Select
Next
If AppArgs.Length = 1 Then Print "ybc: no input files" ; End

If showVersion Then DisplayVersion
If showHelp Then DisplayHelp

?Win32
Local rm:String = "del /Q "
?Not Win32
Local rm:String = "rm "
?

Local allOFiles:String = ""
For Local file:String = EachIn files
	Try
		Local tree:TParseNode = YBParseFile(file)
		If showAST
			Print tree.ToString()
		Else
			YBCodeGen.Build tree
			YBAssembler.Emit file + ".s", YBCodeGen.syms, YBCodeGen.funs, YBCodeGen.vars, YBCodeGen.strs
			If doAssemble
				system_(as + asOpts + file + ".s -o " + file + ".o")
				allOFiles :+ file + ".o "
			EndIf
			If Not keepAsm
				system_ rm + file + ".s"
			EndIf
		EndIf
	Catch e:Object
		Print "Compile error:~n    " + e.ToString()
		Print "Compilation halted."
		?Debug
		Throw e
		?
		End
	End Try
Next

?Linux
Local bLib:String = "b-lib-linux"
?Not Linux
Local bLib:String = "b-lib"
?
If makeExe
	If Not FileType("b-lib.o") Then system_ as + bLib + ".s -o b-lib.o"
	system_(ld + ldOpts + "-o " + output + " " + allOFiles + " b-lib.o")
	system_(rm + allOFiles)
EndIf

Print "done."
End
End Rem
Rem
Function DisplayVersion()
	Print "Shadow SIMD Compiler: version 0.0"
End Function

Function DisplayHelp()
	Print "OVERVIEW: ybc compiler for B~n"
	Print "USAGE: ybc [options] <files>~n"
	Print "OPTIONS:~n"
	Print "  -?, --help  Display this message"
	Print "  -v          Show the compiler version"
	Print "  -o          Set the name of the output executable (default 'a.out')"
	Print "  -c          Produce separate .o files instead of an executable"
	Print "  -s          Keep text assembly .s files"
	Print "  -S          Only produce text assembly, do not assemble binaries"
	Print "  --as        Set the command to use as the assembler"
	Print "  --ld        Set the command to use as the linker"
	Print "  --as-opt    Add an option to pass to the assembler (can repeat)"
	Print "  --ld-opt    Add an option to pass to the linker (can repeat)"
	Print "  --tree      Display the AST of the program source instead of compiling"
	Print "  -w          Silence warnings"
	Print "  --werr      Convert warnings to errors"
	Print "  --warn      Notify but do not halt on warnings (default)"
End Function
End Rem

' Blue Moon
' an implementation of Lua in pure BlitzMax

SuperStrict

'Framework Brl.Blitz
'Import Brl.LinkedList
'Import Brl.Map
'Import Brl.Reflection

Import "bluecompiler.bmx"
Import "blueallocator.bmx"
Rem
Import "blueasm.o"
Extern
Function ADD:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "ADD2"
Function EQ:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "EQ2"
Function GETUPV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "GETUPV2"
Function JIF:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "JIF2"
Function LOADBOOL:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADBOOL2"
Function LOADK:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADK2"
Function LOADNIL:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADNIL2"
Function LOADSI:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "LOADSI2"
Function MOV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "MOV2"
Function NEWUPV:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "NEWUPV2"
Function SETLC:Int(s:Stack, b:Bytecode, r:Byte Ptr) = "SETLC2"
End Extern
End Rem
'Const file:String = "tests/checktable.lua"
'Const file:String = "tests/mandelbrot.lua"
'Const file:String = "tests/sieve.lua"
'Const file:String = "tests/attrib.lua"
Const file:String = "test.lua"

Const outFile:String = "out.lua.so"

Print BlueCompiler.ShowBytecode(file)

Rem
BlueJIT.InitOpTbl()
'BlueJIT.opTbl[BlueJIT.opc.ADD] = ADD
'BlueJIT.opTbl[BlueJIT.opc.EQ] = EQ
'BlueJIT.opTbl[BlueJIT.opc.GETUPV] = GETUPV
'BlueJIT.opTbl[BlueJIT.opc.JIF] = JIF
'BlueJIT.opTbl[BlueJIT.opc.LOADBOOL] = LOADBOOL
'BlueJIT.opTbl[BlueJIT.opc.LOADK] = LOADK
'BlueJIT.opTbl[BlueJIT.opc.LOADNIL] = LOADNIL
'BlueJIT.opTbl[BlueJIT.opc.LOADSI] = LOADSI
BlueJIT.opTbl[BlueJIT.opc.MOV] = MOV
'BlueJIT.opTbl[BlueJIT.opc.NEWUPV] = NEWUPV
'BlueJIT.opTbl[BlueJIT.opc.SETLC] = SETLC
End Rem

Local code:BlueBinary = BlueCompiler.CompileFileForLoad(file)
Local vm:BlueVM = New BlueVM
Local tl:BlueLuaVal = vm.LoadObjectCode(code)
'tl.Call()

Local stk:Stack = BlueJIT.BPtoS(vm.mem.stack)
stk.retIP = Null ; stk.prevBase = Null
Local vc:Int = 10, upvars:Int = 1
stk.varp = Long Ptr(Byte Ptr(stk) + BlueJIT.STACKFRAME_INC) + upvars
stk.func = vm.funIndex[0]
'stk.IP = 0
stk.argv = Null	'may want to add space?
stk.retv = Null
stk.argc = 0
stk.retc = 0

Print "running..."
Local t:Int = MilliSecs()
Local test:Int(_:Byte Ptr) = stk.func.mcode - BlueJIT.PROLOGUESZ ; test(stk)
t = MilliSecs() - t
Print t
Print "run complete"

Print "done."
End

' notes:
' - string constants and bytecode are loaded directly into oldSpc, since they'll be needed often
' - the structure of a bytecode object is:
'    [ machine code ptr ][ id-offset ][ #k ][ #param ][ #upvar ][ frame sz ][ #instrs ][ vm ][ instructions... ][ upvar table... ][ k table... ]
'   initial fields are all 32b; instructions are each 64b; upvar table is pairs of 32b values (level, pos); k table is NaN-box values

' - the structure of a closure object (actual Lua value representing a function) is:
'    [ bytecode ptr ][ upvar values... ]

Type BlueVM
	Field mem:BlueVMMemory, _ENV:BlueLuaVal
	Field idMod:Int, funIndex:Bytecode Ptr, _fiSz:Int

	Method New()
		mem = New BlueVMMemory
	End Method

	' Load the procedures and constants of a compiled binary into the VM, returning the function representing the program toplevel
	Method LoadObjectCode:BlueLuaVal(code:BlueBinary)
		Local buf:Int[] = code.buf
		Local fcount:Int = buf[0], kcount:Int = buf[1], ktblpos:Int = buf[2], ktbl:Double[kcount]
		Local convert:Byte Ptr(o:Object) = Byte Ptr(BlueJIT.Identity)

		For Local k:Int = 0 Until kcount
			Local koff:Int = buf[ktblpos + k], sz:Int = buf[ktblpos + k + 1] - koff
			If sz > 2	'strings have size > 2
				Local length:Double, lp:Int Ptr = Int Ptr(Varptr(length))
				lp[0] = buf[koff] ; lp[1] = buf[koff + 1]
				Local s:Byte Ptr = mem.AllocString(length, Short Ptr(Varptr(buf[koff + 2])))
				ktbl[k] = mem.PtrToVal(s, BlueTypeTag.STR)
			Else
				Local d:Double, dp:Int Ptr = Int Ptr(Varptr(d))
				dp[0] = buf[koff] ; dp[1] = buf[koff + 1]
				ktbl[k] = d
			EndIf
		Next

		ExtendFunIndex(idMod + fcount)
		For Local f:Int = 0 Until fcount
			Local foff:Int = buf[3 + f]
			Local ic:Int = buf[foff + 1], kc:Int = buf[foff + 2], pc:Int = buf[foff + 3], uc:Int = buf[foff + 5], fsz:Int = buf[foff + 6]

			Local b:Bytecode = BPtoBC(mem.AllocObjectOldSpace(mem.oldStrSpace, (8 + 2 * (uc + uc Mod 2) + 2 * kc + 2 * ic) * 4, BlueTypeTag.BCODE))
			b.idMod = idMod ; b.kcount = kc ; b.pcount = pc ; b.upvars = uc + (uc Mod 2)	'round up for alignment
			b.frameSz = BlueJIT.STACKFRAMESZ + b.upvars * 8 + fsz * 8 ; b.icount = ic ; b.vm = convert(Self)

			Local ib:Int Ptr = Int Ptr(Byte Ptr(b) + 4) + 8 + 2 * ic
			For Local u:Int = 0 Until uc
				Local uoff:Int = 7 + u * 2
				ib[u * 2] = buf[foff + uoff] ; ib[u * 2 + 1] = buf[foff + uoff + 1]
			Next
			If uc <> b.upvars	'ensure padding is safe by copying the first one
				ib[uc * 2] = buf[foff + 7] ; ib[uc * 2 + 1] = buf[foff + 7 + 1]
			EndIf

			Local db:Double Ptr = Double Ptr(ib + 2 * b.upvars)
			For Local k:Int = 0 Until kc
				db[k] = ktbl[buf[foff + 7 + uc * 2 + k]]
			Next

			Local ioff:Int = 7 + 2 * uc + kc ; ib = Int Ptr(Byte Ptr(b) + BlueJIT.BYTECODE_INC)

			For Local i:Int = 0 Until ic * 2
				ib[i] = buf[foff + ioff + i]
			Next

			b.mcode = BlueJIT.Compile(Self, ib, ic, b) + BlueJIT.PROLOGUESZ
			funIndex[idMod + f] = b
		Next

		idMod :+ fcount
		Return New BlueLuaVal
	End Method

	Method ExtendFunIndex(sz:Int)	'hack: BlitzMax has a bug with arrays of extern types! so we need to use C-style arrays for now
		Local newFI:Bytecode Ptr = Bytecode Ptr(MemAlloc(sz * 4))
		If _fiSz
			For Local b:Int = 0 Until _fiSz
				newFI[b] = funIndex[b]
			Next
			MemFree(funIndex)
			For Local b:Int = _fiSz Until sz
				newFI[b] = Null
			Next
		EndIf
		funIndex = newFI ; _fiSz = sz
	End Method

	Method CallToLua()
	End Method

	Global BPtoBC:Bytecode(p:Byte Ptr) = Byte Ptr(BlueJIT.PointerToExtType)
End Type

Private
Extern
	Type Stack
		Field retIP:Byte Ptr, prevBase:Stack, varp:Long Ptr, func:Bytecode, _IP:Int, argv:Long Ptr, retv:Long Ptr, argc:Short, retc:Short
	End Type
	Type Bytecode
		Field mcode:Byte Ptr, idMod:Int, kcount:Int, pcount:Int, upvars:Int, frameSz:Int, icount:Int, vm:Byte Ptr
	End Type
End Extern
Public

Type BlueJIT Final
	Const PROLOGUESZ:Int = 25, ISIZE:Int = 5

	Global opTbl:Int(s:Stack, b:Bytecode, r:Byte Ptr)[], opc:BlueOpcode
	Global Prologue:Int[] = [ ..
		$90, $90, ..
		$8b, $44, $24, $04, ..                     'mov 4(%esp), %eax
		$89, $44, $24, $f4, ..                     'mov %eax, -12(%esp)
		$c7, $44, $24, $f8, $FF, $FF, $FF, $FF, .. 'movl ########, -8(%esp)
		$89, $64, $24, $fc, ..                     'mov %esp, -4(%esp)
		$83, $ec, $0c..                            'sub $12, %esp
	]

	Function Compile:Byte Ptr(vm:BlueVM, ins:Byte Ptr, icount:Int, bytecode:Bytecode)
		?Not x86
		RuntimeError "The Blue Moon JIT does not support your platform (x86-32 only at this time)"
		?
		Assert SizeOf(0:Long) = SizeOf(0:Double) And SizeOf(0:Int) = 4 And SizeOf(0:Long) = 8 And SizeOf(Byte Ptr(0)) = 4, ..
			"assumptions about platform datatype sizes are invalid"

		If opTbl = Null Then InitOpTbl()

		Local sz:Int = PROLOGUESZ + icount * ISIZE

		' allocate executable space
		Local blocks:Int[] = vm.mem.AllocCodeBlock(PROLOGUESZ + icount * ISIZE)
		Local code:Byte Ptr = Byte Ptr(blocks[0]), rsize:Int = blocks[1] - (blocks[1] Mod ISIZE)

		For Local p:Int = 0 Until PROLOGUESZ	'emplace prologue (used for calling in from native only)
			code[p] = Prologue[p]
		Next
		Byte Ptr Ptr(code + 14)[0] = Byte Ptr(bytecode)	'replace the ########
		code :+ PROLOGUESZ ; rsize :- PROLOGUESZ	'easier to not have to take this into account below

		Local codePage:Int Ptr = Int Ptr(Int(code) & ((Int(2^12)-1) Shl 20))	'return-to-native for the page
		codePage[1] = $c30cc483	'add $12, %esp ; ret  - i.e. restore the stack to normal

		' generate machine code!
		Repeat

			For Local i:Int = 0 Until rsize / ISIZE	'emplace opcode calls and supporting bytecode data
				Local codep:Byte Ptr = code + i * ISIZE, bytecodep:Byte Ptr = Byte Ptr(Int(codep) + vm.mem.PAGESZ)
				codep[0] = $e8	'call
				Local bi:Int = i * 8, op:Int = ins[bi], ip:Int Ptr = Int Ptr(ins + bi), func:Byte Ptr = opTbl[op]
				Byte Ptr Ptr(codep + 1)[0] = func - Int(codep + ISIZE)

				Select op
					Case opc.LOADSI, opc.CLOSURE, opc.RET, opc.POSTCALL
						bytecodep[0] = ins[bi + 1] ; Int Ptr(bytecodep + 1)[0] = Int Ptr(ins + bi)[1]

					Case opc.LOADK
						Local kp:Double Ptr = Double Ptr(ins + 8 * bytecode.icount + 8 * bytecode.upvars) + ip[1]
						bytecodep[0] = ins[bi + 1] ; Double Ptr Ptr(bytecodep + 1)[0] = kp

					Case opc.CALL
						bytecodep[0] = ins[bi + 1] ; bytecodep[1] = ins[bi + 2]
						Short Ptr(bytecodep)[1] = Int Ptr(ins + bi)[1]

					Case opc.JIF, opc.JNOT
						bytecodep[0] = ins[bi + 1]
						Int Ptr(bytecodep + 1)[0] = Int(codep) + ISIZE * Int Ptr(ins + bi)[1]

					Case opc.JMP
						codep[0] = $e9	'use a true jump
						Int Ptr(codep + 1)[0] = ISIZE * (Int Ptr(ins + bi)[1] - 1)

					Default	'binary operations A = B op C
						bytecodep[0] = ins[bi + 1] ; bytecodep[1] = ins[bi + 2] ; bytecodep[2] = Int Ptr(ins + bi)[1]
				End Select
			Next

			Exit	'deal with overflowing code sections here
		Forever

		Return code - PROLOGUESZ
	End Function

	Const STACKFRAMESZ:Int = 8 * 4, BYTECODESZ:Int = 8 * 4, STACKFRAME_INC:Int = STACKFRAMESZ + 4, BYTECODE_INC:Int = BYTECODESZ + 4
	Const IP_OFFSET:Int = BlueVMMemory.PAGESZ - ISIZE

	'note: extern vars must take into account the vtbl offset, so that converting from a typed pointer can be a simple cast (faster)

	Function MOV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "MOV      //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		varp[rp[0]] = varp[rp[1]]	'assigning through Double is unsafe as it can corrupt the bit pattern
	End Function
	Function GETLC(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETLC(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "SETLC    //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Long Ptr Ptr(varp + rp[0])[0][0] = varp[rp[1]]
	End Function
	Function LOADK(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADK    //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, varp:Long Ptr = stk.varp + rp[0], kp:Long Ptr = Long Ptr Ptr(rp + 1)[0]
		varp[0] = kp[0]
	End Function
	Function LOADSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADSI   //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local val:Int = Int Ptr(rp + 1)[0]
		Double Ptr(stk.varp)[rp[0]] = Double(val)
	End Function
	Function LOADBOOL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADBOOL //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, vp:Int Ptr = Int Ptr(stk.varp + rp[0])
		vp[1] = BlueTypeTag.NANBOX | BlueTypeTag.BOOL
		vp[0] = Int Ptr(rp + 1)[0]
	End Function
	Function LOADNIL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "LOADNIL  //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Int Ptr(stk.varp + rp[0])[1] = BlueTypeTag.NANBOX | BlueTypeTag.NIL
	End Function

	Function GETTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETTABSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTABSI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETTABI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function SETTABI(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function GETUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "GETUPV   //"
		Local varp:Long Ptr = stk.varp, upvp:Byte Ptr Ptr = Byte Ptr Ptr(Byte Ptr(stk) + STACKFRAME_INC)
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET, valp:Long Ptr = Long Ptr(upvp[rp[1]])
		varp[rp[0]] = valp[0]
	End Function
	Function SETUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function NEWTAB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "NEWTAB   //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local tab:Byte Ptr = vm.mem.AllocTable(Null)
		Local d:Int Ptr = Int Ptr(varp + rp[0])
		d[0] = Int(tab) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.TBL
	End Function
	Function CLOSURE(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "CLOSURE  //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local d:Int Ptr = Int Ptr(varp + rp[0])
		Local cbytecode:Bytecode = vm.funIndex[Int Ptr(rp + 1)[0]], upvp:Int Ptr = Int Ptr(Byte Ptr(cbytecode) + BYTECODE_INC + 8 * cbytecode.icount)
		Local closure:Byte Ptr = vm.mem.AllocClosure(cbytecode, cbytecode.upvars)	'upvars is always even (alignment)

		'get upvalues off the stack
		For Local u:Int = 0 Until cbytecode.upvars
			If upvp[2 * u]
				Byte Ptr Ptr(closure)[2 + u] = Byte Ptr Ptr(Byte Ptr(stk) + STACKFRAME_INC)[upvp[2 * u + 1]]
			Else
				Byte Ptr Ptr(closure)[2 + u] = Byte Ptr Ptr(varp + upvp[2 * u + 1])[0]
			EndIf
		Next

		d[0] = Int(closure) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.FUN
	End Function
	Function NEWUPV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "NEWUPV   //"
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local convert:BlueVM(p:Byte Ptr) = Byte Ptr(Identity), vm:BlueVM = convert(bc.vm)
		Local upv:Byte Ptr = vm.mem.AllocObject(8, BlueTypeTag.UPV), d:Int Ptr = Int Ptr(stk.varp + rp[0])
		Long Ptr(upv)[0] = Long Ptr(d)[0]	'promote a value if it existed (useful for parameters)
		d[0] = Int(upv) ; d[1] = BlueTypeTag.NANBOX | BlueTypeTag.UPV
	End Function

	Function ADD(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "ADD      //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local d:Double Ptr = Double Ptr(varp + rp[0])
		Local r:Int Ptr = Int Ptr(varp + rp[1]), l:Int Ptr = Int Ptr(varp + rp[2])
		If l[1] & BlueTypeTag.NANBOX_CHK = BlueTypeTag.NANBOX Or r[1] & BlueTypeTag.NANBOX_CHK = BlueTypeTag.NANBOX
			DebugStop
		Else
			d[0] = Double Ptr(l)[0] + Double Ptr(r)[0]
		EndIf
	End Function
	Function SUB(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function MUL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function DIV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function NMOD(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function POW(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CAT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function IDIV(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BAND(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BOR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BXOR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BSHL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BSHR(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function UNM(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function LNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function ALEN(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function BNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function UNP(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function EQ(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "EQ       //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = (Byte Ptr Ptr(retptr) - 4)[0] + IP_OFFSET
		Local r:Double = Double Ptr(varp)[rp[1]]
		Local l:Double = Double Ptr(varp)[rp[2]]
		Int Ptr(varp + rp[0])[0] = l = r
	End Function
	Function LT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function LEQ(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function

	Function JMP(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
		Print "wait, why are we here?"
	End Function
	Function JIF(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "JIF      //"
		Local rp:Byte Ptr = (Byte Ptr Ptr(retptr) - 4)[0] + IP_OFFSET
		If Int Ptr(stk.varp + rp[0])[0]
			Local target:Int = Int Ptr(rp + 1)[0]
			Int Ptr(retptr)[-4] = target
		EndIf
	End Function
	Function JNOT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "CALL     //"
		Local varp:Long Ptr = stk.varp, rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET
		Local fp:Int Ptr = Int Ptr(varp + rp[0])
		If Not PrepareCall(fp, stk, rp, varp, retptr)	'PrepareCall sets everything up so there's nothing else to do to make the call happen
			'__call metamethod
		EndIf
	End Function
	Function TCALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function RET:Byte Ptr(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "RET      //"
		Local varp:Long Ptr = stk.varp
		Local rp0:Byte Ptr = Byte Ptr Ptr(retptr)[-4], rp:Byte Ptr = rp0 + IP_OFFSET

		Local oldStk:Stack = stk.prevBase
		Local retv:Long Ptr = varp + rp[0]
		If oldStk
			oldStk.retv = retv
			oldStk.retc = Int Ptr(rp + 1)[0]
			Byte Ptr Ptr(retptr)[-4] = stk.retIP
			Byte Ptr Ptr(retptr)[-3] = Byte Ptr(oldStk)
			Byte Ptr Ptr(retptr)[-2] = Byte Ptr(oldStk.func) + BYTECODE_INC
		Else	'return to native code
			Local codePage:Byte Ptr = Byte Ptr(Int(rp0) & ((Int(2^12)-1) Shl 20))
			Byte Ptr Ptr(retptr)[-4] = codePage + 4
			Return retv
		EndIf
	End Function
	Function RETVA(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function POSTCALL(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	'	Print "POSTCALL //"
		Local varp:Long Ptr = stk.varp
		Local rp:Byte Ptr = Byte Ptr Ptr(retptr)[-4] + IP_OFFSET

		For Local r:Int = 0 Until Min(Int Ptr(rp + 1)[0], stk.retc)
			(varp + rp[0])[r] = stk.retv[r]
		'	Print "  return " + r + ": " + Double Ptr(stk.retv)[r]
		Next
	End Function
	Function VARARG(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function VAINIT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function
	Function CALLINIT(stk:Stack, bc:Bytecode, retptr:Byte Ptr)
	End Function

	Function PrepareCall:Int(fp:Int Ptr, stk:Stack, rp:Byte Ptr, varp:Long Ptr, retptr:Byte Ptr)
		If fp[1] = BlueTypeTag.NANBOX | BlueTypeTag.FUN
			Local newStk0:Stack ; Byte Ptr Ptr(Varptr(newStk0))[0] = Byte Ptr(stk) + stk.func.frameSz
			Local newStk:Stack = newStk0	'micro-opt: newStk0 can't be a register because of the unwieldy conversion

			newStk.retIP = Byte Ptr Ptr(retptr)[-4]
			newStk.prevBase = stk
			Local closure:Byte Ptr = Byte Ptr(fp[0])
			Local newBC:Bytecode = Bytecode Ptr(closure)[0]
			Local voff:Int = STACKFRAME_INC + 4 * newBC.upvars
			newStk.varp = Long Ptr(Byte Ptr(newStk) + voff)
			newStk.func = newBC
		'	newStk._IP = 0

			Local argc_actual:Int = Short Ptr(rp)[1], argc_required:Int = newBC.pcount
		'	Local argc_min:Int ; If argc_actual < argc_required Then argc_min = argc_actual Else argc_min = argc_required
			Local argc_min:Int = argc_actual - argc_required ; argc_min = (argc_min & (argc_min Shr 31)) + argc_required 'branchless 32-bit Min

			Local argv:Long Ptr = varp + rp[1], destv:Long Ptr = newStk.varp
			For Local a:Int = 0 Until argc_min
				destv[a] = argv[a]
			'	Print "  arg " + a + ": " + argv[a]
			Next
			For Local a:Int = argc_min Until argc_required	'nil any unfilled parameters
				Int Ptr(destv + a)[1] = BlueTypeTag.NANBOX | BlueTypeTag.NIL
			Next
			newStk.argv = argv + argc_min	'argv should be to the varargs (if any)
			newStk.argc = argc_actual - argc_min	'argc is the number of varargs

			Local destup:Byte Ptr Ptr = Byte Ptr Ptr(Byte Ptr(newStk) + STACKFRAME_INC)
			Local upv:Byte Ptr Ptr = Byte Ptr Ptr(closure + 8)
			For Local up:Int = 0 Until newBC.upvars	'emplace upvars
				destup[up] = upv[up]
			'	Print "  upv " + up + ": " + destv[up]
			'	Print "  val: " + Double Ptr Ptr(Byte Ptr Ptr(closure) + 2 + up)[0][0]
			Next

			'note that the following OVERWRITE THE PARAMETERS (in release mode), so no touching stk from here on
			Byte Ptr Ptr(retptr)[-4] = newBC.mcode
			Byte Ptr Ptr(retptr)[-3] = Byte Ptr(newStk)
			Byte Ptr Ptr(retptr)[-2] = Byte Ptr(newBC) + BYTECODE_INC

		ElseIf fp[1] = BlueTypeTag.NANBOX | BlueTypeTag.NATFUN
			'native call
		Else
			Return False	'not a function; take appropriate action
		EndIf
		Return True	'all good and will auto-call when the caller returns
	End Function

	Function InitOpTbl()
		opc = New BlueOpcode
		opTbl = [MOV, GETLC, SETLC, LOADK, LOADSI, LOADBOOL, LOADNIL, ..
			GETTAB, GETTABSI, SETTAB, SETTABSI, GETTABI, SETTABI, GETUPV, SETUPV, ..
			NEWTAB, CLOSURE, NEWUPV, ..
			ADD, SUB, MUL, DIV, NMOD, POW, CAT, ..
			IDIV, BAND, BOR, BXOR, BSHL, BSHR, ..
			UNM, LNOT, ALEN, BNOT, UNP, ..
			EQ, LT, LEQ, ..
			JMP, JIF, JNOT, CALL, TCALL, RETVA, RETVA, ..	'not a mistake: RET doesn't fit but we need the spacer
			POSTCALL, VARARG, VAINIT, CALLINIT]

		opTbl[opc.RET] = Byte Ptr(RET)
	End Function

	Function Identity:Byte Ptr(b:Byte Ptr)
		Return b
	End Function
	Function PointerToExtType:Byte Ptr(p:Byte Ptr)	'horrible pointer abuse (increment down so we can ignore the nonexistent vtbl)
		Return p - 4'sizeof(Byte Ptr)
	End Function
	Global BPtoS:Stack(p:Byte Ptr) = Byte Ptr(BlueJIT.PointerToExtType)
End Type

Type BlueLuaVal
	Field _obj:BlueGCNode

	Method Call()
	End Method
End Type

Rem
Local files:TList = CreateList()
Local as:String, ld:String, showHelp:Int, output:String = "a.out", doAssemble:Int = 1
Local keepAsm:Int, makeExe:Int = 1, asOpts:String, ldOpts:String, showAST:Int, showVersion:Int

?MacOS
as = "clang -m32 -c " ; ld = "clang -Wl,-no_pie -m32 -read_only_relocs suppress "
?Not MacOS
as = "gcc -m32 -c " ; ld = "gcc -m32 "
?

For Local a:Int = 1 Until AppArgs.Length
	Select AppArgs[a]
		Case "-?", "--help"
			showHelp = 1
		Case "-v"
			showVersion = 1
		Case "-o"
			If makeExe = 0
				Print "warning: -c and -o are mutually exclusive; -c is overruling -o"
			Else
				a :+ 1 ; output = AppArgs[a] ; makeExe = 2
			EndIf
		Case "-c"
			If makeExe = 2
				Print "warning: -o and -c are mutually exclusive; -o is overruling -c"
			Else
				doAssemble = 1 ; makeExe = 0
			EndIf
		Case "-s"
			keepAsm = 1
		Case "-S"
			keepAsm = 1 ; doAssemble = 0 ; makeExe = 0
		Case "--as"
			a :+ 1 ; as = AppArgs[a] + " "
		Case "--ld"
			a :+ 1 ; ld = AppArgs[a] + " "
		Case "--as-opt"
			a :+ 1 ; asOpts :+ AppArgs[a] + " "
		Case "--ld-opt"
			a :+ 1 ; ldOpts :+ AppArgs[a] + " "
		Case "--tree"
			showAST = 1 ; makeExe = 0
		Case "-w"     ; YBCodeGen.SetWarningLevel 0
		Case "--werr" ; YBCodeGen.SetWarningLevel 2
		Case "--warn" ; YBCodeGen.SetWarningLevel 1
		Default
			files.AddLast AppArgs[a]
	End Select
Next
If AppArgs.Length = 1 Then Print "ybc: no input files" ; End

If showVersion Then DisplayVersion
If showHelp Then DisplayHelp

?Win32
Local rm:String = "del /Q "
?Not Win32
Local rm:String = "rm "
?

Local allOFiles:String = ""
For Local file:String = EachIn files
	Try
		Local tree:TParseNode = YBParseFile(file)
		If showAST
			Print tree.ToString()
		Else
			YBCodeGen.Build tree
			YBAssembler.Emit file + ".s", YBCodeGen.syms, YBCodeGen.funs, YBCodeGen.vars, YBCodeGen.strs
			If doAssemble
				system_(as + asOpts + file + ".s -o " + file + ".o")
				allOFiles :+ file + ".o "
			EndIf
			If Not keepAsm
				system_ rm + file + ".s"
			EndIf
		EndIf
	Catch e:Object
		Print "Compile error:~n    " + e.ToString()
		Print "Compilation halted."
		?Debug
		Throw e
		?
		End
	End Try
Next

?Linux
Local bLib:String = "b-lib-linux"
?Not Linux
Local bLib:String = "b-lib"
?
If makeExe
	If Not FileType("b-lib.o") Then system_ as + bLib + ".s -o b-lib.o"
	system_(ld + ldOpts + "-o " + output + " " + allOFiles + " b-lib.o")
	system_(rm + allOFiles)
EndIf

Print "done."
End
End Rem
Rem
Function DisplayVersion()
	Print "Shadow SIMD Compiler: version 0.0"
End Function

Function DisplayHelp()
	Print "OVERVIEW: ybc compiler for B~n"
	Print "USAGE: ybc [options] <files>~n"
	Print "OPTIONS:~n"
	Print "  -?, --help  Display this message"
	Print "  -v          Show the compiler version"
	Print "  -o          Set the name of the output executable (default 'a.out')"
	Print "  -c          Produce separate .o files instead of an executable"
	Print "  -s          Keep text assembly .s files"
	Print "  -S          Only produce text assembly, do not assemble binaries"
	Print "  --as        Set the command to use as the assembler"
	Print "  --ld        Set the command to use as the linker"
	Print "  --as-opt    Add an option to pass to the assembler (can repeat)"
	Print "  --ld-opt    Add an option to pass to the linker (can repeat)"
	Print "  --tree      Display the AST of the program source instead of compiling"
	Print "  -w          Silence warnings"
	Print "  --werr      Convert warnings to errors"
	Print "  --warn      Notify but do not halt on warnings (default)"
End Function
End Rem


Removed unneeded line of code

Removed unneeded line of code

Rem
	bbdoc:
End Rem
Type TXMLRPC_Response_Data_Exception Extends TXMLRPC_Exception
End Type

Rem
	bbdoc: Data returned from XML-RPC server
End Rem
Type TXMLRPC_Response_Data
	Field data:TMap

	Rem
		bbdoc:
	End Rem
	Method Create:TXMLRPC_Response_Data(message:String, options:Byte Ptr)
		Local request:Byte Ptr = XMLRPC_REQUEST_FromXML(message, Null, options)

		Local el:Byte Ptr = XMLRPC_RequestGetData(request)

		Self.data = TXMLRPC_Response_Data.IterateVector(el)

		XMLRPC_RequestFree(request, 1)
		Return Self
	End Method

	Rem
		bbdoc: Iterate over an XMLRPC vector and add it to a TMap
	End Rem
	Function IterateVector:TMap(el:Byte Ptr)
		Local data:TMap = New TMap

		If el
			'Rewind vector
			Local itr:Byte Ptr = XMLRPC_VectorRewind(el)
			If Not itr
				data.Insert("0", TXMLRPC_Data_Type_Abstract.XMLRPC_To_BlizMax(el))
			Else
				Local dataCounter:Int = 0
				While itr
					Local id:String = String.FromCString(XMLRPC_GetValueID(itr))

					If id.Length = 0
						id = String.FromInt(dataCounter)
						dataCounter:+1
					End If

					data.Insert(id, TXMLRPC_Data_Type_Abstract.XMLRPC_To_BlizMax(itr))

					'Next element
					itr = XMLRPC_VectorNext(el)
				Wend
			End If
		End If

		Return data
	End Function

	Rem
		bbdoc: Helper function to show what's inside the map
	End Rem
	Function DebugData:String(map:TMap, pad:Int Var)
		Local str:String
		Local prefix:String
		For Local i:Int = 0 To pad
			prefix:+"-"
		Next

		For Local val:TXMLRPC_Data_Type_Abstract = EachIn map.Values()
			str:+prefix + " " + TTypeId.ForObject(val).Name() + " (" + val.name + ") = " + val.ToString() + "~n"
			If TXMLRPC_Data_Type_Collection(val)
				pad:+1
				str:+TXMLRPC_Response_Data.DebugData(TXMLRPC_Data_Type_Collection(val).data, pad) + "~n"
				pad:-1
			End If
		Next
		Return str
	End Function
End Type

Rem
	bbdoc:
End Rem
Type TXMLRPC_Response_Data_Exception Extends TXMLRPC_Exception
End Type

Rem
	bbdoc: Data returned from XML-RPC server
End Rem
Type TXMLRPC_Response_Data
	Field data:TMap

	Rem
		bbdoc:
	End Rem
	Method Create:TXMLRPC_Response_Data(message:String, options:Byte Ptr)
		Local request:Byte Ptr = XMLRPC_REQUEST_FromXML(message, Null, options)

		Local el:Byte Ptr = XMLRPC_RequestGetData(request)

		Self.data = TXMLRPC_Response_Data.IterateVector(el)

		XMLRPC_RequestFree(request, 1)
		Return Self
	End Method

	Rem
		bbdoc: Iterate over an XMLRPC vector and add it to a TMap
	End Rem
	Function IterateVector:TMap(el:Byte Ptr)
		Local data:TMap = New TMap

		If el
			'Rewind vector
			Local itr:Byte Ptr = XMLRPC_VectorRewind(el)
			If Not itr
				data.Insert("0", TXMLRPC_Data_Type_Abstract.XMLRPC_To_BlizMax(el))
			Else
				Local dataCounter:Int = 0
				While itr
					Local dataType:Int = XMLRPC_GetValueType(itr)
					Local id:String = String.FromCString(XMLRPC_GetValueID(itr))

					If id.Length = 0
						id = String.FromInt(dataCounter)
						dataCounter:+1
					End If

					data.Insert(id, TXMLRPC_Data_Type_Abstract.XMLRPC_To_BlizMax(itr))

					'Next element
					itr = XMLRPC_VectorNext(el)
				Wend
			End If
		End If

		Return data
	End Function

	Rem
		bbdoc: Helper function to show what's inside the map
	End Rem
	Function DebugData:String(map:TMap, pad:Int Var)
		Local str:String
		Local prefix:String
		For Local i:Int = 0 To pad
			prefix:+"-"
		Next

		For Local val:TXMLRPC_Data_Type_Abstract = EachIn map.Values()
			str:+prefix + " " + TTypeId.ForObject(val).Name() + " (" + val.name + ") = " + val.ToString() + "~n"
			If TXMLRPC_Data_Type_Collection(val)
				pad:+1
				str:+TXMLRPC_Response_Data.DebugData(TXMLRPC_Data_Type_Collection(val).data, pad) + "~n"
				pad:-1
			End If
		Next
		Return str
	End Function
End Type


Stop key going over 256 which causes BlitzMax to crash for MonkeyMax.

--HG--
extra : convert_revision : svn%3Ae934d3cd-0d57-f34a-94d0-9e8d31ae1c29/trunk%40353

' ***** Start mojo.bmax.bmx ******

Global app:gxtkApp

Type gxtkApp
	Field ginput:gxtkInput
	Field gaudio:gxtkAudio
	Field ggraphics:gxtkGraphics

	Field dead:Int=0
	Field suspended:Int=0
	Field vloading:Int=0
	Field maxloading:Int=0
	Field updateRate:Int=0
	Field nextUpdate:Float=0
	Field updatePeriod:Float=0
	Field startMillis:Float=0

	Method New()' gxtkApp()
		app=Self
		ggraphics=New gxtkGraphics
	EndMethod

	Method Setup()
		ginput=New gxtkInput
		gaudio=New gxtkAudio

		bb_input_SetInputDevice(ginput)
		bb_audio_SetAudioDevice(gaudio)

		startMillis=BlitzMaxMillisecs()

		SetFrameRate( 0 )

		InvokeOnCreate()
		InvokeOnRender()
		Update()
	EndMethod

	Method Update()
		While Not AppTerminate()
			Local updates:Int = 0

			Local cont:Int = 1
			While (cont)
				nextUpdate:+updatePeriod
				InvokeOnUpdate()
				If Not updatePeriod Then cont = 0
				If nextUpdate>BlitzMaxMillisecs() Then cont = 0
				updates:+1
				If updates = 7 Then
					nextUpdate = BlitzMaxMillisecs()
					cont = 0
				EndIf
			Wend
			InvokeOnRender()
		Wend
	EndMethod

	Method InvokeOnCreate()
		If dead Return
		dead = 1
		OnCreate()
		dead = 0
	EndMethod

	Method InvokeOnUpdate()
		If dead Or suspended Or Not updateRate Or vloading Return
		OnUpdate()
	EndMethod

	Method InvokeOnRender()
		If dead Or suspended Return
		ggraphics.BeginRender()
		If vloading
			OnLoading()
		Else
			OnRender()
		EndIf
		ggraphics.EndRender()
	EndMethod

	Method SetFrameRate( fps:Int )
		If fps
			updatePeriod=1000.0/fps
			nextUpdate=BlitzMaxMillisecs() +updatePeriod
		Else
			updatePeriod=0
		EndIf
	EndMethod

	Method LoadState:String()
'		var file:SharedObject=SharedObject.getLocal( "gxtkapp" );
'		var state:String=file.data.state;
'		file.close();
'		if( state ) return state;
		Return ""
	EndMethod

	Method SaveState:Int( state:String )
'		var file:SharedObject=SharedObject.getLocal( "gxtkapp" );
'		file.data.state=state;
'		file.close();
		Return 0
	EndMethod

	Method LoadString:String( path:String )
		path = "data/" + path
		Return LoadText( path )
	EndMethod

	' ***** GXTK API *****

	Method GraphicsDevice:gxtkGraphics()
		Return ggraphics
	EndMethod

	Method InputDevice:gxtkInput()
		Return ginput
	EndMethod

	Method AudioDevice:gxtkAudio()
		Return gaudio
	EndMethod

	Method SetUpdateRate:Int(hertz:Int)
		updateRate = hertz
		If Not vloading Then SetFrameRate(updateRate)
		Return 0
	EndMethod

	Method MilliSecs:Int()
		Return BlitzMaxMillisecs() - startMillis
	EndMethod

	Method Loading:Int()
		Return vloading
	EndMethod

	Method OnCreate:Int()
		Return 0
	EndMethod

	Method OnUpdate:Int()
		Return 0
	EndMethod

	Method OnSuspend:Int()
		Return 0
	EndMethod

	Method OnResume:Int()
		Return 0
	EndMethod

	Method OnRender:Int()
		Return 0
	EndMethod

	Method OnLoading:Int()
		Return 0
	EndMethod
EndType

Type gxtkGraphics
	Field gmode:Int = 1

	Method Mode:Int()
		Return gmode
	EndMethod

	Method Cls:Int(r:Int = 0, g:Int = 0, b:Int = 0)
		BlitzMaxCls(r, g, b)
		Return 0
	EndMethod

	Method DrawPoint:Int(x:Float, y:Float)
		Plot x, y
	EndMethod

	Method LoadSurface:gxtkSurface(path:String)
		Local image:TImage = LoadImage("data/"+path)
		If image Then
			Local gs:gxtkSurface = New gxtkSurface
			gs.setImage(image)
			Return gs
		EndIf
		Return Null
	EndMethod

	Method BeginRender()
	EndMethod

	Method EndRender()
		Flip
	EndMethod

	Method SetColor:Int(r:Int, g:Int, b:Int)
		BlitzMaxSetColor(r, g, b)
		Return 0
	EndMethod

	Method SetAlpha:Int(a:Float)
		BlitzMaxSetAlpha(a)
		Return 0
	EndMethod

	Method SetBlend:Int(blend:Int)
		BlitzMaxSetBlend(blend)
		Return 0
	EndMethod

	Method Width:Int()
		Return GraphicsWidth()
	EndMethod

	Method Height:Int()
		Return GraphicsHeight()
	EndMethod

	Method SetScissor:Int(x:Int, y:Int, w:Int, h:Int)
		SetViewport(x, y, w, h) ' NOT TESTED!
		Return 0
	EndMethod

	Method SetMatrix:Int(ix:Float,iy:Float,jx:Float,jy:Float,tx:Float,ty:Float)
		Local sx:Float = Sqr( (ix*ix) + (jx*jx) )
		Local sy:Float = Sqr( (iy*iy) + (jy*jy) )
		Local rot:Float = -Atan2( jx, ix )
		SetTransform( rot, sx, sy )
		SetOrigin( tx, ty )
		Return 0
	EndMethod

	Method DrawSurface:Int(surface:gxtkSurface,x:Float,y:Float)
		DrawImage(surface.image, x, y, 0)
		Return 0
	EndMethod

	Method DrawSurface2:Int(surface:gxtkSurface,x:Float,y:Float, srcx:Int, srcy:Int, srcw:Int, srch:Int )
		DrawSubImageRect(surface.image, x, y, srcw, srch, srcx, srcy, srcw, srch)
		Return 0
	EndMethod

	Method DrawLine:Int( x1:Float,y1:Float,x2:Float,y2:Float )
		BlitzMaxDrawLine(x1, y1, x2, y2)
		Return 0
	EndMethod

	Method DrawOval:Int( x:Float, y:Float, w:Float, h:Float )
		BlitzMaxDrawOval(x, y, w, h)
		Return 0
	EndMethod

	Method DrawPoly:Int(vertices:Float[])
		BlitzMaxDrawPoly( vertices )
		Return 0
	EndMethod

	Method DrawRect:Int( x:Float, y:Float, w:Float, h:Float )
		BlitzMaxDrawRect(x, y, w, h)
		Return 0
	EndMethod
EndType

Type gxtkInput
	Method MouseX:Float()
		Return BRL.PolledInput.MouseX()
	EndMethod

	Method MouseY:Float()
		Return BRL.PolledInput.MouseY()
	EndMethod

	Method KeyDown:Int( key:Int )
		If( key >= 1 And key <= 3 )
			Return BRL.PolledInput.MouseDown( key )
		EndIf
		If key < 256
			Return BRL.PolledInput.KeyDown( key )
		Else
			Return 0
		EndIf
	EndMethod

	Method KeyHit:Int( key:Int )
		If( key >= 1 And key <= 3 )
			Return BRL.PolledInput.MouseHit( key )
		EndIf
		If key < 256
			Return BRL.PolledInput.KeyHit( key )
		Else
			Return 0
		EndIf
	EndMethod

	Method GetChar:Int()
		Return BRL.PolledInput.GetChar()
	EndMethod

	Method JoyX:Int( index:Int )
		Return Pub.FreeJoy.JoyX( index )
	EndMethod

	Method JoyY:Int( index:Int )
		Return Pub.FreeJoy.JoyY( index )
	EndMethod

	Method JoyZ:Int( index:Int )
		Return Pub.FreeJoy.JoyZ( index )
	EndMethod

	Method TouchX:Float( index:Int )
		Return BRL.PolledInput.MouseX()
	EndMethod

	Method TouchY:Float( index:Int )
		Return BRL.PolledInput.MouseY()
	EndMethod

	Method AccelX:Int()
		return 0
	EndMethod

	Method AccelY:Int()
		return 0
	EndMethod

	Method AccelZ:Int()
		return 0
	EndMethod

	Method SetKeyboardEnabled:Int( enabled:int )
		Return 0
	EndMethod
EndType

Type gxtkChannel
	Field channel:TChannel	' null then not playing
	Field sample:gxtkSample
	Field loops:int
	'Field transform:SoundTransform=new SoundTransform()
	'Field pausepos:Number
	Field state:int

	Method New()
		channel = New TChannel
	EndMethod
EndType

Type gxtkAudio
	Field amusicState:Int = 0
	Field channels:gxtkChannel[] = New gxtkChannel[33]

	Method New()
		For local i:Int = 0 To 33 - 1
			channels[i] = New gxtkChannel
		Next
	EndMethod

	Method MusicState:Int()
'		If( musicState = 1 And music.isPlaying() = False )
'			musicState = 0;
'		Endif
		Return amusicState
	EndMethod

	Method PlayMusic:Int( path:String, flags:Int )
		Return 0
	EndMethod

	Method ChannelState:int( channel:int )
		Return -1
	EndMethod

	Method StopMusic()
	EndMethod

	Method StopChannel( channel:Int )
	EndMethod

	Method PlaySample( sound:gxtkSample, channel:Int, flags:Int )
		Local chan:gxtkChannel = channels[channel]

		'If chan.state <> 0 Then chan.channel.Stop() <-- this crashes after the first play!?

		chan.sample = sound
		'chan.loops = flags ? 0x7fffffff : 0;
		'chan.channel = sample.sound.play( 0,chan.loops,chan.transform );
		'chan.channel = sound
		chan.state=1

		PlaySound( sound.sound, chan.channel )
	EndMethod

	Method SetPan( channel:Int, pan:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetPan(pan)
	EndMethod

	Method SetRate( channel:Int, rate:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetRate(rate)
	EndMethod

	Method PauseMusic:Int()
		Return 0
	EndMethod

	Method ResumeMusic:Int()
		Return 0
	EndMethod

	Method SetMusicVolume:Int( volume:Float )
		Return 0
	EndMethod

	Method SetVolume:Int( channel:Int, volume:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetVolume(volume)
		Return 0
	EndMethod

	Method LoadSample:gxtkSample( path:String )
		Local sound:TSound = LoadSound("data/"+path)
		If sound Then
			Local gs:gxtkSample = New gxtkSample
			gs.setSound(sound)
			Return gs
		EndIf
		Return Null
	EndMethod
EndType

Type gxtkSample
	Field sound:TSound

	Method setSound(sound:TSound)
		Self.sound = sound
	EndMethod

	Method Discard()
		Self.sound = null
	EndMethod
EndType

Function BlitzMaxDrawPoly:Int(vertices:Float[])
	DrawPoly vertices
	Return 0
EndFunction

Function BlitzMaxDrawRect:Int( x:Float, y:Float, w:Float, h:Float )
	DrawRect x, y, w, h
	Return 0
EndFunction

Function BlitzMaxDrawOval:Int( x:Float, y:Float, w:Float, h:Float )
	DrawOval x, y, w, h
	Return 0
EndFunction

Function BlitzMaxDrawLine:Int( x1:Float,y1:Float,x2:Float,y2:Float )
	DrawLine x1, y1, x2, y2
	Return 0
EndFunction

Function BlitzMaxMillisecs:Int()
	Return MilliSecs()
EndFunction

Function BlitzMaxSetColor(r:Int, g:Int, b:Int)
	SetColor(r, g, b)
EndFunction

Function BlitzMaxSetBlend(blend:Int)
	Select blend
		Case 0
			SetBlend( ALPHABLEND )
		Case 1
			SetBlend( LIGHTBLEND )
	End Select
EndFunction

Function BlitzMaxSetAlpha(a:Float)
	SetAlpha(a)
EndFunction

Function BlitzMaxCls(r:Int = 0, g:Int = 0, b:Int = 0)
	SetClsColor(r, g, b)
	Cls
EndFunction

Type gxtkSurface
	Field w:Int, h:Int
	Field image:TImage

	Method setImage(image:TImage)
		Self.image = image
	EndMethod

	Method Width:Int()
		Return image.Width
	EndMethod

	Method Height:Int()
		Return image.Height
	EndMethod

	Method Discard()
	EndMethod
EndType

' ***** End mojo.bmax.bmx ******

' ***** Start mojo.bmax.bmx ******

Global app:gxtkApp

Type gxtkApp
	Field ginput:gxtkInput
	Field gaudio:gxtkAudio
	Field ggraphics:gxtkGraphics

	Field dead:Int=0
	Field suspended:Int=0
	Field vloading:Int=0
	Field maxloading:Int=0
	Field updateRate:Int=0
	Field nextUpdate:Float=0
	Field updatePeriod:Float=0
	Field startMillis:Float=0

	Method New()' gxtkApp()
		app=Self
		ggraphics=New gxtkGraphics
	EndMethod

	Method Setup()
		ginput=New gxtkInput
		gaudio=New gxtkAudio

		bb_input_SetInputDevice(ginput)
		bb_audio_SetAudioDevice(gaudio)

		startMillis=BlitzMaxMillisecs()

		SetFrameRate( 0 )

		InvokeOnCreate()
		InvokeOnRender()
		Update()
	EndMethod

	Method Update()
		While Not AppTerminate()
			Local updates:Int = 0

			Local cont:Int = 1
			While (cont)
				nextUpdate:+updatePeriod
				InvokeOnUpdate()
				If Not updatePeriod Then cont = 0
				If nextUpdate>BlitzMaxMillisecs() Then cont = 0
				updates:+1
				If updates = 7 Then
					nextUpdate = BlitzMaxMillisecs()
					cont = 0
				EndIf
			Wend
			InvokeOnRender()
		Wend
	EndMethod

	Method InvokeOnCreate()
		If dead Return
		dead = 1
		OnCreate()
		dead = 0
	EndMethod

	Method InvokeOnUpdate()
		If dead Or suspended Or Not updateRate Or vloading Return
		OnUpdate()
	EndMethod

	Method InvokeOnRender()
		If dead Or suspended Return
		ggraphics.BeginRender()
		If vloading
			OnLoading()
		Else
			OnRender()
		EndIf
		ggraphics.EndRender()
	EndMethod

	Method SetFrameRate( fps:Int )
		If fps
			updatePeriod=1000.0/fps
			nextUpdate=BlitzMaxMillisecs() +updatePeriod
		Else
			updatePeriod=0
		EndIf
	EndMethod

	Method LoadState:String()
'		var file:SharedObject=SharedObject.getLocal( "gxtkapp" );
'		var state:String=file.data.state;
'		file.close();
'		if( state ) return state;
		Return ""
	EndMethod

	Method SaveState:Int( state:String )
'		var file:SharedObject=SharedObject.getLocal( "gxtkapp" );
'		file.data.state=state;
'		file.close();
		Return 0
	EndMethod

	Method LoadString:String( path:String )
		path = "data/" + path
		Return LoadText( path )
	EndMethod

	' ***** GXTK API *****

	Method GraphicsDevice:gxtkGraphics()
		Return ggraphics
	EndMethod

	Method InputDevice:gxtkInput()
		Return ginput
	EndMethod

	Method AudioDevice:gxtkAudio()
		Return gaudio
	EndMethod

	Method SetUpdateRate:Int(hertz:Int)
		updateRate = hertz
		If Not vloading Then SetFrameRate(updateRate)
		Return 0
	EndMethod

	Method MilliSecs:Int()
		Return BlitzMaxMillisecs() - startMillis
	EndMethod

	Method Loading:Int()
		Return vloading
	EndMethod

	Method OnCreate:Int()
		Return 0
	EndMethod

	Method OnUpdate:Int()
		Return 0
	EndMethod

	Method OnSuspend:Int()
		Return 0
	EndMethod

	Method OnResume:Int()
		Return 0
	EndMethod

	Method OnRender:Int()
		Return 0
	EndMethod

	Method OnLoading:Int()
		Return 0
	EndMethod
EndType

Type gxtkGraphics
	Field gmode:Int = 1

	Method Mode:Int()
		Return gmode
	EndMethod

	Method Cls:Int(r:Int = 0, g:Int = 0, b:Int = 0)
		BlitzMaxCls(r, g, b)
		Return 0
	EndMethod

	Method DrawPoint:Int(x:Float, y:Float)
		Plot x, y
	EndMethod

	Method LoadSurface:gxtkSurface(path:String)
		Local image:TImage = LoadImage("data/"+path)
		If image Then
			Local gs:gxtkSurface = New gxtkSurface
			gs.setImage(image)
			Return gs
		EndIf
		Return Null
	EndMethod

	Method BeginRender()
	EndMethod

	Method EndRender()
		Flip
	EndMethod

	Method SetColor:Int(r:Int, g:Int, b:Int)
		BlitzMaxSetColor(r, g, b)
		Return 0
	EndMethod

	Method SetAlpha:Int(a:Float)
		BlitzMaxSetAlpha(a)
		Return 0
	EndMethod

	Method SetBlend:Int(blend:Int)
		BlitzMaxSetBlend(blend)
		Return 0
	EndMethod

	Method Width:Int()
		Return GraphicsWidth()
	EndMethod

	Method Height:Int()
		Return GraphicsHeight()
	EndMethod

	Method SetScissor:Int(x:Int, y:Int, w:Int, h:Int)
		SetViewport(x, y, w, h) ' NOT TESTED!
		Return 0
	EndMethod

	Method SetMatrix:Int(ix:Float,iy:Float,jx:Float,jy:Float,tx:Float,ty:Float)
		Local sx:Float = Sqr( (ix*ix) + (jx*jx) )
		Local sy:Float = Sqr( (iy*iy) + (jy*jy) )
		Local rot:Float = -Atan2( jx, ix )
		SetTransform( rot, sx, sy )
		SetOrigin( tx, ty )
		Return 0
	EndMethod

	Method DrawSurface:Int(surface:gxtkSurface,x:Float,y:Float)
		DrawImage(surface.image, x, y, 0)
		Return 0
	EndMethod

	Method DrawSurface2:Int(surface:gxtkSurface,x:Float,y:Float, srcx:Int, srcy:Int, srcw:Int, srch:Int )
		DrawSubImageRect(surface.image, x, y, srcw, srch, srcx, srcy, srcw, srch)
		Return 0
	EndMethod

	Method DrawLine:Int( x1:Float,y1:Float,x2:Float,y2:Float )
		BlitzMaxDrawLine(x1, y1, x2, y2)
		Return 0
	EndMethod

	Method DrawOval:Int( x:Float, y:Float, w:Float, h:Float )
		BlitzMaxDrawOval(x, y, w, h)
		Return 0
	EndMethod

	Method DrawPoly:Int(vertices:Float[])
		BlitzMaxDrawPoly( vertices )
		Return 0
	EndMethod

	Method DrawRect:Int( x:Float, y:Float, w:Float, h:Float )
		BlitzMaxDrawRect(x, y, w, h)
		Return 0
	EndMethod
EndType

Type gxtkInput
	Method MouseX:Float()
		Return BRL.PolledInput.MouseX()
	EndMethod

	Method MouseY:Float()
		Return BRL.PolledInput.MouseY()
	EndMethod

	Method KeyDown:Int( key:Int )
		If( key >= 1 And key <= 3 )
			Return BRL.PolledInput.MouseDown( key )
		EndIf
		Return BRL.PolledInput.KeyDown( key )
	EndMethod

	Method KeyHit:Int( key:Int )
		If( key >= 1 And key <= 3 )
			Return BRL.PolledInput.MouseHit( key )
		EndIf
		Return BRL.PolledInput.KeyHit( key )
	EndMethod

	Method GetChar:Int()
		Return BRL.PolledInput.GetChar()
	EndMethod

	Method JoyX:Int( index:Int )
		Return Pub.FreeJoy.JoyX( index )
	EndMethod

	Method JoyY:Int( index:Int )
		Return Pub.FreeJoy.JoyY( index )
	EndMethod

	Method JoyZ:Int( index:Int )
		Return Pub.FreeJoy.JoyZ( index )
	EndMethod

	Method TouchX:Float( index:Int )
		Return BRL.PolledInput.MouseX()
	EndMethod

	Method TouchY:Float( index:Int )
		Return BRL.PolledInput.MouseY()
	EndMethod

	Method AccelX:Int()
		return 0
	EndMethod

	Method AccelY:Int()
		return 0
	EndMethod

	Method AccelZ:Int()
		return 0
	EndMethod

	Method SetKeyboardEnabled:Int( enabled:int )
		Return 0
	EndMethod
EndType

Type gxtkChannel
	Field channel:TChannel	' null then not playing
	Field sample:gxtkSample
	Field loops:int
	'Field transform:SoundTransform=new SoundTransform()
	'Field pausepos:Number
	Field state:int

	Method New()
		channel = New TChannel
	EndMethod
EndType

Type gxtkAudio
	Field amusicState:Int = 0
	Field channels:gxtkChannel[] = New gxtkChannel[33]

	Method New()
		For local i:Int = 0 To 33 - 1
			channels[i] = New gxtkChannel
		Next
	EndMethod

	Method MusicState:Int()
'		If( musicState = 1 And music.isPlaying() = False )
'			musicState = 0;
'		Endif
		Return amusicState
	EndMethod

	Method PlayMusic:Int( path:String, flags:Int )
		Return 0
	EndMethod

	Method ChannelState:int( channel:int )
		Return -1
	EndMethod

	Method StopMusic()
	EndMethod

	Method StopChannel( channel:Int )
	EndMethod

	Method PlaySample( sound:gxtkSample, channel:Int, flags:Int )
		Local chan:gxtkChannel = channels[channel]

		'If chan.state <> 0 Then chan.channel.Stop() <-- this crashes after the first play!?

		chan.sample = sound
		'chan.loops = flags ? 0x7fffffff : 0;
		'chan.channel = sample.sound.play( 0,chan.loops,chan.transform );
		'chan.channel = sound
		chan.state=1

		PlaySound( sound.sound, chan.channel )
	EndMethod

	Method SetPan( channel:Int, pan:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetPan(pan)
	EndMethod

	Method SetRate( channel:Int, rate:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetRate(rate)
	EndMethod

	Method PauseMusic:Int()
		Return 0
	EndMethod

	Method ResumeMusic:Int()
		Return 0
	EndMethod

	Method SetMusicVolume:Int( volume:Float )
		Return 0
	EndMethod

	Method SetVolume:Int( channel:Int, volume:Float )
		Local chan:gxtkChannel = channels[channel]
		chan.channel.SetVolume(volume)
		Return 0
	EndMethod

	Method LoadSample:gxtkSample( path:String )
		Local sound:TSound = LoadSound("data/"+path)
		If sound Then
			Local gs:gxtkSample = New gxtkSample
			gs.setSound(sound)
			Return gs
		EndIf
		Return Null
	EndMethod
EndType

Type gxtkSample
	Field sound:TSound

	Method setSound(sound:TSound)
		Self.sound = sound
	EndMethod

	Method Discard()
		Self.sound = null
	EndMethod
EndType

Function BlitzMaxDrawPoly:Int(vertices:Float[])
	DrawPoly vertices
	Return 0
EndFunction

Function BlitzMaxDrawRect:Int( x:Float, y:Float, w:Float, h:Float )
	DrawRect x, y, w, h
	Return 0
EndFunction

Function BlitzMaxDrawOval:Int( x:Float, y:Float, w:Float, h:Float )
	DrawOval x, y, w, h
	Return 0
EndFunction

Function BlitzMaxDrawLine:Int( x1:Float,y1:Float,x2:Float,y2:Float )
	DrawLine x1, y1, x2, y2
	Return 0
EndFunction

Function BlitzMaxMillisecs:Int()
	Return MilliSecs()
EndFunction

Function BlitzMaxSetColor(r:Int, g:Int, b:Int)
	SetColor(r, g, b)
EndFunction

Function BlitzMaxSetBlend(blend:Int)
	Select blend
		Case 0
			SetBlend( ALPHABLEND )
		Case 1
			SetBlend( LIGHTBLEND )
	End Select
EndFunction

Function BlitzMaxSetAlpha(a:Float)
	SetAlpha(a)
EndFunction

Function BlitzMaxCls(r:Int = 0, g:Int = 0, b:Int = 0)
	SetClsColor(r, g, b)
	Cls
EndFunction

Type gxtkSurface
	Field w:Int, h:Int
	Field image:TImage

	Method setImage(image:TImage)
		Self.image = image
	EndMethod

	Method Width:Int()
		Return image.Width
	EndMethod

	Method Height:Int()
		Return image.Height
	EndMethod

	Method Discard()
	EndMethod
EndType

' ***** End mojo.bmax.bmx ******


stack overflow detection

stack overflow detection

' Blue Moon
' Memory allocator/garbage collector
' this is a generational three-colour mark/compact collector

' notes:

' - a basic Lua value is represented as a NaN-box (i.e. a double, unless it's a NaN in which case there's a pointer in the significand)

' - objects are allocated in newSpc, Cheney'd over to cpySpc when it runs out; the Eden spaces are 8MB each
' - when less than .edenThreshold remains in cpySpc after a scavenge, objects held from oldSpc are promoted
' - when more than .sizeThreshold has been promoted or less than .edenThreshold still remains, a full GC runs
'   this scan updates usage statistics for each page
'   the "worst" N pages are then compacted; if total usage is still poor, mark for another compact after next scavenge
'   the rest of Eden is then promoted
' - fallback to compacting in one go if usage is catastrophic/increments aren't keeping up
' - roots are obtained from the gcroots list, and the stack

' - before compacting/discarding, the space is scanned for objects with finalizers which are resurrected into newSpc and put on toFinalize
' - during a FULL collection, weak tables are listed in .weakTables rather than colouring elems, then weakscanned before compaction

' - the stack is an 8M block with the last page protected
' - stack frames use this format:
'    [ ret ip ][ prev base ][[ 16b frame sz ][ 16b var ofs ]][ func obj ][ ip ][ argv ][ retv ][[ 16b argc ][ 16b retc ]][ upv0 | upv1 | ... ][ v0 | v1 | ... ][ tmp... ]
'   the upvar slots, var slots, and temp slots beyond are all 64-bit NaN-boxes
'   the preceding slots are 32-bit words except otherwise shown

' - pages in oldPtrSpc use this format:
'    [[[  0..256 metadata  ]  ..16K dirty bitmap  ]  ..1M allocated objects  ]
'   each 64-byte potential NaN-box in the object-space has a corresponding dirty bit that is set if it points to newSpc
'   a metamap in the metadata in turn marks dirty sectors of the bitmap, for reduced scanning
'   metadata also contains allocation pointer and used space total

' - codeSpace stores executable instruction buffers for Lua functions (bytecode is allocated directly into oldStrSpc)

' - bigSpc is a simple list of conventionally-allocated objects that don't fit on a 1M page

' - objects use this layout:
'    [ 64b header: [ 32b size ][ 16b type tag ][ 8b colour ][ 1b hasFinalizer ][ 2b weak keys, values ] ][ N * 64b data area... ]
'   size includes header. for moved objects the second 32b are replaced by a forwarding pointer
'   pointers in general are to the data area, skipping header

' - data types are:  nil, boolean, number, string, closure, natfun, userdata, thread, table ; upvar, tablearray, tablehash, bytecode
'   nil/boolean/number/natfun are value types and need no allocation
'   string uses this structure:
'    [H][ 32b length ][ 32b hash ][ ceil(length/4) * 64b chars... ]
'   closure uses this structure:
'    [H][ 32b bytecode ptr ][32b][ N * 32b upvar ptrs... ] (N rounded up to 2 for alignment)
'   userdata uses this structure:
'    [H][ 32b metatable ][ 32b value ]
'   thread uses this structure:
'    [H][
'   table uses this structure:
'    [H][ 32b metatable ][32b][ 32b hashpart ptr + 8 ][ 32b arraypart ptr + 8 ]
'   tablearray uses this structure:
'    [H][ 32b len ][ 32b maxlen ][ N * 64b values... ]
'   tablehash uses this structure:
'    [H][ 32b count ][ 32b log2(maxlen) ][ N * [ 64b key ][ 64b value ]... ]
'   upvar uses this structure:
'    [H][ 64b value ]
'   bytecode uses this structure:
'    [H][

SuperStrict

Import "blueerror.bmx"
Import "bluememory.c"

Private
Extern
	Function PageAlloc:Byte Ptr(size:Int) = "bluemoon_mmap"
	Function PageSetRW:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_rw"
	Function PageSetRWX:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_rwx"
	Function PageSetProtected:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_none"
	Function PageFree:Int(p:Byte Ptr, sz:Int) = "bluemoon_munmap"
End Extern
Public

Type BlueTypeTag Final
	Const NUM:Int = 0, NIL:Int = 1, BOOL:Int = 1 Shl 1, STR:Int = 1 Shl 2, FUN:Int = 1 Shl 3
	Const NATFUN:Int = 1 Shl 4, USR:Int = 1 Shl 5, THR:Int = 1 Shl 6, TBL:Int = 1 Shl 7
	Const UPV:Int = 1 Shl 8, ARR:Int = 1 Shl 9, HASH:Int = 1 Shl 10, BCODE:Int = 1 Shl 11

	Const NANBOX:Int = Int(2^11 - 1) Shl 20, NANBOX_CHK:Int = NANBOX | (1 Shl 19)	'test against upper word (and that it's not a genuine NaN)
End Type

Type BlueVMMemory Final
	Const PAGESZ:Int = 1048576, PAGEBITMAPSZ:Int = 16384, PAGEMETASZ:Int = 256
	Const EDENSIZE:Int = 8 * PAGESZ, STACKSZ:Int = 8 * PAGESZ, STACKPROTECT:Int = 4096 * 3, BIGOBJECTSZ:Int = 500000
	Const STACKFRAMESZ:Int = 8 * 4, BYTECODESZ:Int = 8 * 4

	Field gcroots:BlueGCNode, stack:Byte Ptr
	Field newSpace:Byte Ptr, cpySpace:Byte Ptr, oldPtrSpace:Byte Ptr[], oldStrSpace:Byte Ptr[], bigSpace:Byte Ptr[]
	Field toFinalize:BlueGCNode, weakTables:BlueGCNode
	Field codeSpace:Byte Ptr[], returnToNative:Int Ptr
	Field bytecodes:Byte Ptr[], kstrings:Byte Ptr[]

	Field memAlloced:Int
	Field edenThreshold:Int, sizeThreshold:Int
	Field newPtr:Int

	Function AlignedAlloc:Byte Ptr(size:Int, align:Int)	'abuse mmap/munmap to get greater-than-4K alignments
		?Not x86
		RuntimeError "The Blue Moon memory system does not support your platform (x86-32 only at this time)"
		?
		Local mem:Byte Ptr = PageAlloc(size + align)
		If Not mem Then Throw BlueInterpretError.Make("unable to allocate enough memory for system")

		' this is where it starts to get unpleasantly x86-32 specific
		Local iMem:Int = Int(mem), offset:Int = iMem Mod align
		If offset
			Local preceding:Int = align - offset
			PageFree(mem, preceding) ; mem :+ preceding
			PageFree(mem + size, offset)	'so we free the surrounding chunks of mem. that aren't aligned, and keep the middle
		Else
			PageFree(mem + size, align)
		EndIf

		Return mem
	End Function

	Method New()
		stack = AlignedAlloc(STACKSZ, PAGESZ)
		PageSetProtected(stack + STACKSZ - STACKPROTECT, STACKPROTECT)	' add protection to end of stack
		newSpace = AlignedAlloc(EDENSIZE, PAGESZ) ; cpySpace = AlignedAlloc(EDENSIZE, PAGESZ)
		newPtr = 0

		AddCodePage() ; returnToNative = Int Ptr(codeSpace[0]) + 1
		AddPage(oldStrSpace, PAGEMETASZ)
		AddPage(oldPtrSpace, PAGEBITMAPSZ)
	End Method
	Method Delete()
		' unmap a bunch of stuff
		' free a bunch of other stuff
	End Method

	Method Write(slot:Long Ptr, val:Long)	'write barrier around old/big-space
		'implement it here
		slot[0] = val
	End Method

	Method Collect()
	End Method

	Method AllocTable:Byte Ptr(meta:Byte Ptr)
		Local ret:Byte Ptr = AllocObject(16, BlueTypeTag.TBL)
		Byte Ptr Ptr(ret)[0] = meta
		Int Ptr(ret)[2] = 0 ; Int Ptr(ret)[3] = 0
		Return ret
	End Method
	Method AllocClosure:Byte Ptr(bc:Byte Ptr, upvars:Int)	'already aligned
		Local ret:Byte Ptr = AllocObject(8 + upvars * 4, BlueTypeTag.FUN)
		Byte Ptr Ptr(ret)[0] = bc
		Return ret
	End Method
	Method AllocString:Byte Ptr(size:Int, charp:Short Ptr)
		Local sz:Int = size
		If sz Mod 4 Then sz :+ 4 - sz Mod 4	'align properly
		Local ret:Byte Ptr = AllocObject(8 + sz * 2, BlueTypeTag.STR), destp:Short Ptr = Short Ptr(ret + 8), hash:Int = 5381
		For Local c:Int = 0 Until size	'fill the string and compute hash in one go
			destp[c] = charp[c]
			hash = (hash * 33) ~ charp[c]	'djb2
		Next
		Int Ptr(ret)[0] = size ; Int Ptr(ret)[1] = hash
		Return ret
	End Method
	Method AllocUserdata:Byte Ptr(meta:Byte Ptr, val:Byte Ptr)
		Local ret:Byte Ptr = AllocObject(8, BlueTypeTag.USR)
		Byte Ptr Ptr(ret)[0] = meta ; Byte Ptr Ptr(ret)[1] = val
		Return ret
	End Method
	Method AllocThread()
	End Method

	Method AllocConstant:Byte Ptr(size:Int, charp:Short Ptr)	'string constants (the only other kind are doubles)
		Local hash:Int = 5381
		For Local c:Int = 0 Until size	'do this first so we can check for duplicates easily
			hash = (hash * 33) ~ charp[c]	'djb2
		Next
		For Local k:Int = 0 Until kstrings.Length
			If hash = Int Ptr(kstrings[k])[3] And size = Int Ptr(kstrings[k])[2]
				Local eq:Int = True
				For Local ch:Int = 0 Until size
					If charp[ch] <> Short Ptr(kstrings[k] + 16)[ch] Then eq = False ; Exit
				Next
				If eq Then Return kstrings[k] + 8	'if it already exists, share it
			EndIf
		Next

		Local ret:Byte Ptr = MemAlloc(8 + 8 + size * 2), destp:Short Ptr = Short Ptr(ret + 16)

		Int Ptr(ret)[0] = (8 + 8 + size * 2) ; Short Ptr(ret + 4)[0] = BlueTypeTag.STR	'set colour too?
		Int Ptr(ret)[2] = size ; Int Ptr(ret)[3] = hash
		For Local ch:Int = 0 Until size
			destp[ch] = charp[ch]
		Next

		kstrings :+ [ret]
		Return ret + 8
	End Method
	Method AllocBytecode:Byte Ptr(upvars:Int, kcount:Int, icount:Int)
		Local ret:Byte Ptr = MemAlloc(4 * BYTECODESZ + 8 * kcount + 8 * icount + 8 * upvars)	'not here to do malloc's job for it
		bytecodes :+ [ret]
		Return ret
	End Method

	Method AddCodePage()
		codeSpace = [AlignedAlloc(2 * PAGESZ, PAGESZ)] + codeSpace
		PageSetRWX(codeSpace[0], PAGESZ)
		Int Ptr(codeSpace[0])[0] = PAGEMETASZ
	End Method
	Method AddPage:Byte Ptr(space:Byte Ptr[] Var, init:Int, exec:Int = False)
		Local p:Byte Ptr = AlignedAlloc(PAGESZ, PAGESZ)	'x86: assume this returns zero-initialized result already
		space = [p] + space ; Int Ptr(p)[0] = init
		If exec Then PageSetRWX(space[0], PAGESZ)
		Return p
	End Method
'	Method HeaderSize:Int(space:Byte Ptr[])
'		Select space
'			Case oldPtrSpace ; Return PAGEBITMAPSZ
'			Default          ; Return PAGEMETASZ
'		End Select
'	End Method

	Method AllocCodeBlock:Byte Ptr(sz:Int)	'this returns the requested size, allocating it externally if necessary
		Local page:Byte Ptr = codeSpace[0], pNewPtr:Int = Int Ptr(page)[0]
		If pNewPtr + sz > PAGESZ
			RuntimeError "not yet implemented"
		Else
			Int Ptr(page)[0] :+ sz
			Return page + pNewPtr
		EndIf
	End Method

	Method AllocObject:Byte Ptr(sz:Int, tag:Short)
		sz :+ 8 ; Local ret:Byte Ptr
		If sz < BIGOBJECTSZ
			If newPtr + sz > EDENSIZE Then Collect()
			ret = newSpace + newPtr; newPtr :+ sz
		Else
			ret = MemAlloc(sz)
			If Not ret Then Throw BlueInterpretError.Make("unable to allocate memory for object")
			bigSpace :+ [ret]
			' track as part of allocated memory
		EndIf
		Int Ptr(ret)[0] = sz ; Short Ptr(ret + 4)[0] = tag
		Return ret + 8
	End Method

	Function PtrToVal:Long(p:Byte Ptr, tag:Short)
		Local ret:Long, rp:Int Ptr = Int Ptr(Varptr(ret))
		rp[0] = Int(p) ; rp[1] = BlueTypeTag.NANBOX | tag
		Return ret
	End Function
	Function ValToPtr:Byte Ptr(v:Long)
		Local vp:Byte Ptr Ptr = Byte Ptr Ptr(Varptr(v))
		Return vp[0]
	End Function
End Type

Type BlueGCNode
	Field pv:BlueGCNode, nx:BlueGCNode, val:Byte Ptr
	Method Remove()
		If pv Then pv.nx = nx ; pv = Null
		If nx Then nx.pv = pv ; nx = Null
	End Method
End Type

Private

Public

' Blue Moon
' Memory allocator/garbage collector
' this is a generational three-colour mark/compact collector

' notes:

' - a basic Lua value is represented as a NaN-box (i.e. a double, unless it's a NaN in which case there's a pointer in the significand)

' - objects are allocated in newSpc, Cheney'd over to cpySpc when it runs out; the Eden spaces are 8MB each
' - when less than .edenThreshold remains in cpySpc after a scavenge, objects held from oldSpc are promoted
' - when more than .sizeThreshold has been promoted or less than .edenThreshold still remains, a full GC runs
'   this scan updates usage statistics for each page
'   the "worst" N pages are then compacted; if total usage is still poor, mark for another compact after next scavenge
'   the rest of Eden is then promoted
' - fallback to compacting in one go if usage is catastrophic/increments aren't keeping up
' - roots are obtained from the gcroots list, and the stack

' - before compacting/discarding, the space is scanned for objects with finalizers which are resurrected into newSpc and put on toFinalize
' - during a FULL collection, weak tables are listed in .weakTables rather than colouring elems, then weakscanned before compaction

' - the stack is an 8M block with the last page protected
' - stack frames use this format:
'    [ ret ip ][ prev base ][[ 16b frame sz ][ 16b var ofs ]][ func obj ][ ip ][ argv ][ retv ][[ 16b argc ][ 16b retc ]][ upv0 | upv1 | ... ][ v0 | v1 | ... ][ tmp... ]
'   the upvar slots, var slots, and temp slots beyond are all 64-bit NaN-boxes
'   the preceding slots are 32-bit words except otherwise shown

' - pages in oldPtrSpc use this format:
'    [[[  0..256 metadata  ]  ..16K dirty bitmap  ]  ..1M allocated objects  ]
'   each 64-byte potential NaN-box in the object-space has a corresponding dirty bit that is set if it points to newSpc
'   a metamap in the metadata in turn marks dirty sectors of the bitmap, for reduced scanning
'   metadata also contains allocation pointer and used space total

' - codeSpace stores executable instruction buffers for Lua functions (bytecode is allocated directly into oldStrSpc)

' - bigSpc is a simple list of conventionally-allocated objects that don't fit on a 1M page

' - objects use this layout:
'    [ 64b header: [ 32b size ][ 16b type tag ][ 8b colour ][ 1b hasFinalizer ][ 2b weak keys, values ] ][ N * 64b data area... ]
'   size includes header. for moved objects the second 32b are replaced by a forwarding pointer
'   pointers in general are to the data area, skipping header

' - data types are:  nil, boolean, number, string, closure, natfun, userdata, thread, table ; upvar, tablearray, tablehash, bytecode
'   nil/boolean/number/natfun are value types and need no allocation
'   string uses this structure:
'    [H][ 32b length ][ 32b hash ][ ceil(length/4) * 64b chars... ]
'   closure uses this structure:
'    [H][ 32b bytecode ptr ][32b][ N * 32b upvar ptrs... ] (N rounded up to 2 for alignment)
'   userdata uses this structure:
'    [H][ 32b metatable ][ 32b value ]
'   thread uses this structure:
'    [H][
'   table uses this structure:
'    [H][ 32b metatable ][32b][ 32b hashpart ptr + 8 ][ 32b arraypart ptr + 8 ]
'   tablearray uses this structure:
'    [H][ 32b len ][ 32b maxlen ][ N * 64b values... ]
'   tablehash uses this structure:
'    [H][ 32b count ][ 32b log2(maxlen) ][ N * [ 64b key ][ 64b value ]... ]
'   upvar uses this structure:
'    [H][ 64b value ]
'   bytecode uses this structure:
'    [H][

SuperStrict

Import "blueerror.bmx"
Import "bluememory.c"

Private
Extern
	Function PageAlloc:Byte Ptr(size:Int) = "bluemoon_mmap"
	Function PageSetRW:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_rw"
	Function PageSetRWX:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_rwx"
	Function PageSetProtected:Int(p:Byte Ptr, sz:Int) = "bluemoon_mprotect_none"
	Function PageFree:Int(p:Byte Ptr, sz:Int) = "bluemoon_munmap"
End Extern
Public

Type BlueTypeTag Final
	Const NUM:Int = 0, NIL:Int = 1, BOOL:Int = 1 Shl 1, STR:Int = 1 Shl 2, FUN:Int = 1 Shl 3
	Const NATFUN:Int = 1 Shl 4, USR:Int = 1 Shl 5, THR:Int = 1 Shl 6, TBL:Int = 1 Shl 7
	Const UPV:Int = 1 Shl 8, ARR:Int = 1 Shl 9, HASH:Int = 1 Shl 10, BCODE:Int = 1 Shl 11

	Const NANBOX:Int = Int(2^11 - 1) Shl 20, NANBOX_CHK:Int = NANBOX | (1 Shl 19)	'test against upper word (and that it's not a genuine NaN)
End Type

Type BlueVMMemory Final
	Const PAGESZ:Int = 1048576, PAGEBITMAPSZ:Int = 16384, PAGEMETASZ:Int = 256
	Const EDENSIZE:Int = 8 * PAGESZ, STACKSZ:Int = 8 * PAGESZ, BIGOBJECTSZ:Int = 500000
	Const STACKFRAMESZ:Int = 8 * 4, BYTECODESZ:Int = 8 * 4

	Field gcroots:BlueGCNode, stack:Byte Ptr
	Field newSpace:Byte Ptr, cpySpace:Byte Ptr, oldPtrSpace:Byte Ptr[], oldStrSpace:Byte Ptr[], bigSpace:Byte Ptr[]
	Field toFinalize:BlueGCNode, weakTables:BlueGCNode
	Field codeSpace:Byte Ptr[], returnToNative:Int Ptr
	Field bytecodes:Byte Ptr[], kstrings:Byte Ptr[]

	Field memAlloced:Int
	Field edenThreshold:Int, sizeThreshold:Int
	Field newPtr:Int

	Function AlignedAlloc:Byte Ptr(size:Int, align:Int)	'abuse mmap/munmap to get greater-than-4K alignments
		?Not x86
		RuntimeError "The Blue Moon memory system does not support your platform (x86-32 only at this time)"
		?
		Local mem:Byte Ptr = PageAlloc(size + align)
		If Not mem Then Throw BlueInterpretError.Make("unable to allocate enough memory for system")

		' this is where it starts to get unpleasantly x86-32 specific
		Local iMem:Int = Int(mem), offset:Int = iMem Mod align
		If offset
			Local preceding:Int = align - offset
			PageFree(mem, preceding) ; mem :+ preceding
			PageFree(mem + size, offset)	'so we free the surrounding chunks of mem. that aren't aligned, and keep the middle
		Else
			PageFree(mem + size, align)
		EndIf

		Return mem
	End Function

	Method New()
		stack = AlignedAlloc(STACKSZ, PAGESZ)
		' add protection to end of stack
		newSpace = AlignedAlloc(EDENSIZE, PAGESZ) ; cpySpace = AlignedAlloc(EDENSIZE, PAGESZ)
		newPtr = 0

		AddCodePage() ; returnToNative = Int Ptr(codeSpace[0]) + 1
		AddPage(oldStrSpace, PAGEMETASZ)
		AddPage(oldPtrSpace, PAGEBITMAPSZ)
	End Method
	Method Delete()
		' unmap a bunch of stuff
		' free a bunch of other stuff
	End Method

	Method Write(slot:Long Ptr, val:Long)	'write barrier around old/big-space
		'implement it here
		slot[0] = val
	End Method

	Method Collect()
	End Method

	Method AllocTable:Byte Ptr(meta:Byte Ptr)
		Local ret:Byte Ptr = AllocObject(16, BlueTypeTag.TBL)
		Byte Ptr Ptr(ret)[0] = meta
		Int Ptr(ret)[2] = 0 ; Int Ptr(ret)[3] = 0
		Return ret
	End Method
	Method AllocClosure:Byte Ptr(bc:Byte Ptr, upvars:Int)	'already aligned
		Local ret:Byte Ptr = AllocObject(8 + upvars * 4, BlueTypeTag.FUN)
		Byte Ptr Ptr(ret)[0] = bc
		Return ret
	End Method
	Method AllocString:Byte Ptr(size:Int, charp:Short Ptr)
		Local sz:Int = size
		If sz Mod 4 Then sz :+ 4 - sz Mod 4	'align properly
		Local ret:Byte Ptr = AllocObject(8 + sz * 2, BlueTypeTag.STR), destp:Short Ptr = Short Ptr(ret + 8), hash:Int = 5381
		For Local c:Int = 0 Until size	'fill the string and compute hash in one go
			destp[c] = charp[c]
			hash = (hash * 33) ~ charp[c]	'djb2
		Next
		Int Ptr(ret)[0] = size ; Int Ptr(ret)[1] = hash
		Return ret
	End Method
	Method AllocUserdata:Byte Ptr(meta:Byte Ptr, val:Byte Ptr)
		Local ret:Byte Ptr = AllocObject(8, BlueTypeTag.USR)
		Byte Ptr Ptr(ret)[0] = meta ; Byte Ptr Ptr(ret)[1] = val
		Return ret
	End Method
	Method AllocThread()
	End Method

	Method AllocConstant:Byte Ptr(size:Int, charp:Short Ptr)	'string constants (the only other kind are doubles)
		Local hash:Int = 5381
		For Local c:Int = 0 Until size	'do this first so we can check for duplicates easily
			hash = (hash * 33) ~ charp[c]	'djb2
		Next
		For Local k:Int = 0 Until kstrings.Length
			If hash = Int Ptr(kstrings[k])[3] And size = Int Ptr(kstrings[k])[2]
				Local eq:Int = True
				For Local ch:Int = 0 Until size
					If charp[ch] <> Short Ptr(kstrings[k] + 16)[ch] Then eq = False ; Exit
				Next
				If eq Then Return kstrings[k] + 8	'if it already exists, share it
			EndIf
		Next

		Local ret:Byte Ptr = MemAlloc(8 + 8 + size * 2), destp:Short Ptr = Short Ptr(ret + 16)

		Int Ptr(ret)[0] = (8 + 8 + size * 2) ; Short Ptr(ret + 4)[0] = BlueTypeTag.STR	'set colour too?
		Int Ptr(ret)[2] = size ; Int Ptr(ret)[3] = hash
		For Local ch:Int = 0 Until size
			destp[ch] = charp[ch]
		Next

		kstrings :+ [ret]
		Return ret + 8
	End Method
	Method AllocBytecode:Byte Ptr(upvars:Int, kcount:Int, icount:Int)
		Local ret:Byte Ptr = MemAlloc(4 * BYTECODESZ + 8 * kcount + 8 * icount + 8 * upvars)	'not here to do malloc's job for it
		bytecodes :+ [ret]
		Return ret
	End Method

	Method AddCodePage()
		codeSpace = [AlignedAlloc(2 * PAGESZ, PAGESZ)] + codeSpace
		PageSetRWX(codeSpace[0], PAGESZ)
		Int Ptr(codeSpace[0])[0] = PAGEMETASZ
	End Method
	Method AddPage:Byte Ptr(space:Byte Ptr[] Var, init:Int, exec:Int = False)
		Local p:Byte Ptr = AlignedAlloc(PAGESZ, PAGESZ)	'x86: assume this returns zero-initialized result already
		space = [p] + space ; Int Ptr(p)[0] = init
		If exec Then PageSetRWX(space[0], PAGESZ)
		Return p
	End Method
'	Method HeaderSize:Int(space:Byte Ptr[])
'		Select space
'			Case oldPtrSpace ; Return PAGEBITMAPSZ
'			Default          ; Return PAGEMETASZ
'		End Select
'	End Method

	Method AllocCodeBlock:Byte Ptr(sz:Int)	'this returns the requested size, allocating it externally if necessary
		Local page:Byte Ptr = codeSpace[0], pNewPtr:Int = Int Ptr(page)[0]
		If pNewPtr + sz > PAGESZ
			RuntimeError "not yet implemented"
		Else
			Int Ptr(page)[0] :+ sz
			Return page + pNewPtr
		EndIf
	End Method

	Method AllocObject:Byte Ptr(sz:Int, tag:Short)
		sz :+ 8 ; Local ret:Byte Ptr
		If sz < BIGOBJECTSZ
			If newPtr + sz > EDENSIZE Then Collect()
			ret = newSpace + newPtr; newPtr :+ sz
		Else
			ret = MemAlloc(sz)
			If Not ret Then Throw BlueInterpretError.Make("unable to allocate memory for object")
			bigSpace :+ [ret]
			' track as part of allocated memory
		EndIf
		Int Ptr(ret)[0] = sz ; Short Ptr(ret + 4)[0] = tag
		Return ret + 8
	End Method

	Function PtrToVal:Long(p:Byte Ptr, tag:Short)
		Local ret:Long, rp:Int Ptr = Int Ptr(Varptr(ret))
		rp[0] = Int(p) ; rp[1] = BlueTypeTag.NANBOX | tag
		Return ret
	End Function
	Function ValToPtr:Byte Ptr(v:Long)
		Local vp:Byte Ptr Ptr = Byte Ptr Ptr(Varptr(v))
		Return vp[0]
	End Function
End Type

Type BlueGCNode
	Field pv:BlueGCNode, nx:BlueGCNode, val:Byte Ptr
	Method Remove()
		If pv Then pv.nx = nx ; pv = Null
		If nx Then nx.pv = pv ; nx = Null
	End Method
End Type

Private

Public