; Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details
	.EQU LOADER_START 4096

	.EQU STRM_FS 16
	.EQU STRM_PTR 0
	.EQU STRM_IDX 4
	.EQU STRM_LEN 8
	.EQU STRM_DELTA 12

; copy bytes inside a pascal string, moving up
; args: string ptr, index, length, delta
STRMOVEUP:
	FPADJ -STRM_FS
	STORE STRM_DELTA
	STORE STRM_LEN
	STORE STRM_IDX
	STORE STRM_PTR


	LOADCP STRM_CHKARGS
	CALL
	CBRANCH.Z STRMU_XT

	; args are ok, call _BMOVEUP
	; offset
	LOAD STRM_DELTA
	; src
	LOAD STRM_IDX
	DEC 1		; adjust for base 1
	LOAD STRM_PTR
	INC 8		; skip string header
	ADD
	; count
	LOAD STRM_LEN

	LOADCP _BMOVEUP
	CALL
STRMU_XT:
	FPADJ STRM_FS
	RET

; check args for STRMOVEUP and STRMOVEDOWN
; shares stack frame with caller
; returns 0 if args are invalid
STRM_CHKARGS:	; check if length or index are negative
	LOAD STRM_LEN
	LOADC 0
	CMP LE
	CBRANCH STRMC_XT

	LOAD STRM_IDX
	LOADC 0
	CMP LE
	CBRANCH STRMC_XT

	LOAD STRM_DELTA
	LOADC 1
	CMP LT
	CBRANCH STRMC_XT

	; check if index + len + delta < string end
	LOAD STRM_PTR
	LOADI		; get string size

	LOAD STRM_IDX 
	LOAD STRM_DELTA
	ADD
	LOAD STRM_LEN
	ADD
	DEC 1		; adjust for base 1

	CMP LT
	CBRANCH STRMC_XT

	LOADC 1
	RET
STRMC_XT:
	LOADC 0
	RET

; copy bytes inside a pascal string, moving down
; index is the destination, index + delta the source
; args: string ptr, index, length, delta
STRMOVEDOWN:
	FPADJ -STRM_FS
	STORE STRM_DELTA
	STORE STRM_LEN
	STORE STRM_IDX
	STORE STRM_PTR

	LOADCP STRM_CHKARGS
	CALL
	CBRANCH.Z STRMD_XT

	; args are ok, call _BMOVEDOWN
	; offset
	LOAD STRM_DELTA
	; src
	LOAD STRM_IDX
	DEC 1		; adjust for base 1
	LOAD STRM_PTR
	INC 8		; skip string header
	ADD
	; count
	LOAD STRM_LEN

	LOADCP _BMOVEDOWN
	CALL
STRMD_XT:
	FPADJ STRM_FS
	RET

; copy bytes from src to src + offset, moving
; upwards. the copied byte ranges may overlap.
; count and offset must be > 0
; args:  offset, src, count
	.EQU BMU_COUNT 0
	.EQU BMU_SRC 4
	.EQU BMU_OFFS 8
	.EQU BMU_FS 12
_BMOVEUP:
	FPADJ -BMU_FS
	DUP
	STORE BMU_COUNT
	DEC 1
	ADD	; store end of source range
	STORE BMU_SRC
	STORE BMU_OFFS

	; copy bytes from end to start, descending
	LOAD BMU_COUNT	; keep count on stack for the loop
_BMU_L:

	LOAD BMU_SRC
	LOAD BMU_OFFS
	ADD		; dest addr = src + offs
	LOADI.S1.X2Y	; [ dest, word ]
	OVER		; [ dest, word, dest ]
	LOADC $FF	; [ dest, word, dest, $FF]
	BPLC
	NOT		; [ dest, word, mask ]
	AND		; [ dest, masked word ]

	OVER		; [ dest, masked, dest ]
	LOAD BMU_SRC	; [ dest, masked, dest, src ]
	LOADI.S1.X2Y	; [ dest, masked, dest, src, src word ]
	BSEL		; [ dest, masked, dest, src byte ]
	BPLC		; [ dest, masked, dest byte ]
	OR		; [ dest, dest word ]
	STOREI
	DROP

	DEC 1
	DUP
	CBRANCH.Z _BMU_X
	LOAD BMU_SRC
	DEC 1
	STORE BMU_SRC
	BRANCH _BMU_L
_BMU_X:
	DROP
	FPADJ BMU_FS
	RET

; copy bytes from dest + offset to dest, moving
; downwards. the copied byte ranges may overlap.
; count and offset must be > 0
; args:  offset, dest, count
	.EQU BMD_COUNT 0
	.EQU BMD_DEST 4
	.EQU BMD_OFFS 8
	.EQU BMD_FS 12
_BMOVEDOWN:
	FPADJ -BMD_FS
	STORE BMD_COUNT
	STORE BMD_DEST
	STORE BMD_OFFS

	; copy bytes from start to end
	LOAD BMU_COUNT	; keep count on stack for the loop
_BMD_L:
	LOAD BMD_DEST	; [ dest ]
	LOADI.S1.X2Y	; [ dest, dest word ]
	OVER		; [ dest, word, dest ]
	LOADC $FF
	BPLC
	NOT		; [ dest, word, mask ]
	AND		; [ dest, masked word ]
	OVER		; [ dest, masked word, dest ]

	DUP
	LOAD BMD_OFFS
	ADD		; src addr = dest + offs
	LOADI.S1.X2Y	; get source word
	BSEL		; get source byte
			; stack now: [ dest, masked word, dest, source byte ]
	BPLC		; [ dest, masked word, rotated byte ]
	OR		; [ dest, new word ]
	STOREI
	DROP

	DEC 1
	DUP
	CBRANCH.Z _BMD_X
	LOAD BMD_DEST
	INC 1
	STORE BMD_DEST
	BRANCH _BMD_L
_BMD_X:
	DROP
	FPADJ BMD_FS
	RET

; copy bytes between two arrays of words
; no bounds check is performed
; parameters: [ dest, destoffset, src, srcoffset, length ]
	.EQU CPB_LEN  0
	.EQU CPB_DPTR 4
	.EQU CPB_SPTR 8
	.EQU CPB_FS 12
COPYBUF:
	FPADJ -CPB_FS
	STORE CPB_LEN
	ADD	; add src and srcoffset
	STORE CPB_SPTR
	ADD	; add dest and destoffset
	STORE CPB_DPTR

	; check if source ptr and dest prtr
	; are word-aligned
	LOAD CPB_SPTR
	LOAD CPB_DPTR
	OR
	LOADC 3
	AND
	CBRANCH COPYBYTES ; if not, continue with COPYBYTES

COPYBUF_1:
	LOAD CPB_LEN	; check if length is smaller than
	LOADC 4		; word size
	CMP LT
	CBRANCH COPYBYTES ; if yes, continue with COPYBYTES

	; else copy whole words
	LOAD CPB_DPTR
	LOAD CPB_SPTR
	LOAD CPB_LEN
	SHR	; COPYWORDS needs number of words, not bytes
	SHR	; so divide by 4
	LOADCP _COPYWORDS
	CALL

	; calculate remaining bytes
	LOAD CPB_LEN
	DUP	; duplicate for offset calculation below
	LOADC 3
	AND	; get lower two bits for remaining byte count
	DUP
	CBRANCH.Z COPYBUF_XT ; if zero remaining, exit
	STORE CPB_LEN ; store as new length
	LOADC ~3 ; calculate length rounded down to word size
	AND	; by setting lower two bits to zero
	DUP	; duplicate it to calculate two offsets
	LOAD CPB_DPTR
	ADD
	STORE CPB_DPTR  ; move dest ptr to remaining bytes
	LOAD CPB_SPTR
	ADD
	STORE CPB_SPTR	; move src ptr to remaining bytes
	BRANCH COPYBYTES

COPYBUF_XT:
	DROP	; cleanup stack
	DROP
	FPADJ CPB_FS
	RET

