proc exposition
; Registers
	; Immutable 20-bit pointer registers:
	rem [stackptr] aka [SP] "Address of the top of the stack"
	rem [frameptr] aka [FP] "Value of [SP] before last transfer"
	rem [hstackptr] aka [HSP] "Address of the top (low address) of the hstack"
	rem [codeptr] aka [IP] "Address of next instruction to execute"
	rem [index] "Index register. Holds 12-bit relocation base, for small immediate pointers"
	
	; Mutable 64-bit registers:
	rem [jump] "Destination of jump/transfer"
	rem [arg] "Program controlled register. See ABI documentation."
	rem [counter] "Program controlled register. Conventionally holds old [stackptr] values"
	rem [gp0] [gp1] "General-purpose registers"
	
	; Immutable special registers:
	rem [flag] "holds some status bits. {cond, zero, carry, sign, overflow, fdomain, fovfl, funfl, sup, intl, inth, parity, }"
	
	; Constant (not immutable) 64-bit registers:
	rem [zero] "always contains 0, even when assigned to"
	rem [max] "always holds FFFF:FFFF:FFFF:FFFFh"
	rem [fzero] "always holds floating-point +0"
	rem [finf] "always holds floating-point +inf"
	
	; Memory-mapped registers:
	rem [r#0] [r#1] ... [r#0FFh] "Input arguments"
	rem [r#d] [r#D] [r#c] [r#C] [r#a] [r#A] [...] "Special arguments"
	rem [err] ... [err]+0FFh "Handler for exceptions"
	
	; Stack management registers (memory-mapped):
	rem [stackval] aka [SV] "Value on top of the stack"
	rem [prevstackval] aka [PSV] "Value one below the top of the stack"
	rem [hstackval] aka [HSV] "Value on top of the hstack"
	
	; Hidden registers:
	rem [IN#n] [OUT#n] "serial devices (n=0..15)"
	rem [LINK] "holds return address"
	; Hidden stack management registers:
	rem [callstackval] aka [CSV] "Most recent return address"

; Instructions
	push (val) ; ( -- val)
	; push *[gp0] interprets [gp0] as a pointer and dereferences it, pushing the pointed-to words
	pop (dest) ; (a -- ) a -> (dest)
		; equivalent to pop [zero]
		drop
	peek (dest) ; (a -- a) a -> (dest)
	; High stack instructions: NOTE: hstack grows downward
	hpush (val) ; ( -- val)
	; push *[gp0] interprets [gp0] as a pointer and dereferences it, pushing the pointed-to words
	hpop (dest) ; (a -- ) a -> (dest)
	hpeek (dest) ; (a -- a) a -> (dest)
	; Save all mutable registers to hstack in one go
	save
	; Read enough values from hstack to fill all registers
	restore
	; Stack-to-stack moving
	; move (len) words from stack to hstack
	movesh (len)=1
	; equivalent to push *[hstackptr] hpop [zero]
	movehs (len)=1
	; Push (len) 0s to the stack/hstack
	reserve (len)
	hreserve (len)
	; Control the hidden serial devices [IN] and [OUT]
	input 
	; With no argument, use the stack pointer to output a single word.
	output (p)=[stackptr]
	; Rotates top (n) values on the stack by (p) places
	rot (n) (p)
	; rot 3 2:
		; (a b c -- b c a)
	; Alias instructions
		swap  ; rot 2 1
		rot31 ; rot 3 1
		rot32 ; rot 3 2 aka rot 3 -1
	; Reverses top (n) stack values
	reverse (n)
	; reverse 3:
		; (a b c -- c b a)
	; Duplicates the top of the stack without using a register
	; Equivalent to push *[SP]
	dup ; (a -- a a)
	over ; (a b -- a b a)
	; Equivalent to push (val); pop (dest)
	set (dest) (val)
	; Reads an unaligned word starting at src + offset/8 and
	; extending count octets and pushes it.
	; The read word is packed to the right.
	load_ua (src) (offset&111b | count-1<<3)
	; Like the above, but the resulting partial word is sign-extended to fill the destination word.
	load_ua_se (src) (offset&111b | count-1<<3)
	; Pops and writes count octets to the unaligned address
	; src + offset/8
	store_ua (dest) (offset&111b | count-1<<3)
	; Shift instructions
		; In all cases: b is implicitly anded with 63
		; Flags are set as in integer math operations
		; Logical shifts
		shll ; (a b -- a*(2^b))
		shlr ; (a b -- a/(2^b))
		; Arithmetic shifts
		shal ; for symmetry, equivalent to shll
		shar
		; Circular shifts
		shcl
		shcr
		; 
	; Stack-based math
	; based on value of (op), performs an integer operation on the values in the stack
	imath (op)
	; Alias instructions
		add ; (a b -- (a+b))
		sub
		mul
		div ; (a b -- (a/b) (a%b))
		idiv ; (a b -- (a/b))
		mod ; (a b -- (a%b))
		abs ; (a -- abs(a))
		fma ; (a b c -- ((a*b)+c))
		; Unsigned
		uadd ; (a b -- (a+b))
		usub
		umul
		udiv
		uidiv
		umod
		ufma ; (a b c -- ((a*b)+c))
		; Stack-based comparisons (result in condition flag)
		; Signed
		cmpgt
		cmpge
		cmplt
		cmple
		; Unsigned
		ucmpgt
		ucmpge
		ucmplt
		ucmple
		; Equality (same regardless of sign)
		cmpne
		cmpeq
		; Stack-based bitwise
		bitand
		bitor
		bitxor
		bitnot
		; Counts set bits
		popcnt
		; Counts leading zeros
		clz
	; FP "coprocessor" control:
	; based on value of (op), performs a floating point operation on the values in the stack
	fmath (op)
	; Alias instructions
		; conversions
		itof
		ftoi
		; simple math
		fadd
		fsub
		fmul
		fdiv ; (a b -- (a/b) (a%b))
		fpow
		ffma ; (a b c -- ((a*b)+c))
		; floating-point comparisons (like integer ones)
		fcmpgt
		fcmpge
		fcmplt
		fcmple
		fcmpne
		fcmpeq
		; single-operand math
		fabs
		fsqrt
		fcbrt
		frcp ; (a -- (1/a))
		fneg ; (a -- (-a))
		; rounding/nearest integer
		fceil
		ffloor
		ftrunc
		fround
		; floating point classifications
		fiszero
		fisnormal
		fissubnormal
		fisinf
		fisnan
		fsign
		; trigonometric functions
		fsin ; (a -- sin(a))
		fcos
		ftan
		fasin
		facos
		fatan
		; Binary trigonometric
		fatan2 ; (a b -- atan2(a, b))
		; hyperbolic functions
		fsinh
		fcosh
		ftanh
		fasinh
		facosh
		fatanh
		; exponential functions
		fexp
		fexp2
		fexpm1
		; logarithms: natural, binary, decimal
		fln
		flb
		flg
		flnp1
		; random float 
		frand ; (a b -- rand_in_range(a, b))
	; add/subtract (n) to register (r) in place. Cannot use any addressing modes other than register,small immediate
	adjust (r) (n)
	; Push a single word of pseudorandom data to the stack
	random
	; C-INTERCAL operations:
	ick (op)
		; binary
		; Interleave lower halfwords of the operands. If either operands' upper halfword is not zero, set overflow flag
		(8) mingle 
		; Packed bitmask
		; See ops.wgc for equivalent written as a function not using select
		(9) select
		; unary
		; i{op} is equivalent to:
			; dup
			; push 1
			; shcr
			; bit{op}
		; but with one instruction
		(4) iand
		(5) ior
		(6) ixor
	; Split top of stack into (n) (power of two in range 2-64) segments, big-endian, data in low bits
	explode#n
	; Join together top (n) (same as above) words' low bits into one word
	collapse#n
	; Stack-based logic
	and
	or
	xor
	; Pops top of stack and converts to bool, result in condition flag
	; Equivalent to:
		; push 0
		; cmpne
	; but faster
	popbool
	; Pushes condition flag to stack
	; equivalent to:
		; cond push 1
		; not
		; cond push 0
		; not
	; but faster
	pushbool
	; inverts condition flag
	not
	; if condition flag is false, skip next instruction (after decoding; will not execute immediate data for a following two-byte instruction)
	cond (flag=cond)
		; Logically equivalent to set {condition flag} 1
		true
		; Logically equivalent to set {condition flag} 0
		false
	; Jump to (j)
	jmp (j)=[jump]
	; Relative jumps: jumps to [codeptr]+(j)
	reljmp (j)=[jump]
	; Function call:
		; Jumps to function in [jump]
		; pushes [FP] and [IP] to call stack
		; sets [FP] to [SP]
	transfer
	; Execution returns to just after the last transfer
	; Undoes side effects of transfer
	return
	; Stops execution normally
	halt
	; Triggers exception without altering [jump]
	trap
	; Stops execution abnormally: value of [arg] is return code
	err
	; pops an unsigned integer from the stack and sleeps for approximately that many microseconds
	wait
	; Perform a system call based on the value of [jump]
	systransfer
	; Instruction that does absolutely nothing.
	nop
	rem
	; Other nops include:
	set [zero] (anything) ; or [max]
	set (anything) (the same thing)
	rot 0 0 ; or rot 1 1 or etc
	reverse 0 ; or reverse 1
	

; Assembler instructions:

	; Defines a function symbol
	proc (convention=gencall) (name)
	; Defines a local label
	label
	; Ends a function
	end
	; Defines a macro (which is text-substituted for its name)
	macro (name)((args))
	; ends a macro
	end
	; Defines a global symbol
	
	; Set *[err]+(I) to (label)
	onerror (I) (label)
	; Like return, but clears an interrupt
	handle
	; Look up name of symbol
	lookup (S)
	
	; A literal for the global symbol S
	@S
	; A literal for the global symbol S (S may be any valid string)
	@"S"
	; A literal for the local symbol S
	$S
	; In a macro, provide a different unique local symbol for every invocation in a given function scope.
	$$S
	; Places string in the strings block
	"string"
	; Places string in the strings block, reserving n words rather than just as many as are needed.
	"string"%n
	; Place the string inline in the code. No reljmp is implicitly placed before it, so the programmer must ensure that it is not executed themselves.
	$"S"
	; Place the string inline in the code, reserving n words of memory.
	$"S"%n
	; Reserve writable memory for "string" at bottom of hstack at beginning of execution
	%"string"
	; Reserve n words of writable memory for "string" at bottom of hstack at beginning of execution (instead of just as many as are needed)
	%"string"%n
	
	; Assembler directives and operators:
	
	; Conditional assembly directives. .if and .elseif are followed by a constant expression
	.if
	.elseif
	.else
	.endif
	
	; Reserve N bytes of heap space
	.heap N
	
	; insert text of file at this point
	.include filename
end

; Builtin macros:

; If [flag] is false, then exit with message (error)
macro assert(error)
	cond jmp $$success
	output @stdout (error)
	set [jump] @__assert_fail__
	trap
	$$success:
end

macro goto(lbl)
	set [jump] (lbl)
	jmp
end

macro ifgoto(lbl)
	set [jump] (lbl)
	cond jmp
end

macro incr(i)
.if is_register((i))
	adjust (i) 1
.elseif is_SV((i)) or is_none((i))
	add 1
.else
	push (i)
	add 1
	pop (i)
.endif
end

macro decr(i)
.if is_register((i))
	adjust (i) 1
.elseif is_SV((i)) or is_none((i))
	sub 1
.else
	push (i)
	sub 1
	pop (i)
.endif
end

; Macros for interpretation of wordgen code:
; Layout of stack frame:
	; {arguments} {state}
	; state: [jump] [counter]
macro frame(f)
	hpush [jump]
	hpush [counter]
	set [counter] [stackptr]
	set [jump] (f)
end

macro call
	push [stackptr]
	push [counter]
	sub
	pop [arg]
	transfer
	hpop [counter]
	hpop [jump]
end

; Manual version of =(#0|0|0|/(*(#d|4)|^(#d|2)))
proc main
	frame @"="
	push [r#0]
	push 0
	push 0
	frame @"/"
	frame @"*"
	push [r#d]
	push 4
	call
	frame @"^"
	push [r#d]
	push 2
	call
	call
	call
	set [arg] 1
	return
end

proc @"*"
	push [arg]
	push 0
	cmpgt
	ifgoto $empty
	push [arg]
	push 1
	cmpeq
	ifgoto $loop
	push 1
	set [arg] 2
	$loop:
		fmul
		
		decr [arg]
		push [arg]
		push 1
		cmpgt
		ifgoto $done
	goto $loop
	; Empty product = 1
	$empty:
	push 1
	$done:
	set [arg] 1
	return
end

; copy of mul for now (fix: right associativity)
proc @"/"
	reverse [arg]
	push [arg]
	push 0
	cmpgt
	ifgoto $empty
	push [arg]
	push 1
	cmpeq
	ifgoto $loop
	push 1
	set [arg] 2
	$loop:
		rot 2 1
		fdiv
		
		decr [arg]
		push [arg]
		push 1
		cmpgt
		ifgoto $done
	goto $loop
	; Empty quotient = 1
	$empty:
	push 1
	$done:
	set [arg] 1
	return
end

macro ifeq comp
	dup
	push comp
	cmpeq
	cond jmp
end

; Shunting-yard algorithm
proc infix
	macro precedence
		hpush [jump]
		set [jump] $2
		ifeq '+'
		ifeq '-'
		set [jump] $3
		ifeq '*'
		ifeq '/'
		set [jump] $4
		ifeq '^'
		; If ifeq didn't jump, then condition flag is false and assert fails
		assert "Unprecedented operator"
		$2:
		push 2
		hpop [jump]
		jmp
		$3:
		push 3
		hpop [jump]
		jmp
		$4:
		push 4
		hpop [jump]
		jmp
	end
	macro push_out
		rot [arg] 1
		decr [arg]
	end
	macro pop_op
		movehs
		decr[gp1]
		push_out
	end
	
	hpush [gp0]
	hpush [gp1]
	hpush [arg]
	set [gp1] 0
	push [arg]
	push 1
	cmpge
	assert "Not enough arguments provided"
	reverse [arg]
	$loop:
		set [jump] $op
		ifeq '+'
		ifeq '-'
		ifeq '*'
		ifeq '/'
		ifeq '^'
		set [jump] $pushop
		ifeq '('
		set [jump] $rbrack
		ifeq ')'
		; value is a number
		push_out
		goto $check
		$op:
			hpeek [gp0]
			push [gp0]
			push '('
			cmpeq
			ifgoto $pushop
			precedence
			dup
			push [gp0]
			prededence
			dup
			rot31
			cmple
			ifgoto $op_next
			pop [zero]
			pop [zero]
			goto $pushop
			$op_next:
			cmpne
			ifgoto $op_skip
			hpeek [gp0]
			push [gp0]
			push '^'
			cmpeq
			ifgoto $pushop
			$op_skip:
			pop_op
		goto $op
		$pushop:
			pop [gp0]
			hpush [gp0]
			incr [gp1]
		goto $check
		$rbrack:
			hpeek [gp0]
			push [gp0]
			push '('
			cmpeq
			ifgoto $pop_brack
			pop_op
		goto $rbrack
		$pop_brack:
		hpop [zero]
		decr [gp1]
	$check:
	push [arg]
	bool
	ifgoto $cleanup
	goto loop
	$cleanup:
	push [gp1]
	push 0
	cmpeq
	goto $done
		pop_op
	goto $cleanup
	$done:
	hpop [arg]
	hpop [gp1]
	hpop [gp0]
	return
end

proc rpn
	
end