Format ElfObj64

#win32 with _
importx "fwrite" fwrite
importx "realloc" realloc
importx "memcpy" memcpy
importx "free" free
importx "strlen" strlen
importx "memcmp" memcmp

^import "platform_iob" platform_iob #full

include "../include/prog.h" "../include/prog.oh"

#multithread unsafe
vdatax structures#max_structures     #others: swapdata_max  brace_blocks_max  dup_member  max_char_records  max_structures(also at alt)    ,    pool.constants
data index=0
char throwless=FALSE
charx ainit_bool#1
data fileRes=fd_none
valuexu basepointer#1
char ebool=0
vdatax action_structures#max_structures
vdatax action_structures_init#max_structures
vdatax actionpool_structures#max_structures
vdatax actionpool_structures_init#max_structures
vdatax actionpool_filter_structures#max_structures
vdatax actionpool_filter_structures_init#max_structures

function printEr(ss msg)
	sv ?len;setcall len strlen(msg)
	sv ?stder;setcall stder platform_iob()
	call fwrite(msg,(BYTE),len,stder)
	#callret
endfunction

function word_swap_arg(ss word)
    sd ?a
    ss aux^a
    set aux# word#
    ss dest
    set dest word
    inc word
    set dest# word#
    set word# aux#
endfunction
function stack_to_word_arg(sw ?intarg,ss arg)
    set arg# intarg
    inc arg
    divu intarg 0x100
    set arg# intarg
endfunction
function stack_to_word_arg_twips(sw ?a,sw dest)
	mult a 20
	call stack_to_word_arg(a,dest)
end
function word_arg_to_stack(ss arg)
    inc arg
    sd value
    set value arg#
    mult value 0x100
    dec arg
    or value arg#
    return value
endfunction
function word_swap(sw word)
	ss p^word
	sw val;set val p#
	mult val 0x100
	divu word 0x100
	or val p#
	return val
endfunction
#swapped data
function dword_swap(sd value)
    sd al
    sd ah
    sd third
    sd last

    set al value
    and al 0xff

    set ah value
    and ah 0xff00

    set third value
    and third (0xff00*0x100)

    set last value
    and last (0xff00<<8<<8)

    sd res=0x100*0x100*0x100
    mult res al
    #
    mult ah 0x100
    or res ah
    #
    div third 0x100
    or res third
    #
    div last (0x100*0x100*0x100)
    #for negative division, the number can be negative
    and last 0xff
    or res last
    #
    return res
endfunction
function struct_off(sd struct_of_ints,sd ?off)
    add struct_of_ints off
    return struct_of_ints#
endfunction

#util