; Copy single bytes, branch from COPYBUF
COPYBYTES:
	LOAD CPB_LEN		; put counter on stack
COPYBYTES_L:
	DUP			; check if remaining length is 0
	CBRANCH.Z COPYBYTES_XT	; exit loop if true
	LOAD CPB_DPTR		; load dest ptr for SETSTRINGCHAR below
	INC.S1.X2Y 1		; increment dest ptr and keep old value
	STORE CPB_DPTR		; store incremented dest ptr, old value is now ToS
	LOAD CPB_SPTR		; load src ptr
	INC.S1.X2Y 1		; increment src ptr and keep old value
	STORE CPB_SPTR		; store incremented src ptr, old value is now ToS
	LOADI.S1.X2Y		; load source word, keep addr
	BSEL			; select byte from word via addr
	LOADCP _SETSTRINGCHAR	; put byte into destination
	CALL
	DEC 1			; decrement counter
	BRANCH COPYBYTES_L
COPYBYTES_XT:
	DROP		; remove counter
	FPADJ CPB_FS
	RET

; helper routine to read a char from a file
; parameters: [ pointer to file record ]
READFSCHAR:
	LOADCP READFSCHARBUF
	LOADC 1  ; length arg
	LOADCP READFS
	CALL

	LOADC 0		; byte address for BSEL
	LOADCP READFSCHARBUF
	LOADI

	BSEL		; get the most significant byte
	RET

READFSCHARBUF:
	.WORD 0

; helper routine to write a byte to a file
; parameters: [ pointer to file record, char value ]
WRITEFSCHAR:
	BROT	; rotate char value to MSB
	BROT
	BROT
	LOADCP WRITEFSCHARBUF
	SWAP
	STOREI ; store rotated value to buffer
		; keep address on stack (WRITEFSCHARBUF)
	LOADC 1 ; length arg
	LOADCP WRITEFS
	JUMP	; save one RET

WRITEFSCHARBUF:
	.WORD 0

; helper routine to write a string to a file
; parameters: pointer to file record, string pointer
WRITEFSSTRING:
	DUP	; duplicate string ptr
	INC 8	; skip string header
	SWAP	; put original string ptr on ToS
	LOADI	; load length from string header
		; stack is now [ ptr to file, string ptr+8, length ]
	LOADCP WRITEFS
	JUMP
; write a number of words to a channel
; parameters: [ ptr to file record, word pointer, word count ]
WRITECHANWORDS:
	; we ignore the file record since there is only
	; one device for now
	DUP
	CBRANCH.Z WRITECHANW_XT	; if count is zero, exit
	DEC 1	; decrement counter
	SWAP	; swap counter and word ptr
	LOADI.S1.X2Y	; load word, keep addr
	LOADCP CONOUTW
	CALL
	INC 4	; increment addr
	SWAP	; swap back word ptr and counter
	BRANCH WRITECHANWORDS
WRITECHANW_XT:
	DROP
	DROP
	DROP
	RET


; read a number of words from a channel
; parameters: [ ptr to file record, destination pointer, word count ]
READCHANWORDS:
	; we ignore the file record since there is only
	; one device for now
	DUP
	CBRANCH.Z WRITECHANW_XT	; if count is zero, exit
	DEC 1	; decrement counter
	SWAP	; swap counter and word ptr
	LOADCP CONINW	; read four bytes
	CALL
	STOREI 4	; store and post-increment
	SWAP	; swap back word ptr and counter
	BRANCH READCHANWORDS
READCHANW_XT:
	DROP
	DROP
	DROP
	RET

; --- check if a string is already initialized
; parameters: addr
; returns: 1 if it is initialied, 0 otherwise
_STRINGISINITED:
	LOADI.S1.X2Y	; load length field, keep addr
	CBRANCH.NZ STRIN_XT1 ; if not zero, it is already inited
	INC 4		; increment addr for max length field
	LOADI
	CBRANCH.NZ STRIN_XT2 ; if not zero, already initialized
	LOADC 0	; return 0
	RET
STRIN_XT1:
	DROP	; remove addr
STRIN_XT2:
	LOADC 1 ; return 1
	RET

; --- initialise a string if it is not already initialized
; parameters: [ length, addr ]
_INITSTRING:
	DUP
	LOADCP _STRINGISINITED
	CALL		; check if string is already initialized
	CBRANCH.Z _INITSTRINGF
	DROP		; if yes, drop args and return immediately
	DROP
	RET

; --- initialise a string, do not check if it is already
; initialized.
; parameters: [ length, addr ]
_INITSTRINGF:
	LOADC 0	; [ length, addr, 0 ]
	STOREI 4 ; set length to 0, store with post-increment [ length, addr + 4 ]
	SWAP	; swap addr and length  [ addr + 4, length ]
	STOREI	4; store max length, post-increment addr by 4  [ addr + 8 ]
	LOADC 0	; [addr + 8, 0 ]
	STOREI	; zero first word [ addr + 8 ]
	DROP	; drop addr from STOREI
	RET

; --- initialise string from another
; parameters: [ dest, src, length ]
_INITSTRINGFROM:
	FPADJ -4
	STORE 0			; [ dest, src ]
	OVER			; [ dest, src, dest ]
	LOAD 0			; [ dest, src, dest, length ]
	SWAP			; [ dest, src, length, dest ]
	LOADCP _INITSTRINGF
	CALL			; [ dest, src ]
	LOADCP _COPYSTRING
	CALL			; [ ]
	FPADJ 4
	RET

; --- copy a pascal string to another
; parameters: [ dest, src ]
	.EQU CPSTR_DST 0
	.EQU CPSTR_SRC 4
	.EQU CPSTR_DSTMAX 8
	.EQU CPSTR_SRCLEN 12
	.EQU CPSTR_FS 16
_COPYSTRING:
	FPADJ -CPSTR_FS
	SWAP	; get dest addr first
	DUP		; dup pointer for LOADI
	STORE CPSTR_DST ; destination pointer
	INC 4	; increment pointer
	LOADI	; load max length of destination
	STORE CPSTR_DSTMAX ; and store into local var
	DUP		; dup src pointer for LOADI
	STORE CPSTR_SRC ; source pointer
	LOADI	; load length of source
	DUP     ; duplicate length for CMPU below
	STORE CPSTR_SRCLEN ; and store into local var
	LOAD CPSTR_DSTMAX  ; if dest max size is zero,
	CBRANCH.NZ CPSTR_0  ; throw a runtime error
	LOADCP _ERRMSG_CONSTWR
	LOADCP _RUNTIME_ERR
	JUMP
CPSTR_0:
	LOAD CPSTR_DSTMAX
	; if dest.max_length < src.length, use dest.max_length as src.length
	CMPU LE			; src.length <= dest.max_length?
	CBRANCH CPSTR_1
	LOAD CPSTR_DSTMAX
	STORE CPSTR_SRCLEN
CPSTR_1:
	; set dest.length to src.length
	LOAD CPSTR_DST  ; load dst addr
	DUP				; dup for INC/STORE below
	LOAD CPSTR_SRCLEN
	STOREI			; store src length to dst length
	DROP			; drop addr from STOREI
	INC 8			; skip length and max length words
	STORE CPSTR_DST
	LOAD CPSTR_SRC  ; skip length and max length words
	INC 8
	STORE CPSTR_SRC

	; copy ((src.length+3) div 4) words from src to dest
	LOAD CPSTR_SRCLEN ; calculate number of words
	LOADC 3
	ADD
	SHR
	SHR
CPSTR_L1:
	DUP				; duplicate word counter
	CBRANCH.Z CPSTR_LE ; if it is zero, exit loop
	LOAD CPSTR_DST	; load dst addr for STOREI below
	LOAD CPSTR_SRC	; load src addr
	LOADI        	; load value
	STOREI 4		; store value, increment dst addr
	STORE CPSTR_DST ; store new dst addr
	LOAD CPSTR_SRC
	INC 4			; increment src addr
	STORE CPSTR_SRC ; and store it
	DEC 1			; decrement word counter
	BRANCH CPSTR_L1
CPSTR_LE:
	; mask bytes in last word depending on length modulo 4:
	; 0: $00000000
	; 1: $FF000000
	; 2: $FFFF0000
	; 3: $FFFFFF00
	LOAD CPSTR_DST
	DEC 4			; get pointer to last word
	LOADI.X2Y.S1	; load value of last word, keep addr
	LOAD CPSTR_SRCLEN ; length of string
	LOADC 3
	AND		; modulo 4
	SHL 2		; *4
	LOADCP CPSTR_MASK ; + addr of mask table
	ADD
	LOADI			; load mask value
	AND
	STOREI			; store masked value
	DROP			; remove addr from STOREI
	DROP			; drop word counter
CPSTR_XT:
	FPADJ CPSTR_FS
	RET
CPSTR_MASK:
	.WORD $FFFFFFFF, $FF000000, $FFFF0000, $FFFFFF00

	.CPOOL

; --- append a pascal string to another
; parameters: [ dest, src ]
_APPENDSTRING:
	.EQU APSTR_SRCLEN 0
	.EQU APSTR_DSTLEN 4
	.EQU APSTR_SRC 8
	.EQU APSTR_DST 12
	.EQU APSTR_DSTMAX 16
	.EQU APSTR_FS 20
	FPADJ -APSTR_FS
	LOADI.X2Y.S1	; load src length, keep addr
	STORE APSTR_SRCLEN ; store it to local var
	INC 8			; increment addr to point to first char/word
	STORE APSTR_SRC ; store it to local var
	LOADI.X2Y.S1	; load dest length, keep addr
	STORE APSTR_DSTLEN ; store it to local var
	INC 4			; increment addr to point to dest max length
	LOADI.X2Y.S1	; load it, keep addr
	STORE APSTR_DSTMAX ; store it to local var
	INC 4			; increment addr to point to first char/word
	STORE APSTR_DST ; store it to local var

	LOAD APSTR_DSTMAX  ; if dest max size is zero,
	CBRANCH.NZ APSTR_0  ; throw a runtime error
	LOADCP _ERRMSG_CONSTWR
	LOADCP _RUNTIME_ERR
	JUMP

APSTR_0:
	; if src.length + dest.length <= dest.maxlength
	;   use src.length as number of characters
	; else
	;   use dest.maxlength - dest.length as number of characters

	LOAD APSTR_SRCLEN ; char counter
	DUP
	LOAD APSTR_DSTLEN
	ADD
	LOAD APSTR_DSTMAX
	CMPU LE
	CBRANCH APSTR_1
	DROP			; drop char counter
	LOAD APSTR_DSTMAX
	LOAD APSTR_DSTLEN
	SUB				; calculate dest.maxlength - dest.length as char counter
APSTR_1:
	; set dest.length to dest.length + number of characters
	LOAD APSTR_DST 
	DEC 8			; get pointer to dest.length for STOREI
	OVER 			; duplicate char counter
	LOAD APSTR_DSTLEN
	ADD				; dest.length = dest.length + char counter
	STOREI
	DROP			; drop STOREI addr, char counter is now on top of stack
	; set dest pointer to start + dest.length
	LOAD APSTR_DST
	LOAD APSTR_DSTLEN
	ADD
	STORE APSTR_DST
APSTR_L0:
	; while number of characters > 0:
	DUP	; duplicate number of remaining characters
	CBRANCH.Z APSTR_3	; if zero, exit loop
	DEC 1				; decrement char counter

	;   load src value, byte select by src addr
	LOAD APSTR_SRC
	LOADI.X2Y.S1
	BSEL
	LOAD APSTR_DST		; load dest pointer
	LOADCP APPENDCHAR_U
	CALL

	;   increment src and dest pointer
	LOAD APSTR_DST
	INC 1
	STORE APSTR_DST
	LOAD APSTR_SRC
	INC 1
	STORE APSTR_SRC
	BRANCH APSTR_L0
APSTR_3:
	DROP ; remove char counter
	FPADJ APSTR_FS
	RET

; write four bytes from a word to console, msb first
; parameters: [ word value ]
CONOUTW:
	BROT	; rotate msb to lsb
	DUP
	LOADC 255 ; mask out all other bytes
	AND
	LOADCP CONOUT
	CALL

	BROT	; rotate msb to lsb
	DUP
	LOADC 255
	AND
	LOADCP CONOUT
	CALL

	BROT	; rotate msb to lsb
	DUP
	LOADC 255
	AND
	LOADCP CONOUT
	CALL

	BROT	; rotate msb to lsb
	LOADC 255
	AND
	LOADCP CONOUT
	CALL

	RET

; read four bytes from console to a word
; returns word on estack
CONINW:
	LOADCP CONIN
	CALL

	BROT
	LOADCP CONIN
	CALL
	OR

	BROT
	LOADCP CONIN
	CALL
	OR

	BROT
	LOADCP CONIN
	CALL
	OR
	RET

; put a byte-sized character into a word.
; this is a utility route for APPENDSTRING, no bounds checking is done.
; bytes in the word after this character are cleared.
; example: destination word is 'ABCD', addr points to word addr +1,
;			character is 'X', result: word contains 'AX\0\0'
; parameters [ character, byte pointer ]
APPENDCHAR_U:
	FPADJ -4
	DUP
	STORE 0
	SWAP	; [ ptr, char ]
	BPLC	; [ rotated char ]
	LOAD 0	; [ rot char, ptr ]
	LOADI	; load word value
	LOAD 0	; calculate mask value by addr modulo 4
	LOADC 3
	AND
	SHL 2
	LOADCP _APPENDMASK
	ADD
	LOADI	; load mask
	AND	; mask word

	OR 	; OR masked dest value with rotated char value
	LOAD 0 	; get word addr again
	SWAP	; swap for STOREI
	STOREI
	DROP	; remove addr from STOREI
	FPADJ 4
	RET
_APPENDMASK: .WORD $00000000, $FF000000, $FFFF0000, $FFFFFF00

; Append a character to a pascal string.
; parameters: [ string ptr, char value ]
; Does a bounds check, so it can be called from Pascal.
APPENDCHAR:
	SWAP	; put string ptr first
	LOADI.S1.X2Y ; get current length, keep ptr
	OVER
	INC 4
	LOADI	; get maximum length
	CMPU LT ; if current length > max length, we can add a character
	CBRANCH.NZ APPENDCHAR_1

	;if not, check for attempt to write to a string constant
	; (which has max length 0)
	NIP	;  we don't need the char value anymore, the string ptr is ToS
	INC 4	; last time we use str ptr, so no DUP
	LOADI	; get max length
	CBRANCH.NZ APPENDCHAR_0

	LOADCP _ERRMSG_CONSTWR
	LOADCP _RUNTIME_ERR
	JUMP
APPENDCHAR_0:
	; if the string is already at max length,
	; we do nothing, analogous to the + operator
	RET

APPENDCHAR_1:	; on stack here: [ char value, str ptr ]
		; calculate byte ptr from str ptr
	LOADI.S1.X2Y	; get length, keep str ptr
	INC 1	; increase length by 1
	STOREI  ; store new length
	LOADI.S1.X2Y ; load it again; keep ptr
	ADD	; add length to str ptr
	INC 8-1	; byte ptr starts at 0, so adjust for header size - 1
	LOADCP APPENDCHAR_U
	JUMP