function string_nl_print(ss msg)
    call printEr(msg)
    char nl={0xa,0}
    call printEr(#nl)
endfunction

#block

function block_reset_size(sd block)
    add block (mem_struct__size_off)
    set block# (mem_struct_size)
endfunction
#size
function block_get_size(sd block)
	sd ?size
	setcall size struct_off(block,(mem_struct__size_off))
	sub size (mem_struct_size)
	return size
endfunction
#psize
function block_get_psize(sd block)
	add block (mem_struct__size_off)
	return block
endfunction
#size
function block_get_fullsize(sd block)
	callret struct_off(block,(mem_struct__size_off))
endfunction
#mem
function block_get_mem(sd block)
    add block (mem_struct_size)
    return block
endfunction
function block_get_mem_size(sd block,sv p_mem,sd p_size)  #size is a stack variable , but since .c it is !xor-ed
    setcall p_mem# block_get_mem(block)
    setcall p_size# block_get_size(block)
endfunction

#mem procedures

function mem_free(sv p_mem)
    call free(p_mem#)
    set p_mem# (NULL)
endfunction

#pointer

function move_to_n_pointer(sd pointer,sdu ?id)
    mult id :
    add pointer id
    return pointer
endfunction

#strings/chars

#chars

#bool
function is_numeric(ss ?charvar)
	char min=_0
	char max=_9
	if charvar<min
		return (FALSE)
	endif
	if charvar<=max
		return (TRUE)
	endif
	return (FALSE)
endfunction
#0 1/2
function part_of_variable(ss value)
	ss ?boolval
	setcall boolval is_numeric(value#)
	if boolval=(TRUE)
		return 1
	endif
	callret is_letter(value)
endfunction
#0 1/2
function is_letter(ss str)
	sd value;set value str#
	if value<(A)
		return 0
	endif
	if value<=(Z)
		return 1
	endif
	if value=(_)
		return 1
	endif
	if value<(a_low)
		return 0
	endif
	if value<=(z_low)
		return 1
	endif
	if value>=(control2_start) #https://www.fileformat.info/info/unicode/utf8.htm  more at ascii.oh
		if value<=(control2_end)
			inc str
			set value str#
			if value>=(continuing_start)
				if value<=(continuing_end)
					return 2
				end
			end
		end
	end
	return 0
endfunction

#strings

function memtrail(ss end)
	whiletrue
		dec end
		if end#!=(Space)
			inc end
			set end# (Nullchar)
			ret
		end
	end
end
function memtrailstrict(ss end)
	dec end;if end#!=(Space)
		ret
	end
	whiletrue
		dec end
		if end#!=(Space)
			inc end
			set end# (Nullchar)
			ret
		end
	end
end

#bool
function str_at_str_start(ss s1,ss s2)
    sd l1
    sd l2
    setcall l1 strlen(s1)
    setcall l2 strlen(s2)
    if l1<l2
        return (FALSE)
    endif
	datax comp#1
	setcall comp memcmp(s1,s2,l2)
	if comp=0
		return (TRUE)
	endif
	return (FALSE)
endfunction

#next/same
function str_expression_at_start(ss string,ss expression)
	ss ?boolval
	setcall boolval str_at_str_start(string,expression)
	if boolval=(FALSE)
		return string
	endif
	ss next
	set next string
	addcall next strlen(expression)
	ss ?sz
	setcall sz part_of_variable(next)
	if sz!=0
		return string
	endif
	callret spaces(next)
endfunction
#next/same
function str_expression_at_start_withEndCare(ss ac,ss expression)
    ss pointer
    setcall pointer str_expression_at_start(ac,expression)
    if pointer=ac
        return ac
    endif
	char term=Semicolon
    if pointer#=term
        inc pointer
    endif
    return pointer
endfunction

#str
function spaces(ss str)
    whiletrue
        if str#!=(Space)
            if str#!=(HorizontalTab)
                return str
            endif
        endif
        inc str
    endwhile
endfunction

#newpos
function compat(ss pointer,sd max,ss against,sd rep)
	sd s;set s strlen(against)
	ss returnval;set returnval max
	add max pointer
	sd start;set start pointer
	sub max s
	while pointer<^max  ## = ? will not be logical to end like "abc and"
		datax c#1;set c memcmp(pointer,against,s)
		if c=0
			inc pointer

			call memcpy(pointer,rep,2)
			if s=5
				ss and;set and pointer
				add and 2
				set and# (Space)
			end

			sub pointer start
			return pointer
		end
		inc pointer
	end
	return returnval
end

#closings

function file_resources_set(sd file)
	set globalt.fileRes file
endfunction
import "file_close" file_close
function file_resources_free()
	if globalt.fileRes!=(fd_none)
		call file_close(#globalt.fileRes)
	endif
endfunction

#

import "free_all_swaps" free_all_swaps
function freelater() #forced free
	#this can be after code_values(in last_free); but normal is this at action and last_free at swf_done(without this)
	call action_debug_free_macro()
	#
	call file_get_content__resources_free()

	call file_resources_free()

	#swaps
	call free_all_swaps()
endfunction

#bool
function mem_cmp_bool(ss a,ss b,sd n)
	add n a
	while a<^n
		if a#!=b#
			return (FALSE)
		end
		inc a
		inc b
	end
	return (TRUE)
end

function mem_block_add_throwless(sv p_block,ss newblock,sd newblock_size)
	set globalt.throwless (TRUE)
	call mem_block_add(p_block,newblock,newblock_size)
	if globalt.throwless=(FALSE)
		return (FALSE)
	end
	set globalt.throwless (FALSE)
	return (TRUE)
end

function struct_ids_free(sd id)
	sv ac_ptr
	setcall ac_ptr struct_ids_action((ids_get),id)
	if ac_ptr!=(NULL)
		call free(ac_ptr)
		setcall ac_ptr struct_ids_actionpool((ids_get),id)
		if ac_ptr!=(NULL)
			call free(ac_ptr)
			call pool_data(id)
		endif
	endif
end

function is_ainit(ss ?a)
	set globalt.ainit_bool a
end
function ainit()
	return globalt.ainit_bool
end

importx "malloc" malloc
importx "fclose" fclose

import "action_error" action_error
import "freereset" freereset   #..x with no args
import "action_debug_free_macro" action_debug_free_macro
import "file_get_content__resources_free" file_get_content__resources_free
import "pool_data" pool_data

function ebase(sv bp)
	set globalt.basepointer bp
end

function erbool()
	#aftercall ebool #still needed at flashalizer at aftecall_get and _reset, and at imgx
	return #globalt.ebool
endfunction



function error(ss msg)
	call string_nl_print(msg)
	call action_error()

	call freereset()
	call freelater()

	ss p;setcall p erbool();set p# 1
	leave globalt.basepointer
endfunction

#
function memrealloc(sd mem,sd size)
    sd ptr
    setcall ptr realloc(mem,size)
    if ptr=(NULL)
        call error("realloc failed")
    endif
    return ptr
endfunction
function memalloc(sd size)
	callret memrealloc(0,size)
endfunction
function memalloc_errors(sd size,sd file)
	sd mem
	set mem malloc(size)
	if mem!=(NULL)
		return mem
	end
	call fclose(file)
	return (NULL)
endfunction

#inits

#id
function def_mem()
	callret struct_ids((ids_set),globalt.index)
endfunction
#mem
function def_data()
	sd mem
	setcall mem memalloc((block_size))
	set mem# (block_size)
	call block_reset_size(mem)
	return mem
endfunction

#mem procedures

function mem_block_add(sv p_block,ss newblock,sd newblock_size)
	sd block
	sd allsize
	sd size

	set block p_block#
	sd sz_test
	setcall size block_get_fullsize(block)
	set allsize block#
	set sz_test size
	add sz_test newblock_size

	if sz_test>^0x7fFFffFF
		if globalt.throwless=(TRUE)
			set globalt.throwless (FALSE)
			ret
		end
		call error("size error") #easy to test, call multiple action(...)
	end

	if sz_test>^allsize
		#was >= but when >?, here and in another 2 places
		divu sz_test (block_size)
		mult sz_test (block_size)
		add sz_test (block_size)
		#set allsize sz_test
		setcall block realloc(block,sz_test)  #allsize
		if block=(NULL)
			if globalt.throwless=(TRUE)
				set globalt.throwless (FALSE)
				ret
			end
			call error("realloc error at add")
		end
		set p_block# block
		set block# sz_test  ##allsize
	endif
	if newblock!=(NULL)
		sd pointer
		set pointer block
		add pointer size
		call memcpy(pointer,newblock,newblock_size)
	end
	add size newblock_size
	add block (mem_struct__size_off)
	set block# size
endfunction

#structure ids

function struct_ids_free_all()
	sv pointer
	#starting with ids_all_free:
	#                #counter increment#, then null at ac,pools
	#   can have errors at any point and here all are verified
	set pointer :;mult pointer globalt.index
	add pointer #globalt.structures  ##is ok at .c, and globalt.structures is same as #globalt.structures at .c
	while #globalt.structures!=pointer
		dec globalt.index
		sub pointer :
		if pointer#!=(NULL)
			call free(pointer#)
			call is_ainit((xlog_ainit_false)) #at root is the only one
			call struct_ids_free(globalt.index)
			call is_ainit((xlog_ainit_true))  #at button is the only one
			call struct_ids_free(globalt.index)
		endif
	endwhile
end
function struct_ids(sd ?proc,sd ?ident)
	sv pointer
	setcall pointer move_to_n_pointer(#globalt.structures,ident)
	if proc=(ids_get)
		return pointer#
	endif
	if proc=(ids_set)
	#id
		if globalt.index=(max_structures)
			call error("too many objects")
		endif
		sd newblock
		setcall newblock def_data()
		#can be in a free place, but since log, that will overwrite previous ids, to keep them compressed, a solution can be to parse twice
		#and in this way, free+NULL only on top id, free only at action/pool/pool_filter
		#	sv iter
		#	set iter pointer
		#	while iter!=strct
		#		sub iter :
		#		if iter#=0
		#			set iter# newblock
		#			sub iter strct
		#			div iter :
		#			return iter
		#		endif
		#	endwhile
		set pointer# newblock
		#counter increment#
		sd c;set c globalt.index;inc globalt.index
		sv ac_ptr
		setcall ac_ptr struct_ids_action((ids_get_pointer),c);set ac_ptr# (NULL)  #required for example at exports and free all
		#counter increment#
		return ident
	endif
	if proc=(ids_get_pointer)
		if ident>=globalt.index;call error("Unexistent input id.");endif
		return pointer
	endif
	#else
	#if proc==(ids_free)
	call mem_free(pointer)
	#endelse
endfunction
function struct_ids_action(sd ?proc,sd ?id)
	sd v
	if globalt.ainit_bool=(xlog_ainit_false)
		set v struct_ids_expand(proc,id,#globalt.action_structures)
	else
		set v struct_ids_expand(proc,id,#globalt.action_structures_init)
	end
	return v
endfunction
function struct_ids_actionpool(sd ?proc,sd ?id)
	sd v
	if globalt.ainit_bool=(xlog_ainit_false)
		set v struct_ids_expand(proc,id,#globalt.actionpool_structures)
	else
		set v struct_ids_expand(proc,id,#globalt.actionpool_structures_init)
	end
	return v
endfunction
function struct_ids_actionpool_filter(sd ?proc,sd ?id)
	sd v
	if globalt.ainit_bool=(xlog_ainit_false)
		set v struct_ids_expand(proc,id,#globalt.actionpool_filter_structures)
	else
		set v struct_ids_expand(proc,id,#globalt.actionpool_filter_structures_init)
	end
	return v
endfunction
function struct_ids_expand(sd ?proc,sd ?id,sd p_action_structures)
	sv pointer;setcall pointer move_to_n_pointer(p_action_structures,id)
	if proc=(ids_get)
		return pointer#
	endif
	if proc=(ids_set)
		set pointer# (NULL)  #this is extra at action but a lot of get_pointer set (NULL) are removed on the same way
		setcall pointer# def_data()
	elseif proc=(ids_get_pointer)
		#call to verify if the user input has a wrong id
		if id>=globalt.index;call error("Unregistered input id.");endif
		#
		return pointer
	else
		#if proc==(ids_free)
		call free(pointer#)
	endelse
endfunction
function struct_ids_action_set(sd ?id,ss ?ainitvalue)
	call is_ainit(ainitvalue)
	call struct_ids_action((ids_set),id)
	# is next and is set (NULL) inside. sv p;set p struct_ids_actionpool((ids_get_pointer),id);set p# (NULL)
	callg struct_ids_actionpool_set(id)
end
function struct_ids_actionpool_set(sd ?id)
	call struct_ids_actionpool((ids_set),id)
	callg struct_ids_actionpool_filter((ids_set),id) #flag_pool is almost default
end

#strings

function len_of(sd s,sd add)
	sd s2;set s2 s
	add s add
	if s<^s2
		call error("gigantic path error")
	end
	return s
end
function strlen_of(ss p,sd add) #of from overflow
	sd s;set s strlen(p)
	set s len_of(s,add)
	return s
end

#alloc
function dupreserve_string(ss str)
    sd len
    setcall len strlen(str)
    inc len
	callret memalloc(len)
endfunction

#pointer after "abc"
function str_escape(ss src,ss dest,sd delim)
	sd loop=1
	sd escapes=0
	inc src
	while loop=1
		if src#=delim
			set loop 0
		#elseif src#==delim2
		#    set loop 0
		else
			char esc=Backslash
			while src#=esc
				if escapes=0
					set escapes 1
				else
					set dest# src#
					inc dest
					set escapes 0
				endelse
				inc src
			endwhile
			if src#=0
				call error("end string expected")
			endif
			if escapes=1
				set dest# src#
				inc src
				inc dest
				set escapes 0
			elseif src#!=delim
				#if src#!=delim2
				set dest# src#
				inc src
				inc dest
				#endif
			endelseif
		endelse
	endwhile
	set dest# 0
	inc src
	return src
endfunction

entryraw globalt()