; compare two pascal strings for equality.
; the last word must be padded with null bytes
; if string length is not divisible by 4
; (which is ensured by _INITSTRING/APPENDSTRING).
; parameters: [ string1, string2 ]
; returns: 0 if not equal, 1 if equal
_CMPSTRING:
	.EQU CMPSTR_S1 0
	.EQU CMPSTR_S2 4
	.EQU CMPSTR_FS 8
	FPADJ -CMPSTR_FS
	STORE CMPSTR_S2		; store s2 string pointer
	STORE CMPSTR_S1		; store s1 string pointer
	LOAD CMPSTR_S1
	LOADI				; load s1.length
	LOAD CMPSTR_S2
	LOADI				; load s2.length
	CMPU NE				; if string lengths are not the same, 
	CBRANCH CMPSTR_XT_NE1 ; strings are not equal

	LOAD CMPSTR_S1
	LOADI.X2Y.S1		; load s1 length again, keep addr
	INC 3				; calculate number of words to compare:
	SHR					; count = (length + 3) div 4
	SHR					
	SWAP				; put addr on top
	INC 8				; increment addr to skip length fields
	STORE CMPSTR_S1		; store new addr
	LOAD CMPSTR_S2		; skip length fields for s2 pointer too
	INC 8
	STORE CMPSTR_S2
	; word counter is now on top of stack
CMPSTR_L0:
	DUP					; if word counter is zero, strings are equal
	CBRANCH.Z CMPSTR_XT_EQ
	LOAD CMPSTR_S1		; load current word of s1 and s2
	LOADI
	LOAD CMPSTR_S2
	LOADI
	CMPU NE
	CBRANCH CMPSTR_XT_NE    ; if not equal, strings are not equal
	LOAD CMPSTR_S1		; increment s1 pointer
	INC 4
	STORE CMPSTR_S1
	LOAD CMPSTR_S2		; increment s2 pointer
	INC 4
	STORE CMPSTR_S2
	DEC 1				; decrement word counter
	BRANCH CMPSTR_L0	; loop
CMPSTR_XT_EQ:
	DROP		; remove word counter
	LOADC 1		; return 1
	BRANCH CMPSTR_XT
CMPSTR_XT_NE:
	DROP		; remove word counter
CMPSTR_XT_NE1:
	LOADC 0		; return 0
CMPSTR_XT:
	FPADJ CMPSTR_FS
	RET

; compare two pascal strings lexicographically
; parameters: [ pointer to string a, pointer to string b ]
; returns: -1 if a < b, 0 if a = b, 1 if a > b
; NOTE: does not really do a lexicographic comparison, but
; 	a byte-wise numeric comparison. this works for ascii
;	but not for other characters like umlauts etc.
;	requires that the unused bytes in the last word
;	are set to zero (which is guaranteed by _INITSTRING
;	and APPENDSTRING).

	.EQU CMPSTRL_A_COUNT 0
	.EQU CMPSTRL_B_COUNT 4
	.EQU CMPSTRL_A 8
	.EQU CMPSTRL_B 12
	.EQU CMPSTRL_OFFS 16
	.EQU CMPSTRL_RESULT 20
	.EQU CMPSTRL_FS 24
_CMPSTRINGL:
	FPADJ -CMPSTRL_FS
	STORE CMPSTRL_B
	STORE CMPSTRL_A
	LOAD CMPSTRL_A	; load ptr to A
	LOADI		; get length field
	INC 3		; add wordsize - 1
	SHR
	SHR		; divide by 4 to get length in words
	STORE CMPSTRL_A_COUNT
	LOAD CMPSTRL_B	; load ptr to B
	LOADI		; get length field
	INC 3		; add wordsize - 1
	SHR
	SHR		; divide by 4 to get length in words
	STORE CMPSTRL_B_COUNT

	LOADC 8
	STORE CMPSTRL_OFFS ; offset for both strings, start after string header

CMPSTRL_L:			; loop start
	LOAD CMPSTRL_A_COUNT
	CBRANCH.NZ CMPSTRL_1 ; if word count A if zero:
	LOAD CMPSTRL_B_COUNT
	CBRANCH.NZ CMPSTRL_1A ; and word count B is zero,
	LOADC 0
	BRANCH CMPSTRL_XT  ; strings are equal
CMPSTRL_1A:
			; word count A is zero, word count B is not zero: A < B
	LOADC -1
	BRANCH CMPSTRL_XT
CMPSTRL_1:
	LOAD CMPSTRL_B_COUNT
	CBRANCH.NZ CMPSTRL_2 ; if word count B is zero (and word count A cannot be zero here)
	LOADC 1
	BRANCH CMPSTRL_XT ; A > B
CMPSTRL_2:		; both strings have remaining words to compare here
	LOAD CMPSTRL_OFFS
	LOAD CMPSTRL_A ; word address = A ptr + offset
	ADD
	LOADI		; load word from A
	LOAD CMPSTRL_OFFS ; word address = B ptr + offset
	LOAD CMPSTRL_B
	ADD
	LOADI		; load word from B
	OVER
	OVER		; duplicate both words
	CMPU LT		; check if word from A < word from B
	CBRANCH.Z CMPSTRL_2A
	DROP
	DROP
	LOADC -1	; result code for A < B
	BRANCH CMPSTRL_XT
CMPSTRL_2A:
	CMPU GT		; check if word from A > word from B
	CBRANCH CMPSTRL_2B
	; nope, they are equal
	; continue loop: decrease counters, increase offset
	LOAD CMPSTRL_A_COUNT
	DEC 1
	STORE CMPSTRL_A_COUNT
	LOAD CMPSTRL_B_COUNT
	DEC 1
	STORE CMPSTRL_B_COUNT
	LOAD CMPSTRL_OFFS
	INC 4
	STORE CMPSTRL_OFFS
	BRANCH CMPSTRL_L
CMPSTRL_2B:
	LOADC 1	; result code for A > B
CMPSTRL_XT:
	FPADJ CMPSTRL_FS
	RET

	.CPOOL

; create a string from a character
; requires a pointer to a buffer of 12 bytes (minimum string buffer size)
; parameters: [ char value, pointer to string buffer ]
_CHARTOSTRING:
	LOADC 1
	STOREI 4 ; store 1 to length field, post-increment addr
	LOADC 1
	STOREI 4 ; store 1 to max length field, post-increment addr
	SWAP	; swap addr and char value, char is now on ToS
	LOADC 255 ; mask lsb of word
	AND
	BROT	; rotate lsb to msb
	BROT
	BROT
	STOREI ; store it
	DROP
	RET

; convert string and index to a byte pointer.
; does a bounds check.
; parameters [ str ptr, char index ]
; returns: byte ptr
_INDEXSTRING:
	DEC 1	; adjust to base 0, string indices start at 1
	OVER	; [ str, index, str ]
	LOADI	; [ str, index, length ]
	CMPU.S0 GE ; [ str, index, cmp ]
	CBRANCH INDEXSTRING_ERR ; [ str, index ]
	INC 8	; account for string header
	ADD	; add index to ptr to get byte ptr
	RET
INDEXSTRING_ERR:
	DROP
	DROP
	LOADCP _ERRMSG_STRIDX
	LOADCP _RUNTIME_ERR
	JUMP

; set a char at a specific index in a string.
; expects a byte pointer and a char value.
; the byte pointer contains the byte address in bits 0-1.
; no bounds check is performed.
; parameters: [ byte ptr, char value ]
_SETSTRINGCHAR:
	BPLC.S0	; [ ptr, rotated char ]
	OVER	; [ ptr, rot char, ptr ]
	LOADC $FF ;[ptr, rot char, ptr, $FF]
	BPLC.S0	; [ ptr, rot char, ptr, ~mask ]
	NOT	; [ ptr, rot char, ptr, mask ]
	SWAP	; [ ptr, rot char, mask, ptr ]
	LOADI	; [ ptr, rot char, mask, word ]
	AND	; [ ptr, rot char, masked word ]
	OR	; [ ptr, new word ]
	STOREI	; [ ptr ]
	DROP
	RET

; convert string to char
; string must have length of 1, otherwise a runtime error occurs
; parameters [ pointer to string ]
; returns: char value
_STRINGTOCHAR:
	DUP	; dup addr for later
	LOADI	; load string length
	LOADC 1 ; compare with 1
	CMPU EQ
	CBRANCH STRINGTOCHAR_1
	DROP
	LOADCP _ERRMSG_STR2CHAR ; if not 1, issue runtime error
	LOADCP _RUNTIME_ERR
	JUMP
STRINGTOCHAR_1:
	INC 8	; increment addr to skip string header
	LOADI	; load first string word
	BROT	; rotate msb byte to lsb
		; which is the first char/byte of the string.
		; since the last string word is always zero-padded,
		; we dont need to mask the byte
	RET

; set the current length of a pascal string.
; must be less or equal than the maximum length of the string.
; if the new length is larger than the old length, the string
; is padded with zero bytes.
; parameters: [ pointer to string, new length ]
	.EQU SETSTRL_NEWLEN	0
	.EQU SETSTRL_PTR	4
	.EQU SETSTRL_FS		8
_SETSTRINGLENGTH:
	FPADJ -SETSTRL_FS
	DUP
	STORE SETSTRL_NEWLEN
	SWAP			; [ newlen, ptr ]
	DUP			; [ newlen, ptr, ptr ]
	STORE SETSTRL_PTR	; [ newlen, ptr ]
	INC 4		; skip to max length field [ newlen, ptr+4 ]
	LOADI		; load max length [ newlen, maxlen ]
	CMPU.S1.X2Y GE	; new length > max_length?  [ newlen, maxlen, cmp_result ]
	CBRANCH.Z SETSTRL_0_0 ; if not, skip the following [ newlen, maxlen ]
			; if it is, clamp new length to max length
	NIP		; [ maxlen ]
	DUP		; [ maxlen, maxlen ]
	STORE SETSTRL_NEWLEN ; store maxlen as newlen [ ]
	BRANCH SETSTRL_0
SETSTRL_0_0:
	DROP		; remove maxlen
SETSTRL_0:		; newlen is on stack here
	LOAD SETSTRL_PTR ; load ptr to string, size field
			; stack is now: [ newlen, ptr ]
	; loop from addr + old_length - 1
	;	to addr + new_length - 1:
	;   SETSTRINGCHAR(a, chr(0))
	LOADI		; load current length	     [ newlen, oldlen ]
	CMPU LE		; new length <= old length?
	CBRANCH SETSTRL_1 ; if yes, skip padding

	; string is being expanded, need to pad with zero bytes
	LOAD SETSTRL_NEWLEN ; load new length
	LOAD SETSTRL_PTR ; load string pointer yet again
	LOADI		; load current(old) length
	SUB		; calculate length difference (old - new)
			; this is out char counter
	LOAD SETSTRL_PTR ; load string pointer yet again
	LOADI.S1.X2Y    ; load old string length
	ADD		; add to pointer
	INC 8		; adjust for string header

SETSTRL_0_L:
	DUP		; duplicate pointer
	LOADC 0		; zero arg
	LOADCP _SETSTRINGCHAR
	CALL

	INC 1		; increment pointer
	SWAP		; swap pointer and counter
	DEC 1		; decrement counter
	DUP
	CBRANCH.Z SETSTRL_1_0 ; if counter is zero, end loop
	SWAP		; swap pointer and counter again
	BRANCH SETSTRL_0_L
SETSTRL_1_0:
	DROP
	DROP		; remove pointer and counter
SETSTRL_1:		; pad last word of string with zero bytes
	LOAD SETSTRL_PTR
	INC 8		; get pointer to first word
	LOAD SETSTRL_NEWLEN
	ADD		; get pointer to last word
	LOADI.S1.X2Y	; load word, keep addr
	OVER		; duplicate addr
	LOADC 3
	AND		; addr modulo 4
	SHL 2		; * 4 = offset into table borrowed from COPYSTRING
	LOADCP CPSTR_MASK
	ADD		; add up to addr of mask
	LOADI		; load mask
	; now on stack: [ word ptr, word, word mask ]
	AND		; apply mask [ word ptr, word AND mask ]
	STOREI		; store new word
	DROP		; remove addr from STOREI

SETSTRL_XT2:
	LOAD SETSTRL_PTR	; store new length in the length field
	LOAD SETSTRL_NEWLEN	; of the string
	STOREI
	DROP

	FPADJ SETSTRL_FS
	RET

; check if a char value is contained
; within a string.
; parameters: [ value, ptr to string ]
; returns: nonzero if string contains value, 0 if not
_ISCHARINSTRING:
	FPADJ -4
	SWAP
	STORE 0		; store value to find
	LOADI.S1.X2Y	; load string length
	SWAP		; [ length, ptr ]
	INC 8		; skip string header
	SWAP		; [ ptr+8, length ]
ISCHIS_L:
	DUP 		; check if bytes remaining
	CBRANCH.Z ISCHIS_XT0 ; if zero, exit
	SWAP		; [ length, ptr+n ]
	DUP		; [ length, ptr+n, ptr+n ]
	LOADI.S1.X2Y	; [ length, ptr+n, ptr+n, word ]
	BSEL		; [ length, ptr+n, char ]
	LOAD 0
	CMP EQ		; compare with char value
	CBRANCH ISCHIS_FND ; found it
			; [ length, ptr+n ]
	INC 1		; increment byte ptr
	SWAP		; [ ptr+n, length ]
	DEC 1		; decrement counter
	BRANCH ISCHIS_L
ISCHIS_FND:
	LOADC 1
	BRANCH ISCHIS_XT
ISCHIS_XT0:
	LOADC 0
ISCHIS_XT:
	NIP	; remove ptr
	NIP	; and counter, keeping the result code
	FPADJ 4
	RET

; check if an integer value is contained
; within an array of integers
; parameters: [ value, ptr to array, size in words ]
; returns: 1 if  array contains value, 0 if not
_ISINTINARRAY:
	FPADJ -4
	SWAP	; swap size and array
	STORE 0	; store ptr
ISINTINA_L:
	DUP			; duplicate word counter
	CBRANCH.Z ISINTINA_XT0	; if counter is zero, exit
	OVER			; copy value to top of stack
	LOAD 0			; load ptr
	INC.S1.X2Y 4		; increment ptr, keep old value on stack
	STORE 0			; store new ptr
	LOADI			; load array element via old ptr
	CMP NE			; compare value and array element
	CBRANCH ISINTINA_1	; if not equal, skip the following
	DROP
	DROP			; drop counter and value
	LOADC 1			; we found our value, load 1 as return value
	BRANCH ISINTINA_XT	; and branch to exit
ISINTINA_1:
	DEC 1			; decrease counter
	BRANCH ISINTINA_L	; and loop
ISINTINA_XT0:
	DROP			; drop counter and value
	DROP
	LOADC 0			; return 0
ISINTINA_XT:
	FPADJ 4
	RET

; Set a bit in a word. The bit is specified by index (0-31)
; where 0 indicates the lsb and 31 the msb.
; parameters: [ word, bit number ]
; returns: word with bit set
_SETBIT:
	SHL 2	; bit number * 4 = offset into table
	LOADCP _BITTABLE
	ADD
	LOADI	; get bit value
	OR	; combine original value and shifted bit
	RET

; Clear a bit in a word. The bit is specified by index (0-31)
; where 0 indicates the lsb and 31 the msb.
; parameters: [ word, bit number ]
; returns: word with bit cleared
_CLEARBIT:
	SHL 2	; bit number * 4 = offset into table
	LOADCP _BITTABLE
	ADD
	LOADI	; get bit value
	NOT	; invert mask
	AND	; combine original value and shifted bit
	RET

; test if a bit is set a word. The bit is specified by index (0-31)
; where 0 indicates the lsb and 31 the msb.
; parameters: [ bit number, word ]
; returns: 1 if bit is set, 0 otherwise
_TESTBIT:
	SWAP
	SHL 2	; bit number * 4 = offset into table
	LOADCP _BITTABLE
	ADD
	LOADI	; get bit value
	AND	; combine original value and shifted bit
	LOADC 0
	CMP NE ; if not zero, return 1
	RET

; Convert an integer array to a 32-bit set, by
; iterating over all array values and calling SETBIT.
; parameters: [ array ptr, array size in words ]
; returns: set value as a single word
_ARRAYTOSET:
	FPADJ -4 ; local var offset 0 is the result value
	LOADC 0
	STORE 0 ; clear result value
ARRAYTOSET_L:
	DUP	; duplicate word counter
	CBRANCH.Z ARRAYTOSET_X	; if zero, we are done
	SWAP	; swap counter and ptr, ptr is on ToS
	LOADI.S1.X2Y ; load value from array, keep ptr
	LOADC 31
	AND	; clamp bit number to 31
	LOAD 0	; load result value
	SWAP	; SETBIT wants [ value, bit number ]
	LOADCP _SETBIT ; set the bit
	CALL
	STORE 0	; store result
	INC 4	; increment ptr
	SWAP	; swap ptr and counter again
	DEC 1	; decrement counter
	BRANCH ARRAYTOSET_L ; and loop
ARRAYTOSET_X:
	DROP	; remove word counter
	DROP	; remove ptr
	LOAD 0	; load result
	FPADJ 4
	RET

_BITTABLE:
	.WORD %00000000000000000000000000000001
	.WORD %00000000000000000000000000000010
	.WORD %00000000000000000000000000000100
	.WORD %00000000000000000000000000001000
	.WORD %00000000000000000000000000010000
	.WORD %00000000000000000000000000100000
	.WORD %00000000000000000000000001000000
	.WORD %00000000000000000000000010000000
	.WORD %00000000000000000000000100000000
	.WORD %00000000000000000000001000000000
	.WORD %00000000000000000000010000000000
	.WORD %00000000000000000000100000000000
	.WORD %00000000000000000001000000000000
	.WORD %00000000000000000010000000000000
	.WORD %00000000000000000100000000000000
	.WORD %00000000000000001000000000000000
	.WORD %00000000000000010000000000000000
	.WORD %00000000000000100000000000000000
	.WORD %00000000000001000000000000000000
	.WORD %00000000000010000000000000000000
	.WORD %00000000000100000000000000000000
	.WORD %00000000001000000000000000000000
	.WORD %00000000010000000000000000000000
	.WORD %00000000100000000000000000000000
	.WORD %00000001000000000000000000000000
	.WORD %00000010000000000000000000000000
	.WORD %00000100000000000000000000000000
	.WORD %00001000000000000000000000000000
	.WORD %00010000000000000000000000000000
	.WORD %00100000000000000000000000000000
	.WORD %01000000000000000000000000000000
	.WORD %10000000000000000000000000000000

	.CPOOL

	.EQU _HEAP_HDR_SZ 8
	.EQU _HEAP_MIN_SZ 32
; MEM_ALLOC
; allocate a chunk of memory
; parameters: [ size in bytes ]
; returns: starting address of allocated memory, or 0 if
;		no more space is available
	.EQU MA_REQD_SIZE 0
	.EQU MA_CURCHUNK 4
	.EQU MA_LASTCHUNK 8
	.EQU MA_CURCHUNK_SIZE 12
	.EQU MA_NEWCHUNK 16
	.EQU MA_FS 20
_MEM_ALLOC:
	FPADJ -MA_FS
	; round up requested size
	LOADC _HEAP_HDR_SZ
	ADD
	LOADC _HEAP_MIN_SZ -1
	ADD
	LOADC ~_HEAP_MIN_SZ + 1
	AND
	STORE MA_REQD_SIZE

	;LOAD MA_REQD_SIZE
	;LOADCP PRINTDEC
	;CALL
	;LOADCP NEWLINE
	;CALL

	; get current alloc pointer (points to last previously seen free chunk)
	LOADCP _HEAP_CUR
	LOADI
	STORE MA_CURCHUNK
MEM_ALLOC_L0:
	; get next free chunk
	LOAD MA_CURCHUNK
	DUP
	STORE MA_LASTCHUNK	; last chunk = cur chunk
	LOADI			; load next ptr
	DUP			; dup ptr for accessing the size
	STORE MA_CURCHUNK 	; cur chunk = cur chunk^.next
	INC 4			; skip to size field
	LOADI			; load it
	STORE MA_CURCHUNK_SIZE	; and store to local var

	;LOADC ':'
	;LOADCP CONOUT
	;CALL

	;LOAD MA_CURCHUNK
	;LOADCP PRINTHEXW
	;CALL

	;LOADCP 's'
	;LOADCP CONOUT
	;CALL

	;LOAD MA_CURCHUNK_SIZE
	;LOADCP PRINTHEXW
	;CALL

	;LOADCP '?'
	;LOADCP CONOUT
	;CALL

	;LOAD MA_REQD_SIZE
	;LOADCP PRINTHEXW
	;CALL

	;LOADCP NEWLINE
	;CALL

	; if requested size is less or equal than chunk size, jump to allocation
	LOAD MA_REQD_SIZE
	LOAD MA_CURCHUNK_SIZE
	CMPU LE
	CBRANCH MEM_ALLOC_A
	; if back to where we started, return failure
	LOADCP _HEAP_CUR
	LOADI
	LOAD MA_CURCHUNK
	CMPU NE
	CBRANCH MEM_ALLOC_L0 ; else, go to next chunk

	;LOADC 'e'
	;LOADCP CONOUT
	;CALL

	; TODO: grow heap and add new chunk, check for
	; collision with downward growing user stack (FP)

	LOADC 0
	BRANCH MEM_ALLOC_XT

	; allocation:
MEM_ALLOC_A:
	LOAD MA_CURCHUNK
	STORE MA_NEWCHUNK

	LOADCP _HEAP_CUR	; remember last chunk
	LOAD MA_LASTCHUNK	; for next invocation
	STOREI
	DROP
	; split chunk:
	;	skip if requested_size = chunk size
	LOAD MA_CURCHUNK_SIZE
	LOAD MA_REQD_SIZE
	CMPU EQ
	CBRANCH MEM_ALLOC_A0
	;	new chunk is head portion of current chunk
	;	new chunk size = requested size
	LOAD MA_NEWCHUNK
	INC 4 ; skip zo size field
	LOAD MA_REQD_SIZE
	STOREI   ; store size
	DROP

	;LOADC '|'
	;LOADCP CONOUT
	;CALL

	; current chunk is the split off free chunk
	;	current chunk start += requested size
	;	current chunk size -= requested size
	LOAD MA_CURCHUNK_SIZE
	LOAD MA_REQD_SIZE
	SUB	; new size = old size - requested
	LOAD MA_CURCHUNK
	LOADI  ; load old next ptr

	LOAD MA_CURCHUNK
	LOAD MA_REQD_SIZE
	ADD	; new addr of current chunk = old addr + requested size
	DUP
	STORE MA_CURCHUNK
	; the stack at this point: [ new size, old next ptr, cur chunk addr ]
	; now write new header
	SWAP		; swap next ptr and addr
	STOREI 4	; store next ptr to addr, leave addr + 4
	SWAP		; swap addr and size
	STOREI		; store size
	DROP

	; previous chunk next pointer = current chunk pointer
	LOAD MA_LASTCHUNK
	LOAD MA_CURCHUNK
	STOREI
	DROP
	BRANCH MEM_ALLOC_A1

MEM_ALLOC_A0:
	;LOADC 'O'
	;LOADCP CONOUT
	;CALL

	; if chunk was not split: previous chunk next ptr = current chunk next ptr
	LOAD MA_LASTCHUNK
	LOAD MA_CURCHUNK
	LOADI
	STOREI
	DROP

MEM_ALLOC_A1:
	;	return new chunk pointer + header size
	LOAD MA_NEWCHUNK
	INC _HEAP_HDR_SZ

MEM_ALLOC_XT:
	FPADJ MA_FS
	RET

; MEM_FREE
; free a chunk of memory which was allocated by MEM_ALLOC
; parameters: [ address previously returned by MEM_ALLOC ]
	.EQU MF_FREECHUNK 0
	.EQU MF_CURCHUNK 4
	.EQU MF_NEXTCHUNK 8
	.EQU MF_CURCHUNK_END 12
	.EQU MF_FS	16
_MEM_FREE:
	FPADJ -MF_FS
	DEC _HEAP_HDR_SZ
	DUP	; dup for comparison below	[ ptr, ptr ]
	DUP	; dup for other comparison below [ ptr, ptr, ptr ]
	STORE MF_FREECHUNK ; to-be-freed chunk pointer = address - header size  [ptr, ptr ]
	LOADCP _HEAP_ANCHOR ; [ ptr, ptr, anchor ]
	CMP GT			; [ ptr , cmp ]
	CBRANCH MEM_FREE_L	; [ ptr ]

	DUP
	LOADCP PRINTHEXW
	CALL

	DROP

	LOADCP _ERRMSG_MEMFREE
	LOADCP _RUNTIME_ERR
	JUMP
MEM_FREE_L:
	LOADCP _HEAP_CUR
	LOADI	; load current heap pointer
	DUP	; dup for comparison below
	STORE MF_CURCHUNK
			; on the stack now: [ freechunk,  heap_cur ]
	CMPU GE
	CBRANCH MEM_FREE_L0
	LOADCP _HEAP_ANCHOR
	STORE MF_CURCHUNK
MEM_FREE_L0:
	; get current alloc pointer (points to last seen free chunk)
	LOAD MF_CURCHUNK
	DUP
	DUP
	INC 4	; skip curchunk ptr to size field
	LOADI   ; load size
	ADD	; add to curchunk ptr to get end of chunk
	STORE	MF_CURCHUNK_END
	LOADI	 ; get next chunk pointer
	STORE MF_NEXTCHUNK

	;LOADC 'N'
	;LOADCP CONOUT
	;CALL
	;LOAD MF_NEXTCHUNK
	;LOADCP PRINTHEXW
	;CALL
	;LOADC 'C'
	;LOADCP CONOUT
	;CALL
	;LOAD MF_CURCHUNK
	;LOADCP PRINTHEXW
	;CALL
	;LOADC 'F'
	;LOADCP CONOUT
	;CALL
	;LOAD MF_FREECHUNK
	;LOADCP PRINTHEXW
	;CALL
	;LOADCP NEWLINE
	;CALL

        ; if next ptr < to-be-freed, skip to next chunk
	LOAD MF_NEXTCHUNK
	LOAD MF_FREECHUNK
	CMPU LT
	CBRANCH MEM_FREE_CT1

MEM_FREE_INS:
	LOAD MF_FREECHUNK
	LOAD MF_NEXTCHUNK
	CMP NE
	CBRANCH MEM_FREE_INS1

	LOADCP _ERRMSG_MEMDFREE
	LOADCP _RUNTIME_ERR
	JUMP

MEM_FREE_INS1:

	;	to-be-freed chunk next ptr = next chunk
	LOAD MF_FREECHUNK
	LOAD MF_NEXTCHUNK
	STOREI
	DROP

	;	current chunk next ptr = to-be-freed chunk
	LOAD MF_CURCHUNK
	LOAD MF_FREECHUNK
	STOREI
	DROP

	;LOADC 'i'
	;LOADCP CONOUT
	;CALL

	; merge down if needed
	;	if current chunk end = to-be-freed chunk start:
	;		current chunk size += to-be-freed size
	;		to-be-freed chunk = current chunk
	;		current chunk next = next
	LOAD MF_CURCHUNK_END
	LOAD MF_FREECHUNK
	CMPU NE
	CBRANCH MEM_FREE_CT

	;LOADC 'v'
	;LOADCP CONOUT
	;CALL

	LOAD MF_CURCHUNK
	INC 4
	DUP		; dup addr of cur chunk size for STOREI below
	LOADI		; get cur chunk size
	LOAD MF_FREECHUNK
	INC 4
	LOADI		; get to-be-freed chunk size
	ADD
	STOREI		; store new cur chunk size
	DROP

	LOAD MF_CURCHUNK ; set current chunk next pointer again
	LOAD MF_NEXTCHUNK
	STOREI		; store and reuse addr
	STORE MF_FREECHUNK ; to-be-freed chunk becomes current chunk

	; merge up if needed
	;	if to-be-freed chunk end = next chunk start:
	;		to-be-freed-chunk size += next chunk size
	;		to-be-freed next ptr = next chunk next ptr
MEM_FREE_CT:
	LOAD MF_FREECHUNK
	DUP
	INC 4
	LOADI
	ADD		; calculate to-be-freed chunk end
	LOAD MF_NEXTCHUNK
	CMPU NE
	CBRANCH MEM_FREE_CT0

	;LOADC '^'
	;LOADCP CONOUT
	;CALL

	LOAD MF_FREECHUNK ; store next chunk next ptr to to-be-freed next ptr
	LOAD MF_NEXTCHUNK
	LOADI
	STOREI 4	; store and post-increment addr to to-be-freed size field
	LOADI.S1.X2Y	; load size and keep addr
	LOAD MF_NEXTCHUNK
	INC 4
	LOADI		; get next chunk size
	ADD
	STOREI
	DROP

MEM_FREE_CT0:

	BRANCH MEM_FREE_XT

MEM_FREE_CT1:
	;LOADC '>'
	;LOADCP CONOUT
	;CALL
	; if we are at the end of the list, insert there
	LOADCP _HEAP_ANCHOR
	LOAD MF_NEXTCHUNK
	CMPU EQ
	CBRANCH MEM_FREE_INS

	; move to next chunk
	LOAD MF_NEXTCHUNK
	STORE MF_CURCHUNK
	BRANCH MEM_FREE_L0

MEM_FREE_XT:
	; reset current heap pointer because
	; a merge might have invalidated it
	LOADCP _HEAP_CUR
	LOADCP _HEAP_ANCHOR
	STOREI
	DROP

	FPADJ MF_FS
	RET

; MEM_INIT
; Initialize dynamic memory, user stack and return stack.
; Since the return stack is no longer valid afterwards, directly
; jumps to _MAIN instead of using RET.

; parameters: [ start of heap address ]
_MEM_INIT:
	; initialize anchor chunk with start of heap address
	; and heap size - header size
	LOADCP _HEAP_CUR ; load addr of _HEAP_CUR for STOREI below
	LOADCP _HEAP_ANCHOR
	DUP
	DUP	; anchor points to itself at first
	STOREI 4
	LOADC 0 ; store size 0
	STOREI
	DROP
	STOREI  ; store _HEAP_ANCHOR to _HEAP_CUR
	DROP

	LOADCP _HEAP_SZ_PTR	; load the value of the heap size from
	LOADI			; the program header

	; set user stack pointer to heap start + heap size + stack size
	OVER	; [ start, size, start ]
	OVER	; [ start, size, start, size ]
	ADD	; [ start, size, start+size ]
	LOADCP _STACK_SZ_PTR
	LOADI
	ADD	; add user stack size to get new FP value [ start, size, start+heapsize+stacksize]
	STOREREG FP

	LOADREG FP
	INC 4
	STOREREG RP	; set RP to start right after user stack
			; this trashes the previous return stack,
			; so we cannot use RET at the end of MEM_INIT

	; set chunk header
	OVER 	; [ start, size, start ]
	LOADC 0	; [ start, size, start, 0 ]	; set next chunk ptr
	STOREI 4 ; [ start, size , start + 4 ]	; to zero or we get an error in _MEM_FREE
	SWAP	; [ start, start + 4, size ]
	STOREI					; store the size
	DROP	; [ start ]

	LOADC _HEAP_HDR_SZ
	ADD	; adjust chunk address for header

	LOADCP _MEM_FREE ; add chunk to free list
	CALL

	LOADCP _MAIN
	JUMP

; allocate a string with MEM_ALLOC.
; the string is also initialized.
; parameters: [ max length ]
; returns: pointer to allocated string, or zero if
;		no heap space available

_STRING_ALLOC:
	DUP			; [ length, length ]
	INC 8			; adjust length for string header
	LOADCP _MEM_ALLOC
	CALL			; [ length, addr ]
	DUP			; [ length, addr, addr ]
	CBRANCH.Z STRING_ALLOC_E  ; [ length, addr ]
	SWAP			; [ addr, length ]
	OVER			; [ addr, length, addr ]
	LOADCP _INITSTRINGF	; set max string length (forced)
	CALL			; [ addr ]
	RET
STRING_ALLOC_E:
	SWAP
	DROP
	RET

	.CPOOL

LENGTH:
	LOADI
	RET

MAXLENGTH:
	INC 4
	LOADI
	RET

; issue a runtime error if pointer is zero
_CHECK_ALLOC:
	;TODO: check for heap overrun by user stack

	;DUP
	;LOADCP _CHECK_CHUNK ; check for corrupted free list
	;CALL

	DUP
	CBRANCH.NZ _CHECK_ALLOC_OK
	LOADCP _ERRMSG_MEMALLOC
	LOADCP _RUNTIME_ERR
	JUMP
_CHECK_ALLOC_OK:
	RET

; print the free list for debugging
MEM_DUMP:
	LOADC 35
	LOADCP CONOUT
	CALL
	LOADCP _HEAP_ANCHOR
	DUP
	LOADCP PRINTHEXW
	CALL
	LOADC '^'
	LOADCP CONOUT
	CALL
	LOADCP _HEAP_CUR
	LOADI
	LOADCP PRINTHEXW
	CALL
	LOADCP NEWLINE
	CALL
MEM_DUMP_L0:
	DUP	; dup cur ptr for later
	DUP	; dup cur ptr for printing
	LOADCP PRINTHEXW
	CALL
	LOADC ' '
	LOADCP CONOUT
	CALL
	INC 4
	LOADI
	LOADCP PRINTHEXW
	CALL
	LOADC '>'
	LOADCP CONOUT
	CALL
	LOADI	; load next ptr
	DUP
	LOADCP PRINTHEXW
	CALL
	LOADCP NEWLINE
	CALL
	DUP	; dup for comparison
	LOADCP _HEAP_ANCHOR
	CMPU NE	; if next ptr is anchor, we are done
	CBRANCH MEM_DUMP_L0
	DROP
	RET

; check if a pointer is part of the free list
; args: pointer returned by MEM_ALLOC
; throws runtime error if the pointer is found
_CHECK_CHUNK:
	FPADJ -4
	LOADC _HEAP_HDR_SZ	; adjust for header
	SUB
	STORE 0			; store chunk addr in local var

	LOADCP _HEAP_ANCHOR	; start loop with anchor address
CHK_CH_L:
	DUP		; current chunk addr is on stack
	LOADI		; load next ptr
	LOAD 0		; load addr to be checked
	CMP EQ		; if equal, error
	CBRANCH.NZ CHK_ERR

	LOADI		; load next ptr again
	LOADCP _HEAP_ANCHOR
	CMP.S0 EQ	; compare with anchor, keep ptr on stack
	CBRANCH.Z CHK_CH_L ; in not equal, loop

	DROP		; remove current chunk ptr

	FPADJ 4
	RET
CHK_ERR:
	LOAD 0
	LOADCP PRINTHEXW
	CALL
	LOADCP NEWLINE
	CALL

	LOADCP MEM_DUMP
	CALL
	; remove one return stack entry
	; for reporting the correct PC
	; since _CHECK_CHUNK is
	; always called by another checking
	; routine (e.g. _CHECK_ALLOC)
	LOADREG RP
	DEC 4
	STOREREG RP

	LOADCP _ERRMSG_MEMBROKEN
	LOADCP _RUNTIME_ERR
	JUMP

; array bounds check
; parameters [ index, array size ]
; throws a runtime error when not inside bounds
_BOUNDSCHECK:
	CMPU LT
	CBRANCH _BOUNDSCHECK_OK
	LOADCP _ERRMSG_ARRAY_OOB
	LOADCP _RUNTIME_ERR
	JUMP
_BOUNDSCHECK_OK:
	RET

; subrange check
; parameters: [ value, min, max ]
; throws runtime error when not inside bounds
_RANGECHECK:
	FPADJ -4
	STORE 0 ; store max value
	OVER	; dup value, stack is now [ v, min,  v ]
	CMP GT	; if min is greater than value
	CBRANCH _RANGE_ERR ; then it is a runtime error
	LOAD 0	; load max again, stack is now [ v, max ]
	CMP GT	; if value is greater than max
	CBRANCH _RANGE_ERR ; then it is a runtime error
	FPADJ 4
	RET
_RANGE_ERR:
	LOADCP _ERRMSG_RANGE
	LOADCP _RUNTIME_ERR
	JUMP

; enum range check
; parameters: [ value, max ]
; throws runtime error when outside bounds
_ENUMCHECK:
	CMPU GT
	CBRANCH _ENUM_ERR
	RET
_ENUM_ERR:
	LOADCP _ERRMSG_ENUM
	LOADCP _RUNTIME_ERR
	JUMP

HALT:
	LOADCP PTERM
	JUMP

; Show runtime error, to be called from Pascal.
; The string must end in a null byte, for example
; by having a greater maximum string length than
; actual length, or by adding a chr(0) at the end.
; parameters: [ ptr to pascal string ]
RUNTIMEERROR:
	INC 8	; skip string header
	; fall through to _RUNTIME_ERR

; show runtime error message and abort program
; args: error message
_RUNTIME_ERR:
	LOADCP _ERRMSG_1
	LOADCP PRINTLINE
	CALL
	LOADREG RP
	LOADI
	LOADCP PRINTHEXW
	CALL
	LOADCP NEWLINE
	CALL
	LOADCP PRINTLINE
	CALL
	LOADCP NEWLINE
	CALL

	LOADCP PTERM
	JUMP

	.EQU _ESP_EMPTY 0

_CLEARESTACK:
	LOADREG ESP
	LOADC _ESP_EMPTY
	CMP EQ
	CBRANCH _CLEARESTACK_XT
	DROP
	BRANCH _CLEARESTACK
_CLEARESTACK_XT:
	RET

; Terminate program: clear estack and
; jump to coreloader
PTERM:
	LOADCP _CLEARESTACK
	CALL
	LOADCP LOADER_START
	JUMP

; Return an integer representation
; of a real(float32) number.
; This is our native format, so
; we do not have to do anything.
ENCODEFLOAT32:
	RET

	.CPOOL

_HEAP_START:	.WORD 0
_HEAP_MAX:	.WORD 0
_HEAP_CUR:	.WORD 0
_HEAD_FIRSTF:	.WORD 0
_HEAP_ANCHOR:	.WORD 0,0

_ERRMSG_1: .BYTE 13,10,"Runtime error at PC ",0
_ERRMSG_ARRAY_OOB: .BYTE "Array index out of bounds",0
_ERRMSG_CONSTWR: .BYTE "Write to constant string",0
_ERRMSG_STR2CHAR: .BYTE "Invalid conversion from string to char",0
_ERRMSG_STRIDX: .BYTE "String index out of bounds",0
_ERRMSG_RANGE: .BYTE "Range check",0
_ERRMSG_ENUM: .BYTE "Invalid enum value",0
_ERRMSG_MEMFREE: .BYTE "Invalid pointer in dispose",0
_ERRMSG_MEMDFREE: .BYTE "Chunk already disposed",0
_ERRMSG_MEMALLOC: .BYTE "Out of heap space",0
_ERRMSG_MEMBROKEN: .BYTE "Heap corrupted",0
NEWLINESTR:
	.WORD 2,0
	.BYTE 13,10

	.CPOOL
