' ____ ____
' | __ ) __ _ / ___|___ _ __
' | _ \ / _` | | / _ \| '_ \
' | |_) | (_| | |__| (_) | | | | --= A BaCon BASIC-to-C converter =--
' |____/ \__,_|\____\___/|_| |_|
'
' Peter van Eerten - March 2009/December 2023. License: MIT License.
'
'---------------------------------------------------------------------------------------------------------------------
' CREDITS to all people of the BaCon forum. Without them BaCon would not be as it is now.
'---------------------------------------------------------------------------------------------------------------------
'
' Though BaCon is much more powerful than KSH or BASH, for reason of maintainability and consistency this program
' follows a similar structure and approach as the existing shell script implementation where possible.
'
'---------------------------------------------------------------------------------------------------------------------
' GLOBAL INITIALIZATIONS
'---------------------------------------------------------------------------------------------------------------------
' Lower bound of array starts with 1
OPTION BASE 1
' Prevent parse errors
OPTION COLLAPSE TRUE
' Version of BACON
CONST g_VERSION$ = "4.7.1"
' Our numerical environment is POSIX
SETENVIRON "LC_NUMERIC", "POSIX"
' Verify that BaCon has been compiled with correct version
IF VERSION$ != g_VERSION$ THEN
EPRINT "System error: this BaCon binary was compiled with a previous BaCon version and therefore may not function correctly."
EPRINT "Recompile BaCon with the Shell implementation version ", g_VERSION$, "."
END 1
END IF
' Solaris
IF TALLY(OS$, "SunOS") THEN g_LDFLAGS$ = "-lnsl -lsocket"
' Haiku
IF TALLY(OS$, "Haiku") THEN g_LDFLAGS$ = "-lbsd -lnetwork"
' musl C
IF ISTRUE(LEN(EXEC$("command -v objdump 2>/dev/null"))) THEN
IF INSTR(EXEC$("objdump -x " & ME$), "musl") THEN
g_LDFLAGS$ = g_LDFLAGS$ & " -lfts"
ENDIF
ENDIF
' Global to define '$', '%' and '#'-replacement
CONST g_STRINGSIGN$ = "__b2c__string_var"
CONST g_LONGSIGN$ = "__b2c__long_var"
CONST g_FLOATSIGN$ = "__b2c__float_var"
CONST g_RANGEOP1$ = "BETWEEN "
CONST g_RANGEOP2$ = "BEYOND "
' Intense Flag for ASCII editor
DECLARE Color_Intense = 0
' Line Number Flag for ASCII editor
DECLARE Line_Number_Active = 0
' Define the coloring for the ASCII editor syntax highlighing
DECLARE Stat_Col = 2, Func_Col = 6, Var_Col = 3, Type_Col = 3, Num_Col = 1, Comm_Col = 4, Quot_Col = 5, Def_Col = 7
' Needed to prevent accidental variable names using C keywords
CONST g_C_KEYWORDS$ = "^(asm|auto|break|case|char|const|continue|default|do|double|else|enum|extern|float|for|goto|if|inline|int|long|register|return|short|signed|sizeof|static|struct|switch|typedef|union|unsigned|void|volatile|while|y0|y1|yn|y0f|y1f|ynf|y0l|y1l|ynl)$"
'----------------------------------------------------------------------------------------------
FUNCTION Get_Var$(VAR arg$ SIZE amount)
LOCAL var$, result$, record$
' Get rid of assignment notation
IF INSTR(arg$[1], "=") THEN
var$ = LEFT$(arg$[1], INSTR(arg$[1], "=")-1)
ELSE
var$ = arg$[1]
ENDIF
' Get rid of '*' sign in variable name
var$ = EXTRACT$(var$, CHR$(42))
' Get rid of '.' sign within variable name
IF AMOUNT(var$, ".") > 1 THEN
record$ = TOKEN$(var$, 1, ".")
var$ = TOKEN$(var$, 2, ".")
ELSE
record$ = g_RECORDVAR$
ENDIF
record$ = CHOP$(EXTRACT$(record$,"\\[.*", TRUE))
' If there is a record name then add a "."
IF LEN(record$) THEN record$ = record$ & "."
' Get rid of array notation
IF INSTR(var$, "[") THEN var$ = LEFT$(var$, INSTR(var$, "[")-1)
' Get rid of brackets in case of function pointer or assoc var
IF INSTR(var$, "(") THEN var$ = LEFT$(var$, INSTR(var$, "(")-1)
' Get rid of type signs
var$ = REPLACE$(var$, "$", g_STRINGSIGN$)
var$ = REPLACE$(var$, "#", g_FLOATSIGN$)
var$ = REPLACE$(var$, "%", g_LONGSIGN$)
result$ = g_ALL_MAIN_VARS$(record$ & var$)
IF amount > 1 AND NOT(LEN(result$)) THEN result$ = g_ALL_FUNC_VARS$(record$ & var$, arg$[2])
RETURN result$
END FUNCTION
'----------------------------------------------------------------------------------------------
SUB Save_Main_Var(STRING var$, STRING type$)
' Make sure the asterisk is attached to type
IF LEFT$(var$, 1) = "*" THEN
type$ = type$ & FILL$(COUNT(var$, 42), 42)
var$ = EXTRACT$(var$, CHR$(42))
END IF
' Get rid of assignment notation
IF INSTR(var$, "=") THEN
var$ = LEFT$(var$, INSTR(var$, "=")-1)
ENDIF
' Get rid of array notation
IF INSTR(var$, "[") THEN
var$ = LEFT$(var$, INSTR(var$, "[")-1)
ENDIF
IF LEN(g_RECORDVAR$) THEN
IF LEN(var$) THEN
g_ALL_MAIN_VARS$(CHOP$(EXTRACT$(g_RECORDVAR$,"\\[.*", TRUE)) & "." & CHOP$(var$)) = type$
ELSE
g_ALL_MAIN_VARS$(CHOP$(EXTRACT$(g_RECORDVAR$,"\\[.*", TRUE))) = type$
ENDIF
ELSE
g_ALL_MAIN_VARS$(CHOP$(var$)) = type$
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Save_Func_Var(STRING var$, STRING func$, STRING type$)
' Make sure the asterisk is attached to type
IF LEFT$(var$, 1) = "*" THEN
type$ = type$ & FILL$(COUNT(var$, 42), 42)
var$ = EXTRACT$(var$, CHR$(42))
END IF
' Get rid of assignment notation
IF INSTR(var$, "=") THEN
var$ = LEFT$(var$, INSTR(var$, "=")-1)
ENDIF
' Get rid of array notation
IF INSTR(var$, "[") THEN
var$ = LEFT$(var$, INSTR(var$, "[")-1)
ENDIF
IF LEN(g_RECORDVAR$) THEN
g_ALL_FUNC_VARS$(CHOP$(EXTRACT$(g_RECORDVAR$,"\\[.*", TRUE)) & "." & CHOP$(var$), func$) = type$
ELSE
g_ALL_FUNC_VARS$(CHOP$(var$), func$) = type$
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Debug_Vars
LOCAL xxx, many, total, i
PRINT
LOOKUP g_ALL_MAIN_VARS$ TO mainvar$ SIZE many
IF many THEN
FOR xxx = 1 TO many
EPRINT g_ALL_MAIN_VARS$(mainvar$[xxx]), ":MAIN:", mainvar$[xxx], " ";
NEXT
PRINT
ENDIF
LOOKUP g_ALL_FUNC_VARS$ TO funcvar$ SIZE many
IF many THEN
FOR xxx = 1 TO many
EPRINT g_ALL_FUNC_VARS$(funcvar$[xxx]), ":", TOKEN$(funcvar$[xxx], 2), ":", TOKEN$(funcvar$[xxx], 1), " ";
NEXT
PRINT
ENDIF
FOR i = 0 TO 0x3FFFFF
IF __b2c__exceptions[i]>0 THEN
INCR total
EPRINT (char*)__b2c__exceptions[i] FORMAT "Exception string found: %s\n"
FI
NEXT
EPRINT total FORMAT "Total exceptions: %lu\n"
END SUB
'----------------------------------------------------------------------------------------------
' This function registers variables
SUB Register_Numeric(arg$, type$)
IF NOT(LEN(Get_Var$(arg$, g_FUNCNAME$))) THEN
' Variable may not be class, array member, record, assoc, or pointer
IF NOT(INSTR(arg$, "::")) AND NOT(REGEX(arg$, "\\[.*\\]")) AND NOT(TALLY(arg$, ".")) AND NOT(REGEX(arg$, "\\(.*\\)")) AND NOT(TALLY(arg$, "->")) THEN
IF g_OPTION_EXPLICIT$ = "1" OR g_OPTION_EXPLICIT$ = "TRUE" THEN
EPRINT NL$, "Syntax error: OPTION EXPLICIT forces explicit variable declaration at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF type$ <> "default" THEN
WRITELN type$, " ", arg$, " = 0;" TO g_HFILE
Save_Main_Var(arg$, type$)
ELSE
IF REGEX(arg$, g_FLOATSIGN$ & "$") THEN
WRITELN "double ", arg$, " = 0.0;" TO g_HFILE
Save_Main_Var(arg$, "double")
ELIF REGEX(arg$, g_LONGSIGN$ & "$") THEN
WRITELN "long ", arg$, " = 0;" TO g_HFILE
Save_Main_Var(arg$, "long")
ELSE
WRITELN g_VARTYPE$, " ", arg$, " = 0;" TO g_HFILE
Save_Main_Var(arg$, g_VARTYPE$)
ENDIF
ENDIF
ENDIF
ENDIF
ENDSUB
SUB Register_Pointer(arg$, type$)
IF NOT(LEN(Get_Var$(arg$, g_FUNCNAME$))) THEN
' Variable may not be record, nor pointer
IF NOT(TALLY(arg$, ".")) AND NOT(TALLY(arg$, "->")) THEN
IF g_OPTION_EXPLICIT$ = "1" OR g_OPTION_EXPLICIT$ = "TRUE" THEN
EPRINT NL$, "Syntax error: OPTION EXPLICIT forces explicit variable declaration at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
WRITELN type$, " ", arg$, " = NULL;" TO g_HFILE
Save_Main_Var(arg$, type$)
ENDIF
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
' Mini parser to obtain chunk of text separated by comma. The comma in function arguments is ignored.
' This function will NOT attach the last ")" in case of a function and then jump out.
FUNCTION Mini_Parser$(VAR exp$ SIZE amount)
LOCAL in_string, escaped, x TYPE unsigned long
LOCAL in_func
FOR x = 1 TO LEN(exp$[1])
IF amount = 2 THEN
IF MID$(exp$[1], x, LEN(exp$[2])) = exp$[2] THEN
IF ISFALSE(in_string) AND ISFALSE(in_func) THEN BREAK
ENDIF
ENDIF
SELECT ASC(MID$(exp$[1], x, 1))
CASE 44;
CASE 59
IF ISFALSE(in_string) AND ISFALSE(in_func) THEN BREAK
CASE 92
IF escaped THEN
escaped = FALSE
ELSE
escaped = TRUE
ENDIF
CASE 34
IF ISFALSE(escaped) THEN in_string = NOT(in_string)
escaped = FALSE
CASE 40
IF ISFALSE(in_string) THEN INCR in_func
escaped = FALSE
CASE 41
IF ISFALSE(in_string) THEN DECR in_func
escaped = FALSE
DEFAULT
escaped = FALSE
END SELECT
IF in_func < 0 THEN BREAK
NEXT
RETURN LEFT$(exp$[1], x-1)
END FUNCTION
'----------------------------------------------------------------------------------------------
FUNCTION Check_String_Type(arg$)
LOCAL type$
' Get rid of casting in array indicators
arg$ = EXTRACT$(arg$, "\\(uint64_t\\)", TRUE)
' Remove part after '(' in case of function or assoc array
arg$ = IIF$(TALLY(arg$, "("), TOKEN$(arg$, 1, "("), arg$)
' It contains double quotes or ends with '$' symbol (Parse_Equation)
IF INSTR(arg$, CHR$(34)) OR RIGHT$(arg$, 1) = "$" THEN
RETURN TRUE
ELSE
' Check variable registration
type$ = Get_Var$(arg$, g_FUNCNAME$)
IF LEN(type$) THEN
IF INSTR(type$, "char*") OR INSTR(type$, "STRING") THEN
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ELIF INSTR(arg$, g_STRINGSIGN$) AND NOT(INSTR(arg$, "__b2c_array")) THEN
RETURN TRUE
ELSE
RETURN FALSE
ENDIF
ENDIF
END FUNCTION
'----------------------------------------------------------------------------------------------
SUB Assign_To_String(from$, to$, memsize$)
LOCAL lft$, str$
IF REGEX(to$, "\\(.*\\)$") THEN
str$ = INBETWEEN$(to$, "(", ")", 2)
lft$ = MID$(to$, 1, INSTR(to$, "(")-1)
WRITELN "__b2c__hash_add_str(__b2c__assoc_", lft$, ", ", from$, ", ", str$, ");" TO g_CFILE
WRITELN "free(", from$, "); ", from$, " = NULL;" TO g_CFILE
' Check for relations
CALL Relate_Recurse(lft$, str$, to$, -1)
ELIF Check_String_Type(to$) THEN
IF INSTR(to$, g_STRINGSIGN$) THEN
WRITELN to$, " = __b2c_Copy_String(", to$, ", ", from$, ");" TO g_CFILE
WRITELN "__b2c__STRFREE(", from$, "); ", from$, " = NULL;" TO g_CFILE
ELSE
WRITELN "__b2c__STRFREE(", to$, "); ", to$, " = ", from$, ";" TO g_CFILE
END IF
ELSE
WRITELN "memcpy((void*)(", to$, "), (void*)", from$, ", ", memsize$, "); free(", from$, ");" TO g_CFILE
ENDIF
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Assign_To_Number(from$, to$, flag)
LOCAL type$, lft$, str$
' Get the type
IF REGEX(to$, "\\(.*\\)$") THEN
type$ = Get_Var$("__b2c__assoc_" & to$, g_FUNCNAME$)
ELSE
type$ = Get_Var$(to$, g_FUNCNAME$)
ENDIF
' Make sure internal var is copied to var of program
IF REGEX(to$, "\\(.*\\)$") THEN
str$ = INBETWEEN$(to$, "(", ")", 2)
lft$ = MID$(to$, 1, INSTR(to$, "(")-1)
IF flag THEN
IF INSTR(type$, "double") OR INSTR(type$, "float") OR INSTR(type$, "FLOATING") THEN
WRITELN "__b2c__assoc_", lft$, "_eval = atof(", from$, ");" TO g_CFILE
ELIF INSTR(type$, "long") OR INSTR(type$, "NUMBER") THEN
WRITELN "__b2c__assoc_", lft$, "_eval = atol(", from$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__assoc_", lft$, "_eval = atoi(", from$, ");" TO g_CFILE
END IF
WRITELN "free(", from$, "); ", from$, " = NULL;" TO g_CFILE
ELSE
WRITELN "__b2c__assoc_", lft$, "_eval = (", type$, ")(", from$, ");" TO g_CFILE
ENDIF
WRITELN "__b2c__hash_add(__b2c__assoc_", lft$, ", &__b2c__assoc_", lft$, "_eval, ", str$, ");" TO g_CFILE
' Check for relations
CALL Relate_Recurse(lft$, str$, to$, -1)
ELSE
IF flag THEN
IF INSTR(type$, "double") OR INSTR(type$, "float") OR INSTR(type$, "FLOATING") THEN
WRITELN to$, " = atof(", from$, ");" TO g_CFILE
ELIF INSTR(type$, "long") OR INSTR(type$, "NUMBER") THEN
WRITELN to$, " = atol(", from$, ");" TO g_CFILE
ELSE
WRITELN to$, " = atoi(", from$, ");" TO g_CFILE
END IF
WRITELN "free(", from$, "); ", from$, " = NULL;" TO g_CFILE
ELSE
WRITELN to$, " = (", type$, ")(", from$, ");" TO g_CFILE
ENDIF
END IF
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Print_Element (STRING arg$, STRING std$)
' Check if var is string var
IF Check_String_Type(arg$) THEN
WRITELN "__b2c__assign = (char*)", arg$, "; if(__b2c__assign != NULL) { fputs(__b2c__assign, ", std$, "); }" TO g_CFILE
ELSE
WRITELN "fputs(STR", g_STRINGSIGN$, "(", arg$, "), ", std$, ");" TO g_CFILE
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Print(STRING arg$, STRING std$)
LOCAL exp$, form$, to$, token$, str$, lft$
LOCAL size, total
' Check if argument
IF ISTRUE(LEN(arg$)) THEN
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "PRINT * FORMAT * TO * SIZE *" TO match$ SIZE total
exp$ = IIF$(total > 0, match$[1])
form$ = IIF$(total > 1, match$[2])
to$ = IIF$(total > 2, match$[3])
size = IIF(total > 3, VAL(match$[4]), g_BUFFER_SIZE)
IF LEN(form$) THEN
IF LEN(to$) THEN
' Check if var is string var
IF REGEX(to$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(to$, "char*")
ELIF NOT(REGEX(to$, g_STRINGSIGN$ & "\\(.*\\)$")) THEN
EPRINT NL$, "Syntax error: variable for PRINT at line ", g_COUNTER, " in file '", g_CURFILE$, "' must be string!"
END 1
FI
IF REGEX(to$, "\\(.*\\)$") THEN
str$ = INBETWEEN$(to$, "(", ")", 2)
lft$ = MID$(to$, 1, INSTR(to$, "(")-1)
WRITELN "snprintf(__b2c__hash_realloc_str_value(__b2c__assoc_", lft$, ", ", size, "+1, ", str$, "), ", size, "+1, ", form$, ", ", exp$, ");" TO g_CFILE
CALL Relate_Recurse(lft$, str$, to$, -1)
ELSE
WRITELN to$, " = (char*)__b2c_str_realloc(", to$, ", (", size, "+1)*sizeof(char));" TO g_CFILE
WRITELN "snprintf(", to$, ", ", size, "+1, ", form$, ", ", exp$, "); __b2c__SETLEN(", to$, ", strlen(", to$, "));" TO g_CFILE
ENDIF
ELSE
WRITELN "fprintf(", std$, ", ", CHOP$(form$, ";", 2), ", ", exp$, ");" TO g_CFILE
END IF
ELSE
' Start miniparser
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
Print_Element(CHOP$(token$), std$)
exp$ = MID$(exp$, LEN(token$)+2)
WEND
' If line ends with ';' then skip newline
IF RIGHT$(arg$, 1) <> ";" THEN
WRITELN "fputs(\"\\n\", ", std$, ");" TO g_CFILE
ELSE
WRITELN "fflush(", std$, ");" TO g_CFILE
ENDIF
END IF
ELSE
WRITELN "fputs(\"\\n\", ", std$, ");" TO g_CFILE
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Input(STRING arg$)
LOCAL type$, lft$, str$, token$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty INPUT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Start miniparser
WHILE LEN(arg$)
token$ = Mini_Parser$(arg$)
arg$ = MID$(arg$, LEN(token$)+2)
IF LEN(arg$) THEN Print_Element(CHOP$(token$), "stdout")
WEND
WRITELN "fflush(stdout);" TO g_CFILE
arg$ = CHOP$(token$)
' Check if var is string var
IF REGEX(arg$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(arg$, "char*")
ELSE
Register_Numeric(arg$, "default")
END IF
' Translate function to C function
WRITELN "__b2c__input(__LINE__, __FILE__, &__b2c__assign, ", g_OPTION_INPUT$, ");" TO g_CFILE
IF Check_String_Type(arg$) THEN
Assign_To_String("__b2c__assign", arg$, NULL)
ELSE
Assign_To_Number("__b2c__assign", arg$, 1)
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_For(STRING arg$)
LOCAL var$, in$, from$, to$, step$
LOCAL total
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) AND NOT(ISTOKEN(arg$, "DOWNTO")) AND NOT(ISTOKEN(arg$, "IN")) THEN
EPRINT NL$, "Syntax error: missing IN/TO/DOWNTO in FOR statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' What kind of FOR are we dealing with
IF ISTOKEN(arg$, "TO") OR ISTOKEN(arg$, "DOWNTO") THEN
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "FOR * " & IIF$(ISTOKEN(arg$, "TO"), "TO", "DOWNTO") & " * STEP *" TO match$ SIZE total
var$ = CHOP$(TOKEN$(match$[1], 1, "="))
from$ = CHOP$(TOKEN$(match$[1], 2, "="))
to$ = match$[2]
step$ = IIF$(total > 2, match$[3], "1")
IF ISTOKEN(arg$, "DOWNTO") THEN step$ = "-" & step$
ELSE
PARSE COLLAPSE$(arg$) WITH "FOR * IN * STEP *" TO match$ SIZE total
var$ = match$[1]
in$ = match$[2]
step$ = IIF$(total > 2, match$[3], "__b2c__option_delim")
' Define help variables
IF LEN(g_FUNCNAME$) > 0 THEN
IF NOT(INSTR(g_STRINGARGS$, "__b2c__forin_" & var$ & "_ptr")) THEN
g_STRINGARGS$ = g_STRINGARGS$ & " int __b2c__forin_" & var$ & "_ptr = 0;"
Save_Func_Var("__b2c__forin_" & var$ & "_ptr", g_FUNCNAME$, "int")
g_STRINGARGS$ = g_STRINGARGS$ & " char* __b2c__forin_" & var$ & "_string = NULL;"
Save_Func_Var("__b2c__forin_" & var$ & "_string", g_FUNCNAME$, "char*")
g_STRINGARGS$ = g_STRINGARGS$ & " char* __b2c__forin_" & var$ & "_string_org = NULL;"
Save_Func_Var("__b2c__forin_" & var$ & "_string_org", g_FUNCNAME$, "char*")
g_STRINGARGS$ = g_STRINGARGS$ & " char* __b2c__forin_" & var$ & "_step = NULL;"
Save_Func_Var("__b2c__forin_" & var$ & "_step", g_FUNCNAME$, "char*")
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__STRFREE(__b2c__forin_" & var$ & "_string); __b2c__forin_" & var$ & "_string = NULL;"
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__STRFREE(__b2c__forin_" & var$ & "_step); __b2c__forin_" & var$ & "_step = NULL;"
END IF
ELSE
IF NOT(LEN(Get_Var$("__b2c__forin_" & var$ & "_ptr"))) THEN
WRITELN "int __b2c__forin_", var$, "_ptr = 0;" TO g_HFILE
Save_Main_Var("__b2c__forin_" & var$ & "_ptr", "int")
WRITELN "char* __b2c__forin_", var$, "_string = NULL;" TO g_HFILE
Save_Main_Var("__b2c__forin_" & var$ & "_string", "char*")
WRITELN "char* __b2c__forin_", var$, "_string_org = NULL;" TO g_HFILE
Save_Main_Var("__b2c__forin_" & var$ & "_string_org", "char*")
WRITELN "char* __b2c__forin_", var$, "_step = NULL;" TO g_HFILE
Save_Main_Var("__b2c__forin_" & var$ & "_step", "char*")
END IF
END IF
END IF
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(var$, "char*")
ELIF REGEX(from$ & to$ & step$, "[0-9]\\.[0-9]") OR REGEX(Get_Var$(step$, g_FUNCNAME$), "double|float|FLOATING") THEN
Register_Numeric(var$, "double")
ELSE
Register_Numeric(var$, "default")
ENDIF
' Check type of var, string?
IF Check_String_Type(var$) THEN
WRITELN "__b2c__forin_", var$, "_string = __b2c_Copy_String(__b2c__forin_", var$, "_string, ", in$, "); __b2c__forin_", var$, "_string_org = __b2c__forin_", var$, "_string;" TO g_CFILE
WRITELN "__b2c__forin_", var$, "_step = __b2c_Copy_String(__b2c__forin_", var$, "_step, ", step$, ");" TO g_CFILE
WRITELN "__b2c__forin_", var$, "_ptr = __b2c__for_amount(__b2c__forin_", var$, "_string, __b2c__forin_", var$, "_step);" TO g_CFILE
WRITELN "for(; __b2c__forin_", var$, "_ptr > 0; __b2c__forin_", var$, "_ptr--) { __b2c__for_item(&__b2c__forin_", var$, "_string_org, __b2c__forin_", var$, "_step, &", var$, ");" TO g_CFILE
ELSE
' Translate function to C function
IF VAL(step$) < 0 THEN
WRITELN "for(", var$," = ", from$, "; ", var$, " >= ", to$, ";", var$, " += ", step$, "){" TO g_CFILE
ELSE
WRITELN "for(", var$," = ", from$, "; ", var$, " <= ", to$, ";", var$, " += ", step$, "){" TO g_CFILE
END IF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_While(arg$)
PARSE COLLAPSE$(arg$) WITH "WHILE * DO" TO match$
WRITELN "while(", Parse_Equation$(match$[1]), "){" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
' $1: name of ASSOC variable
' $2: name of index
' $3: actual value to assign
' $4: recursion level
SUB Relate_Recurse(STRING var$, STRING str$, STRING tmp$, NUMBER lvl)
LOCAL rel$
LOCAL ctr
' Check endless recursion
INCR lvl
IF lvl > g_RELATE_CTR THEN
EPRINT NL$, "Syntax error: endless recursion in RELATE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Now add relation
FOR ctr = 0 TO g_RELATE_CTR
IF TOKEN$(g_RELATE$[ctr], 1) = var$ THEN
rel$ = TOKEN$(g_RELATE$[ctr], 2)
IF INSTR(rel$, g_STRINGSIGN$) THEN
WRITELN "__b2c__hash_add_str(__b2c__assoc_", rel$, ", ", tmp$, ", ", str$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__assoc_", rel$, "_eval = " , tmp$, "; __b2c__hash_add(__b2c__assoc_", rel$, ", &__b2c__assoc_", rel$, "_eval, ", str$, ");" TO g_CFILE
END IF
Relate_Recurse(rel$, str$, tmp$, lvl)
END IF
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Let(STRING arg$)
LOCAL x TYPE unsigned long
LOCAL in_string, escaped, pos, in_func
LOCAL var$, tmp$, str$, lft$, rel$, ptr$, type$, item$
' Start miniparser to find last unquoted '='
FOR x = 1 TO LEN(arg$)
SELECT ASC(MID$(arg$, x, 1))
CASE 92
IF escaped THEN
escaped = FALSE
ELSE
escaped = TRUE
FI
CASE 34
IF ISFALSE(escaped) THEN in_string = NOT(in_string)
escaped = FALSE
CASE 40
IF ISFALSE(in_string) THEN INCR in_func
escaped = FALSE
CASE 41
IF ISFALSE(in_string) THEN DECR in_func
escaped = FALSE
CASE 61
IF ISFALSE(in_string) AND ISFALSE(in_func) THEN pos = x
escaped = FALSE
DEFAULT
escaped = FALSE
END SELECT
NEXT
' Check if there is an assignment at all, if not exit
IF NOT(pos) THEN
IF g_IGNORE_PARSE$ = "0" OR g_IGNORE_PARSE$ = "FALSE" THEN
WRITELN arg$, ";" TO g_CFILE
EXIT SUB
ELSE
EPRINT NL$, "Syntax error: could not parse line ", g_COUNTER, " in file '", g_CURFILE$, "': ", CHR$(34), arg$, CHR$(34)
END 1
END IF
END IF
' Get the variablename without surrounding spaces
var$ = CHOP$(LEFT$(arg$, pos - 1))
tmp$ = CHOP$(MID$(arg$, pos + 1))
' Check for MEMORY allocation
IF REGEX(tmp$, "[ \\t]*MEMORY[ \\t]*\\(") OR REGEX(tmp$, "[ \\t]*BLOAD[ \\t]*\\(") THEN g_SEMANTIC_MEMFREE$(var$) = "'" & var$ & "' at line " & STR$(g_COUNTER) & " in file '" & g_CURFILE$ & "'"
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") AND NOT(ISTOKEN(g_DYNAMICARRAYS$, var$ & "@" & g_FUNCNAME$)) THEN
Register_Pointer(var$, "char*")
ELIF NOT(INSTR(var$, "=")) AND NOT(TALLY(var$, "->")) THEN
IF REGEX(tmp$, "[0-9]\\.[0-9]") AND NOT(INSTR(tmp$, CHR$(34))) THEN
Register_Numeric(EXTRACT$(var$, "[\\+\\-\\*/% ]", TRUE), "double")
ELSE
Register_Numeric(EXTRACT$(var$, "[\\+\\-\\*/% ]", TRUE), "default")
ENDIF
END IF
' Check if there is associative array assignment
IF REGEX(var$, "\\(.*\\)$") THEN
lft$ = LEFT$(var$, INSTR(var$, "(") - 1)
IF REGEX(var$, "\\(\\)$") THEN
str$ = LEFT$(tmp$, INSTR(tmp$, "(") - 1)
IF INSTR(lft$, g_STRINGSIGN$) THEN
WRITELN "__b2c__hash_dup_str(__b2c__assoc_", str$, ", __b2c__assoc_", lft$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__hash_dup(__b2c__assoc_", str$, ", __b2c__assoc_", lft$, ");" TO g_CFILE
ENDIF
ELSE
str$ = INBETWEEN$(var$, "(", ")", 2)
IF INSTR(lft$, g_STRINGSIGN$) THEN
WRITELN "__b2c__hash_add_str(__b2c__assoc_", lft$, ", ", tmp$, ", ", str$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__assoc_", lft$, "_eval = ", tmp$, "; __b2c__hash_add(__b2c__assoc_", lft$, ", &__b2c__assoc_", lft$, "_eval, ", str$, ");" TO g_CFILE
END IF
' Check for relations
Relate_Recurse(lft$, str$, tmp$, -1)
ENDIF
' Is there an array variable without subscript?
ELIF NOT(INSTR(var$, "[")) AND ISTOKEN(g_DYNAMICARRAYS$, var$ & "@" & g_FUNCNAME$) THEN
IF INSTR(var$, g_STRINGSIGN$) THEN WRITELN "__b2c__free_str_array_members(&" & var$ & ", " & STR$(g_OPTION_BASE) & ", " & var$ & "__b2c_array);" TO g_CFILE
WRITELN "free(", var$, ");" TO g_CFILE
WRITELN g_WITHVAR$, arg$, ";" TO g_CFILE
' Do we have a STRING variable or STRING array?
ELIF Check_String_Type(var$) AND REGEX(var$, g_STRINGSIGN$) THEN
type$ = Get_Var$(var$, g_FUNCNAME$)
IF INSTR(type$, "const") THEN
WRITELN g_WITHVAR$, var$, " = (char*)__b2c__strdup((const char*)", tmp$, ");" TO g_CFILE
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
Save_Func_Var(var$, g_FUNCNAME$, CHOP$(EXTRACT$(type$, "const")))
ELSE
Save_Main_Var(var$, CHOP$(EXTRACT$(type$, "const")))
ENDIF
ELSE
' Memory optimizations for string functions
str$ = HEAD$(EXTRACT$(tmp$, " "), 1, "(")
IF REGEX(str$, "^CONCAT" & g_STRINGSIGN$ & "|^MID" & g_STRINGSIGN$ & "|^APPEND" & g_STRINGSIGN$ & "|^CHOP" & g_STRINGSIGN$) THEN
WRITELN g_WITHVAR$, var$, " = F_", str$, "(", g_WITHVAR$, var$, ",", LAST$(tmp$, 1, "("), ";" TO g_CFILE
ELSE
WRITELN g_WITHVAR$, var$, " = __b2c_Copy_String(", g_WITHVAR$, var$, ", (char*)", tmp$, ");" TO g_CFILE
ENDIF
ENDIF
' Also check if string var already is used for IMPORT, if so, perform dlopen again
ptr$ = EXTRACT$(var$, "[[:punct:]]", TRUE)
IF LEN(Get_Var$("__b2c__dlopen__pointer_" & ptr$)) THEN
WRITELN "__b2c__dlopen__pointer_", ptr$, " = dlopen(", var$, ", RTLD_LAZY); if(__b2c__dlopen__pointer_", ptr$, " == NULL)" TO g_CFILE
WRITELN "{ if(__b2c__trap){ERROR = 3;if(!__b2c__catch_set) RUNTIMEERROR(\"IMPORT\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; } }" TO g_CFILE
ENDIF
' Check for array member in RECORD
IF INSTR(var$, ".") AND REGEX(var$, "\\[.*\\]\\.") AND LEN(g_FUNCNAME$) AND NOT(LEN(Get_Var$(var$))) THEN
IF NOT(INSTR(g_LOCALSTRINGS$, var$)) AND NOT(REGEX(var$, "\\[.*\\]$")) THEN
g_LOCALSTRINGS$ = var$ & " " & g_LOCALSTRINGS$
ENDIF
ENDIF
' Pointer type
ELIF TALLY(var$, "->") THEN
WRITELN g_WITHVAR$, arg$, ";" TO g_CFILE
' Pointer to string
ELIF NOT(REGEX(var$, g_STRINGSIGN$ & "$")) AND REGEX(tmp$, g_STRINGSIGN$ & "$") THEN
type$ = EXTRACT$(Get_Var$(var$, g_FUNCNAME$), "static")
WRITELN g_WITHVAR$, var$, "=(", type$, ")(", tmp$, ");" TO g_CFILE
' Numeric or foreign type
ELSE
type$ = EXTRACT$(Get_Var$(var$, g_FUNCNAME$), "static")
' Float and not assoc
IF REGEX(type$, "float|double|FLOATING") AND NOT(INSTR(type$, "*")) THEN
' Cast the expression to type of variable, divide symbol needs extra cast
WRITELN g_WITHVAR$, var$, "=(", type$, ")(", DELIM$(tmp$, "/", "/(" & type$ & ")"), ");" TO g_CFILE
ELIF REGEX(var$, ".*\\[.*\\].*") AND REGEX(type$, ".*\\*.*") THEN
WRITELN g_WITHVAR$, arg$, ";" TO g_CFILE
' If var is pointer then skip casting
ELIF LEN(type$) AND LEFT$(var$) <> "*" THEN
WRITELN g_WITHVAR$, var$, "=(", type$, ")(", tmp$, ");" TO g_CFILE
' Other type
ELSE
WRITELN g_WITHVAR$, arg$, ";" TO g_CFILE
ENDIF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Open(STRING arg$)
LOCAL check
LOCAL var$, mode$, handle$, from$ = "NULL"
' Check if FOR is available
IF NOT(ISTOKEN(arg$, "FOR")) THEN
EPRINT NL$, "Syntax error: missing FOR in OPEN statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Check if AS is available
IF NOT(ISTOKEN(arg$, "AS")) THEN
EPRINT NL$, "Syntax error: missing AS in OPEN statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "FROM") THEN
PARSE COLLAPSE$(arg$) WITH "OPEN * FOR * FROM * AS *" TO match$
from$ = match$[3]
arg$ = APPEND$(HEAD$(arg$, ISTOKEN(arg$, "FROM")-1), 0, LAST$(arg$, ISTOKEN(arg$, "AS")-1))
ENDIF
PARSE COLLAPSE$(arg$) WITH "OPEN * FOR * AS *" TO match$
var$ = match$[1]
mode$ = match$[2]
handle$ = match$[3]
' Check if var is string var
IF REGEX(handle$, g_STRINGSIGN$ & "$") AND mode$ <> "MEMORY" THEN
EPRINT NL$, "Syntax error: variable for OPEN at line ", g_COUNTER, " in file '", g_CURFILE$, "' cannot be string!"
END 1
END IF
' Check for OPEN/CLOSE pair, keep the last
g_SEMANTIC_OPENCLOSE$(handle$) = "'" & handle$ & "' at line " & STR$(g_COUNTER) & " in file '" & g_CURFILE$ & "'"
' Check if variable was declared
IF NOT(INSTR(handle$, ".")) THEN
check = LEN(Get_Var$(handle$, g_FUNCNAME$))
ELSE
check = TRUE
FI
IF ISFALSE(check) THEN
IF mode$ = "DIRECTORY" THEN
Register_Pointer(handle$, "DIR*")
ELIF mode$ = "MEMORY" THEN
Register_Pointer(handle$, "char*")
ELIF mode$ = "NETWORK" OR mode$ = "SERVER" OR mode$ = "UDP" OR mode$ = "DEVICE" THEN
Register_Numeric(handle$, "uintptr_t")
ELSE
Register_Pointer(handle$, "FILE*")
ENDIF
ENDIF
' Convert to C syntax
IF mode$ = "READING" THEN
WRITELN handle$, " = fopen((const char*)", var$, ", \"r\");" TO g_CFILE
WRITELN "if(", handle$, " == NULL){if(__b2c__trap){ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR READING\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "WRITING" THEN
WRITELN handle$, " = fopen((const char*)", var$, ", \"w\");" TO g_CFILE
WRITELN "if(", handle$, " == NULL){if(__b2c__trap){ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR WRITING\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "APPENDING" THEN
WRITELN handle$, " = fopen((const char*)", var$, ", \"a\");" TO g_CFILE
WRITELN "if(", handle$, " == NULL){if(__b2c__trap){ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR APPENDING\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "READWRITE" THEN
WRITELN handle$, " = fopen((const char*)", var$, ", \"r+\");" TO g_CFILE
WRITELN "if(", handle$, " == NULL){if(__b2c__trap){ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR READWRITE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "DIRECTORY" THEN
WRITELN handle$, " = opendir(", var$, ");" TO g_CFILE
WRITELN "if(", handle$, " == NULL){if(__b2c__trap){ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR DIRECTORY\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "MEMORY" THEN
IF NOT(LEN(Get_Var$("__b2c_mem_" & handle$, g_FUNCNAME$))) THEN
WRITELN "long __b2c_mem_" & handle$, " = 0;" TO g_HFILE
Save_Main_Var("__b2c_mem_" & handle$, "long")
ENDIF
IF INSTR(handle$, g_STRINGSIGN$) THEN WRITELN "__b2c__STRFREE(", handle$, ");" TO g_CFILE
WRITELN handle$, " = (char*)", var$, "; __b2c_mem_", handle$, " = (uintptr_t)", var$, ";" TO g_CFILE
WRITELN "if(__b2c__trap){if(!__b2c__memory__check(", handle$, ", sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR MEMORY\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELIF mode$ = "NETWORK" THEN
' Network code
WRITELN "ERROR = __b2c__network_init((uintptr_t*)&", handle$, ", ", var$, ", ", from$, ", ", g_SOCKTYPE$, ", ", g_OPTION_SOCKET, ", \"", g_NETWORKTYPE$, "\", ", g_MULTICAST_TTL, ", ", g_SCTP_STREAMS, ", __b2c__capeer, __b2c__cacerts);" TO g_CFILE
WRITELN "if(ERROR && __b2c__trap){ if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR NETWORK\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; }" TO g_CFILE
ELIF mode$ = "SERVER" THEN
' Network code
WRITELN "ERROR = __b2c__server_init((uintptr_t*)&", handle$, ", ", var$, ", ", g_SOCKTYPE$, ", ", g_OPTION_SOCKET, ", ", g_SCTP_STREAMS, ");" TO g_CFILE
WRITELN "if(ERROR && __b2c__trap){ if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR SERVER\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; }" TO g_CFILE
ELIF mode$ = "DEVICE" THEN
WRITELN handle$, " = open(", var$, ", __b2c__option_open, S_IRUSR|S_IWUSR);" TO g_CFILE
WRITELN "if(", handle$, " < 0){if(__b2c__trap){ERROR = 32; if(!__b2c__catch_set) RUNTIMEERROR(\"OPEN FOR DEVICE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
END IF
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Readln(STRING arg$)
LOCAL var$, from$
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in READLN statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "READLN * FROM *" TO match$
var$ = match$[1]
from$ = match$[2]
' Check if var is string var
IF NOT(Check_String_Type(var$)) THEN
EPRINT NL$, "Syntax error: variable for READLN at line ", g_COUNTER, " in file '", g_CURFILE$, "' must be string!"
END 1
END IF
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN Register_Pointer(var$, "char*")
' Translate function to C function
WRITELN "__b2c__readln(&__b2c__assign, ", from$, ");" TO g_CFILE
Assign_To_String("__b2c__assign", var$, NULL)
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Writeln(STRING arg$)
LOCAL var$, to$, token$, org$
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in WRITELN statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "WRITELN * TO *" TO match$
var$ = match$[1]
to$ = match$[2]
org$ = var$
' Start miniparser
WHILE LEN(var$)
token$ = Mini_Parser$(var$)
Print_Element(CHOP$(token$), to$)
var$ = MID$(var$, LEN(token$)+2)
WEND
IF RIGHT$(org$, 1) <> ";" THEN
WRITELN "fputs(\"\\n\", ", to$, ");" TO g_CFILE
ELSE
WRITELN "fflush(", to$, ");" TO g_CFILE
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Getbyte(STRING arg$)
LOCAL var$, from$, size$, type$, chunk$
LOCAL total
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in GETBYTE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF MATCH(COLLAPSE$(arg$), "* CHUNK *") THEN
PARSE COLLAPSE$(arg$) WITH "GETBYTE * FROM * CHUNK * SIZE *" TO match$ SIZE total
chunk$ = match$[3]
size$ = IIF$(total > 3, match$[4])
arg$ = HEAD$(arg$, ISTOKEN(arg$, "CHUNK")-1)
ELIF MATCH(COLLAPSE$(arg$), "* SIZE *") THEN
PARSE COLLAPSE$(arg$) WITH "GETBYTE * FROM * SIZE *" TO match$
size$ = match$[3]
arg$ = HEAD$(arg$, ISTOKEN(arg$, "SIZE")-1)
ENDIF
PARSE COLLAPSE$(arg$) WITH "GETBYTE * FROM *" TO match$
var$ = match$[1]
from$ = match$[2]
' Ensure backwards compatibility
IF LEN(size$) THEN
IF LEN(chunk$) = 0 THEN
chunk$ = size$
size$ = "__b2c__counter"
ENDIF
ELSE
IF LEN(chunk$) = 0 THEN chunk$ = "1"
size$ = "__b2c__counter"
ENDIF
' Variable may not be array, these should be defined with DECLARE
IF LEN(size$) AND size$ <> "__b2c__counter" THEN Register_Numeric(size$, "default")
' Detect type of descriptor
type$ = Get_Var$(from$, g_FUNCNAME$)
' Translate function to C function
WRITELN "if(__b2c__trap){if(!__b2c__memory__check((char*)", var$, ", sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"GETBYTE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF INSTR(type$, "int") THEN
WRITELN "if((", size$, " = read(", from$, ", (void*)(", var$, "), ", chunk$, ")) < 0)" TO g_CFILE
WRITELN "{if(__b2c__trap){ERROR = 34; if(!__b2c__catch_set) RUNTIMEERROR(\"GETBYTE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELSE
WRITELN size$, " = fread((void*)(", var$, "), sizeof(__b2c__MEMTYPE), ", chunk$, ", ", from$, ");" TO g_CFILE
END IF
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Putbyte(STRING arg$)
LOCAL var$, to$, size$, type$, chunk$
LOCAL total
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in PUTBYTE statement at line at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF MATCH(COLLAPSE$(arg$), "* CHUNK *") THEN
PARSE COLLAPSE$(arg$) WITH "PUTBYTE * TO * CHUNK * SIZE *" TO match$ SIZE total
chunk$ = match$[3]
size$ = IIF$(total > 3, match$[4])
arg$ = HEAD$(arg$, ISTOKEN(arg$, "CHUNK")-1)
ELIF MATCH(COLLAPSE$(arg$), "* SIZE *") THEN
PARSE COLLAPSE$(arg$) WITH "PUTBYTE * TO * SIZE *" TO match$
size$ = match$[3]
arg$ = HEAD$(arg$, ISTOKEN(arg$, "SIZE")-1)
ENDIF
PARSE COLLAPSE$(arg$) WITH "PUTBYTE * TO *" TO match$
var$ = match$[1]
to$ = match$[2]
' Ensure backwards compatibility
IF LEN(size$) THEN
IF LEN(chunk$) = 0 THEN
chunk$ = size$
size$ = "__b2c__counter"
ENDIF
ELSE
IF LEN(chunk$) = 0 THEN chunk$ = "1"
size$ = "__b2c__counter"
ENDIF
' Variable may not be array, these should be defined with DECLARE
IF LEN(size$) AND size$ <> "__b2c__counter" THEN Register_Numeric(size$, "default")
' Detect type of descriptor
type$ = Get_Var$(to$, g_FUNCNAME$)
' Translate function to C function
WRITELN "if(__b2c__trap){if(!__b2c__memory__check((char*)", var$, ", sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"PUTBYTE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF INSTR(type$, "int") THEN
WRITELN "if((", size$, " = write(", to$, ", (void*)(", var$, "), ", chunk$, ")) < 0)" TO g_CFILE
WRITELN "{if(__b2c__trap){ERROR = 34; if(!__b2c__catch_set) RUNTIMEERROR(\"PUTBYTE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELSE
WRITELN size$, " = fwrite((void*)", var$, ", sizeof(__b2c__MEMTYPE), ", chunk$, ", ", to$, "); fflush(", to$, ");" TO g_CFILE
ENDIF
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Getfile(STRING arg$)
LOCAL var$, from$, type$, ftype$
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in GETFILE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "FTYPE") THEN
ftype$ = LAST$(arg$, ISTOKEN(arg$, "FTYPE"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "FTYPE")-1)
ENDIF
PARSE COLLAPSE$(arg$) WITH "GETFILE * FROM *" TO match$
var$ = match$[1]
from$ = match$[2]
' Check if var is string var
IF NOT(Check_String_Type(var$)) THEN
EPRINT NL$, "Syntax error: variable for GETFILE at line ", g_COUNTER, " in file '", g_CURFILE$, "' must be string!"
END 1
END IF
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN Register_Pointer(var$, "char*")
' Check if FTYPE var is declared
IF LEN(ftype$) THEN
Register_Numeric(ftype$, "default")
type$ = Get_Var$(ftype$, g_FUNCNAME$)
ENDIF
' Translate statement to C function
WRITELN "__b2c__getfile(__LINE__, __FILE__, &__b2c__assign, ", from$, ", &__b2c__counter);" TO g_CFILE
Assign_To_String("__b2c__assign", var$, NULL)
IF LEN(ftype$) THEN WRITELN ftype$, " = (", type$, ")__b2c__counter;" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Receive(STRING arg$)
LOCAL var$, from$, size$, chunk$
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in RECEIVE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "SIZE") THEN
size$ = LAST$(arg$, ISTOKEN(arg$, "SIZE"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "SIZE")-1)
ENDIF
IF ISTOKEN(arg$, "CHUNK") THEN
chunk$ = LAST$(arg$, ISTOKEN(arg$, "CHUNK"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "CHUNK")-1)
ELSE
IF g_OPTION_TLS THEN
chunk$ = "32768"
ELSE
chunk$ = STR$(g_BUFFER_SIZE)
ENDIF
ENDIF
from$ = LAST$(arg$, ISTOKEN(arg$, "FROM"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "FROM")-1)
var$ = CHOP$(arg$)
' Variable may not be array, these should be defined with DECLARE
IF LEN(size$) THEN
Register_Numeric(size$, "default")
ELSE
size$ = "__b2c__counter"
END IF
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN Register_Pointer(var$, "char*")
' Translate function to C function
WRITELN "__b2c__assign = (char*)calloc((", chunk$, "+1), sizeof(char));" TO g_CFILE
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "if((", size$, " = sctp_recvmsg(", from$, ", (void*)__b2c__assign, ", chunk$, ", 0, 0, 0, 0)) < 0) {" TO g_CFILE
ELSE
' Receive from SSL socket if option was set
IF g_OPTION_TLS THEN
WRITELN "if(", from$, " > 0) { ", size$, " = SSL_read((SSL*)", from$, ", (void*)__b2c__assign, ", chunk$, "); } if(", size$, " <= 0) { fprintf(stderr, \"SSL READ error in line ", g_COUNTER, ": %s\\n\", ERR_error_string(SSL_get_error((SSL*)", from$, ", ", size$, "), NULL));" TO g_CFILE
ELSE
WRITELN "if((", size$, " = recv(", from$, ", (void*)__b2c__assign, ", chunk$,", 0)) < 0) {" TO g_CFILE
ENDIF
END IF
WRITELN "if(__b2c__trap){ERROR = 14; if(!__b2c__catch_set) RUNTIMEERROR(\"RECEIVE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; } }" TO g_CFILE
Assign_To_String("__b2c__assign", var$, size$)
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Send(STRING arg$)
LOCAL var$, to$, chunk$, size$
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in SEND statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "SIZE") THEN
size$ = LAST$(arg$, ISTOKEN(arg$, "SIZE"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "SIZE")-1)
ENDIF
IF ISTOKEN(arg$, "CHUNK") THEN
chunk$ = LAST$(arg$, ISTOKEN(arg$, "CHUNK"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "CHUNK")-1)
ENDIF
to$ = LAST$(arg$, ISTOKEN(arg$, "TO"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "TO")-1)
var$ = CHOP$(arg$)
IF LEN(chunk$) = 0 THEN chunk$ = "strlen(" & var$ & ")"
' Variable may not be array, these should be defined with DECLARE
IF LEN(size$) THEN
Register_Numeric(size$, "default")
ELSE
size$ = "__b2c__counter"
END IF
' Translate function to C function
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "if((", size$, " = sctp_sendmsg(", to$, ", (void*)(", var$, "), ", chunk$, ", NULL, 0, 0, 0, 0, 0, 0)) < 0) {" TO g_CFILE
ELSE
' Send to SSL socket if option was set
IF g_OPTION_TLS THEN
WRITELN size$, " = SSL_write((SSL*)", to$, ", (const void*)(", var$, "), ", chunk$, "); if(", size$, " <= 0) { fprintf(stderr, \"SSL WRITE error: %s\\n\", ERR_error_string(SSL_get_error((SSL*)", to$, ", ", size$, "), NULL));" TO g_CFILE
ELSE
WRITELN "if((", size$, " = send(", to$, ", (void*)(", var$, "), ", chunk$, ", 0)) < 0) {" TO g_CFILE
ENDIF
ENDIF
WRITELN "if(__b2c__trap){ERROR = 15; if(!__b2c__catch_set) RUNTIMEERROR(\"SEND\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Getline(STRING arg$)
LOCAL var$, from$
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in GETLINE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "GETLINE * FROM *" TO match$
var$ = match$[1]
from$ = match$[2]
' Check if var is string var
IF NOT(Check_String_Type(var$)) THEN
EPRINT NL$, "Syntax error: variable for GETLINE at line $g_COUNTER in file ", g_COUNTER, " in file '", g_CURFILE$, "' must be string!"
END 1
END IF
' Check if var is string var, exclude RECORD elements
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN Register_Pointer(var$, "char*")
' Translate to C function
WRITELN "__b2c__assign = __b2c__getline(&", from$, ");" TO g_CFILE
Assign_To_String("__b2c__assign", var$, NULL)
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Putline(STRING arg$)
LOCAL var$, to$, token$
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in PUTLINE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "PUTLINE * TO *" TO match$
var$ = match$[1]
to$ = match$[2]
' Start miniparser
WHILE LEN(var$)
token$ = Mini_Parser$(var$)
' Check if var is string var
IF Check_String_Type(token$) THEN
WRITELN "strcat(", to$, ", ", CHOP$(token$), ");", to$, "+=strlen(", CHOP$(token$), ");" TO g_CFILE
ELSE
WRITELN "strcat(", to$, ", STR", g_STRINGSIGN$, "(", CHOP$(token$), "));", to$, "+=strlen(STR", g_STRINGSIGN$, "(", CHOP$(token$), "));" TO g_CFILE
END IF
var$ = MID$(var$, LEN(token$)+2)
WEND
WRITELN "strcat(", to$, ", \"\\n\"); ", to$, "+=1;" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Import(STRING arg$)
LOCAL lib$, type$, sym$, token$, alias$, ptr$
LOCAL total
' Check if FROM is available
IF NOT(ISTOKEN(arg$, "FROM")) THEN
EPRINT NL$, "Syntax error: missing FROM in IMPORT statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Check if TYPE is available
IF NOT(ISTOKEN(arg$, "TYPE")) THEN
EPRINT NL$, "Syntax error: missing TYPE in IMPORT statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "IMPORT * FROM * TYPE * ALIAS *" TO match$ SIZE total
sym$ = EXTRACT$(match$[1], CHR$(34))
lib$ = match$[2]
type$ = match$[3]
IF total > 3 THEN
alias$ = match$[4]
g_IMPORTED$ = alias$ & " " & g_IMPORTED$
ENDIF
' Separate symbol and args
IF INSTR(sym$, "(") THEN
token$ = INBETWEEN$(sym$, "(", ")")
sym$ = CHOP$(TOKEN$(sym$, 1, "("))
ENDIF
' If library is libm or libc, skip dlopen as we're linking with those anyway
IF NOT(INSTR(lib$, "libc.so") ) AND NOT(INSTR(lib$, "libm.so")) THEN
IF NOT(TALLY(OS$, "OSF1")) AND NOT(TALLY(OS$, "BSD")) AND NOT(TALLY(OS$, "Haiku")) AND NOT(INSTR(g_LDFLAGS$, "-ldl")) THEN g_LDFLAGS$ = g_LDFLAGS$ & " -ldl"
' Create name from libname
ptr$ = EXTRACT$(lib$, "[[:punct:]]", TRUE)
' Check if variable was declared
IF NOT(LEN(Get_Var$("__b2c__dlopen__pointer_" & ptr$, g_FUNCNAME$))) THEN
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
g_STRINGARGS$ = g_STRINGARGS$ & "static void *__b2c__dlopen__pointer_" & ptr$ & " = NULL;"
Save_Func_Var("__b2c__dlopen__pointer_" & ptr$, g_FUNCNAME$, "void*")
ELSE
WRITELN "void* __b2c__dlopen__pointer_", ptr$, " = NULL;" TO g_HFILE
Save_Main_Var("__b2c__dlopen__pointer_" & ptr$, "void*")
ENDIF
END IF
WRITELN "if(__b2c__dlopen__pointer_", ptr$, " == NULL){__b2c__dlopen__pointer_", ptr$, " = dlopen(", lib$, ", RTLD_LAZY); if(__b2c__dlopen__pointer_", ptr$, " == NULL){" TO g_CFILE
WRITELN "if(__b2c__trap){ERROR = 3;if(!__b2c__catch_set) RUNTIMEERROR(\"IMPORT\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} } }" TO g_CFILE
' Create prototype
IF lib$ <> "NULL" THEN
WRITELN type$, "(*", sym$, ")(", token$, ");" TO g_HFILE
WRITELN "*(", type$, "**) (&", sym$, ") = (", type$,"*)dlsym(__b2c__dlopen__pointer_", ptr$, ", \"", sym$, "\");" TO g_CFILE
WRITELN "if(", sym$, " == NULL) {if(__b2c__trap){ ERROR = 4; if(!__b2c__catch_set) RUNTIMEERROR(\"IMPORT\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ELSE
WRITELN type$, "(*", alias$, ")(", token$, ");" TO g_HFILE
WRITELN "*(", type$, "**) (&", alias$, ") = (", type$,"*)dlsym(__b2c__dlopen__pointer_", ptr$, ", \"", sym$, "\");" TO g_CFILE
WRITELN "if(", alias$, " == NULL) {if(__b2c__trap){ ERROR = 4; if(!__b2c__catch_set) RUNTIMEERROR(\"IMPORT\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
ENDIF
END IF
' Make symbol known to parser
IF lib$ <> "NULL" THEN
IF ISTOKEN(g_IMPORTED$, sym$) THEN
IF g_SEMANTIC = 0 THEN EPRINT NL$, "WARNING: duplicate symbol '", sym$, "' at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
ELSE
g_IMPORTED$ = APPEND$(g_IMPORTED$, 0, sym$)
ENDIF
IF LEN(alias$) THEN WRITELN "#define ", alias$, " ", sym$ TO g_HFILE
ENDIF
' Announce runtime error usage
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Normal_Dyn_Array(STRING t$, STRING var$, STRING array$, int is_static, int is_local)
LOCAL i$, j$, old$, end$, tmp_arr$, idx$, type$, org_type$
LOCAL nr
FOR i$ IN var$ STEP ","
type$ = t$
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, CHOP$(i$) & "@" & g_FUNCNAME$)
' Initialize strings
IF REGEX(type$, "STRING|char\\*$") OR INSTR(i$, g_STRINGSIGN$) THEN
IF INSTR(IIF$(TALLY(array$, "("), TOKEN$(array$, 1, "("), array$), ",") THEN
EPRINT NL$, "Syntax error: string array cannot have more than one dimension line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
IF is_local THEN
WRITELN type$, "* ", i$, ";" TO g_CFILE
Save_Func_Var(i$, g_FUNCNAME$, type$)
g_STRINGARGS$ = g_STRINGARGS$ & " long " & CHOP$(i$) & "__b2c_array;"
Save_Func_Var(CHOP$(i$) & "__b2c_array", g_FUNCNAME$, "long")
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & CHOP$(i$) & ", " & STR$(g_OPTION_BASE) & ", " & CHOP$(i$) & "__b2c_array);"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & i$
ENDIF
ELSE
WRITELN type$, "* ", i$, ";" TO g_HFILE
Save_Main_Var(i$, type$)
WRITELN "long ", CHOP$(i$), "__b2c_array;" TO g_HFILE
Save_Main_Var(CHOP$(i$) & "__b2c_array", "long")
END IF
WRITELN i$, " = (", type$, "*)calloc(", array$, "+", g_OPTION_BASE, ", sizeof(", type$, "));" TO g_CFILE
WRITELN CHOP$(i$), "__b2c_array = ", array$, ";" TO g_CFILE
WRITELN "for(__b2c__ctr=0; __b2c__ctr<", array$, "+", g_OPTION_BASE, "; __b2c__ctr++)", i$, "[__b2c__ctr] = (char*)calloc(1, sizeof(char));" TO g_CFILE
ELSE
org_type$ = type$
' Count elements
nr = 0
FOR j$ IN array$ STEP ","
INCR nr
type$ = type$ & "*"
NEXT
' Declare top most dimension
IF is_local THEN
WRITELN type$, " ", i$, ";" TO g_CFILE
Save_Func_Var(i$, g_FUNCNAME$, org_type$)
g_STRINGARGS$ = g_STRINGARGS$ & " long " & CHOP$(i$) & "__b2c_array;"
Save_Func_Var(CHOP$(i$) & "__b2c_array", g_FUNCNAME$, "long")
IF NOT(is_static) THEN
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & CHOP$(i$)
ELSE
g_STATICARRAYS$ = g_STATICARRAYS$ & " " & CHOP$(i$) & ":" & STR$(COUNT(type$, 42))
ENDIF
ELSE
WRITELN type$, " ", i$, ";" TO g_HFILE
Save_Main_Var(i$, org_type$)
WRITELN "long ", CHOP$(i$), "__b2c_array;" TO g_HFILE
Save_Main_Var(CHOP$(i$) & "__b2c_array", "long")
END IF
WRITELN CHOP$(i$), "__b2c_array = ", TOKEN$(array$, 1, ","), ";" TO g_CFILE
WRITELN i$, " = (", type$, ")calloc((size_t)", TOKEN$(array$, 1, ","), "+", g_OPTION_BASE, ", sizeof(", LEFT$(type$, LEN(type$)-1), "));" TO g_CFILE
' Proceed with other dimensions in array
IF nr > 1 THEN
old$ = LEFT$(array$, INSTR(array$, ",")-1)
tmp_arr$ = MID$(array$, INSTR(array$, ",")+1)
nr = 0
idx$ = i$
end$ = ""
' Construct array initialization
FOR j$ IN tmp_arr$ STEP ","
INCR nr
IF is_local THEN
g_STRINGARGS$ = g_STRINGARGS$ & " int __b2c_" & CHOP$(i$) & STR$(nr) & ";"
ELSE
WRITELN "int __b2c_", CHOP$(i$), nr, ";" TO g_HFILE
END IF
idx$ = idx$ & "[__b2c_" & CHOP$(i$) & STR$(nr) & "]"
WRITELN "for(__b2c_", CHOP$(i$), nr, " = 0; __b2c_", CHOP$(i$), STR$(nr), " < ", old$, "+", g_OPTION_BASE, "; __b2c_", CHOP$(i$), nr, "++){" TO g_CFILE
type$ = LEFT$(type$, LEN(type$)-1)
WRITELN idx$, " = (", type$, ")calloc((size_t)", j$, "+", g_OPTION_BASE, ", sizeof(", LEFT$(type$, LEN(type$)-1), "));" TO g_CFILE
end$ = end$ & " }"
old$ = j$
NEXT
WRITELN end$ TO g_CFILE
type$ = LEFT$(type$, LEN(type$)-1)
' De-initialize array members in case of FUNCTION
IF is_local AND nr > 0 THEN
nr = 1
end$ = ""
FOR j$ IN LEFT$(array$, INSTRREV(array$, ",")-1) STEP ","
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " for(__b2c_" & CHOP$(i$) & STR$(nr) & " = 0; __b2c_" & CHOP$(i$) & STR$(nr) & " < " & j$ & "+" & STR$(g_OPTION_BASE) & "; __b2c_" & CHOP$(i$) & STR$(nr) & "++){"
end$ = end$ & " __b2c__STRFREE(" & idx$ & "); }"
idx$ = LEFT$(idx$, INSTRREV(idx$, "[")-1)
INCR nr
END IF
NEXT
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " " & end$
ENDIF
END IF
END IF
END IF
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Record_Dyn_Array(STRING t$, STRING var$, STRING array$, int is_static)
LOCAL i$, j$, old$, end$, tmp_arr$, idx$, type$, org_type$
LOCAL nr
IF LEN(g_RECORDARRAY$) THEN
EPRINT NL$, "Syntax error: dynamic array cannot be declared within a dynamic RECORD array at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
FOR i$ IN var$ STEP ","
type$ = t$
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, g_RECORDVAR$ & "." & CHOP$(i$) & "@" & g_FUNCNAME$)
' Initialize strings
IF REGEX(type$, "STRING|char\\*$") OR INSTR(i$, g_STRINGSIGN$) THEN
IF INSTR(IIF$(TALLY(array$, "("), TOKEN$(array$, 1, "("), array$), ",") THEN
EPRINT NL$, "Syntax error: string array cannot have more than one dimension line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & " = (" & type$ & "*)calloc(" & array$ & "+" & STR$(g_OPTION_BASE) & ", sizeof(" & type$ & "));"
IF LEN(g_FUNCNAME$) > 0 THEN
WRITELN type$, "* ", i$, ";" TO g_CFILE
Save_Func_Var(i$, g_FUNCNAME$, type$)
WRITELN "long ", CHOP$(i$), "__b2c_array;" TO g_CFILE
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array = " & array$ & "; for(__b2c__ctr=0; __b2c__ctr<" & array$ & "+" & STR$(g_OPTION_BASE) & "; __b2c__ctr++) " & g_RECORDVAR$ & "." & CHOP$(i$) & "[__b2c__ctr] = (char*)calloc(1, sizeof(char));"
Save_Func_Var(CHOP$(i$) & "__b2c_array", g_FUNCNAME$, "long")
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & "__b2c__free_str_array_members(&" & g_RECORDVAR$ & "." & CHOP$(i$) & ", " & STR$(g_OPTION_BASE) & ", " & g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array);"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & g_RECORDVAR$ & "." & CHOP$(i$)
ENDIF
ELSE
WRITELN type$, "* ", i$, ";" TO g_HFILE
Save_Main_Var(i$, type$)
WRITELN "long " & CHOP$(i$), "__b2c_array;" TO g_HFILE
Save_Main_Var(CHOP$(i$) & "__b2c_array", "long")
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array = " & array$ & "; for(__b2c__ctr=0; __b2c__ctr<" & array$ & "+" & STR$(g_OPTION_BASE) & "; __b2c__ctr++)" & g_RECORDVAR$ & "." & CHOP$(i$) & "[__b2c__ctr] = (char*)calloc(1, sizeof(char));"
END IF
ELSE
org_type$ = type$
' Count elements
nr = 0
FOR j$ IN array$ STEP ","
INCR nr
type$ = type$ & "*"
NEXT
' Declare top most dimension
IF LEN(g_FUNCNAME$) > 0 THEN
WRITELN type$, " ", i$, ";" TO g_CFILE
Save_Func_Var(i$, g_FUNCNAME$, org_type$)
WRITELN "long ", CHOP$(i$), "__b2c_array;" TO g_CFILE
Save_Func_Var(g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array", g_FUNCNAME$, "long")
IF NOT(is_static) THEN
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & g_RECORDVAR$ & "." & CHOP$(i$)
ELSE
g_STATICARRAYS$ = g_STATICARRAYS$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & ":" & STR$(COUNT(type$,42))
ENDIF
ELSE
WRITELN type$, " ", i$, ";" TO g_HFILE
Save_Main_Var(i$, org_type$)
WRITELN "long " & CHOP$(i$), "__b2c_array;" TO g_HFILE
Save_Main_Var(g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array", "long")
END IF
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & "__b2c_array = " & TOKEN$(array$, 1, ",") & ";"
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(i$) & " = (" & type$ & ")calloc((size_t)" & TOKEN$(array$, 1, ",") & "+" & STR$(g_OPTION_BASE) & ", sizeof(" & LEFT$(type$, LEN(type$)-1) & "));"
' Proceed with other dimensions in array
IF nr > 1 THEN
old$ = LEFT$(array$, INSTR(array$, ",")-1)
tmp_arr$ = MID$(array$, INSTR(array$, ",")+1)
nr = 0
idx$ = g_RECORDVAR$ & "." & i$
end$ = ""
' Construct array initialization
FOR j$ IN tmp_arr$ STEP ","
INCR nr
IF LEN(g_FUNCNAME$) > 0 THEN
g_STRINGARGS$ = g_STRINGARGS$ & " int __b2c_" & CHOP$(i$) & STR$(nr) & ";"
ELSE
g_RECORDEND_HEADER$ = g_RECORDEND_HEADER$ & " int __b2c_" & CHOP$(i$) & STR$(nr) & ";"
END IF
idx$ = idx$ & "[__b2c_" & CHOP$(i$) & STR$(nr) & "]"
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " for(__b2c_" & CHOP$(i$) & STR$(nr) & " = 0; __b2c_" & CHOP$(i$) & STR$(nr) & " < " & old$ & "+" & STR$(g_OPTION_BASE) & "; __b2c_" & CHOP$(i$) & STR$(nr) & "++){"
type$ = LEFT$(type$, LEN(type$)-1)
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & idx$ & " = (" & type$ & ")calloc((size_t)" & j$ & "+" & STR$(g_OPTION_BASE) & ", sizeof(" & LEFT$(type$, LEN(type$)-1) & "));"
end$ = end$ & " }"
old$ = j$
NEXT
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & end$
type$ = LEFT$(type$, LEN(type$)-1)
' De-initialize array members in case of FUNCTION
IF LEN(g_FUNCNAME$) > 0 AND nr > 0 THEN
nr = 1
end$ = ""
FOR j$ IN LEFT$(array$, INSTRREV(array$, ",")-1) STEP ","
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " for(__b2c_" & CHOP$(i$) & STR$(nr) & " = 0; __b2c_" & CHOP$(i$) & STR$(nr) & " < " & j$ & "+" & STR$(g_OPTION_BASE) & "; __b2c_" & CHOP$(i$) & STR$(nr) & "++){"
end$ = end$ & " __b2c__STRFREE(" & idx$ & "); }"
idx$ = LEFT$(idx$, INSTRREV(idx$, "[")-1)
INCR nr
END IF
NEXT
IF NOT(is_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " " & end$
ENDIF
END IF
END IF
END IF
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Assoc_Array(STRING var$, STRING type$, int by_local)
LOCAL str$, value$
FOR str$ IN var$ STEP ","
value$ = CHOP$(str$)
' Check if name not already global
IF LEN(g_FUNCNAME$) AND LEN(Get_Var$("__b2c__assoc_" & value$)) THEN
EPRINT NL$, "Syntax error: associative array '", value$, "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
END 1
ENDIF
IF by_local THEN
WRITELN type$, " __b2c__assoc_", value$, "_eval;" TO g_CFILE
Save_Func_Var("__b2c__assoc_" & value$, g_FUNCNAME$, type$)
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__hash_clear(__b2c__assoc_" & value$ & "); free(__b2c__assoc_" & value$ & "); __b2c__assoc_" & value$ & " = NULL;"
ELSE
WRITELN type$, " __b2c__assoc_", value$, "_eval;" TO g_HFILE
Save_Main_Var("__b2c__assoc_" & value$, type$)
ENDIF
WRITELN "__b2c__htable *__b2c__assoc_", value$, ", *__b2c__assoc_", value$, "_orig;" TO g_HFILE
WRITELN "__b2c__assoc_", value$, " = __b2c__hash_new();" TO g_CFILE
WRITELN type$, " __b2c__assoc_", value$, "_func(const char *key){void *result; result = __b2c__hash_find_value(__b2c__assoc_", value$, ", key);" TO g_HFILE
IF INSTR(value$, g_STRINGSIGN$) OR REGEX(type$, "STRING|char\\*$") THEN
WRITELN "if(result == NULL) { return(NULL); } return((", type$, ")result); }" TO g_HFILE
ELSE
WRITELN "if(result == NULL) { return(0); } return(*(", type$, "*)result); }" TO g_HFILE
ENDIF
WRITELN "#define ", value$, "(...) __b2c__assoc_", value$, "_func(__b2c__KEYCOLLECT(__VA_ARGS__))" TO g_HFILE
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Binary_Tree(STRING var$, STRING type$, int by_local)
LOCAL str$, value$
FOR str$ IN var$ STEP ","
value$ = CHOP$(str$)
' Check if name not already global
IF LEN(g_FUNCNAME$) AND LEN(Get_Var$("__b2c__tree_" & value$)) THEN
EPRINT NL$, "Syntax error: tree variable '", value$, "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
END 1
ENDIF
' Determine binary tree type
IF REGEX(type$, "STRING|char\\*$") THEN
type$ = "__b2c__sortstr"
ELIF INSTR(type$, "double") OR INSTR(type$, "FLOATING") THEN
type$ = "__b2c__sortnrd"
ELIF INSTR(type$, "float") THEN
type$ = "__b2c__sortnrf"
ELIF INSTR(type$, "long") OR INSTR(type$, "NUMBER") THEN
type$ = "__b2c__sortnrl"
ELIF INSTR(type$, "int") THEN
type$ = "__b2c__sortnri"
ELIF INSTR(type$, "short") THEN
type$ = "__b2c__sortnrs"
ELIF INSTR(type$, "short") THEN
type$ = "__b2c__sortnrc"
ELSE
EPRINT NL$, "Syntax error: unsupported TREE type at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Declare tree variables
IF by_local THEN
WRITELN "void* ", value$, " = NULL;" TO g_CFILE
Save_Func_Var("__b2c__tree_" & value$, g_FUNCNAME$, type$)
ELSE
WRITELN "void* ", value$, " = NULL;" TO g_HFILE
Save_Main_Var("__b2c__tree_" & value$, type$)
ENDIF
NEXT
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Handle_Declare(STRING arg$)
LOCAL var$, type$, new$, value$, array$, str$
LOCAL opt
IF LEN(g_RECORDNAME$) > 0 THEN
EPRINT NL$, "Syntax error: DECLARE/GLOBAL cannot be used within a RECORD at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Check on a GLOBAL RECORD
IF ISTOKEN(arg$, "RECORD") THEN
' Translate to C typedef struct
g_RECORDNAME$ = "RECORD_" & STR$(g_COUNTER)
WRITELN "typedef struct {" TO g_HFILE
g_RECORDVAR$ = MID$(CHOP$(arg$), INSTR(CHOP$(arg$), " ") + 1)
IF ISTOKEN(g_RECORDVAR$, "ARRAY") THEN
g_RECORDARRAY$ = MID$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "ARRAY")+5)
g_RECORDVAR$ = LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "ARRAY")-1) & "[" & g_RECORDARRAY$ & "]"
ENDIF
' Store current function name
IF LEN(g_FUNCNAME$) > 0 THEN
g_RECORDCACHE$ = g_FUNCNAME$
g_FUNCNAME$ = ""
END IF
ELSE
' Get the variablename and type
IF ISTOKEN(arg$, "TYPE") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "TYPE"))
type$ = CHOP$(TOKEN$(arg$, 2, "TYPE"))
IF ISTOKEN(type$, "ARRAY") THEN
array$ = TOKEN$(type$, 2, "ARRAY")
type$ = CHOP$(TOKEN$(type$, 1, "ARRAY"))
ENDIF
ELIF ISTOKEN(arg$, "ASSOC") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "ASSOC"))
type$ = CHOP$(TOKEN$(arg$, 2, "ASSOC"))
ELIF ISTOKEN(arg$, "TREE") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "TREE"))
type$ = CHOP$(TOKEN$(arg$, 2, "TREE"))
ELSE
var$ = CHOP$(arg$)
IF ISTOKEN(var$, "ARRAY") THEN
array$ = TOKEN$(var$, 2, "ARRAY")
var$ = TOKEN$(var$, 1, "ARRAY")
FI
type$ = IIF$(INSTR(var$, g_STRINGSIGN$), "char*", IIF$(INSTR(var$, g_FLOATSIGN$), "double", g_VARTYPE$))
END IF
' Check if variable was already declared
IF NOT(INSTR(var$, ".")) AND LEFT$(var$, 1) != "(" THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
' Check for C keywords
IF REGEX(str$, g_C_KEYWORDS$) THEN
EPRINT NL$, "Syntax error: variable '", str$, "' in DECLARE/GLOBAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' is a C keyword or function!"
END 1
ENDIF
' Previous definitions
IF LEN(Get_Var$(str$, g_FUNCNAME$)) THEN
EPRINT NL$, "Syntax error: variable '", str$, "' in DECLARE/GLOBAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
END 1
ENDIF
NEXT
END IF
' Check for associative array
IF ISTOKEN(arg$, "ASSOC") THEN
CALL Assoc_Array(var$, type$, 0)
' Check for binary tree
ELIF ISTOKEN(arg$, "TREE") THEN
CALL Binary_Tree(var$, type$, 0)
' Check for dynamic array declaration
ELIF ISTRUE(LEN(array$)) THEN
Normal_Dyn_Array(type$, var$, array$, FALSE, FALSE)
' Check if it is a known type, if not BaCon has to use external .h file
ELIF NOT(REGEX(EXTRACT$(type$, "*"), "DIR|FILE|short$|int$|long$|float$|double$|char$|void|STRING|NUMBER|FLOATING")) THEN
IF INSTR(var$, "=") THEN
WRITELN type$, " ", var$, ";" TO g_HFILE
Save_Main_Var(var$, type$)
ELSE
FOR str$ IN EXTRACT$(var$, " ") STEP ","
WRITELN type$, " ", str$, ";" TO g_HFILE
Save_Main_Var(str$, type$)
NEXT
ENDIF
' Check if var is string var
ELIF ( INSTR(var$, g_STRINGSIGN$) OR REGEX(type$, "STRING|char\\*$") ) AND NOT(INSTR(var$, "=")) THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF NOT(LEN(Get_Var$(str$, g_FUNCNAME$))) THEN
IF INSTR(str$, "[") THEN
WRITELN "char *", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { NULL };" TO g_HFILE
' Save type
Save_Main_Var(str$, "char*")
ELIF INSTR(str$, "(") THEN
' Function pointer
WRITELN type$, " ", str$, ";" TO g_HFILE
str$ = LEFT$(str$, INSTRREV(str$, "(")-1)
Save_Main_Var(EXTRACT$(str$, "[\\(\\*\\)]", TRUE), "void*")
ELSE
WRITELN "char *", str$, " = NULL;" TO g_HFILE
Save_Main_Var(str$, "char*")
END IF
END IF
NEXT
' Var is string array assignment
ELIF ( INSTR(var$, g_STRINGSIGN$) OR REGEX(type$, "STRING|char\\*$") ) AND INSTR(var$, "=") THEN
IF NOT(LEN(Get_Var$(var$, g_FUNCNAME$))) THEN
IF REGEX(TOKEN$(var$, 1, "="), "\\[.*\\].*") THEN
' Check on multidimensional stringarrays
IF REGEX(var$, "\\[.*\\]\\[") THEN
EPRINT NL$, "Syntax error: multidimensional stringarrays at line ", g_COUNTER, " in file '", g_CURFILE$, "' are not supported!"
END 1
END IF
WRITELN "char *", LEFT$(var$, INSTR(var$, "[") - 1), "[", STR$(COUNT(var$, 44)+1+g_OPTION_BASE), "] = { NULL };" TO g_HFILE
' Save type
Save_Main_Var(var$, "char*")
' Copy elements
opt = g_OPTION_BASE
array$ = MID$(var$, INSTR(var$, "{")+1)
WHILE LEN(array$)
str$ = Mini_Parser$(array$)
WRITELN LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "] = __b2c_Copy_String(", LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "], ", CHOP$(str$, "}", 2), ");" TO g_CFILE
array$ = MID$(array$, LEN(str$)+2)
INCR opt
WEND
ELSE
WHILE LEN(var$)
str$ = Mini_Parser$(var$)
WRITELN "char *", LEFT$(str$, INSTR(str$, "=")-1), " = NULL;" TO g_HFILE
WRITELN g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), " = __b2c_Copy_String(", g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), ", ", MID$(str$, INSTR(str$, "=")+1), ");" TO g_CFILE
Save_Main_Var(LEFT$(str$, INSTR(str$, "=")-1), "char*")
var$ = MID$(var$, LEN(str$)+2)
WEND
ENDIF
ENDIF
' Assume char assignment or number
ELSE
IF INSTR(var$, "[") AND NOT(INSTR(var$, "=")) THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
WRITELN type$, " ", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { 0 };" TO g_HFILE
' Save type
Save_Main_Var(str$, type$)
NEXT
ELIF INSTR(var$, "[") AND INSTR(var$, "=") THEN
WRITELN type$, " ", MID$(var$, 1, INSTR(var$, "{")) TO g_HFILE
opt = g_OPTION_BASE
IF opt > 0 AND COUNT(var$, 91) > 1 THEN EPRINT NL$, "WARNING: OPTION BASE has no impact on multidimensional array '", MID$(var$, 1, INSTR(var$, "[")-1), "' in DECLARE/GLOBAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
WHILE opt > 0 AND COUNT(var$, 91) = 1
WRITELN " 0, " TO g_HFILE
DECR opt
WEND
WRITELN MID$(var$, INSTR(var$, "{")+1), ";" TO g_HFILE
' Save type
Save_Main_Var(var$, type$)
ELIF INSTR(var$, "(") THEN
' Function pointer
WRITELN type$, " ", var$, ";" TO g_HFILE
var$ = LEFT$(var$, INSTRREV(var$, "(")-1)
Save_Main_Var(EXTRACT$(var$, "[\\(\\*\\)]", TRUE), "void*")
ELSE
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF INSTR(str$, "=") THEN
WRITELN type$, " ", str$, ";" TO g_HFILE
ELIF RIGHT$(type$) = "*" OR LEFT$(var$) = "*" THEN
WRITELN type$, " ", str$, " = NULL;" TO g_HFILE
ELSE
WRITELN type$, " ", str$, " = 0;" TO g_HFILE
ENDIF
Save_Main_Var(str$, type$)
NEXT
END IF
ENDIF
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Local(STRING arg$)
LOCAL var$, type$, new$, value$, dim$, dim2$, array$, str$
LOCAL opt
' Get the variablename and type
IF ISTOKEN(arg$, "TYPE") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "TYPE"))
type$ = CHOP$(TOKEN$(arg$, 2, "TYPE"))
IF ISTOKEN(type$, "ARRAY") THEN
array$ = TOKEN$(type$, 2, "ARRAY")
type$ = CHOP$(TOKEN$(type$, 1, "ARRAY"))
ENDIF
ELIF ISTOKEN(arg$, "ASSOC") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "ASSOC"))
type$ = CHOP$(TOKEN$(arg$, 2, "ASSOC"))
ELIF ISTOKEN(arg$, "TREE") THEN
var$ = CHOP$(TOKEN$(arg$, 1, "TREE"))
type$ = CHOP$(TOKEN$(arg$, 2, "TREE"))
ELSE
var$ = CHOP$(arg$)
IF ISTOKEN(var$, "ARRAY") THEN
array$ = TOKEN$(var$, 2, "ARRAY")
var$ = TOKEN$(var$, 1, "ARRAY")
FI
type$ = IIF$(INSTR(var$, g_STRINGSIGN$), "char*", IIF$(INSTR(var$, g_FLOATSIGN$), "double", g_VARTYPE$))
END IF
' Check if variable was already declared
IF NOT(INSTR(var$, ".")) AND LEFT$(var$, 1) != "(" THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
' Check for C keywords
IF REGEX(str$, g_C_KEYWORDS$) THEN
EPRINT NL$, "Syntax error: variable '", str$, "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' is a C keyword or function!"
END 1
ENDIF
' Previous definitions
IF LEN(Get_Var$(str$, g_FUNCNAME$)) THEN
EPRINT NL$, "Syntax error: variable '", str$, "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
END 1
ENDIF
NEXT
END IF
' Check for associative array
IF ISTOKEN(arg$, "ASSOC") THEN
CALL Assoc_Array(var$, type$, 1)
' Check for binary tree
ELIF ISTOKEN(arg$, "TREE") THEN
CALL Binary_Tree(var$, type$, 1)
' Check for dynamic array declaration
ELIF ISTRUE(LEN(array$)) THEN
IF LEN(g_RECORDNAME$) > 0 THEN
IF INSTR(array$, "STATIC") THEN
Record_Dyn_Array(type$, var$, MID$(array$, 1, INSTR(array$, "STATIC")-1), TRUE)
ELSE
Record_Dyn_Array(type$, var$, array$, FALSE)
FI
ELSE
IF INSTR(array$, "STATIC") THEN
IF LEN(g_FUNCNAME$) THEN
Normal_Dyn_Array(type$, var$, MID$(array$, 1, INSTR(array$, "STATIC")-1), TRUE, TRUE)
ELSE
Normal_Dyn_Array(type$, var$, MID$(array$, 1, INSTR(array$, "STATIC")-1), TRUE, FALSE)
ENDIF
ELSE
IF LEN(g_FUNCNAME$) THEN
Normal_Dyn_Array(type$, var$, array$, FALSE, TRUE)
ELSE
Normal_Dyn_Array(type$, var$, array$, FALSE, FALSE)
ENDIF
FI
ENDIF
' Check if it is a known type, if not BaCon has to use external .h file
ELIF NOT(REGEX(EXTRACT$(type$, "*"), "DIR|FILE|short$|int$|long$|float$|double$|char$|void|STRING|NUMBER|FLOATING")) AND NOT(LEN(g_RECORDNAME$)) THEN
IF INSTR(var$, "=") THEN
WRITELN type$, " ", var$, ";" TO g_CFILE
IF LEN(g_FUNCNAME$) THEN
Save_Func_Var(var$, g_FUNCNAME$, type$)
ELSE
Save_Main_Var(var$, type$)
ENDIF
ELSE
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF LEN(g_FUNCNAME$) THEN
WRITELN type$, " ", str$, ";" TO g_CFILE
Save_Func_Var(str$, g_FUNCNAME$, type$)
ELSE
WRITELN type$, " ", str$, ";" TO g_HFILE
Save_Main_Var(str$, type$)
ENDIF
NEXT
ENDIF
' Check if var is string var
ELIF ( REGEX(type$, "STRING|char\\*$") OR INSTR(var$, g_STRINGSIGN$) ) AND NOT(INSTR(var$, "=")) AND NOT(REGEX(type$, ".+\\[.+" & g_STRINGSIGN$ & "\\]")) THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF NOT(LEN(Get_Var$(str$, g_FUNCNAME$))) THEN
' Check on multidimensional stringarrays
IF REGEX(str$, "\\[.*\\]\\[") THEN
EPRINT NL$, "Syntax error: multidimensional stringarrays at line ", g_COUNTER, " in file '", g_CURFILE$, "' are not supported!"
END 1
END IF
' Are we in a function?
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF ISTRUE(LEN(g_RECORDNAME$)) THEN
IF REGEX(str$, "\\[.*\\]") THEN
WRITELN "char *", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), ";" TO g_CFILE
dim$ = MID$(str$, INSTR(str$, "[") + 1)
IF REGEX(g_RECORDVAR$, "\\[.*\\]") THEN
IF LEN(g_RECORDARRAY$) THEN
dim2$ = "__b2c_record_" & EXTRACT$(g_RECORDNAME$, "_TYPE")
ELSE
dim2$ = MID$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[") + 1)
ENDIF
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " for(__b2c__counter=0; __b2c__counter<" & LEFT$(dim2$, INSTR(dim2$, "]") - 1) & ";__b2c__counter++) {for(__b2c__ctr=0; __b2c__ctr<" & LEFT$(dim$, INSTR(dim$, "]") - 1) & "; __b2c__ctr++)" & LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1) & "[__b2c__counter]." & LEFT$(str$, INSTR(str$, "[")-1) & "[__b2c__ctr] = NULL;}"
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " for(__b2c__counter=0; __b2c__counter<" & LEFT$(dim2$, INSTR(dim2$, "]") - 1) & ";__b2c__counter++) {for(__b2c__ctr=0; __b2c__ctr<" & LEFT$(dim$, INSTR(dim$, "]") - 1) & "; __b2c__ctr++) { __b2c__STRFREE(" & LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1) & "[__b2c__counter]." & LEFT$(str$, INSTR(str$, "[")-1) & "[__b2c__ctr]);} }"
ELSE
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " for(__b2c__ctr=0; __b2c__ctr<" & LEFT$(dim$, INSTR(dim$, "]") - 1) & "; __b2c__ctr++)" & g_RECORDVAR$ & "." & LEFT$(str$, INSTR(str$, "[")-1) & "[__b2c__ctr] = NULL;"
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & TOKEN$(str$, 1, "[") & ", " & STR$(g_OPTION_BASE) & ", " & g_RECORDVAR$ & "." & TOKEN$(dim$, 1, "]") & ");"
ENDIF
ELSE
WRITELN "char *", str$, ";" TO g_CFILE
' Pointer var should not be initialized
IF INSTR(str$, g_STRINGSIGN$) AND NOT(REGEX(g_RECORDVAR$, "\\[.*\\]")) AND NOT(LEN(g_RECORDARRAY$)) THEN
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & str$ & " = NULL;"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & g_RECORDVAR$ & "." & str$
ENDIF
END IF
Save_Func_Var(str$, g_FUNCNAME$, "char*")
ELSE
IF REGEX(str$, "\\[.*\\]") THEN
WRITELN "char *", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { NULL };" TO g_CFILE
' Save type
Save_Func_Var(str$, g_FUNCNAME$, "char*")
dim$ = MID$(str$, INSTR(str$, "[") + 1)
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " for(__b2c__ctr=0; __b2c__ctr<" & TOKEN$(dim$, 1, "]") & "; __b2c__ctr++) { __b2c__STRFREE(" & g_WITHVAR$ & TOKEN$(str$, 1, "[") & "[__b2c__ctr]); }"
ELIF INSTR(str$, "(") THEN
' Function pointer
WRITELN type$, " ", str$, ";" TO g_CFILE
str$ = LEFT$(str$, INSTRREV(str$, "(")-1)
Save_Func_Var(EXTRACT$(str$, "[\\(\\*\\)]", TRUE), g_FUNCNAME$, "void*")
ELSE
WRITELN "char *", str$, " = NULL;" TO g_CFILE
Save_Func_Var(str$, g_FUNCNAME$, "char*")
' Defined as string?
IF INSTR(str$, g_STRINGSIGN$) THEN
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & str$
ENDIF
END IF
END IF
' We are in the mainprogram
ELSE
IF ISTRUE(LEN(g_RECORDNAME$)) THEN
IF REGEX(str$, "\\[.*\\]") THEN
WRITELN "char *", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), ";" TO g_HFILE
ELSE
WRITELN "char *", str$, ";" TO g_HFILE
' Pointer var should not be initialized
IF INSTR(str$, g_STRINGSIGN$) AND NOT(REGEX(g_RECORDVAR$, "\\[.*\\]")) AND NOT(LEN(g_RECORDARRAY$)) THEN g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " " & g_RECORDVAR$ & "." & CHOP$(str$) & " = NULL;"
ENDIF
Save_Main_Var(str$, "char*")
ELSE
IF REGEX(str$, "\\[.*\\]") THEN
WRITELN "char *", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { NULL };" TO g_HFILE
' Save type
Save_Main_Var(str$, "char*")
ELIF INSTR(str$, "(") THEN
' Function pointer
WRITELN type$, " ", str$, ";" TO g_HFILE
str$ = LEFT$(str$, INSTRREV(str$, "(")-1)
Save_Main_Var(EXTRACT$(str$, "[\\(\\*\\)]", TRUE), "void*")
ELSE
WRITELN "char *", str$, " = NULL; " TO g_HFILE
Save_Main_Var(str$, "char*")
END IF
END IF
END IF
END IF
NEXT
ELIF ( INSTR(var$, g_STRINGSIGN$) OR REGEX(type$, "STRING|char\\*") ) AND INSTR(var$, "=") THEN
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF NOT(LEN(Get_Var$(var$, g_FUNCNAME$))) THEN
' String array assignment
IF REGEX(TOKEN$(var$, 1, "="), "\\[.*\\].*") THEN
' Check on multidimensional stringarrays
IF REGEX(var$, "\\[.*\\]\\[") THEN
EPRINT NL$, "Syntax error: multidimensional stringarrays at line ", g_COUNTER, " in file '", g_CURFILE$, "' are not supported!"
END 1
END IF
WRITELN "static char *", LEFT$(var$, INSTR(var$, "[") - 1), "[", STR$(COUNT(var$, 44)+1), "+", STR$(g_OPTION_BASE), "] = { NULL };" TO g_CFILE
IF LEN(g_RECORDVAR$) THEN
EPRINT NL$, "Syntax error: C does not allow initialization of an array within a struct at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Save type
Save_Func_Var(var$, g_FUNCNAME$, "char*")
' Copy elements
opt = g_OPTION_BASE
array$ = MID$(var$, INSTR(var$, "{")+1)
WHILE LEN(array$)
str$ = Mini_Parser$(array$)
WRITELN LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "] = __b2c_Copy_String(", LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "], ", CHOP$(str$, "}", 2), ");" TO g_CFILE
array$ = MID$(array$, LEN(str$)+2)
INCR opt
WEND
ELSE
WHILE LEN(var$)
str$ = Mini_Parser$(var$)
WRITELN "static char *", LEFT$(str$, INSTR(str$, "=")-1), " = NULL;" TO g_CFILE
WRITELN g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), " = __b2c_Copy_String(", g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), ", ", MID$(str$, INSTR(str$, "=")+1), ");" TO g_CFILE
Save_Func_Var(LEFT$(str$, INSTR(str$, "=")-1), g_FUNCNAME$, "char*")
var$ = MID$(var$, LEN(str$)+2)
WEND
ENDIF
ENDIF
ELSE
IF NOT(LEN(Get_Var$(var$, g_FUNCNAME$))) THEN
IF REGEX(TOKEN$(var$, 1, "="), "\\[.*\\].*") THEN
' Check on multidimensional stringarrays
IF REGEX(var$, "\\[.*\\]\\[") THEN
EPRINT NL$, "Syntax error: multidimensional stringarrays at line ", g_COUNTER, " in file '", g_CURFILE$, "' are not supported!"
END 1
END IF
WRITELN "char *", LEFT$(var$, INSTR(var$, "[") - 1), "[", STR$(COUNT(var$, 44)+1+g_OPTION_BASE), "] = { NULL };" TO g_HFILE
IF LEN(g_RECORDVAR$) THEN
EPRINT NL$, "Syntax error: C does not allow initialization of an array within a struct at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Save type
Save_Main_Var(var$, "char*")
' Copy elements
opt = g_OPTION_BASE
array$ = MID$(var$, INSTR(var$, "{")+1)
WHILE LEN(array$)
str$ = Mini_Parser$(array$)
WRITELN LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "] = __b2c_Copy_String(", LEFT$(var$, INSTR(var$, "[")-1), "[", opt, "], ", CHOP$(str$, "}", 2), ");" TO g_CFILE
array$ = MID$(array$, LEN(str$)+2)
INCR opt
WEND
ELSE
WHILE LEN(var$)
str$ = Mini_Parser$(var$)
WRITELN "char *", LEFT$(str$, INSTR(str$, "=")-1), " = NULL;" TO g_HFILE
WRITELN g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), " = __b2c_Copy_String(", g_WITHVAR$, LEFT$(str$, INSTR(str$, "=")-1), ", ", MID$(str$, INSTR(str$, "=")+1), ");" TO g_CFILE
Save_Main_Var(LEFT$(str$, INSTR(str$, "=")-1), "char*")
var$ = MID$(var$, LEN(str$)+2)
WEND
ENDIF
ENDIF
END IF
' Assume number or complicated type
ELSE
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF INSTR(var$, "[") AND NOT(INSTR(var$, "=")) THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF NOT(LEN(g_RECORDNAME$)) THEN
WRITELN type$, " ", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { 0 };" TO g_CFILE
ELSE
WRITELN type$, " ", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), ";" TO g_CFILE
ENDIF
' Save type
Save_Func_Var(str$, g_FUNCNAME$, type$)
NEXT
ELIF INSTR(var$, "[") AND INSTR(var$, "=") THEN
' Numeric array assignment
WRITELN type$, " ", MID$(var$, 1, INSTR(var$, "{")) TO g_CFILE
opt = g_OPTION_BASE
IF opt > 0 AND COUNT(var$, 91) > 1 THEN EPRINT NL$, "WARNING: OPTION BASE has no impact on multidimensional array '", MID$(var$, 1, INSTR(var$, "[")-1), "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
WHILE opt > 0 AND COUNT(var$, 91) = 1
WRITELN " 0, " TO g_CFILE
DECR opt
WEND
WRITELN MID$(var$, INSTR(var$, "{")+1), ";" TO g_CFILE
IF LEN(g_RECORDVAR$) THEN
EPRINT NL$, "Syntax error: C does not allow initialization of an array within a struct at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Save type
Save_Func_Var(var$, g_FUNCNAME$, type$)
ELIF INSTR(var$, "(") THEN
' Function pointer
WRITELN type$, " ", var$, ";" TO g_CFILE
var$ = LEFT$(var$, INSTRREV(var$, "(")-1)
Save_Func_Var(EXTRACT$(var$, "[\\(\\*\\)]", TRUE), g_FUNCNAME$, "void*")
ELSE
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF INSTR(str$, "=") OR LEN(g_RECORDVAR$) THEN
WRITELN type$, " ", str$, ";" TO g_CFILE
ELIF RIGHT$(type$) = "*" OR LEFT$(var$) = "*" THEN
WRITELN type$, " ", str$, " = NULL;" TO g_CFILE
ELSE
WRITELN type$, " ", str$, " = 0;" TO g_CFILE
ENDIF
Save_Func_Var(str$, g_FUNCNAME$, type$)
NEXT
END IF
ELSE
IF INSTR(var$, "[") AND NOT(INSTR(var$, "=")) THEN
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF NOT(LEN(g_RECORDNAME$)) THEN
WRITELN type$, " ", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { 0 };" TO g_HFILE
ELSE
WRITELN type$, " ", REPLACE$(str$, "]", "+" & STR$(g_OPTION_BASE) & "]"), ";" TO g_HFILE
ENDIF
' Save type
Save_Main_Var(str$, type$)
NEXT
ELIF INSTR(var$, "[") AND INSTR(var$, "=") THEN
' Numeric array assignment
WRITELN type$, " ", MID$(var$, 1, INSTR(var$, "{")) TO g_HFILE
opt = g_OPTION_BASE
IF opt > 0 AND COUNT(var$, 91) > 1 THEN EPRINT NL$, "WARNING: OPTION BASE has no impact on multidimensional array '", MID$(var$, 1, INSTR(var$, "[")-1), "' in LOCAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
WHILE opt > 0 AND COUNT(var$, 91) = 1
WRITELN " 0, " TO g_HFILE
DECR opt
WEND
WRITELN MID$(var$, INSTR(var$, "{")+1), ";" TO g_HFILE
IF LEN(g_RECORDVAR$) THEN
EPRINT NL$, "Syntax error: C does not allow initialization of an array within a struct at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Save type
Save_Main_Var(var$, type$)
ELIF INSTR(var$, "(") THEN
' Function pointer
WRITELN type$, " ", var$, ";" TO g_HFILE
var$ = LEFT$(var$, INSTRREV(var$, "(")-1)
Save_Main_Var(EXTRACT$(var$, "[\\(\\*\\)]", TRUE), "void*")
ELSE
FOR str$ IN EXTRACT$(var$, " ") STEP ","
IF INSTR(str$, "=") OR LEN(g_RECORDVAR$) THEN
WRITELN type$, " ", str$, ";" TO g_HFILE
ELIF RIGHT$(type$) = "*" OR LEFT$(var$) = "*" THEN
WRITELN type$, " ", str$, " = NULL;" TO g_HFILE
ELSE
WRITELN type$, " ", str$, " = 0;" TO g_HFILE
ENDIF
Save_Main_Var(str$, type$)
NEXT
END IF
END IF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Read(STRING arg$)
LOCAL type$, element$, lft$, str$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty READ at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
FOR element$ IN EXTRACT$(arg$, " ") STEP ","
' Check if var is string var
IF REGEX(element$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(element$, "char*")
type$ = "char*"
ELSE
Register_Numeric(element$, "default")
type$ = Get_Var$(element$, g_FUNCNAME$)
END IF
' Check type of var, string?
IF Check_String_Type(element$) THEN
' Convert to C
WRITELN "__b2c__assign = __b2c__strdup(__b2c__stringarray[__b2c__stringarray_ptr]); __b2c__stringarray_ptr++;" TO g_CFILE
Assign_To_String("__b2c__assign", element$, NULL)
ELSE
Assign_To_Number("__b2c__floatarray[__b2c__floatarray_ptr]", element$, 0)
WRITELN "__b2c__floatarray_ptr++;" TO g_CFILE
END IF
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Endfunction()
LOCAL line$, tfil$
LOCAL tmp_HFILE TYPE FILE*
' Check if we're in a FUNCTION
IF NOT(LEN(g_FUNCNAME$)) THEN
EPRINT NL$, "Syntax error: ENDFUNC(TION) outside FUNCTION at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Check if return was found
IF ISFALSE(LEN(g_FUNCTYPE$)) THEN
EPRINT NL$, "Syntax error: function '", g_FUNCNAME$, "' was defined without returning a value or string!"
END 1
END IF
' Close the current C file
CLOSE FILE g_CFILE
' Put prototype to header file
IF NOT(INSTR(g_PROTOTYPE$, "::")) THEN WRITELN g_FUNCTYPE$, " ", g_PROTOTYPE$, ";" TO g_HFILE
g_PROTOTYPE$ = ""
' Open temporary header file
tfil$ = MID$(g_CURFILE$, INSTRREV(g_CURFILE$, "/") + 1)
OPEN g_TEMPDIR$ & "/" & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h" FOR WRITING AS tmp_HFILE
' Get original function name
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO tmp_HFILE
WRITELN "#undef __b2c__exitval" TO tmp_HFILE
WRITELN "#define __b2c__exitval 0" TO tmp_HFILE
IF NOT(INSTR(g_ORIGFUNCNAME$, "(")) THEN
WRITELN g_FUNCTYPE$, " ", g_FUNCNAME$, "(void) {" TO tmp_HFILE
ELSE
WRITELN g_FUNCTYPE$, " ", g_ORIGFUNCNAME$, " {" TO tmp_HFILE
END IF
' Add function body
WRITELN g_STRINGARGS$ TO tmp_HFILE
OPEN g_CFILE$ FOR READING AS g_CFILE
WHILE NOT(ENDFILE(g_CFILE)) DO
READLN line$ FROM g_CFILE
IF NOT(ENDFILE(g_CFILE)) THEN WRITELN line$ TO tmp_HFILE
WEND
CLOSE FILE g_CFILE
IF g_CATCH_USED = 1 THEN WRITELN "__B2C__PROGRAM__EXIT: ;" TO tmp_HFILE
' Make sure pointers are always reset
WRITELN "__b2c__catch_set = __b2c__catch_set_backup;" TO tmp_HFILE
' Make sure the function always returns something
IF REGEX(g_FUNCTYPE$, "char\\*$|STRING$") THEN
WRITELN "return (NULL);}" TO tmp_HFILE
ELIF REGEX(g_FUNCTYPE$, "char$|short$|int$|long$|double$|float$|NUMBER$|FLOATING$") THEN
WRITELN "return (0);}" TO tmp_HFILE
ELSE
WRITELN "}" TO tmp_HFILE
ENDIF
CLOSE FILE tmp_HFILE
' Include header file
IF NOT(INSTR(g_INCLUDE_FILES$, LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h")) THEN
g_INCLUDE_FILES$ = g_INCLUDE_FILES$ & " " & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h"
END IF
' Add to total filelist
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_TEMPDIR$ & "/" & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h"
' Delete temp funcfile
DELETE FILE g_CFILE$
' Restore mainfile
g_CFILE$ = g_COPY_CFILE$
OPEN g_CFILE$ FOR APPENDING AS g_CFILE
' Restore CATCH routine
g_CATCHGOTO$ = g_ORIGCATCHGOTO$
g_CATCH_USED = g_ORIGCATCH_USED
' Clear function variables
g_ORIGFUNCNAME$ = ""
g_FUNCNAME$ = ""
g_FUNCTYPE$ = ""
g_LOCALSTRINGS$ = ""
g_STRINGARRAYS$ = ""
g_STRINGARGS$ = ""
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Return(STRING arg$)
LOCAL type$, str$, name$
LOCAL x
arg$ = CHOP$(arg$)
' Check if we have an argument at all, if not, we return from a GOSUB
IF ISFALSE(LEN(arg$)) THEN
WRITELN "if(__b2c__gosub_buffer_ptr >= 0) longjmp(__b2c__gosub_buffer[__b2c__gosub_buffer_ptr], 1);" TO g_CFILE
EXIT SUB
END IF
type$ = IIF$(LEN(g_FUNCTYPE$)>0, g_FUNCTYPE$, Get_Var$(arg$, g_FUNCNAME$))
' Check type of var, string or normal string?
IF Check_String_Type(arg$) OR REGEX(g_FUNCTYPE$, "char\\*$|STRING$") OR REGEX(g_FUNCNAME$, g_STRINGSIGN$ & "$") THEN
' Dynamic array or array created by SPLIT or LOOKUP
IF ISTOKEN(g_DYNAMICARRAYS$, arg$ & "@" & g_FUNCNAME$) THEN
g_FUNCTYPE$ = "char**"
' We return a string
ELSE
g_FUNCTYPE$ = "char*"
WRITELN "__b2c__assign = __b2c__return(", arg$, ");" TO g_CFILE
arg$ = "__b2c__assign"
ENDIF
' Assume variable, check if declared before
ELIF ISTRUE(LEN(type$)) THEN
IF INSTR(arg$, "[") THEN
FOR x = 1 TO COUNT(arg$, 91)
IF RIGHT$(type$, 1) = "*" THEN type$ = LEFT$(type$, LEN(type$)-1)
NEXT
ELSE
FOR name$ IN g_STATICARRAYS$
IF INSTR(name$, arg$) THEN
type$ = type$ & FILL$(VAL(MID$(name$, INSTR(name$, ":")+1)), 42)
BREAK
ENDIF
NEXT
ENDIF
g_FUNCTYPE$ = type$
' Not declared, assume actual value
ELIF REGEX(arg$, g_LONGSIGN$ & "$") OR REGEX(g_FUNCNAME$, g_LONGSIGN$ & "$") THEN
g_FUNCTYPE$ = "long"
ELIF INSTR(arg$, ".") OR REGEX(arg$, g_FLOATSIGN$ & "$") OR REGEX(g_FUNCNAME$, g_FLOATSIGN$ & "$") THEN
g_FUNCTYPE$ = "double"
ELSE
g_FUNCTYPE$ = g_VARTYPE$
END IF
' Free strings variables if there are any
WRITELN g_STRINGARRAYS$ TO g_CFILE
FOR str$ IN g_LOCALSTRINGS$
WRITELN "__b2c__STRFREE(", str$, ");" TO g_CFILE
NEXT
' The actual return value
WRITELN "__b2c__catch_set = __b2c__catch_set_backup;" TO g_CFILE
WRITELN "return(", arg$, ");" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Push(STRING arg$)
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty PUSH at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Store result as string
WRITELN "__b2c__stack = (char**)realloc(__b2c__stack, (SP+1)*sizeof(char*));" TO g_CFILE
IF Check_String_Type(arg$) THEN
WRITELN "__b2c__stack[SP] = __b2c__strdup(", arg$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__stack[SP] = calloc(", g_MAX_DIGITS, ", sizeof(char)); snprintf(__b2c__stack[SP], ", g_MAX_DIGITS-1, ", \"%g\", (double)(", arg$, "));" TO g_CFILE
ENDIF
' Increase stackpointer
WRITELN "SP++;" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Pull(STRING arg$)
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty PULL at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Argument must be a variable
IF NOT(REGEX(arg$, "[a-zA-Z]+.*")) THEN
EPRINT NL$, "Syntax error: argument in PULL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' is not a variable!"
END 1
END IF
' Check if var is string var
IF REGEX(arg$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(arg$, "char*")
' Assume number, exclude RECORD elements
ELSE
Register_Numeric(arg$, "default")
END IF
' Decrease stackpointer again
WRITELN "SP--; if(SP >= 0) {" TO g_CFILE
' Get the last value from stack
IF Check_String_Type(arg$) THEN
Assign_To_String("__b2c__stack[SP]", arg$, NULL)
ELSE
Assign_To_Number("__b2c__stack[SP]", arg$, 1)
END IF
WRITELN "} else { SP = 0; }" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_SubFunc(STRING arg$)
LOCAL x, dim, total
LOCAL dim$, arr$, size$, var$, no_arg$, type$
' Check argument
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty SUB/FUNCTION at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Check if we are in a sub already
IF LEN(g_FUNCNAME$) > 0 THEN
EPRINT NL$, "Syntax error: cannot define a SUB/FUNCTION within a SUB/FUNCTION at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the functype
no_arg$ = OUTBETWEEN$(arg$, "(", ")", 1)
IF ISTOKEN(no_arg$, "TYPE") THEN
PARSE COLLAPSE$(no_arg$) WITH "* TYPE *" TO match$ SIZE total
g_FUNCTYPE$ = CHOP$(match$[2])
arg$ = FIRST$(arg$, 1, "TYPE")
ENDIF
' Get the funcname
IF INSTR(arg$, "(") THEN
g_ORIGFUNCNAME$ = CHOP$(TOKEN$(arg$, 1, "(")) & "("
g_PROTOTYPE$ = g_ORIGFUNCNAME$
g_FUNCNAME$ = CHOP$(TOKEN$(arg$, 1, "("))
ELSE
g_ORIGFUNCNAME$ = CHOP$(arg$) & "("
g_PROTOTYPE$ = g_ORIGFUNCNAME$
g_FUNCNAME$ = CHOP$(arg$)
ENDIF
' In case of C++ classes
IF INSTR(g_FUNCNAME$, "::") THEN g_FUNCNAME$ = REPLACE$(g_FUNCNAME$, "::", "__")
' Check if name exists
IF ISTOKEN(g_IMPORTED$, g_FUNCNAME$) THEN
EPRINT NL$, "Syntax error: duplicate SUB or FUNCTION name at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Start miniparser to duplicate string arguments
IF INSTR(arg$, "(") THEN SPLIT CHOP$(MID$(arg$, INSTR(arg$, "(")), "() ") BY "," TO element$ SIZE dim
' If there are no arguments to the function at all
IF dim = 0 THEN
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & " void)"
g_PROTOTYPE$ = g_PROTOTYPE$ & " void)"
ENDIF
FOR x = 1 TO dim
element$[x] = CHOP$(element$[x])
' Save type
IF TOKEN$(element$[x], 1) = "VAR" THEN
IF dim > 1 THEN
EPRINT NL$, "Syntax error: variable argument list cannot be followed by other arguments at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF INSTR(g_PROTOTYPE$, ",") THEN
EPRINT NL$, "Syntax error: variable argument list cannot be preceded by other arguments at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF NOT(ISTOKEN(element$[x], "SIZE")) THEN
EPRINT NL$, "Syntax error: variable argument list lacks SIZE argument at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
PARSE COLLAPSE$(element$[x]) WITH "VAR * " & IIF$(ISTOKEN(element$[x], "TYPE"), "TYPE * ") & "SIZE *" TO match$ SIZE total
arr$ = match$[1]
IF total = 2 THEN
type$ = "long"
size$ = match$[2]
ELSE
type$ = match$[2]
size$ = match$[3]
ENDIF
' These are in the function header, and do not exist yet - no need to check with Get_Var
g_STRINGARGS$ = g_STRINGARGS$ & " long " & size$ & ";"
Save_Func_Var(size$, g_FUNCNAME$, "long")
IF Check_String_Type(arr$) OR REGEX(type$, "STRING|char\\*$") THEN
Save_Func_Var(arr$, g_FUNCNAME$, "char*")
g_STRINGARGS$ = g_STRINGARGS$ & "long __b2c__var_" & arr$ & " = " & STR$(g_OPTION_BASE) & "; va_list __b2c__ap; char **" & arr$ & " = NULL;" & arr$ & " = (char **)calloc(__b2c__arg_tot+" & STR$(g_OPTION_BASE) & ", sizeof(char*));"
g_STRINGARGS$ = g_STRINGARGS$ & size$ & " = __b2c__arg_tot; va_start(__b2c__ap, __b2c__arg_tot); while(__b2c__arg_tot)"
g_STRINGARGS$ = g_STRINGARGS$ & "{" & arr$ & "[__b2c__var_" & arr$ & "] = __b2c__strdup(va_arg(__b2c__ap, char*)); if(" & arr$ & "[__b2c__var_" & arr$ & "] == NULL){ break; } __b2c__var_" & arr$ & "++; __b2c__arg_tot--; } va_end(__b2c__ap);"
g_PROTOTYPE$ = "__" & g_PROTOTYPE$ & "int, ..."
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & "int __b2c__arg_tot, ..."
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & arr$ & ", " & STR$(g_OPTION_BASE) & ", " & size$ & "); free(" & arr$ & ");"
WRITELN "#define ", g_FUNCNAME$, "(...) __", g_FUNCNAME$, "(sizeof((const char*[]) {__VA_ARGS__}) / sizeof(char*), (char*)__VA_ARGS__)" TO g_HFILE
ELSE
' The var_args API always uses double when type actually is float. Prevent compile warnings.
IF INSTR(arr$, g_FLOATSIGN$) OR type$ = "float" THEN type$ = "double"
Save_Func_Var(arr$, g_FUNCNAME$, type$ & "*")
g_STRINGARGS$ = g_STRINGARGS$ & "long __b2c__var_" & arr$ & " = " & STR$(g_OPTION_BASE) & "; va_list __b2c__ap; " & type$ & "*" & arr$ & " = NULL;" & arr$ & " = (" & type$ & "*)calloc(__b2c__arg_tot+" & STR$(g_OPTION_BASE) & ", sizeof(" & type$ & "));"
g_STRINGARGS$ = g_STRINGARGS$ & size$ & " = __b2c__arg_tot; va_start(__b2c__ap, __b2c__arg_tot); while(__b2c__arg_tot)"
g_STRINGARGS$ = g_STRINGARGS$ & "{" & arr$ & "[__b2c__var_" & arr$ & "] = va_arg(__b2c__ap, " & type$ & "); __b2c__var_" & arr$ & "++; __b2c__arg_tot--; } va_end(__b2c__ap);"
g_PROTOTYPE$ = "__" & g_PROTOTYPE$ & "int, ..."
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & "int __b2c__arg_tot, ..."
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " free(" & arr$ & ");"
WRITELN "#define ", g_FUNCNAME$, "(...) __", g_FUNCNAME$, "(sizeof((const " & type$ & "[]) {__VA_ARGS__}) / sizeof(" & type$ & "), (" & type$ & ")__VA_ARGS__)" TO g_HFILE
ENDIF
' Add macro in case of VAR argument
g_ORIGFUNCNAME$ = "__" & g_ORIGFUNCNAME$
ELIF INSTR(element$[x], "STRING ") OR INSTR(element$[x], "char* ") OR INSTR(element$[x], g_STRINGSIGN$) THEN
' Add type if it is missing
IF NOT(HASDELIM(element$[x])) THEN element$[x] = "char* " & element$[x]
' Check if already declared
IF REGEX(TAIL$(element$[x], 1), g_C_KEYWORDS$) THEN
EPRINT NL$, "Syntax error: variable '", TAIL$(element$[x], 1), "' in SUB/FUNCTION statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' is a C keyword or function!"
END 1
ELIF NOT(LEN(Get_Var$(TAIL$(element$[x], 1), g_FUNCNAME$))) THEN
Save_Func_Var(TAIL$(element$[x], 1), g_FUNCNAME$, FIRST$(element$[x], 1))
ELSE
IF g_SEMANTIC = 0 THEN EPRINT NL$, "WARNING: variable '", TAIL$(element$[x], 1), "' in function header at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
ENDIF
arr$ = MID$(element$[x], INSTR(element$[x], " ")+1, INSTR(element$[x], "[") - INSTR(element$[x], " ")-1)
dim$ = MID$(element$[x], INSTR(element$[x], "[")+1, INSTR(element$[x], "]") - INSTR(element$[x], "[")-1)
IF NOT(INSTR(element$[x], g_STRINGSIGN$)) AND REGEX(element$[x], ".*\\[.*\\].*") THEN
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & "char *__b2c_" & arr$ & "[" & dim$ & "+" & STR$(g_OPTION_BASE) &"]"
g_STRINGARGS$ = g_STRINGARGS$ & " char** " & arr$ & " = __b2c_" & arr$ & ";"
g_PROTOTYPE$ = g_PROTOTYPE$ & " " & element$[x]
ELIF NOT(INSTR(element$[x], g_STRINGSIGN$)) THEN
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & HEAD$(element$[x], AMOUNT(element$[x])-1) & " __b2c_" & TAIL$(element$[x], 1)
g_STRINGARGS$ = g_STRINGARGS$ & HEAD$(element$[x], AMOUNT(element$[x])-1) & " " & TAIL$(element$[x], 1) & " = __b2c_" & TAIL$(element$[x], 1) & ";"
g_PROTOTYPE$ = g_PROTOTYPE$ & " " & element$[x]
ELIF REGEX(element$[x], ".*\\[.*\\].*") THEN
IF LEN(dim$) < 1 THEN
g_ORIGFUNCNAME$ = CHOP$(g_ORIGFUNCNAME$ & " " & element$[x])
g_PROTOTYPE$ = g_PROTOTYPE$ & " " & element$[x]
ELSE
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & "char *__b2c_" & arr$ & "[" & dim$ & "+" & STR$(g_OPTION_BASE) &"]"
g_STRINGARGS$ = g_STRINGARGS$ & "char *" & arr$ & "[" & dim$ & "+" & STR$(g_OPTION_BASE) & "] = { NULL };"
g_STRINGARGS$ = g_STRINGARGS$ & "for(__b2c__ctr=0; __b2c__ctr<" & dim$ & "+" & STR$(g_OPTION_BASE) & "; __b2c__ctr++){if(__b2c_" & arr$ & "[__b2c__ctr]!=NULL) " & arr$ & "[__b2c__ctr] = __b2c__strdup(__b2c_" & arr$ & "[__b2c__ctr]);}"
g_STRINGARRAYS$ = g_STRINGARRAYS$ & "for(__b2c__ctr=0; __b2c__ctr<" & dim$ & "+" & STR$(g_OPTION_BASE) & "; __b2c__ctr++) { __b2c__STRFREE(" & arr$ & "[__b2c__ctr]); }"
g_PROTOTYPE$=g_PROTOTYPE$ & "char *__b2c_" & CHOP$(MID$(element$[x], INSTR(element$[x], " ")))
END IF
ELSE
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & "char *__b2c_" & CHOP$(MID$(element$[x], INSTR(element$[x], " ")))
var$ = CHOP$(MID$(element$[x], INSTR(element$[x], " ")))
g_STRINGARGS$ = g_STRINGARGS$ & "char *" & var$ & " = NULL;" & var$ & " = __b2c_Copy_String(" & var$ & ", __b2c_" & var$ & ");"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & CHOP$(MID$(element$[x], INSTR(element$[x], " ")))
g_PROTOTYPE$ = g_PROTOTYPE$ & " " & element$[x]
END IF
ELSE
' Add type if it is missing
IF NOT(HASDELIM(element$[x])) AND NOT(REGEX(element$[x], "^DIR|^FILE|^short|^int|^long|^float|^double|^char|^void|^STRING|^NUMBER|^FLOATING")) THEN
element$[x] = IIF$(REGEX(element$[x], g_FLOATSIGN$ & "$"), "double ", g_VARTYPE$ & " ") & element$[x]
ENDIF
' Check if already declared
IF REGEX(TAIL$(element$[x], 1), g_C_KEYWORDS$) THEN
EPRINT NL$, "Syntax error: variable '", TAIL$(element$[x], 1), "' in SUB/FUNCTION statement at line ", g_COUNTER, " in file '", g_CURFILE$, "' is a C keyword or function!"
END 1
ELIF NOT(LEN(Get_Var$(TAIL$(element$[x], 1), g_FUNCNAME$))) THEN
Save_Func_Var(TAIL$(element$[x], 1), g_FUNCNAME$, FIRST$(element$[x], 1))
ELSE
IF g_SEMANTIC = 0 THEN EPRINT NL$, "WARNING: variable '", TAIL$(element$[x], 1), "' in function header at line ", g_COUNTER, " in file '", g_CURFILE$, "' was defined previously!"
ENDIF
IF REGEX(element$[x], ".*\\[.*\\].*\\].*") THEN
EPRINT NL$, "Syntax error: cannot pass multidimensional numeric array at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF REGEX(element$[x], ".*\\[\\].*") THEN
g_ORIGFUNCNAME$ = CHOP$(g_ORIGFUNCNAME$ & " " & element$[x])
ELIF REGEX(element$[x], ".*\\[.*\\].*") THEN
dim$ = MID$(element$[x], INSTR(element$[x], "[")+1, INSTR(element$[x], "]") - INSTR(element$[x], "[")-1)
arr$ = MID$(element$[x], INSTRREV(element$[x], " ")+1, INSTR(element$[x], "[") - INSTRREV(element$[x], " ")-1)
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & TOKEN$(element$[x], 1) & " __b2c_" & arr$ & "[" & dim$ & "+" & STR$(g_OPTION_BASE) & "]"
g_STRINGARGS$ = g_STRINGARGS$ & TOKEN$(element$[x], 1) & " " & arr$ & "[" & dim$ & "+" & STR$(g_OPTION_BASE) & "] = { 0 };"
g_STRINGARGS$ = g_STRINGARGS$ & "memmove(" & arr$ & ", __b2c_" & arr$ & ", (" & dim$ & "+" & STR$(g_OPTION_BASE) & ")*sizeof(" & TOKEN$(element$[x], 1) & "));"
ELSE
g_ORIGFUNCNAME$ = CHOP$(g_ORIGFUNCNAME$ & " " & element$[x])
END IF
g_PROTOTYPE$ = g_PROTOTYPE$ & " " & element$[x]
END IF
' Set separation
IF x < dim THEN
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & ","
g_PROTOTYPE$ = g_PROTOTYPE$ & ","
ELSE
g_ORIGFUNCNAME$ = g_ORIGFUNCNAME$ & ")"
g_PROTOTYPE$ = g_PROTOTYPE$ & ")"
ENDIF
NEXT
' Close the current C file
CLOSE FILE g_CFILE
' Make symbol known to parser
g_IMPORTED$ = g_FUNCNAME$ & " " & g_IMPORTED$
' Save CATCH routine
g_ORIGCATCHGOTO$ = g_CATCHGOTO$
g_ORIGCATCH_USED = g_CATCH_USED
g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT"
g_CATCH_USED = 0
g_STRINGARGS$ = g_STRINGARGS$ & " __b2c__catch_set_backup = __b2c__catch_set; __b2c__catch_set = 0;"
' Switch to header file
g_COPY_CFILE$ = g_CFILE$
g_COPY_COUNTER = g_COUNTER
g_CFILE$ = LEFT$(g_CFILE$, INSTR(g_CFILE$, ".c")) & g_FUNCNAME$ & ".tmp"
' Open temp C file
OPEN g_CFILE$ FOR WRITING AS g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Endsub()
LOCAL tmp_HFILE TYPE FILE*
LOCAL line$, element$, tfil$
' Check if we're in a SUB
IF NOT(LEN(g_FUNCNAME$)) THEN
EPRINT NL$, "Syntax error: ENDSUB outside SUB at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Close the current C file
CLOSE FILE g_CFILE
' Put prototype to header file
IF NOT(INSTR(g_PROTOTYPE$, "::")) THEN WRITELN "void ", g_PROTOTYPE$, ";" TO g_HFILE
g_PROTOTYPE$ = ""
' Open temporary header file
tfil$ = MID$(g_CURFILE$, INSTRREV(g_CURFILE$, "/") + 1)
OPEN g_TEMPDIR$ & "/" & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h" FOR WRITING AS tmp_HFILE
' Get original function name
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO tmp_HFILE
WRITELN "#undef __b2c__exitval" TO tmp_HFILE
WRITELN "#define __b2c__exitval" TO tmp_HFILE
IF INSTR(g_ORIGFUNCNAME$, " (") THEN
WRITELN "void ", g_ORIGFUNCNAME$, " {" TO tmp_HFILE
ELIF INSTR(g_ORIGFUNCNAME$, "(") THEN
WRITELN "void ", g_ORIGFUNCNAME$, " {" TO tmp_HFILE
ELSE
WRITELN "void ", g_FUNCNAME$, "(void) {" TO tmp_HFILE
END IF
' Finalize sub
WRITELN g_STRINGARGS$ TO tmp_HFILE
OPEN g_CFILE$ FOR READING AS g_CFILE
WHILE NOT(ENDFILE(g_CFILE)) DO
READLN line$ FROM g_CFILE
IF NOT(ENDFILE(g_CFILE)) THEN WRITELN line$ TO tmp_HFILE
WEND
CLOSE FILE g_CFILE
' Free strings variables if there are any
WRITELN g_STRINGARRAYS$ TO tmp_HFILE
FOR element$ IN g_LOCALSTRINGS$
IF LEN(element$) > 0 THEN WRITELN "__b2c__STRFREE(", element$, ");" TO tmp_HFILE
NEXT
IF g_CATCH_USED = 1 THEN WRITELN "__B2C__PROGRAM__EXIT: ;" TO tmp_HFILE
WRITELN "__b2c__catch_set = __b2c__catch_set_backup;" TO tmp_HFILE
WRITELN "}" TO tmp_HFILE
CLOSE FILE tmp_HFILE
' Include header file
IF NOT(INSTR(g_INCLUDE_FILES$, LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h")) THEN
g_INCLUDE_FILES$ = g_INCLUDE_FILES$ & " " & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h"
END IF
' Add to total filelist
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_TEMPDIR$ & "/" & LEFT$(tfil$, INSTR(tfil$, ".bac")) & g_FUNCNAME$ & ".h"
' Delete temp funcfile
DELETE FILE g_CFILE$
' Restore mainfile
g_CFILE$ = g_COPY_CFILE$
OPEN g_CFILE$ FOR APPENDING AS g_CFILE
' Restore CATCH routine
g_CATCHGOTO$ = g_ORIGCATCHGOTO$
g_CATCH_USED = g_ORIGCATCH_USED
' Reset variables
g_ORIGFUNCNAME$ = ""
g_FUNCNAME$ = ""
g_LOCALSTRINGS$ = ""
g_STRINGARRAYS$ = ""
g_STRINGARGS$ = ""
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Deffn(STRING arg$)
LOCAL var$, str$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty DEF FN at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "DEF FN *" TO match$
var$ = CHOP$(TOKEN$(match$[1], 1, "="))
str$ = CHOP$(LAST$(match$[1], 1, "="))
WRITELN "#define ", var$, " (", str$, ")" TO g_HFILE
' Needed in TOKENIZE to determine amount of intermediate strings
IF REGEX(TOKEN$(var$, 1, "("), g_STRINGSIGN$ & "$") THEN g_MACRO_STRINGS$(TOKEN$(var$, 1, "(")) = str$
' Make symbol known to parser
g_IMPORTED$ = TOKEN$(var$, 1, "(") & " " & g_IMPORTED$
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Const(STRING arg$)
LOCAL var$, str$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty CONST at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "CONST *" TO match$
var$ = CHOP$(TOKEN$(match$[1], 1, "="))
str$ = CHOP$(LAST$(match$[1], 1, "="))
WRITELN "#define ", var$, " (", str$, ")" TO g_HFILE
' Needed in TOKENIZE to determine amount of intermediate strings
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN g_MACRO_STRINGS$(var$) = str$
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Seek(STRING arg$)
LOCAL descriptor$, offset$, whence$
LOCAL total
' Check if OFFSET is available
IF NOT(ISTOKEN(arg$, "OFFSET")) THEN
EPRINT NL$, "Syntax error: missing OFFSET in SEEK statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "SEEK * OFFSET * WHENCE *" TO match$ SIZE total
descriptor$ = match$[1]
offset$ = match$[2]
whence$ = IIF$(total > 2, match$[3])
' Convert to C function
SELECT whence$
CASE "START"
WRITELN "fseek(", descriptor$, ", ", offset$, ", SEEK_SET);" TO g_CFILE
CASE "CURRENT"
WRITELN "fseek(", descriptor$, ", ", offset$, ", SEEK_CUR);" TO g_CFILE
CASE "END"
WRITELN "fseek(", descriptor$, ", ", offset$, ", SEEK_END);" TO g_CFILE
DEFAULT
WRITELN "fseek(", descriptor$, ", ", offset$, ", SEEK_SET);" TO g_CFILE
ENDSELECT
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Copy(STRING arg$)
LOCAL from$, to$, size$
LOCAL total
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in COPY statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "COPY * TO * SIZE *" TO match$ SIZE total
from$ = match$[1]
to$ = match$[2]
size$ = IIF$(total > 2, match$[3])
' Translate to C function
IF LEN(size$) = 0 THEN
WRITELN "if(__b2c__copy(", from$, ", ", to$, ")){ if(__b2c__trap){ ERROR = 2; if(!__b2c__catch_set) RUNTIMEERROR(\"COPY\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; } }" TO g_CFILE
ELSE
WRITELN "if (__b2c__trap){if(!__b2c__memory__check((char*)", to$, ", sizeof(__b2c__MEMTYPE)*", size$, ")) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"COPY\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF INSTR(from$, g_STRINGSIGN$) THEN
WRITELN "__b2c__free_str_array_members(&" & to$ & ", " & STR$(g_OPTION_BASE) & ", " & size$ & ");" TO g_CFILE
WRITELN "if(", from$, "[__b2c__ctr+", g_OPTION_BASE, "]!=NULL) ", to$, "[__b2c__ctr+", g_OPTION_BASE, "]=strdup(", from$, "[__b2c__ctr+", g_OPTION_BASE, "]);}" TO g_CFILE
ELSE
WRITELN "memmove((void*)", to$, ", (void*)", from$, ", sizeof(__b2c__MEMTYPE)*", size$, ");" TO g_CFILE
ENDIF
FI
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Rename(STRING arg$)
LOCAL from$, to$
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in RENAME statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the filename and copyname
PARSE COLLAPSE$(arg$) WITH "RENAME * TO * " TO match$
from$ = match$[1]
to$ = match$[2]
' Translate to C function
WRITELN "if(rename(", from$, ", ", to$, ") < 0) {if(__b2c__trap){ERROR = 9; if(!__b2c__catch_set) RUNTIMEERROR(\"RENAME\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Color(STRING arg$)
LOCAL bfg$, col$
LOCAL total
' Check syntax
PARSE COLLAPSE$(arg$) WITH "COLOR * TO *" TO match$ SIZE total
SELECT match$[1]
CASE "RESET"
WRITELN "fputs(\"\\033[0m\", stdout); fflush(stdout);" TO g_CFILE
CASE "INTENSE"
WRITELN "fputs(\"\\033[1m\", stdout); fflush(stdout);" TO g_CFILE
CASE "INVERSE"
WRITELN "fputs(\"\\033[7m\", stdout); fflush(stdout);" TO g_CFILE
CASE "NORMAL"
WRITELN "fputs(\"\\033[22m\", stdout); fflush(stdout);" TO g_CFILE
DEFAULT
IF total <= 1 THEN
EPRINT NL$, "Syntax error: missing TO in COLOR statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
SELECT match$[1]
CASE "FG"
bfg$ = "3"
CASE "BG"
bfg$ = "4"
DEFAULT
IF REGEX(match$[1], "0|1") THEN bfg$ = STR$(VAL(match$[1]) + 3)
ELSE bfg$ = match$[1]
END SELECT
IF ISTOKEN(match$[2], "INTENSE") THEN
WRITELN "fputs(\"\\033[1m\", stdout); fflush(stdout);" TO g_CFILE
match$[2] = DEL$(match$[2], ISTOKEN(match$[2], "INTENSE"))
ENDIF
IF ISTOKEN(match$[2], "NORMAL") THEN
WRITELN "fputs(\"\\033[22m\", stdout); fflush(stdout);" TO g_CFILE
match$[2] = DEL$(match$[2], ISTOKEN(match$[2], "NORMAL"))
ENDIF
SELECT match$[2]
CASE "BLACK"
col$ = "0"
CASE "RED"
col$ = "1"
CASE "GREEN"
col$ = "2"
CASE "YELLOW"
col$ = "3"
CASE "BLUE"
col$ = "4"
CASE "MAGENTA"
col$ = "5"
CASE "CYAN"
col$ = "6"
CASE "WHITE"
col$ = "7"
DEFAULT
col$ = match$[2]
END SELECT
WRITELN "fprintf(stdout,\"\\033[%ld%ldm\", (long)", bfg$, ", (long)", col$, "); fflush(stdout);" TO g_CFILE
ENDIF
ENDSELECT
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Handle_Type(STRING arg$)
LOCAL type$
LOCAL offset, cfg
' Check syntax
IF NOT(ISTOKEN(arg$, "SET")) AND NOT(ISTOKEN(arg$, "UNSET")) AND NOT(ISTOKEN(arg$, "RESET")) THEN
EPRINT NL$, "Syntax error: missing SET/UNSET/RESET in TYPE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Check action
IF ISTOKEN(arg$, "RESET") THEN
WRITELN "fputs(\"\\033[21m\\033[23m\\033[24m\\033[25m\\033[27m\\033[29m\", stdout); fflush(stdout);" TO g_CFILE
ELSE
IF ISTOKEN(arg$, "UNSET") THEN offset = 20
PARSE COLLAPSE$(arg$) WITH "TYPE " & IIF$(ISTOKEN(arg$, "SET"), "SET", "UNSET") & " *" TO match$
IF ISTOKEN(match$[1], "BOLD") THEN
cfg = 1 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF ISTOKEN(match$[1], "ITALIC") THEN
cfg = 3 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF ISTOKEN(match$[1], "UNDERLINE") THEN
cfg = 4 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF ISTOKEN(match$[1], "BLINK") THEN
cfg = 5 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF ISTOKEN(match$[1], "INVERSE") THEN
cfg = 7 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF ISTOKEN(match$[1], "STRIKE") THEN
cfg = 9 + offset
type$ = type$ & "\\033[" & STR$(cfg) & "m"
ENDIF
IF NOT(LEN(type$)) THEN
EPRINT NL$, "Syntax error: argument in TYPE statement not recognized at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
WRITELN "fputs(\"", type$, "\", stdout); fflush(stdout);" TO g_CFILE
ENDIF
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Handle_Gotoxy(STRING arg$)
LOCAL token$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty GOTOXY at at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Get the target and colorname
IF INSTR(arg$, ",") THEN
token$ = Mini_Parser$(arg$)
arg$ = MID$(arg$, LEN(token$)+2)
ELSE
EPRINT NL$, "Syntax error: missing coordinate in GOTOXY at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Translate to C
WRITELN "fprintf(stdout, \"\\033[%ld;%ldH\",(long)(", CHOP$(arg$), "), (long)(", CHOP$(token$), ")); fflush(stdout);" TO g_CFILE
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Split(STRING arg$)
LOCAL source$, by$, to$, size$
LOCAL use_static, total
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in SPLIT statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "STATIC") THEN
use_static = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "STATIC"))
ENDIF
IF ISTOKEN(arg$, "BY") THEN
PARSE COLLAPSE$(arg$) WITH "SPLIT * BY * TO * SIZE *" TO match$
by$ = match$[2]
arg$ = APPEND$(HEAD$(arg$, ISTOKEN(arg$, "BY")-1), 0, LAST$(arg$, ISTOKEN(arg$, "TO")-1))
ELSE
by$ = "__b2c__option_delim"
ENDIF
PARSE COLLAPSE$(arg$) WITH "SPLIT * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
to$ = match$[2]
size$ = IIF$(total > 2, match$[3])
' Check type of var, string?
IF Check_String_Type(to$) = 0 THEN
EPRINT NL$, "Syntax error: variable ", to$, " in SPLIT statement must be string at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Register numeric
IF LEN(size$) THEN Register_Numeric(size$, "default")
' Translate to C code
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF NOT(LEN(Get_Var$(to$, g_FUNCNAME$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
g_STRINGARGS$ = g_STRINGARGS$ & " char **" & to$ & " = NULL; long " & CHOP$(to$) & "__b2c_array = 0;"
Save_Func_Var(to$, g_FUNCNAME$, "char*")
Save_Func_Var(to$ & "__b2c_array", g_FUNCNAME$, "long")
END IF
ELSE
IF NOT(LEN(Get_Var$(to$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN "char **", to$, " = NULL; long ", CHOP$(to$), "__b2c_array = 0;" TO g_HFILE
Save_Main_Var(to$, "char*")
Save_Main_Var(to$ & "__b2c_array", "long")
END IF
END IF
' Run the SPLIT code
IF Check_String_Type(by$) OR by$ = "__b2c__option_delim" THEN
WRITELN "__b2c__split_by(&", to$, ", ", g_OPTION_BASE, ", &", to$, "__b2c_array, ", source$, ", ", by$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__split_with(&", to$, ", ", g_OPTION_BASE, ", &", to$, "__b2c_array, ", source$, ", ", by$, ");" TO g_CFILE
ENDIF
IF LEN(size$) THEN WRITELN size$, " = ", to$, "__b2c_array;" TO g_CFILE
' Add declared array to array list if we are in a function
IF ISTRUE(LEN(g_FUNCNAME$)) AND NOT(INSTR(g_STRINGARRAYS$, to$)) THEN
IF NOT(use_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & to$ & ", " & STR$(g_OPTION_BASE) & ", " & to$ & "__b2c_array);"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & to$
ENDIF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Join(STRING arg$)
LOCAL source$, by$, to$, size$, type$
LOCAL total
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in JOIN statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "BY") THEN
PARSE COLLAPSE$(arg$) WITH "JOIN * BY * TO * SIZE *" TO match$
by$ = match$[2]
arg$ = APPEND$(HEAD$(arg$, ISTOKEN(arg$, "BY")-1), 0, LAST$(arg$, ISTOKEN(arg$, "TO")-1))
ELSE
by$ = "__b2c_EMPTYSTRING"
ENDIF
PARSE COLLAPSE$(arg$) WITH "JOIN * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
to$ = match$[2]
size$ = IIF$(total > 2, match$[3])
' Determine sze if not provided
IF NOT(LEN(size$)) THEN
IF ISTOKEN(g_DYNAMICARRAYS$, source$ & "@" & g_FUNCNAME$) THEN
size$ = source$ & "__b2c_array"
ELSE
type$ = Get_Var$(source$, g_FUNCNAME$)
size$ = "(sizeof(" & source$ & ")/sizeof(" & type$ & ")-" & STR$(g_OPTION_BASE) & ")"
ENDIF
ENDIF
' Check type of var, string?
IF Check_String_Type(to$) = 0 THEN
EPRINT NL$, "Syntax error: variable ", to$, " in JOIN statement must be string at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF REGEX(to$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(to$, "char*")
END IF
ENDIF
' Translate function to C function
WRITELN "__b2c__join(&__b2c__assign, ", source$, ", ", g_OPTION_BASE, ", ", size$, ", ", by$, ");" TO g_CFILE
Assign_To_String("__b2c__assign", to$, NULL)
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Sort(STRING arg$)
LOCAL source$, size$, type$, down$
LOCAL total
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty SORT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "DOWN") THEN
down$ = "_down"
arg$ = DEL$(arg$, ISTOKEN(arg$, "DOWN"))
ENDIF
PARSE COLLAPSE$(arg$) WITH "SORT * SIZE *" TO match$ SIZE total
source$ = match$[1]
size$ = IIF$(total > 2, match$[2])
' Determine data type
type$ = Get_Var$("__b2c__assoc_" & source$, g_FUNCNAME$)
IF LEN(type$) THEN
IF REGEX(type$, "char\\*|STRING") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 0, __b2c__sortstr", down$, ");" TO g_CFILE
ELIF REGEX(type$, "double|FLOATING") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 1, __b2c__sortnrd_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "float") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 2, __b2c__sortnrf_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "long|NUMBER") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 3, __b2c__sortnrl_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "int") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 4, __b2c__sortnri_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "short") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 5, __b2c__sortnrs_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "char") THEN
WRITELN "__b2c__assoc_sort(&__b2c__assoc_", source$, ", 6, __b2c__sortnrc_wrap", down$, ");" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: unsupported associative array type in SORT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELSE
type$ = Get_Var$(source$, g_FUNCNAME$)
IF LEN(type$) THEN
IF LEN(size$) = 0 THEN
IF ISTOKEN(g_DYNAMICARRAYS$, source$ & "@" & g_FUNCNAME$) THEN
size$ = source$ & "__b2c_array"
ELSE
size$ = "(sizeof(" & source$ & ")/sizeof(" & type$ & ")-" & STR$(g_OPTION_BASE) & ")"
ENDIF
ENDIF
ELSE
EPRINT NL$, "Syntax error: unknown array '", source$, "' in SORT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Check DIM size
WRITELN "if((", size$, "-", g_OPTION_BASE, ") < 0) {if(__b2c__trap){ERROR=36; if(!__b2c__catch_set) RUNTIMEERROR(\"SORT\",", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
' Determine type
IF REGEX(source$, g_STRINGSIGN$ & "$") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(char*), __b2c__sortstr", down$, ");" TO g_CFILE
ELIF INSTR(type$, "double") OR INSTR(type$, "FLOATING") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(double), __b2c__sortnrd", down$, ");" TO g_CFILE
ELIF INSTR(type$, "float") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(float), __b2c__sortnrf", down$, ");" TO g_CFILE
ELIF INSTR(type$, "long") OR INSTR(type$, "NUMBER") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(long), __b2c__sortnrl", down$, ");" TO g_CFILE
ELIF INSTR(type$, "int") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(int), __b2c__sortnri", down$, ");" TO g_CFILE
ELIF INSTR(type$, "short") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(short), __b2c__sortnrs", down$, ");" TO g_CFILE
ELIF INSTR(type$, "short") THEN
WRITELN "qsort(&", source$, "[", g_OPTION_BASE, "], ", size$, ", sizeof(char), __b2c__sortnrc", down$, ");" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: unsupported array type in SORT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Alias(STRING arg$)
LOCAL var$, to$
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in ALIAS statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "ALIAS * TO *" TO match$
var$ = match$[1]
to$ = match$[2]
' Translate to C
WRITELN "#define ", EXTRACT$(to$, CHR$(34)), " ", EXTRACT$(var$, CHR$(34)) TO g_HFILE
g_IMPORTED$ = to$ & " " & g_IMPORTED$
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Lookup(STRING arg$)
LOCAL source$, to$, size$, sort$, down$, type$
LOCAL total, use_sort, use_static
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in LOOKUP statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF MATCH(COLLAPSE$(arg$), "* SORT *") THEN
use_sort = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "SORT"))
ENDIF
IF ISTOKEN(arg$, "DOWN") THEN
down$ = "_down"
arg$ = DEL$(arg$, ISTOKEN(arg$, "DOWN"))
ENDIF
IF ISTOKEN(arg$, "STATIC") THEN
use_static = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "STATIC"))
ENDIF
PARSE COLLAPSE$(arg$) WITH "LOOKUP * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
to$ = match$[2]
size$ = IIF$(total > 2, match$[3])
' Check type of var, string?
IF Check_String_Type(to$) = 0 THEN
EPRINT NL$, "Syntax error: variable ", to$, " in LOOKUP statement must be string at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Register numeric var
IF LEN(size$) THEN Register_Numeric(size$, "default")
' Translate to C code
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF NOT(LEN(Get_Var$(to$, g_FUNCNAME$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
g_STRINGARGS$ = g_STRINGARGS$ & " char **" & to$ & " = { NULL }; long " & to$ & "__b2c_array = 0;"
Save_Func_Var(to$, g_FUNCNAME$, "char*")
Save_Func_Var(to$ & "__b2c_array", g_FUNCNAME$, "long")
END IF
ELSE
IF NOT(LEN(Get_Var$(to$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN "char **", to$, " = { NULL }; long ", to$, "__b2c_array = 0;" TO g_HFILE
Save_Main_Var(to$, "char*")
Save_Main_Var(to$ & "__b2c_array", "long")
END IF
END IF
' Run the LOOKUP code
IF NOT(use_sort) THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_order(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ");" TO g_CFILE
ELSE
type$ = Get_Var$("__b2c__assoc_" & source$, g_FUNCNAME$)
IF REGEX(type$, "char\\*|STRING") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 0, __b2c__sortstr", down$, ");" TO g_CFILE
ELIF REGEX(type$, "double|FLOATING") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 1, __b2c__sortnrd_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "float") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 2, __b2c__sortnrf_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "long|NUMBER") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 3, __b2c__sortnrl_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "int") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 4, __b2c__sortnri_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "short") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 5, __b2c__sortnrs_wrap", down$, ");" TO g_CFILE
ELIF REGEX(type$, "char") THEN
WRITELN to$, "__b2c_array = __b2c__lookup_by_sort(__b2c__assoc_", source$, ", &", to$, ", ", to$, "__b2c_array, ", g_OPTION_BASE, ", 6, __b2c__sortnrc_wrap", down$, ");" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: unsupported array type in LOOKUP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ENDIF
IF LEN(size$) THEN WRITELN size$, " = ", to$, "__b2c_array;" TO g_CFILE
' Add declared array to array list if we are in a function
IF ISTRUE(LEN(g_FUNCNAME$)) AND NOT(INSTR(g_STRINGARRAYS$, to$ & "__b2c_array")) THEN
IF NOT(use_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & to$ & ", " & STR$(g_OPTION_BASE) & ", " & to$ & "__b2c_array);"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & to$
ENDIF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Relate(STRING arg$)
LOCAL source$, to$, str$
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in RELATE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
to$ = LAST$(arg$, ISTOKEN(arg$, "TO"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "TO")-1)
source$ = CHOP$(arg$)
' Check if declared as ASSOC
IF NOT(LEN(Get_Var$("__b2c__assoc_" & source$))) AND NOT(LEN(Get_Var$("__b2c__assoc_" & source$, g_FUNCNAME$))) THEN
EPRINT NL$, "Syntax error: variable '", source$, "' not declared as ASSOC in RELATE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Assign relations
FOR str$ IN EXTRACT$(to$, " ") STEP ","
IF NOT(LEN(Get_Var$("__b2c__assoc_" & str$))) AND NOT(LEN(Get_Var$("__b2c__assoc_" & str$, g_FUNCNAME$))) THEN
EPRINT NL$, "Syntax error: variable '", str$, "' not declared as ASSOC in RELATE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
g_RELATE$[g_RELATE_CTR] = source$ & " " & str$
INCR g_RELATE_CTR
NEXT
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Data(STRING arg$)
LOCAL token$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty DATA at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Start miniparser
WHILE LEN(arg$)
token$ = Mini_Parser$(arg$)
IF INSTR(token$, CHR$(34)) THEN
WRITELN CHOP$(token$), ", "; TO STRINGARRAYFILE
INCR g_CCTR
ELSE
WRITELN CHOP$(token$), ", "; TO FLOATARRAYFILE
INCR g_FCTR
END IF
arg$ = MID$(arg$, LEN(token$)+2)
WEND
' Align properly
IF INSTR(token$, CHR$(34)) THEN
WRITELN "" TO STRINGARRAYFILE
ELSE
WRITELN "" TO FLOATARRAYFILE
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Redim(STRING arg$)
LOCAL type$, var$, to$
' Check if TO is available
IF NOT(INSTR(arg$, " TO ")) THEN
EPRINT NL$, "Syntax error: missing TO in REDIM statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the source string
var$ = CHOP$(LEFT$(arg$, INSTR(arg$, " TO ") - 1))
to$ = CHOP$(MID$(arg$, INSTR(arg$, " TO ") + 4))
type$ = CHOP$(Get_Var$(var$, g_FUNCNAME$))
IF NOT(LEN(type$)) AND NOT(Check_String_Type(var$)) THEN
EPRINT NL$, "Syntax error: cannot REDIM array which is not declared previously at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Delete old data from strings if new size is smaller
IF Check_String_Type(var$) THEN
WRITELN "if(", to$, "<", var$, "__b2c_array) {for(__b2c__ctr=", to$, "; __b2c__ctr<", var$, "__b2c_array; __b2c__ctr++) {__b2c__STRFREE(", var$, "[__b2c__ctr+", g_OPTION_BASE, "]);} }" TO g_CFILE
type$ = "char*"
END IF
' Realloc
WRITELN var$, " = (", type$, "*)realloc(", var$, ", (", to$, "+", g_OPTION_BASE, ")*sizeof(", type$, "));" TO g_CFILE
' Re-initialize records if new area is bigger
IF REGEX(type$, "_type$") OR REGEX(type$, "_TYPE$") THEN
WRITELN "if(__b2c_record_", MID$(var$, INSTR(var$, ".")+1), " < ", to$, ") { for(__b2c__ctr=__b2c_record_", MID$(var$, INSTR(var$, ".")+1), "+", g_OPTION_BASE, "; __b2c__ctr<", to$, "+", g_OPTION_BASE, "; __b2c__ctr++) memset(&", var$, "[__b2c__ctr], 0, sizeof(", type$, "));}" TO g_CFILE
WRITELN "__b2c_record_", MID$(var$, INSTR(var$, ".")+1), " = ", to$, ";" TO g_CFILE
ELSE
' Re-initialize strings if new area is bigger
IF Check_String_Type(var$) THEN
WRITELN "if(", to$, ">", var$, "__b2c_array) {for(__b2c__ctr=", var$, "__b2c_array; __b2c__ctr<", to$, "; __b2c__ctr++) ", var$, "[__b2c__ctr+", g_OPTION_BASE, "] = (char*)calloc(1, sizeof(char));}" TO g_CFILE
END IF
WRITELN var$, "__b2c_array = ", to$, ";" TO g_CFILE
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Swap(STRING arg$)
LOCAL var$, to$, type$, tmp$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty SWAP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Get the source string
var$ = CHOP$(LEFT$(arg$, INSTR(arg$, ",") - 1))
to$ = CHOP$(MID$(arg$, INSTR(arg$, ",") + 1))
' Perform universal swap
IF Check_String_Type(var$) AND NOT(Check_String_Type(to$)) THEN
WRITELN "__b2c__assign = calloc(", g_MAX_DIGITS, "+1, sizeof(char)); if (floor(", to$, ") == ", to$, ") { __b2c__ctr = snprintf(__b2c__assign, ", g_MAX_DIGITS, ", \"%ld\", (long) ", to$, "); }" TO g_CFILE
WRITELN "else { __b2c__ctr = snprintf (__b2c__assign, ", g_MAX_DIGITS, ", \"%g\", (double) ", to$, "); } ", to$, " = VAL(", var$, "); __b2c__STRFREE(", var$, "); ", var$, " = __b2c__assign;" TO g_CFILE
ELIF NOT(Check_String_Type(var$)) AND Check_String_Type(to$) THEN
WRITELN "__b2c__assign = calloc(", g_MAX_DIGITS, "+1, sizeof(char)); if (floor(", var$, ") == ", var$, ") { __b2c__ctr = snprintf(__b2c__assign, ", g_MAX_DIGITS, ", \"%ld\", (long) ", var$, "); }" TO g_CFILE
WRITELN "else { __b2c__ctr = snprintf (__b2c__assign, ", g_MAX_DIGITS, ", \"%g\", (double) ", var$, "); } ", var$, " = VAL(", to$, "); __b2c__STRFREE(", to$, "); ", to$, " = __b2c__assign;" TO g_CFILE
ELSE
' Determine type
IF Check_String_Type(var$) THEN
type$ = "char *"
ELSE
type$ = Get_Var$(var$, g_FUNCNAME$)
IF LEN(type$) = 0 THEN
EPRINT NL$, "Syntax error: cannot determine type of variables in SWAP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Leave one dimension out to exchange array variables
type$ = LEFT$(type$, INSTR(type$, "*")-1)
END IF
' Get rid of array syntax
tmp$ = IIF$(INSTR(var$, "["), LEFT$(var$, INSTR(var$, "[")-1), var$)
' Declare temp variable
IF LEN(g_FUNCNAME$) > 0 THEN
IF NOT(LEN(Get_Var$("__b2c__" & tmp$ & "_swap", g_FUNCNAME$))) THEN
g_STRINGARGS$ = g_STRINGARGS$ & " " & type$ & " __b2c__" & tmp$ & "_swap;"
Save_Func_Var("__b2c__" & tmp$ & "_swap", g_FUNCNAME$, type$)
ENDIF
ELSE
IF NOT(LEN(Get_Var$("__b2c__" & tmp$ & "_swap"))) THEN
WRITELN type$, " __b2c__", tmp$, "_swap;" TO g_HFILE
Save_Main_Var("__b2c__" & tmp$ & "_swap", type$)
ENDIF
ENDIF
WRITELN "__b2c__", tmp$, "_swap = ", var$, "; ", var$, " = ", to$, "; ", to$, " = __b2c__", tmp$, "_swap;" TO g_CFILE
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Setserial(STRING arg$)
LOCAL desc$, value$, param$ = "0", not$ = "0"
LOCAL which
' Check if a mode is available
IF NOT(REGEX(arg$, " IMODE | OMODE | CMODE | LMODE | OTHER | SPEED ")) THEN
EPRINT NL$, "Syntax error: no mode specified in SETSERIAL statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
desc$ = LEFT$(arg$, INSTR(arg$, " "))
' Get the setting
IF INSTR(arg$, " OTHER ") THEN
value$ = MID$(arg$, INSTRREV(arg$, "OTHER ")+6)
ELIF INSTR(arg$, " SPEED ") THEN
value$ = MID$(arg$, INSTRREV(arg$, "SPEED ")+6)
ELSE
value$ = MID$(arg$, INSTRREV(arg$, "MODE ")+5)
ENDIF
IF INSTR(arg$, "IMODE") THEN
which = 0
ELIF INSTR(arg$, "OMODE") THEN
which = 1
ELIF INSTR(arg$, "CMODE") THEN
which = 2
ELIF INSTR(arg$, "LMODE") THEN
which = 3
ELIF INSTR(arg$, "OTHER") THEN
which = 4
param$ = TOKEN$(value$, 1, "=")
value$ = TOKEN$(value$, 2, "=")
ELIF INSTR(arg$, "SPEED") THEN
which = 5
END IF
IF INSTR(value$, "~") THEN not$ = "1"
WRITELN "ERROR = __b2c_setserial(", desc$, ", ", which, ", ", param$, ", ", value$, ", ", not$, ");" TO g_CFILE
WRITELN "if(ERROR && __b2c__trap){ if(!__b2c__catch_set) RUNTIMEERROR(\"SETSERIAL\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Call(STRING arg$)
LOCAL var$, lft$, str$
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty CALL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
' Make sure to set function syntax
IF NOT(REGEX(TOKEN$(arg$, 1, " TO "), "\\(.*\\)")) THEN
IF INSTR(arg$, " TO ") THEN
arg$ = TOKEN$(arg$, 1, " TO ") & "() TO " & TOKEN$(arg$, 2, " TO ")
ELSE
arg$ = arg$ & "()"
ENDIF
ENDIF
' Just call, no assignment
IF NOT(INSTR(arg$, " TO ")) THEN
WRITELN arg$, ";" TO g_CFILE
ELSE
var$ = CHOP$(TOKEN$(arg$, 2, " TO "))
' Check if var is string var
IF REGEX(var$, g_STRINGSIGN$ & "$") THEN
Register_Pointer(var$, "char*")
' Assume number, exclude RECORD elements
ELSE
Register_Numeric(var$, "default")
END IF
' Check type of var, string?
IF Check_String_Type(var$) THEN
WRITELN "__b2c__assign = (char*)__b2c__strdup(", TOKEN$(arg$, 1, " TO "), ");" TO g_CFILE
WRITELN "if(__b2c__assign == NULL) { __b2c__assign = (char*)calloc(1, sizeof(char)); }" TO g_CFILE
Assign_To_String("__b2c__assign", var$, NULL)
ELSE
Assign_To_Number(TOKEN$(arg$, 1, " TO "), var$, 0)
END IF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Run(STRING arg$)
' Check if we have an argument at all
IF AMOUNT(arg$) = 1 THEN
EPRINT NL$, "Syntax error: empty RUN at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
arg$ = LAST$(arg$, 1)
IF TALLY(arg$, CHR$(34)) THEN
arg$ = EXTRACT$(arg$, CHR$(34))
WRITELN "execlp(", CHR$(34), TOKEN$(arg$, 1), CHR$(34), ",", CHR$(34), arg$, CHR$(34), ", NULL); fflush(stdout);" TO g_CFILE
ELSE
WRITELN "execlp(", arg$, ",", arg$, ", NULL); fflush(stdout);" TO g_CFILE
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Save(type, arg$)
LOCAL var$, to$, size$
' Check syntax
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: SAVE/BSAVE/APPEND/BAPPEND without TO at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Get the arguments
IF ISTOKEN(arg$, "SIZE") THEN
size$ = LAST$(arg$, ISTOKEN(arg$, "SIZE"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "SIZE")-1)
ELSE
size$ = "0"
ENDIF
to$ = LAST$(arg$, ISTOKEN(arg$, "TO"))
arg$ = HEAD$(arg$, ISTOKEN(arg$, "TO")-1)
var$ = CHOP$(arg$)
' How to open the file
WRITELN "ERROR = __b2c__save(", type, ", ", size$, ", ", to$, ", ", var$, ", NULL);" TO g_CFILE
WRITELN "if(ERROR && __b2c__trap) { if(!__b2c__catch_set) RUNTIMEERROR(\"SAVE/BSAVE/APPEND/BAPPEND\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, "; }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Map(STRING arg$)
LOCAL source$, by$, to$, size$, type$, i$
LOCAL use_static, total
' Check if BY is available
IF NOT(ISTOKEN(arg$, "BY")) THEN
EPRINT NL$, "Syntax error: missing BY in MAP statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in MAP statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "STATIC") THEN
use_static = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "STATIC"))
ENDIF
PARSE COLLAPSE$(arg$) WITH "MAP * BY * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
by$ = match$[2]
to$ = match$[3]
size$ = IIF$(total > 3, match$[4])
' Determine sze if not provided
IF NOT(LEN(size$)) THEN
IF ISTOKEN(g_DYNAMICARRAYS$, CHOP$(TOKEN$(source$, 1, ",")) & "@" & g_FUNCNAME$) THEN
size$ = CHOP$(TOKEN$(source$, 1, ",")) & "__b2c_array"
ELSE
type$ = Get_Var$(CHOP$(TOKEN$(source$, 1, ",")), g_FUNCNAME$)
size$ = "(sizeof(" & CHOP$(TOKEN$(source$, 1, ",")) & ")/sizeof(" & type$ & ")-" & STR$(g_OPTION_BASE) & ")"
ENDIF
ENDIF
' Remove doublequotes from BY
by$ = EXTRACT$(by$, CHR$(34))
' Make sure to get the type right
type$ = "long"
IF Check_String_Type(by$) THEN
type$ = "char*"
ELSE
FOR i$ IN source$
IF REGEX(Get_Var$(i$, g_FUNCNAME$), ".*double.*|.*FLOATING.*") THEN
type$ = "double"
BREAK
ENDIF
NEXT
ENDIF
' Declare target array
IF NOT(LEN(Get_Var$(to$, g_FUNCNAME$))) THEN
IF g_OPTION_EXPLICIT$ = "1" OR g_OPTION_EXPLICIT$ = "TRUE" THEN
EPRINT NL$, "Syntax error: OPTION EXPLICIT forces explicit variable declaration at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN type$ , "* ", to$, "; long ", to$, "__b2c_array;" TO g_CFILE
Save_Func_Var(to$, g_FUNCNAME$, type$ & "*")
Save_Func_Var(to$ & "__b2c_array", g_FUNCNAME$, "long")
ELSE
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN type$ , "* ", to$, "; long ", to$, "__b2c_array;" TO g_HFILE
Save_Main_Var(to$, type$ & "*")
Save_Main_Var(to$ & "__b2c_array", "long")
END IF
WRITELN to$, " = (", type$, "*)calloc((size_t)(", size$, "+", g_OPTION_BASE, "), sizeof(", type$, "));" TO g_CFILE
WRITELN to$, "__b2c_array = ", size$, ";" TO g_CFILE
' Cleanup local array members
IF use_static = 0 THEN
IF type$ = "char*" THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & to$ & ", " & STR$(g_OPTION_BASE) & ", " & size$ & ");"
ENDIF
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & to$
ENDIF
END IF
' Create the C code
WRITELN "for(__b2c__ctr=", g_OPTION_BASE, "; __b2c__ctr<", size$, "+", g_OPTION_BASE, "; __b2c__ctr++){" TO g_CFILE
IF type$ = "char*" THEN
WRITELN to$, "[__b2c__ctr] = __b2c_Copy_String(", to$, "[__b2c__ctr], ", by$, "(", REPLACE$(source$, ",", "[__b2c__ctr],"), "[__b2c__ctr])); }" TO g_CFILE
ELSE
WRITELN to$, "[__b2c__ctr] = ", by$, "(", REPLACE$(source$, ",", "[__b2c__ctr],"), "[__b2c__ctr]); }" TO g_CFILE
ENDIF
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Handle_Tree(STRING arg$)
LOCAL tree$, node$, type$, func$
LOCAL total
' Check if NODE is available
IF NOT(ISTOKEN(arg$, "NODE")) THEN
EPRINT NL$, "Syntax error: missing NODE in TREE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
PARSE COLLAPSE$(arg$) WITH "TREE * NODE * TYPE *" TO match$ SIZE total
tree$ = match$[1]
node$ = match$[2]
type$ = IIF$(total > 2, match$[3])
func$ = Get_Var$("__b2c__tree_" & tree$, g_FUNCNAME$)
IF LEN(type$) THEN
WRITELN "__b2c__treenr((void*)__b2c__MEMDUP(sizeof(", type$, "), ", node$, "), &", tree$, ", ", func$, ");" TO g_CFILE
ELSE
IF func$ = "__b2c__sortnrd" THEN
type$ = "double"
ELIF func$ = "__b2c__sortnrf" THEN
type$ = "float"
ELIF func$ = "__b2c__sortnrl" THEN
type$ = "long"
ELIF func$ = "__b2c__sortnri" THEN
type$ = "int"
ELIF func$ = "__b2c__sortnrs" THEN
type$ = "short"
ELIF func$ = "__b2c__sortnrc" THEN
type$ = "char"
ENDIF
IF func$ = "__b2c__sortstr" THEN
WRITELN "__b2c__assign = __b2c__strdup(", node$, "); __b2c__treestr((void*)__b2c__MEMDUP(sizeof(char*), __b2c__assign), __b2c__assign, &", tree$, ", ", func$, ");" TO g_CFILE
ELSE
WRITELN "__b2c__assign = (char*)", node$, "; __b2c__treenr((void*)__b2c__MEMDUP(sizeof(", type$, "), __b2c__assign), &", tree$, ", ", func$, ");" TO g_CFILE
ENDIF
ENDIF
END SUB
'----------------------------------------------------------------------------------------------
SUB Handle_Collect(STRING arg$)
LOCAL source$, to$, size$, sort$, type$
LOCAL total, use_static
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in COLLECT statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Get the arguments
IF ISTOKEN(arg$, "STATIC") THEN
use_static = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "STATIC"))
ENDIF
PARSE COLLAPSE$(arg$) WITH "COLLECT * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
to$ = match$[2]
size$ = IIF$(total > 2, match$[3])
' Register numeric var
IF LEN(size$) THEN Register_Numeric(size$, "default")
' Translate to C code
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF NOT(LEN(Get_Var$(to$, g_FUNCNAME$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
g_STRINGARGS$ = g_STRINGARGS$ & " void **" & to$ & " = { NULL }; long " & to$ & "__b2c_array = " & STR$(g_OPTION_BASE) & ";"
Save_Func_Var(to$, g_FUNCNAME$, "void*")
Save_Func_Var(to$ & "__b2c_array", g_FUNCNAME$, "long")
END IF
ELSE
IF NOT(LEN(Get_Var$(to$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN "void **", to$, " = { NULL }; long ", to$, "__b2c_array = ", g_OPTION_BASE, ";" TO g_HFILE
Save_Main_Var(to$, "void*")
Save_Main_Var(to$ & "__b2c_array", "long")
END IF
END IF
' Run the COLLECT code
WRITELN to$, "__b2c_array = __b2c__collect(", source$, ", &", to$, ", ", g_OPTION_BASE, ");" TO g_CFILE
IF LEN(size$) THEN WRITELN size$, " = ", to$, "__b2c_array;" TO g_CFILE
' Add declared array to array list if we are in a function
IF ISTRUE(LEN(g_FUNCNAME$)) AND NOT(INSTR(g_STRINGARRAYS$, to$ & "__b2c_array")) THEN
IF NOT(use_static) THEN
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & to$
ENDIF
END IF
ENDSUB
'----------------------------------------------------------------------------------------------
SUB Handle_Parse(STRING arg$)
LOCAL source$, to$, with$, size$, by$ = "__b2c__option_delim"
LOCAL use_static, total
' Check if TO is available
IF NOT(ISTOKEN(arg$, "WITH")) THEN
EPRINT NL$, "Syntax error: missing WITH in PARSE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Check if TO is available
IF NOT(ISTOKEN(arg$, "TO")) THEN
EPRINT NL$, "Syntax error: missing TO in PARSE statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Get the arguments
IF ISTOKEN(arg$, "STATIC") THEN
use_static = 1
arg$ = DEL$(arg$, ISTOKEN(arg$, "STATIC"))
ENDIF
IF ISTOKEN(arg$, "BY") THEN
PARSE COLLAPSE$(arg$) WITH "PARSE * WITH * BY * TO * SIZE *" TO match$
by$ = match$[3]
arg$ = APPEND$(HEAD$(arg$, ISTOKEN(arg$, "BY")-1), 0, LAST$(arg$, ISTOKEN(arg$, "TO")-1))
ENDIF
PARSE COLLAPSE$(arg$) WITH "PARSE * WITH * TO * SIZE *" TO match$ SIZE total
source$ = match$[1]
with$ = match$[2]
to$ = match$[3]
size$ = IIF$(total > 3, match$[4])
' Check type of var, string?
IF Check_String_Type(to$) = 0 THEN
EPRINT NL$, "Syntax error: variable ", to$, " in PARSE statement must be string at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Register numeric
IF LEN(size$) THEN Register_Numeric(size$, "default")
' Translate to C code
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
IF NOT(LEN(Get_Var$(to$, g_FUNCNAME$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
g_STRINGARGS$ = g_STRINGARGS$ & " char **" & to$ & " = NULL; long " & CHOP$(to$) & "__b2c_array = 0;"
Save_Func_Var(to$, g_FUNCNAME$, "char*")
Save_Func_Var(to$ & "__b2c_array", g_FUNCNAME$, "long")
END IF
ELSE
IF NOT(LEN(Get_Var$(to$))) THEN
g_DYNAMICARRAYS$ = APPEND$(g_DYNAMICARRAYS$, 0, to$ & "@" & g_FUNCNAME$)
WRITELN "char **", to$, " = NULL; long ", CHOP$(to$), "__b2c_array = 0;" TO g_HFILE
Save_Main_Var(to$, "char*")
Save_Main_Var(to$ & "__b2c_array", "long")
END IF
END IF
' Run the PARSE code
WRITELN "__b2c__parse(&", to$, ", ", g_OPTION_BASE, ", &", to$, "__b2c_array, ", source$, ", ", with$, ",", by$, ");" TO g_CFILE
IF LEN(size$) THEN WRITELN size$, " = ", to$, "__b2c_array;" TO g_CFILE
' Add declared array to array list if we are in a function
IF ISTRUE(LEN(g_FUNCNAME$)) AND NOT(INSTR(g_STRINGARRAYS$, to$)) THEN
IF NOT(use_static) THEN
g_STRINGARRAYS$ = g_STRINGARRAYS$ & " __b2c__free_str_array_members(&" & to$ & ", " & STR$(g_OPTION_BASE) & ", " & to$ & "__b2c_array);"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & to$
ENDIF
END IF
END SUB
'----------------------------------------------------------------------------------------------
SUB guiGenerate(data$)
LOCAL widget$, type$, name$, parent$, callback$, uid$, resource$, icon$, map$, func$, prop$, arg$
LOCAL gui TYPE FILE*
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".gui.h"
OPEN g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".gui.h" FOR WRITING AS gui
IF g_WHICH_GUI = 2 THEN
WRITELN "void* __b2c__cld = NULL; struct __b2c__cdk{ void *addr; char *name; }; struct __b2c__cdk *__b2c__cdknames = { NULL }; int __b2c__cdknr = 0;" TO gui
WRITELN "void *__b2c_get_by_name(uintptr_t id, char *name) { void *result = NULL; int x; for(x=0; x<__b2c__cdknr; x++){ if(!strcmp(name, __b2c__cdknames[x].name)) { result = __b2c__cdknames[x].addr; break; } } return(result); }" TO gui
WRITELN "static int __b2c_cdk_callback(EObjectType cdktype GCC_UNUSED, void *object, void *clientData, chtype key GCC_UNUSED) { __b2c__cld = clientData; return(TRUE); }" TO gui
WRITELN "char *__b2c__guiExecute(uintptr_t id, int type) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned long len; int key; boolean function; CDKOBJS *obj; CDKSCREEN *screen; screen = (CDKSCREEN*)id; __b2c__cld = NULL; refreshCDKScreen(screen);" TO gui
WRITELN "while(__b2c__cld == NULL) { obj = getCDKFocusCurrent(screen); if(obj != NULL) { key = getchCDKObject(obj, &function); traverseCDKOnce(screen, obj, key, function, NULL); } } len = strlen((char *) __b2c__cld); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO gui
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); memmove(buf[idx], __b2c__cld, len); __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO gui
WRITELN "uintptr_t __b2c__guiDefine(void){ atexit(endCDK);" TO gui
ELIF g_WHICH_GUI = 1 OR g_WHICH_GUI = 3 THEN
WRITELN "gpointer __b2c__cld = NULL; gpointer __b2c__cad = NULL;" TO gui
WRITELN "GtkWidget *__b2c_get_by_name(uintptr_t id, char *name) { GList *widget, *x; widget = (GList*)id; for(x = widget; x != NULL; x = x->next) { if(!strcmp(name, gtk_widget_get_name(GTK_WIDGET(x->data)))) { break; } } if(x==NULL) { return(NULL); } else { return(x->data); } }" TO gui
WRITELN "void __b2c_gtk_callback(gpointer client_data, uintptr_t call_data, GtkWidget *w) { size_t size; __b2c__cld = client_data;" TO gui
WRITELN "if(call_data) {if( (sizeof(call_data)>sizeof(gint) ? call_data>>(sizeof(gint)*8) : 0) == 0 && (gint)call_data < 0 && (gint)call_data > -16) { __b2c__cad = realloc(__b2c__cad, sizeof(gint)); (*(gint*)__b2c__cad) = (gint)call_data; } else" TO gui
IF g_WHICH_GUI = 1 THEN
WRITELN "{ switch(((GdkEventAny*)call_data)->type) { case GDK_BUTTON_PRESS: size = sizeof(GdkEventButton); break; case GDK_2BUTTON_PRESS: size = sizeof(GdkEventButton); break; case GDK_3BUTTON_PRESS: size = sizeof(GdkEventButton); break;" TO gui
WRITELN "case GDK_BUTTON_RELEASE: size = sizeof(GdkEventButton); break; case GDK_EXPOSE: size = sizeof(GdkEventExpose); break; case GDK_DAMAGE: size = sizeof(GdkEventExpose); break; case GDK_ENTER_NOTIFY: size = sizeof(GdkEventCrossing); break;" TO gui
WRITELN "case GDK_LEAVE_NOTIFY: size = sizeof(GdkEventCrossing); break; case GDK_FOCUS_CHANGE: size = sizeof(GdkEventFocus); break; case GDK_CONFIGURE: size = sizeof(GdkEventConfigure); break; case GDK_PROPERTY_NOTIFY: size = sizeof(GdkEventProperty); break;" TO gui
WRITELN "case GDK_SCROLL: size = sizeof(GdkEventScroll); break; case GDK_KEY_PRESS: size = sizeof(GdkEventKey); break; case GDK_KEY_RELEASE: size = sizeof(GdkEventKey); break; case GDK_SETTING: size = sizeof(GdkEventSetting); break;" TO gui
WRITELN "default: size = sizeof(GdkEventAny); } __b2c__cad = realloc(__b2c__cad, size); memcpy(__b2c__cad, (void*)call_data, size); } } }" TO gui
ELSE
WRITELN "{ size = sizeof(void*); __b2c__cad = realloc(__b2c__cad, size); memcpy(__b2c__cad, (void*)call_data, size); } } }" TO gui
ENDIF
WRITELN "char *__b2c__guiExecute(uintptr_t id, int type) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; GList *widget; const char *name = NULL; unsigned long len, total = 0; widget=(GList*)id; __b2c__cld = NULL;" TO gui
WRITELN "GTKWIDGETSHOW(widget->data); while(1) { GTKMAINITERATION; if(__b2c__cld) { break; } } len = strlen((char*)__b2c__cld); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); memmove(buf[idx], __b2c__cld, len);" TO gui
WRITELN "if(type == 1) { total += len; buf[idx] = (char*)__b2c_str_realloc(buf[idx], total+1+", g_MAX_DIGITS, "+1); len = snprintf(buf[idx]+total, ", g_MAX_DIGITS, ", \" %p\", __b2c__cad); }" TO gui
WRITELN "total += len; __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO gui
WRITELN "uintptr_t __b2c__guiDefine(void){ GList *widget_list = NULL; GTKINIT;" TO gui
ELIF g_WHICH_GUI = 4 THEN
WRITELN "#define bacon64_width 64" TO gui
WRITELN "#define bacon64_height 64" TO gui
WRITELN "static unsigned char __b2c_bacon64_bits[] = {" TO gui
WRITELN "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0xc0, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x00, 0xc0, 0x0f, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x3c, 0x00, 0x00, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x1c, 0x50, 0x00, 0x3c, 0x00, 0x00, 0x00, 0x00, 0x0e, 0xda, 0x1a, 0x78, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0e, 0xa5, 0x6d, 0xe8, 0x00, 0x00, 0x00, 0x00, 0x0e, 0x03, 0xa0, 0xf0, 0x00, 0x00, 0x00, 0x00, 0x86, 0x00, 0x40, 0xe0, 0x01, 0x00, 0x00," TO gui
WRITELN "0x00, 0x86, 0x01, 0x80, 0xc3, 0x03, 0x00, 0x00, 0x00, 0x8e, 0xa0, 0x02, 0x45, 0x03, 0x00, 0x00, 0x00, 0x0e, 0xf1, 0x1f, 0xca, 0x07, 0x00, 0x00," TO gui
WRITELN "0x00, 0x86, 0xf0, 0x3f, 0x84, 0x06, 0x00, 0x00, 0x00, 0x8e, 0x71, 0x6c, 0x88, 0x07, 0x00, 0x00, 0x00, 0x86, 0xb8, 0x3f, 0x18, 0x07, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0e, 0xf9, 0x2f, 0x10, 0x07, 0x00, 0x00, 0x00, 0x86, 0xf0, 0x13, 0x18, 0x07, 0x00, 0x00, 0x00, 0x8e, 0xf9, 0x00, 0x10, 0x07, 0x00, 0x00," TO gui
WRITELN "0x00, 0x46, 0x70, 0x80, 0x0a, 0x07, 0x00, 0x00, 0x00, 0xce, 0xf8, 0xf5, 0x0e, 0x07, 0x00, 0x00, 0x00, 0x86, 0xf8, 0x17, 0x01, 0x07, 0x00, 0x00," TO gui
WRITELN "0x00, 0x86, 0x78, 0x00, 0x80, 0x07, 0x00, 0x00, 0x00, 0xce, 0x78, 0x00, 0xe0, 0x03, 0x00, 0x00, 0x00, 0x8e, 0x78, 0x00, 0xe8, 0x03, 0x00, 0x00," TO gui
WRITELN "0x00, 0xce, 0xf8, 0xfd, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x8c, 0xf8, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0xcc, 0xf8, 0xff, 0x3f, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0c, 0xf9, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x8c, 0x7c, 0x00, 0xf0, 0x01, 0x00, 0x00, 0x00, 0x8c, 0x79, 0x00, 0xe0, 0x03, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0c, 0xf9, 0x55, 0x41, 0x07, 0x00, 0x00, 0x00, 0x0c, 0xf9, 0x5b, 0x87, 0x0f, 0x00, 0x00, 0x00, 0x8c, 0xf0, 0x80, 0x0c, 0x1f, 0x00, 0x00," TO gui
WRITELN "0x00, 0x8e, 0xf8, 0x00, 0x14, 0x1e, 0x00, 0x00, 0x00, 0x8e, 0xf1, 0x2b, 0x30, 0x3c, 0x00, 0x00, 0x00, 0x0e, 0xf1, 0xef, 0x61, 0x7c, 0x00, 0x00," TO gui
WRITELN "0x00, 0x8e, 0x70, 0x7f, 0x41, 0x78, 0x00, 0x00, 0x00, 0x8e, 0x71, 0x7c, 0xc3, 0x78, 0x00, 0x00, 0x00, 0x0e, 0xe1, 0xc0, 0x45, 0x71, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0e, 0xf1, 0xc3, 0x47, 0xf1, 0x00, 0x00, 0x00, 0x8e, 0xe1, 0xff, 0xc1, 0xe0, 0x00, 0x00, 0x00, 0x0e, 0xe1, 0xff, 0xa3, 0xe1, 0x00, 0x00," TO gui
WRITELN "0x00, 0x8e, 0x00, 0x25, 0xa0, 0xe0, 0x00, 0x00, 0x00, 0x8e, 0x01, 0x00, 0x50, 0xe1, 0x00, 0x00, 0x00, 0x0e, 0x01, 0x00, 0x68, 0xb1, 0x00, 0x00," TO gui
WRITELN "0x00, 0x0e, 0xb7, 0x00, 0xaf, 0xf0, 0x00, 0x00, 0x00, 0x0e, 0x6d, 0xff, 0x20, 0xe8, 0x00, 0x00, 0x00, 0x0e, 0x00, 0x4a, 0x00, 0xe8, 0x00, 0x00," TO gui
WRITELN "0x00, 0x06, 0x00, 0x00, 0x00, 0x76, 0x00, 0x00, 0x00, 0x0e, 0x00, 0x00, 0x50, 0x3d, 0x00, 0x00, 0x00, 0x4e, 0x52, 0x55, 0xaf, 0x1a, 0x00, 0x00," TO gui
WRITELN "0x00, 0xfe, 0xfe, 0xfd, 0xea, 0x1f, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0xff, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00," TO gui
WRITELN "0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 };" TO gui
WRITELN "void *__b2c__cld = NULL; int __b2c_tk_callback(ClientData client_data, Tcl_Interp *i, int argc, const char **argv) { if(client_data) { __b2c__cld = (void*)client_data; } else { __b2c__cld = NULL; } return(TCL_OK); }" TO gui
WRITELN "char *__b2c__guiExecute(uintptr_t id, int type) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned long len; while(1) { if(Tcl_DoOneEvent(TCL_ALL_EVENTS)) { if(__b2c__cld) { break; } } }" TO gui
WRITELN "len = __b2c__len(__b2c__cld); buf[idx] = (char*) __b2c_str_realloc (buf[idx], len+1); memmove(buf[idx], __b2c__cld, len); __b2c__SETLEN (buf[idx], len); buf[idx][len] = '\\0'; __b2c__cld = NULL; return(char*)(buf[idx]); }" TO gui
WRITELN "uintptr_t __b2c__guiDefine(void){ Tcl_Interp *interp; char *gui = NULL; Tcl_FindExecutable(\"", BASENAME$(g_CURFILE$, 1), "\"); interp = Tcl_CreateInterp();" TO gui
WRITELN "if(Tcl_Init(interp) == TCL_ERROR) { fprintf(stderr, \"No TCL INIT possible: %s\\n\", Tcl_GetStringResult(interp)); exit(TCL_ERROR); }" TO gui
WRITELN "if(Tk_Init(interp) == TCL_ERROR) { fprintf(stderr, \"No TK INIT possible: %s\\n\", Tcl_GetStringResult(interp)); exit(TCL_ERROR); }" TO gui
WRITELN "gui = (char*)calloc(128+", LEN(data$), ", sizeof(char)); strncpy(gui, \"package require Tk\\n\", 127);" TO gui
IF LEN(data$) THEN WRITELN "gui = strcat(gui, \"", data$, "\");" TO gui
FOR item$ IN data$ STEP ";"
IF ISTOKEN(item$, "\\\"WM_DELETE_WINDOW\\\"") THEN callback$ = APPEND$(callback$, 0, TOKEN$(item$, ISTOKEN(item$, "\\\"WM_DELETE_WINDOW\\\"")+1))
IF ISTOKEN(item$, "-command") AND REGEX(TOKEN$(item$, ISTOKEN(item$, "-command")+1), "^[a-zA-Z0-9_]+$") THEN callback$ = APPEND$(callback$, 0, TOKEN$(item$, ISTOKEN(item$, "-command")+1))
IF HEAD$(CHOP$(item$), 1) = "bind" AND AMOUNT(item$) = 4 AND REGEX(TAIL$(CHOP$(item$), 1), "^[a-zA-Z0-9_]+$") THEN callback$ = APPEND$(callback$, 0, TAIL$(CHOP$(item$), 1))
NEXT
IF LEN(callback$) THEN
FOR item$ IN callback$
WRITELN "Tcl_CreateCommand(interp, \"", item$, "\", __b2c_tk_callback, (ClientData)\"", item$, "\", NULL);" TO gui
NEXT
ENDIF
WRITELN "Tk_DefineBitmap(interp, Tk_GetUid(\"BaCon\"), __b2c_bacon64_bits, 64, 64); Tk_GetBitmap(interp, Tk_MainWindow(interp), Tk_GetUid(\"BaCon\")); Tcl_Eval(interp, gui); return((uintptr_t)interp); }" TO gui
ELSE
WRITELN "Widget __b2c__CallbackedWidget; XtPointer __b2c__cld = NULL; XtPointer __b2c__cad = NULL; Atom __b2c_wm_delete_window = 0;" TO gui
WRITELN "int __b2c_xt_close(Display *dpy) { XtCloseDisplay(dpy); exit(EXIT_SUCCESS); }" TO gui
WRITELN "static void __b2c_wm_delete(Widget w, XEvent *event, String *params, Cardinal *num_params)" TO gui
WRITELN "{ if(event->type == ClientMessage && event->xclient.data.l[0] == __b2c_wm_delete_window) { __b2c__CallbackedWidget = w; __b2c__cld = params[0]; } }" TO gui
WRITELN "void __b2c_xt_callback(Widget w, XtPointer client_data, XtPointer call_data)" TO gui
WRITELN "{ __b2c__CallbackedWidget = w; if(client_data) { __b2c__cld = client_data; } if(call_data) { __b2c__cad = calloc(1, sizeof(XtPointer)); memcpy(__b2c__cad, call_data, sizeof(XtPointer)); } }" TO gui
WRITELN "char *__b2c__guiExecute(uintptr_t id, int type) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *name; unsigned long len, total = 0; __b2c__CallbackedWidget = NULL; if(__b2c__cad) { free(__b2c__cad); } __b2c__cad = NULL; __b2c__cld = NULL;" TO gui
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } XtRealizeWidget((Widget)id); if(__b2c_wm_delete_window) { XSetWMProtocols(XtDisplay((Widget)id), XtWindow((Widget)id), &__b2c_wm_delete_window, 1); }" TO gui
WRITELN "while(1) { XtAppProcessEvent(XtWidgetToApplicationContext((Widget)id), XtIMAll); if(__b2c__CallbackedWidget) { break; } } if(__b2c__cld) { len = strlen(__b2c__cld); buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); memmove(buf[idx], __b2c__cld, len); }" TO gui
WRITELN "else { name = XtName(__b2c__CallbackedWidget); if(name == NULL) { return(NULL); } len = strlen(name); buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); memmove(buf[idx], name, len); } if(type == 1) { total += len;" TO gui
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], total+1+", g_MAX_DIGITS, "+1); len = snprintf(buf[idx]+total, ", g_MAX_DIGITS, ", \" %p\", __b2c__cad); }" TO gui
WRITELN "total += len; __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO gui
WRITELN "uintptr_t __b2c__guiDefine(void){XtAppContext app; Display *dpy; Screen *scr; Arg args[32]; int n = 0, argc = 1; char *argv[1];" TO gui
ENDIF
WHILE LEN(data$) > 2 AND g_WHICH_GUI <> 4
widget$ = FLATTEN$(INBETWEEN$(data$, "{" , "}"))
data$ = CHOP$(OUTBETWEEN$(data$, "{", "}"))
type$ = "" : name$ = "" : parent$ = "" : callback$ = "" : prop$ = "," : arg$ = ""
FOR item$ IN widget$
item$ = REPLACE$(CHOP$(item$), "\\$$", g_STRINGSIGN$, TRUE)
SELECT TOKEN$(item$, 1, "=")
CASE "type"
type$ = TOKEN$(item$, 2, "=")
IF (g_WHICH_GUI = 1 OR g_WHICH_GUI = 3) AND NOT(INSTR(type$, "_TYPE_")) THEN type$ = "GTK_TYPE_" & UCASE$(type$)
CASE "name"
name$ = TOKEN$(item$, 2, "=")
CASE "parent"
parent$ = TOKEN$(item$, 2, "=")
CASE "callback"
callback$ = APPEND$(callback$, 0, TOKEN$(item$, 2, "="))
CASE "map"
map$ = APPEND$(map$, 0, TOKEN$(item$, 2, "="))
CASE "uid"
uid$ = APPEND$(uid$, 0, TOKEN$(item$, 2, "="))
CASE "resources"
resource$ = TOKEN$(item$, 2, "=")
CASE "args"
arg$ = TOKEN$(item$, 2, "=")
arg$ = REPLACE$(CHOP$(arg$), "$", g_STRINGSIGN$)
DEFAULT
IF g_WHICH_GUI = 1 OR g_WHICH_GUI = 3 THEN
prop$ = prop$ & CHR$(34) & TOKEN$(item$, 1, "=") & CHR$(34) & "," & TOKEN$(item$, 2, "=") & ","
ELIF g_WHICH_GUI = 0 THEN
WRITELN "XtSetArg(args[n], ", DELIM$(item$, "=", ","), "); n++;" TO gui
ENDIF
ENDSELECT
NEXT
IF LEN(name$) = 0 AND g_WHICH_GUI <> 4 THEN
EPRINT NL$, "Syntax error: widget does not have a name at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF LEN(type$) = 0 AND g_WHICH_GUI <> 4 THEN
EPRINT NL$, "Syntax error: widget does not have a type at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF g_WHICH_GUI = 2 THEN
IF LCASE$(type$) = "window" THEN
WRITELN "CDKSCREEN *" & name$ & ", *__main_window;" TO gui
WRITELN name$, " = initCDKScreen(initscr()); initCDKColor(); __main_window = ", name$, ";" TO gui
ELSE
WRITELN "CDK", UCASE$(type$), " *", name$, ";" TO gui
WRITELN name$, " = newCDK", PROPER$(type$), "(", arg$, ");" TO gui
ENDIF
WRITELN "__b2c__cdknames = realloc(__b2c__cdknames, sizeof(struct __b2c__cdk)*(__b2c__cdknr+1));" TO gui
WRITELN "__b2c__cdknames[__b2c__cdknr].name = __b2c__strdup(\"", name$, "\"); __b2c__cdknames[__b2c__cdknr].addr = ", name$, "; __b2c__cdknr++;" TO gui
IF LEN(callback$) THEN
FOR item$ IN callback$
IF HASDELIM(item$, ",") THEN
WRITELN "bindCDKObject(v", UCASE$(type$), ", ", name$, ", ", TOKEN$(item$, 1, ","), ", __b2c_cdk_callback, \"", TOKEN$(item$, 2, ","), "\");" TO gui
ELSE
WRITELN "bindCDKObject(v", UCASE$(type$), ", ", name$, ", ", TOKEN$(item$, 1, ","), ", __b2c_cdk_callback, \"", name$, "\");" TO gui
ENDIF
NEXT
ENDIF
ELIF g_WHICH_GUI = 1 OR g_WHICH_GUI = 3 THEN
WRITELN "GtkWidget *", name$, ";" TO gui
WRITELN name$, "= GTK_WIDGET(g_object_new(" & type$ & " " & prop$ & " NULL));" TO gui
IF type$ = "GTK_TYPE_WINDOW" OR INSTR(type$, "DIALOG") THEN WRITELN "gtk_window_set_icon_name(GTK_WINDOW(" & name$ & "), \"bacon\");" TO gui
WRITELN "gtk_widget_set_name(" & name$ & ", \"" & name$ & "\");" TO gui
WRITELN "widget_list = g_list_append(widget_list, ", name$, ");" TO gui
IF LEN(parent$) THEN
IF type$ = "GTK_TYPE_MENU" OR type$ = "GTK_TYPE_MENU_ITEM" THEN
WRITELN "gtk_menu_shell_append(GTK_MENU_SHELL(" & parent$ & "), " & name$ & ");" TO gui
ELSE
WRITELN "GTKCONTAINERADD(" & parent$ & ", " & name$ & ");" TO gui
ENDIF
ENDIF
IF LEN(callback$) THEN
FOR item$ IN callback$
IF HASDELIM(item$, ",") THEN
WRITELN "g_signal_connect_swapped(G_OBJECT(", name$, "), \"", TOKEN$(item$, 1, ","), "\", G_CALLBACK(__b2c_gtk_callback), \"", TOKEN$(item$, 2, ","), "\");" TO gui
ELSE
WRITELN "g_signal_connect_swapped(G_OBJECT(", name$, "), \"", TOKEN$(item$, 1, ","), "\", G_CALLBACK(__b2c_gtk_callback), \"", name$, "\");" TO gui
ENDIF
NEXT
ENDIF
ELSE
WRITELN "Widget ", name$, ";" TO gui
IF type$ = "window" THEN
WRITELN "Widget __main_window; Dimension w, h;" TO gui
IF LEN(callback$) THEN WRITELN "XtActionsRec actions[1];" TO gui
WRITELN "XtSetLanguageProc(NULL, NULL, NULL);" TO gui
WRITELN "argv[0] = calloc(1, sizeof(char));" TO gui
IF FILEEXISTS("/usr/local/share/pixmaps/BaCon.xbm") THEN
icon$ = "/usr/local/share/pixmaps/BaCon.xbm"
ELIF FILEEXISTS("/usr/share/pixmaps/BaCon.xbm") THEN
icon$ = "/usr/share/pixmaps/BaCon.xbm"
ELSE
icon$ = "xlogo32"
ENDIF
IF LEN(resource$) THEN
WRITELN "String resources[] = { \"*iconPixmap:" & icon$ & "\", ", resource$, ", NULL };" TO gui
ELSE
WRITELN "String resources[] = { \"*iconPixmap:" & icon$ & "\", NULL };" TO gui
ENDIF
WRITELN name$, " = XtOpenApplication(&app, \"BaConGUI\", NULL, 0, &argc, argv, resources, sessionShellWidgetClass, args, n);" TO gui
WRITELN "dpy = XtDisplay(", name$, ");" TO gui
WRITELN "scr = XtScreen(", name$, ");" TO gui
WRITELN "XtVaGetValues(", name$, ", XtNwidth, &w, XtNheight, &h, NULL);" TO gui
WRITELN "XtVaSetValues(", name$, ", XtNx, WidthOfScreen(scr)/2-(w/2), XtNy, HeightOfScreen(scr)/2-(h/2), NULL);" TO gui
IF LEN(callback$) THEN
WRITELN "__b2c_wm_delete_window = XInternAtom(dpy, \"WM_DELETE_WINDOW\", False);" TO gui
WRITELN "actions[0].string = \"__b2c_wm_delete\"; actions[0].proc = __b2c_wm_delete;" TO gui
WRITELN "XtAppAddActions(app, actions, XtNumber(actions));" TO gui
WRITELN "XtOverrideTranslations(", name$, ", XtParseTranslationTable(\"<Message>WM_PROTOCOLS: __b2c_wm_delete(", callback$, ")\"));" TO gui
WRITELN "#ifndef __b2c__gui_xaw" TO gui
WRITELN "XtVaSetValues(", name$, ", XmNdeleteResponse, XmDO_NOTHING, NULL);" TO gui
WRITELN "#endif" TO gui
ENDIF
WRITELN "__main_window = ", name$, ";" TO gui
WRITELN "XSetIOErrorHandler(__b2c_xt_close);" TO gui
WRITELN "#ifdef __b2c__gui_uil" TO gui
WRITELN "MrmHierarchy hierarchy;" TO gui
WRITELN "MrmType class_code;" TO gui
WRITELN "Widget main_object;" TO gui
WRITELN "static MrmRegisterArg callback_list[] = {" TO gui
IF LEN(map$) THEN
FOR item$ IN map$
FOR func$ IN item$ STEP ","
WRITELN "{ \"", func$, "\", (XtPointer)__b2c_xt_callback }," TO gui
NEXT
NEXT
ELSE
WRITELN " NULL " TO gui
ENDIF
WRITELN "};" TO gui
WRITELN "static String uid_file_list[] = {" TO gui
IF AMOUNT(uid$) THEN
WRITELN "\"", HEAD$(uid$, 1), "\"" TO gui
IF AMOUNT(uid$) > 1 THEN
FOR item$ IN LAST$(uid$, 1)
WRITELN ", \"", item$, "\" " TO gui
NEXT
ENDIF
ELSE
WRITELN " NULL " TO gui
ENDIF
WRITELN "};" TO gui
WRITELN "MrmInitialize();" TO gui
WRITELN "MrmOpenHierarchyPerDisplay(dpy, XtNumber(uid_file_list), uid_file_list, NULL, &hierarchy);" TO gui
WRITELN "MrmRegisterNames(callback_list, XtNumber(callback_list));" TO gui
WRITELN "MrmFetchWidget(hierarchy, \"main\", ", name$, ", &main_object, &class_code);" TO gui
WRITELN "MrmCloseHierarchy(hierarchy);" TO gui
WRITELN "XtManageChild(main_object);" TO gui
WRITELN "#endif" TO gui
WRITELN "free(argv[0]);" TO gui
ELSE
IF LEFT$(type$, 5) = "shell" OR LEFT$(type$, 10) = "simpleMenu" OR INSTR(type$, "Shell") THEN
WRITELN name$, " = XtCreatePopupShell(\"", name$, "\", ", type$, ", ", parent$, ", args, n);" TO gui
IF INSTR(LCASE$(type$), "shell") THEN
WRITELN "XtVaGetValues(", name$, ", XtNwidth, &w, XtNheight, &h, NULL);" TO gui
WRITELN "XtVaSetValues(", name$, ", XtNx, WidthOfScreen(scr)/2-(w/2), XtNy, HeightOfScreen(scr)/2-(h/2), NULL);" TO gui
ENDIF
ELSE
WRITELN name$, " = XtCreateManagedWidget(\"", name$, "\", ", type$, ", ", parent$, ", args, n);" TO gui
ENDIF
IF LEN(callback$) THEN
FOR item$ IN callback$
IF HASDELIM(item$, ",") THEN
WRITELN "XtAddCallback(", name$, ", ", TOKEN$(item$, 1, ","), ", __b2c_xt_callback, \"", TOKEN$(item$, 2, ","), "\");" TO gui
ELSE
WRITELN "XtAddCallback(", name$, ", ", item$, ", __b2c_xt_callback, NULL);" TO gui
ENDIF
NEXT
ENDIF
ENDIF
WRITELN "n = 0;" TO gui
ENDIF
WEND
IF g_WHICH_GUI = 2 THEN
WRITELN "refreshCDKScreen(__main_window); setCDKFocusFirst(__main_window); resetCDKScreen(__main_window); return((uintptr_t)__main_window); }" TO gui
ELIF g_WHICH_GUI = 1 OR g_WHICH_GUI = 3 THEN
WRITELN "return((uintptr_t)widget_list); }" TO gui
ELIF g_WHICH_GUI = 0 THEN
WRITELN "return((uintptr_t)__main_window); }" TO gui
ENDIF
CLOSE FILE gui
ENDSUB
'----------------------------------------------------------------------------------------------
' Simple parser to tokenize line.
'
' Logic: each line of source code should begin with a statement. If not, then it is considered
' to be an assignment (LET).
' The rest of the line may contain functions, these are converted using C macros.
'----------------------------------------------------------------------------------------------
SUB Parse_Line(STRING statement$)
LOCAL inc$, copy_curfile$, total$, txt$, sym$, exp$, then$, lft$, str$, newfeed$, token$, rel$
LOCAL dim, i, found, copy_counter, to_parse, size, trc_backup
LOCAL newfile, src_tmp, src_in, src_out TYPE FILE*
SPLIT statement$ BY " " TO element$ SIZE dim
IF dim > 0 THEN
' See if we need to pass C code
IF ISTRUE(g_USE_C) THEN
IF LEFT$(statement$, 8) = "END USEC" OR element$[1] = "ENDUSEC" THEN
g_USE_C = 0
ELIF LEFT$(statement$, 8) = "END ENUM" OR element$[1] = "ENDENUM" THEN
g_USE_C = 0
WRITELN "};" TO g_CFILE
ELSE
WRITELN statement$ TO g_CFILE
END IF
ELIF ISTRUE(g_USE_H) THEN
IF REGEX(statement$, "END.*USEH") THEN
g_USE_H = 0
ELIF REGEX(statement$, "END.*ENUM") OR REGEX(statement$, "END.*CLASS") THEN
g_USE_H = 0
WRITELN "};" TO g_HFILE
ELSE
WRITELN statement$ TO g_HFILE
END IF
ELIF LEFT$(element$[1], 2) = "#!" THEN
'Do nothing
ELIF LEFT$(element$[1], 1) = "'" THEN
'Do nothing
ELIF RIGHT$(element$[dim], 2) = "*/" THEN
g_COMMENT = FALSE
ELIF LEFT$(element$[1], 2) = "/*" THEN
g_COMMENT = TRUE
ELIF g_COMMENT = FALSE THEN
SELECT element$[1]
CASE "USEC"
g_USE_C = 1
CASE "USEH"
g_USE_H = 1
CASE "CLASS"
g_USE_H = 1
WRITELN "class ", LAST$(statement$, 1), "{" TO g_HFILE
CASE "PRINT"
Handle_Print(statement$, "stdout")
CASE "EPRINT"
Handle_Print(MID$(statement$, 2), "stderr")
CASE "INPUT"
Handle_Input(statement$)
CASE "FOR"
INCR g_LOOPCTR
Handle_For(statement$)
CASE "NEXT"
WRITELN "}" TO g_CFILE
IF g_LOOPCTR > 0 AND g_OPTION_BREAK THEN
DECR g_LOOPCTR
IF g_LOOPCTR > 0 THEN
WRITELN "if(__b2c__break_ctr) {__b2c__break_ctr--; if (!__b2c__break_ctr){if(__b2c__break_flag == 1) break; else continue;} else break; }" TO g_CFILE
END IF
END IF
CASE "IF"
' Check if THEN is available
IF NOT(ISTOKEN(statement$, "THEN")) THEN
EPRINT NL$, "Syntax error: missing THEN in IF statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate function to C function
then$ = CHOP$(LAST$(statement$, ISTOKEN(statement$, "THEN")))
sym$ = HEAD$(statement$, ISTOKEN(statement$, "THEN")-1)
exp$ = CHOP$(LAST$(sym$, ISTOKEN(sym$, "IF")))
WRITELN "if(", Parse_Equation$(exp$), "){" TO g_CFILE
IF LEN(then$) > 0 THEN
trc_backup = g_TRACE
g_TRACE = 0
CALL Tokenize(then$)
g_TRACE = trc_backup
WRITELN "}" TO g_CFILE
END IF
ENDIF
CASE "ELIF"
' Check if THEN is available
IF NOT(ISTOKEN(statement$, "THEN")) THEN
EPRINT NL$, "Syntax error: missing THEN in ELIF statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate function to C function
then$ = CHOP$(LAST$(statement$, ISTOKEN(statement$, "THEN")))
sym$ = HEAD$(statement$, ISTOKEN(statement$, "THEN")-1)
exp$ = CHOP$(LAST$(sym$, ISTOKEN(sym$, "ELIF")))
IF LEN(then$) > 0 THEN
IF g_TRACE = 1 THEN
g_TRACE_PREFIX$ = "RUNTIMEDEBUG(" & g_CURFILE$ & ", " & STR$(g_COUNTER) & ", \"" & REPLACE$(statement$, CHR$(34) & CHR$(92), CHR$(39) & CHR$(47), 2) & "\")"
WRITELN "else if(!(", g_TRACE_PREFIX$, ")){ ; }" TO g_CFILE
ENDIF
WRITELN "else if(", Parse_Equation$(exp$), "){" TO g_CFILE
CALL Tokenize(then$)
WRITELN "}" TO g_CFILE
ELSE
IF g_TRACE = 1 THEN
g_TRACE_PREFIX$ = "RUNTIMEDEBUG(" & g_CURFILE$ & ", " & STR$(g_COUNTER) & ", \"ELIF " & REPLACE$(exp$, CHR$(34) & CHR$(92), CHR$(39) & CHR$(47), 2) & "\")"
WRITELN "} else if(!(", g_TRACE_PREFIX$, ")){ ;" TO g_CFILE
ENDIF
WRITELN "} else if(", Parse_Equation$(exp$), "){" TO g_CFILE
IF g_TRACE = 1 THEN g_TRACE_PREFIX$ = ""
END IF
END IF
CASE "ELSE"
' Translate function to C function
exp$ = CHOP$(LAST$(statement$, ISTOKEN(statement$, "ELSE")))
IF LEN(exp$) > 0 THEN
IF g_TRACE = 1 THEN
g_TRACE_PREFIX$ = "RUNTIMEDEBUG(" & g_CURFILE$ & ", " & STR$(g_COUNTER) & ", \"" & REPLACE$(statement$, CHR$(34) & CHR$(92), CHR$(39) & CHR$(47), 2) & "\")"
WRITELN "else if(!(", g_TRACE_PREFIX$, ")){ ; }" TO g_CFILE
ENDIF
WRITELN "else {" TO g_CFILE
CALL Tokenize(exp$)
WRITELN "}" TO g_CFILE
ELSE
IF g_TRACE = 1 THEN
g_TRACE_PREFIX$ = "RUNTIMEDEBUG(" & g_CURFILE$ & ", " & STR$(g_COUNTER) & ", \"ELSE\")"
WRITELN "} else if(!(", g_TRACE_PREFIX$, ")){ ;" TO g_CFILE
ENDIF
WRITELN "} else {" TO g_CFILE
IF g_TRACE = 1 THEN g_TRACE_PREFIX$ = ""
END IF
CASE "FI"
WRITELN "}" TO g_CFILE
CASE "DOTIMES"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty DOTIMES at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "long __do_times_", g_DOTIMES, " = 0;" TO g_HFILE
WRITELN "for(__do_times_", g_DOTIMES, " = 0; __do_times_", g_DOTIMES, "<", MID$(statement$, INSTR(statement$, "DOTIMES") + 7), "; __do_times_", g_DOTIMES, "++) { _ = __do_times_", g_DOTIMES, "+1;" TO g_CFILE
INCR g_DOTIMES
END IF
CASE "DO"
WRITELN "{" TO g_CFILE
CASE "DONE"
WRITELN "}" TO g_CFILE
CASE "WHILE"
INCR g_LOOPCTR
Handle_While(statement$)
CASE "WEND"
WRITELN "}" TO g_CFILE
IF g_LOOPCTR > 0 AND g_OPTION_BREAK THEN
DECR g_LOOPCTR
IF g_LOOPCTR > 0 THEN
WRITELN "if(__b2c__break_ctr) {__b2c__break_ctr--; if (!__b2c__break_ctr){if(__b2c__break_flag == 1) break; else continue;} else break; }" TO g_CFILE
END IF
END IF
CASE "BREAK"
' Check argument
IF g_OPTION_BREAK THEN
IF dim > 1 AND VAL(MID$(statement$, INSTR(statement$, "BREAK") + 5)) <> 0 THEN
WRITELN "__b2c__break_ctr = ", MID$(statement$, INSTR(statement$, "BREAK") + 5), "-1; __b2c__break_flag = 1;" TO g_CFILE
END IF
WRITELN "break;" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: use of BREAK at line ", g_COUNTER, " in file '", g_CURFILE$, "' was disbaled!"
END 1
ENDIF
CASE "CONTINUE"
' Check argument
IF dim > 1 AND VAL(MID$(statement$, INSTR(statement$, "CONTINUE") + 8)) <> 0 THEN
WRITELN "__b2c__break_ctr = ", MID$(statement$, INSTR(statement$, "CONTINUE") + 8), "-1; __b2c__break_flag = 2;" TO g_CFILE
END IF
IF VAL(MID$(statement$, INSTR(statement$, "CONTINUE") + 8)) > 1 THEN
WRITELN "break;" TO g_CFILE
ELSE
WRITELN "continue;" TO g_CFILE
END IF
CASE "REPEAT"
INCR g_LOOPCTR
WRITELN "do{" TO g_CFILE
CASE "UNTIL"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty UNTIL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Convert to legal C code
exp$ = Parse_Equation$(MID$(statement$, INSTR(statement$, "UNTIL") + 5) )
WRITELN "} while(!(", exp$, "));" TO g_CFILE
IF g_LOOPCTR > 0 AND g_OPTION_BREAK THEN
DECR g_LOOPCTR
IF g_LOOPCTR > 0 THEN
WRITELN "if(__b2c__break_ctr) {__b2c__break_ctr--; if (!__b2c__break_ctr){if(__b2c__break_flag == 1) break; else continue;} else break; }" TO g_CFILE
END IF
END IF
END IF
CASE "LET"
Handle_Let(MID$(statement$, INSTR(statement$, "LET") + 3))
CASE "SYSTEM"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SYSTEM at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "SYSTEM (", MID$(statement$, INSTR(statement$, "SYSTEM") + 6), ");" TO g_CFILE
END IF
CASE "SLEEP"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SLEEP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "usleep(", MID$(statement$, INSTR(statement$, "SLEEP") + 5), "*1000);" TO g_CFILE
END IF
CASE "OPEN"
Handle_Open(statement$)
CASE "CLOSE"
' Check argument
IF dim < 3 THEN
EPRINT NL$, "Syntax error: empty CLOSE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = LAST$(statement$, 1)
SELECT element$[2]
CASE "FILE"
exp$ = LAST$(exp$, 1)
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
WRITELN "fclose(", token$, ");" TO g_CFILE
exp$ = MID$(exp$, LEN(token$)+2)
token$ = CHOP$(token$)
FREE g_SEMANTIC_OPENCLOSE$(token$)
WEND
CASE "DIRECTORY"
exp$ = LAST$(exp$, 1)
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
WRITELN "closedir(", token$, ");" TO g_CFILE
exp$ = MID$(exp$, LEN(token$)+2)
token$ = CHOP$(token$)
FREE g_SEMANTIC_OPENCLOSE$(token$)
WEND
CASE "MEMORY"
exp$ = LAST$(exp$, 1)
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
WRITELN token$, " = NULL;" TO g_CFILE
exp$ = MID$(exp$, LEN(token$)+2)
token$ = CHOP$(token$)
FREE g_SEMANTIC_OPENCLOSE$(token$)
WEND
CASE "LIBRARY"
exp$ = LAST$(exp$, 1)
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
WRITELN "if(__b2c__dlopen__pointer_", EXTRACT$(token$, "[[:punct:]]", TRUE), " != NULL) {dlclose(__b2c__dlopen__pointer_", EXTRACT$(token$, "[[:punct:]]", TRUE), "); __b2c__dlopen__pointer_", EXTRACT$(token$, "[[:punct:]]", TRUE), " = NULL;}" TO g_CFILE
exp$ = MID$(exp$, LEN(token$)+2)
token$ = CHOP$(token$)
WEND
CASE "NETWORK";
CASE "SERVER";
CASE "UDP";
CASE "DEVICE"
exp$ = LAST$(exp$, 1)
WHILE LEN(exp$)
token$ = Mini_Parser$(exp$)
' Close SSL socket if option was set
IF g_OPTION_TLS THEN
WRITELN "SSL_shutdown((SSL*)", token$, ");" TO g_CFILE
WRITELN "SSL_free((SSL*)", token$, ");" TO g_CFILE
ELSE
WRITELN "shutdown((uintptr_t)", token$, ", SHUT_RDWR);" TO g_CFILE
WRITELN "close((uintptr_t)", token$, ");" TO g_CFILE
ENDIF
exp$ = MID$(exp$, LEN(token$)+2)
token$ = CHOP$(token$)
FREE g_SEMANTIC_OPENCLOSE$(token$)
WEND
DEFAULT
EPRINT NL$, "Syntax error: erroneous CLOSE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END SELECT
END IF
CASE "REWIND"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty REWIND at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "rewind(", element$[2], ");" TO g_CFILE
END IF
CASE "MEMREWIND"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty MEMREWIND at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN element$[2], " = (char*)__b2c_mem_", element$[2], ";" TO g_CFILE
END IF
CASE "SEEK"
Handle_Seek(statement$)
CASE "READLN"
Handle_Readln(statement$)
CASE "WRITELN"
Handle_Writeln(statement$)
CASE "GETBYTE"
Handle_Getbyte(statement$)
CASE "PUTBYTE"
Handle_Putbyte(statement$)
CASE "GETFILE"
Handle_Getfile(statement$)
CASE "GETLINE"
Handle_Getline(statement$)
CASE "PUTLINE"
Handle_Putline(statement$)
CASE "END";
CASE "ENDIF";
CASE "ENDSUB";
CASE "ENDFUNC";
CASE "ENDWITH";
CASE "ENDFORK";
CASE "ENDRECORD";
CASE "ENDSELECT";
CASE "ENDFUNCTION"
exp$ = IIF$(dim > 1, element$[2], MID$(element$[1], 4))
SELECT exp$
CASE "IF"
WRITELN "}" TO g_CFILE
CASE "RECORD"
IF LEN(g_FUNCNAME$) > 0 THEN
WRITELN "}", g_RECORDNAME$, ";" TO g_CFILE
WRITELN "typedef ", g_RECORDNAME$, " ", EXTRACT$(g_RECORDNAME$, "_TYPE"), "_type;" TO g_CFILE
IF LEN(g_RECORDARRAY$) THEN
WRITELN g_RECORDNAME$, " *", LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1), " = (", g_RECORDNAME$, "*)calloc(", g_RECORDARRAY$, "+", g_OPTION_BASE, ", sizeof(", g_RECORDNAME$, "));" TO g_CFILE
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1)
g_RECORDEND_BODY$ = " long __b2c_record_" & EXTRACT$(g_RECORDNAME$, "_TYPE") & " = " & g_RECORDARRAY$ & "+" & STR$(g_OPTION_BASE) & ";" & g_RECORDEND_BODY$
ELSE
WRITELN g_RECORDNAME$, " ", REPLACE$(g_RECORDVAR$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { 0 } ;" TO g_CFILE
ENDIF
ELSE
WRITELN "}", g_RECORDNAME$, ";" TO g_HFILE
WRITELN "typedef ", g_RECORDNAME$, " ", EXTRACT$(g_RECORDNAME$, "_TYPE") , "_type;" TO g_HFILE
IF LEN(g_RECORDARRAY$) THEN
WRITELN g_RECORDNAME$, " *", LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1), ";" TO g_HFILE
WRITELN LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1), " = (", g_RECORDNAME$, "*)calloc(", g_RECORDARRAY$, "+", g_OPTION_BASE, ", sizeof(", g_RECORDNAME$, "));" TO g_CFILE
WRITELN "long __b2c_record_" & EXTRACT$(g_RECORDNAME$, "_TYPE") & ";" TO g_HFILE
g_RECORDEND_BODY$ = g_RECORDEND_BODY$ & " __b2c_record_" & EXTRACT$(g_RECORDNAME$, "_TYPE") & " = " & g_RECORDARRAY$ & "+" & STR$(g_OPTION_BASE) & ";"
ELSE
WRITELN g_RECORDNAME$, " ", REPLACE$(g_RECORDVAR$, "]", "+" & STR$(g_OPTION_BASE) & "]"), " = { 0 } ;" TO g_HFILE
ENDIF
WRITELN g_RECORDEND_HEADER$ TO g_HFILE
END IF
WRITELN g_RECORDEND_BODY$ TO g_CFILE
g_RECORDNAME$ = ""
g_RECORDVAR$ = ""
g_RECORDEND_BODY$ = ""
g_RECORDEND_HEADER$ = ""
g_RECORDARRAY$ = ""
' Restore function name if GLOBAL was used
IF LEN(g_RECORDCACHE$) > 0 THEN
g_FUNCNAME$ = g_RECORDCACHE$
g_RECORDCACHE$ = ""
ENDIF
CASE "FUNC", "FUNCTION"
Handle_Endfunction
CASE "SUB"
Handle_Endsub
CASE "WITH"
g_WITHVAR$ = ""
CASE "SELECT"
IF g_SELECTVAR_CTR = 0 THEN
EPRINT NL$, "Syntax error: invalid END SELECT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "}" TO g_CFILE
g_SELECTVAR$[g_SELECTVAR_CTR] = ""
g_IN_CASE[g_SELECTVAR_CTR] = 0
g_CASE_FALL$ = ""
g_CASE_CONT$ = ""
DECR g_SELECTVAR_CTR
END IF
CASE "FORK"
IF dim > 2 THEN
WRITELN "_exit(", MID$(statement$, INSTR(statement$, "FORK")+4), ");" TO g_CFILE
ELSE
WRITELN "_exit(EXIT_SUCCESS);" TO g_CFILE
ENDIF
DEFAULT
WRITELN "exit(", IIF$(dim > 1, MID$(statement$, INSTR(statement$, "END")+3), "EXIT_SUCCESS"), ");" TO g_CFILE
END SELECT
CASE "SUB"
Handle_SubFunc(statement$)
CASE "CALL"
Handle_Call(statement$)
CASE "FUNCTION"
Handle_SubFunc(statement$)
CASE "FUNC"
Handle_SubFunc(statement$)
CASE "RETURN"
Handle_Return(MID$(statement$, INSTR(statement$, "RETURN") + 6))
CASE "IMPORT"
Handle_Import(statement$)
CASE "DECLARE"
Handle_Declare(MID$(statement$, INSTR(statement$, "DECLARE") + 7))
CASE "GLOBAL"
Handle_Declare(MID$(statement$, INSTR(statement$, "GLOBAL") + 6))
CASE "LOCAL"
Handle_Local(MID$(statement$, INSTR(statement$, "LOCAL") + 5))
CASE "DATA"
Handle_Data(statement$)
CASE "RESTORE"
IF dim = 1 THEN
WRITELN "__b2c__floatarray_ptr = 0;" TO g_CFILE
WRITELN "__b2c__stringarray_ptr = 0;" TO g_CFILE
ELSE
WRITELN "__b2c__floatarray_ptr = __b2c__label_floatarray_", element$[2], ";" TO g_CFILE
WRITELN "__b2c__stringarray_ptr = __b2c__label_stringarray_", element$[2], ";" TO g_CFILE
END IF
CASE "READ"
Handle_Read(statement$)
CASE "PUSH"
Handle_Push(statement$)
CASE "PULL"
Handle_Pull(statement$)
CASE "SEED"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty DATA at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
WRITELN "srandom((unsigned int)", MID$(statement$, INSTR(statement$, " ")+1), ");" TO g_CFILE
END IF
CASE "DEF"
Handle_Deffn(statement$)
CASE "CONST"
Handle_Const(statement$)
CASE "INCLUDE"
' Get rid of doublequotes if they are there
inc$ = EXTRACT$((CHOP$(MID$(statement$, INSTR(statement$, " ") + 1))), CHR$(34))
' See if there are arguments
IF INSTR(inc$, ",") THEN
SPLIT MID$(inc$, INSTR(inc$, ",")+1) BY "," TO element$ SIZE size
FOR i = 1 TO size
element$[i] = EXTRACT$(element$[i], g_STRINGSIGN$)
NEXT
inc$ = MID$(inc$, 1, INSTR(inc$, ",")-1)
ELSE
to_parse = 2
END IF
' Check file extension
IF RIGHT$(inc$, 4) <> ".bac" THEN inc$ = inc$ & ".bac"
' Check argument
IF NOT(FILEEXISTS(inc$)) OR dim = 1 OR (FILETYPE(inc$) != 1 AND FILETYPE(inc$) != 6) THEN
EPRINT NL$, "System error: missing file '", inc$, "' for INCLUDE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Clear current terminal line
PRINT CR$, EL$;
' Check if the C Preprocessor needs to run
IF ISTRUE(g_CPP) THEN
IF ISTRUE(LEN(EXEC$("command -v cpp 2>/dev/null"))) THEN
PRINT "Preprocessing '", inc$, "'... ";
' Change next line marker to overcome C preprocessor interpretation
OPEN inc$ & ".tmp" FOR WRITING AS src_tmp
OPEN inc$ FOR READING AS src_in
WHILE NOT(ENDFILE(src_in))
READLN txt$ FROM src_in
IF LEFT$(txt$, 1) = "#" THEN
WRITELN txt$ TO src_tmp
ELSE
WRITELN "@" & txt$ & "@" TO src_tmp
ENDIF
WEND
CLOSE FILE src_in, src_tmp
SYSTEM "cpp -P -w " & inc$ & ".tmp " & inc$ & ".cpp"
' Restore next line marker
OPEN inc$ & ".cpp" FOR READING AS src_cpp
OPEN inc$ & ".bac2" FOR WRITING AS src_out
WHILE NOT(ENDFILE(src_cpp))
READLN txt$ FROM src_cpp
WRITELN MID$(txt$, 2, LEN(txt$)-2) TO src_out
WEND
CLOSE FILE src_out, src_cpp
newfeed$ = inc$ & ".bac2"
g_TMP_FILES$ = g_TMP_FILES$ & " " & inc$ & ".cpp" & " " & inc$ & ".tmp" & " " & inc$ & ".bac2"
PRINT "done."
ELSE
EPRINT "System error: the C Preprocessor 'cpp' not found on this system! Exiting..."
END 1
END IF
ELSE
newfeed$ = inc$
END IF
g_TMP_FILES$ = g_TMP_FILES$ & " " & inc$
' Start walking through program
copy_counter = g_COUNTER
g_COUNTER = 1
' Assign new file
copy_curfile$ = g_CURFILE$
' Set current filename
g_CURFILE$ = newfeed$
OPEN newfeed$ FOR READING AS newfile
REPEAT
READLN txt$ FROM newfile
' See if we need to enable flag
IF size > 0 THEN
FOR i = 1 TO size
IF ( to_parse = 0 AND REGEX(CHOP$(MID$(txt$, INSTR(txt$, " "))), "^" & CHOP$(element$[i])) AND REGEX(txt$, "SUB|FUNCTION") ) OR REGEX(txt$, "INCLUDE$") THEN
to_parse = 1
BREAK
END IF
NEXT
END IF
' Line is not empty?
IF LEN(txt$) > 0 AND to_parse > 0 THEN
IF NOT(g_QUIET) THEN PRINT "\rConverting '", newfeed$, "'... ", g_COUNTER, EL$;
IF RIGHT$(txt$, 1) = CR$ THEN
EPRINT "\nSystem error: Windows file detected! Remove non-Unix CR line separators first. Exiting..."
END 1
ELIF RIGHT$(txt$, 2) = " \\" AND LEFT$(txt$, 1) != CHR$(39) THEN
total$ = total$ & LEFT$(txt$, LEN(txt$)-2)
ELSE
total$ = CHOP$(total$ & txt$)
IF LEFT$(total$, 1) != CHR$(39) THEN
IF g_DEBUG THEN
WRITELN "/* line ", g_COUNTER, " \"", newfeed$, "\" */" TO g_CFILE
WRITELN "/* line ", g_COUNTER, " \"", newfeed$, "\" */" TO g_HFILE
ELSE
WRITELN "#line ", g_COUNTER, " \"", newfeed$, "\"" TO g_CFILE
WRITELN "#line ", g_COUNTER, " \"", newfeed$, "\"" TO g_HFILE
ENDIF
CALL Tokenize(total$)
END IF
LET total$ = ""
END IF
ENDIF
' See if we need to stop parsing
IF to_parse = 1 AND INSTR(txt$, "END") AND REGEX(txt$, "SUB|FUNCTION") THEN to_parse = 0
' Increase line number
INCR g_COUNTER
UNTIL ENDFILE(newfile)
CLOSE FILE newfile
' Save total amount of lines
INCR g_TOTAL_LINES, g_COUNTER
' Restore original counter
g_COUNTER = copy_counter
' Restore original file
g_CURFILE$ = copy_curfile$
' Set DATA array indexes correctly
WRITELN "__b2c__stringarray_ptr = ", g_CCTR, ";" TO g_CFILE
WRITELN "__b2c__floatarray_ptr = ", g_FCTR, ";" TO g_CFILE
END IF
CASE "POKE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty POKE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = MID$(statement$, INSTR(statement$, "POKE") + 4)
IF TALLY(exp$, " SIZE ") THEN
str$ = TOKEN$(exp$, 2, " SIZE ")
exp$ = TOKEN$(exp$, 1, " SIZE ")
token$ = Mini_Parser$(exp$)
exp$ = MID$(exp$, LEN(token$)+2)
WRITELN "if (__b2c__trap){if(!__b2c__memory__check((char*)", token$, ", (" & str$ & ")*sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"POKE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
WRITELN "memset((void*)(__b2c__MEMTYPE*)(" & token$ & "), " & exp$ & ", (" & str$ & ")*sizeof(__b2c__MEMTYPE));" TO g_CFILE
ELSE
token$ = Mini_Parser$(exp$)
exp$ = MID$(exp$, LEN(token$)+2)
WRITELN "if (__b2c__trap){if(!__b2c__memory__check((char*)", token$, ", sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"POKE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
WRITELN "*(__b2c__MEMTYPE*)(", token$, ") = ( __b2c__MEMTYPE)(", exp$, ");" TO g_CFILE
ENDIF
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
CASE "RESIZE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty RESIZE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = MID$(statement$, INSTR(statement$, "RESIZE") + 6)
lft$ = CHOP$(TOKEN$(exp$, 1, " TO "))
str$ = CHOP$(TOKEN$(exp$, 2, " TO "))
WRITELN "if(__b2c__trap) {if(!__b2c__memory__check((char*)", lft$, ", sizeof(__b2c__MEMTYPE))) {ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"RESIZE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
WRITELN lft$, " = (", Get_Var$(EXTRACT$(lft$, "."), g_FUNCNAME$), ")realloc((void*)", lft$, ", sizeof(__b2c__MEMTYPE)*(", str$, "+1));" TO g_CFILE
WRITELN "if(__b2c__trap) {if((void*)", lft$, " == NULL) {ERROR=6; if(!__b2c__catch_set) RUNTIMEERROR(\"RESIZE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
CASE "COPY"
Handle_Copy(statement$)
CASE "DELETE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty DELETE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C function
IF element$[2] = "FILE" THEN
WRITELN "if (unlink(", MID$(statement$, INSTR(statement$, " FILE ") + 6), ")==-1){if(__b2c__trap){ERROR = 7;if(!__b2c__catch_set) RUNTIMEERROR(\"DELETE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
ELIF element$[2] = "DIRECTORY" THEN
WRITELN "if (rmdir(", MID$(statement$, INSTR(statement$, " DIRECTORY ") + 11), ") == -1){if(__b2c__trap){ERROR = 20;if(!__b2c__catch_set) RUNTIMEERROR(\"DELETE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
ELIF element$[2] = "RECURSIVE" THEN
WRITELN "__b2c__rmrecursive(__LINE__, __FILE__, ", MID$(statement$, INSTR(statement$, " RECURSIVE ") + 11), ");" TO g_CFILE
ELIF ISTOKEN(statement$, "FROM") THEN
sym$ = CHOP$(LAST$(statement$, ISTOKEN(statement$, "FROM")))
exp$ = HEAD$(statement$, ISTOKEN(statement$, "FROM")-1)
exp$ = LAST$(exp$, ISTOKEN(exp$, "DELETE"))
IF Get_Var$("__b2c__tree_" & sym$, g_FUNCNAME$) = "__b2c__sortstr" THEN
WRITELN "__b2c__assign = *(char**)", exp$, "; tdelete((void*)", exp$, ", &", sym$, ", ", Get_Var$("__b2c__tree_" & sym$, g_FUNCNAME$), "); free(__b2c__assign);" TO g_CFILE
ELSE
WRITELN "tdelete((void*)", exp$, ", &", sym$, ", ", Get_Var$("__b2c__tree_" & sym$, g_FUNCNAME$), ");" TO g_CFILE
ENDIF
ELSE
EPRINT NL$, "Syntax error: erronuous argument for DELETE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
END IF
CASE "RENAME"
Handle_Rename(statement$)
CASE "MAKEDIR"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty MAKEDIR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C function
WRITELN "ERROR = __b2c__makedir(", LAST$(statement$, 1), "); if(ERROR && __b2c__trap){ if(!__b2c__catch_set) RUNTIMEERROR(\"MAKEDIR\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";}" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
CASE "CHANGEDIR"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty CHANGEDIR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C function
WRITELN "if(", LAST$(statement$, 1), " == NULL || chdir(", LAST$(statement$, 1), ") == -1){if(__b2c__trap) {ERROR = 22;if(!__b2c__catch_set) RUNTIMEERROR(\"CHANGEDIR\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
CASE "FREE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty FREE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C function
IF REGEX(statement$, "[a-zA-Z]+\\(.*\\)$") THEN
' Start miniparser
exp$ = LAST$(statement$, 1)
WHILE LEN(exp$)
token$ = CHOP$(LEFT$(exp$, INSTR(exp$, "(")-1))
str$ = CHOP$(Mini_Parser$(exp$))
txt$ = MID$(str$, INSTR(str$, "(")+1)
WRITELN "__b2c__hash_del(__b2c__assoc_", token$, ", ", LEFT$(txt$, LEN(txt$)-1), ");" TO g_CFILE
exp$ = MID$(exp$, LEN(str$)+2)
WEND
ELSE
FOR str$ IN EXTRACT$(LAST$(statement$, 1), " ") STEP ","
IF LEN(Get_Var$("__b2c__assoc_" & str$)) OR LEN(Get_Var$("__b2c__assoc_" & str$, g_FUNCNAME$)) THEN
WRITELN "__b2c__hash_clear(__b2c__assoc_", str$, ");" TO g_CFILE
ELSE
WRITELN "if(__b2c__trap){if(!__b2c__memory__check((char *)", str$, ", sizeof(__b2c__MEMTYPE)))" TO g_CFILE
WRITELN "{ERROR=1; if(!__b2c__catch_set) RUNTIMEERROR(\"FREE\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} } free((void*)", str$, ");" TO g_CFILE
FREE g_SEMANTIC_MEMFREE$(str$)
ENDIF
NEXT
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
END IF
CASE "ON"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty ON at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF NOT(ISTOKEN(statement$, "GOTO")) AND NOT(INSTR(statement$, "CALL")) THEN
EPRINT NL$, "Syntax error: ON without CALL/GOTO at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
PARSE COLLAPSE$(statement$) WITH "ON * " & IIF$(ISTOKEN(statement$, "CALL"), "CALL", "GOTO") & " *" TO match$
' Convert to C 'switch' statement
i = 1
WRITELN "switch(", match$[1], "){" TO g_CFILE
WHILE LEN(match$[2])
token$ = Mini_Parser$(match$[2])
IF ISTOKEN(statement$, "GOTO") THEN
WRITELN "case ", i, ": goto ", token$, "; break;" TO g_CFILE
ELSE
IF NOT(REGEX(token$, "\\(.*\\)$")) THEN
WRITELN "case ", i, ": ", token$, "(); break;" TO g_CFILE
ELSE
WRITELN "case ", i, ": ", token$, "; break;" TO g_CFILE
ENDIF
ENDIF
match$[2] = MID$(match$[2], LEN(token$)+2)
INCR i
WEND
WRITELN "}" TO g_CFILE
END IF
CASE "GOTO"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty GOTO at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C label
WRITELN "goto ", element$[2], ";" TO g_CFILE
END IF
CASE "GOSUB"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty GOSUB at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C label
WRITELN "__b2c__gosub_buffer_ptr++; if (__b2c__gosub_buffer_ptr >= ", g_MAX_RBUFFERS, ") {ERROR=31; if(!__b2c__catch_set) RUNTIMEERROR(\"GOSUB\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";}" TO g_CFILE
WRITELN "if(!setjmp(__b2c__gosub_buffer[__b2c__gosub_buffer_ptr])) goto ", element$[2], ";" TO g_CFILE
WRITELN "__b2c__gosub_buffer_ptr--; if(__b2c__gosub_buffer_ptr < -1) __b2c__gosub_buffer_ptr = -1;" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
END IF
CASE "LABEL"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty LABEL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Translate to C label
WRITELN element$[2], ":" TO g_CFILE
WRITELN ";" TO g_CFILE
' Needed for RESTORE
WRITELN "#undef __b2c__label_floatarray_", element$[2], " " TO g_HFILE
WRITELN "#define __b2c__label_floatarray_", element$[2], " ", g_FCTR TO g_HFILE
WRITELN "#undef __b2c__label_stringarray_", element$[2], " " TO g_HFILE
WRITELN "#define __b2c__label_stringarray_", element$[2], " ", g_CCTR TO g_HFILE
END IF
CASE "TRAP"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty TRAP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF element$[2] = "LOCAL" THEN
WRITELN "/* Error catching is enabled */" TO g_CFILE
WRITELN "__b2c__trap = 1;" TO g_CFILE
WRITELN "signal(SIGILL, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGABRT, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGFPE, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGSEGV, __b2c__catch_signal);" TO g_CFILE
ELIF element$[2] = "SYSTEM" THEN
WRITELN "/* Error catching is disabled */" TO g_CFILE
WRITELN "__b2c__trap = 0;" TO g_CFILE
WRITELN "signal(SIGILL, SIG_DFL);" TO g_CFILE
WRITELN "signal(SIGABRT, SIG_DFL);" TO g_CFILE
WRITELN "signal(SIGFPE, SIG_DFL);" TO g_CFILE
WRITELN "signal(SIGSEGV, SIG_DFL);" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument for TRAP at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
END IF
CASE "CATCH"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty CATCH at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF element$[2] = "GOTO" THEN
WRITELN "__b2c__catch_set = 1;" TO g_CFILE
g_CATCHGOTO$ = element$[3]
ELIF element$[2] = "ERROR" THEN
WRITELN "__b2c__error_callback = & ", element$[3], ";" TO g_CFILE
ELIF element$[2] = "RESET" THEN
WRITELN "__b2c__catch_set = 0;" TO g_CFILE
g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT"
ELSE
EPRINT NL$, "Syntax error: CATCH without GOTO or RESET at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
CASE "RESUME"
WRITELN "longjmp(__b2c__jump, 1);" TO g_CFILE
CASE "CLEAR"
WRITELN "fprintf(stdout,\"\\033[2J\"); fprintf(stdout,\"\\033[0;0f\");fflush(stdout);" TO g_CFILE
CASE "COLOR"
Handle_Color(statement$)
CASE "TYPE"
Handle_Type(statement$)
CASE "SCREEN"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SCREEN at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF element$[2] = "SAVE" THEN
WRITELN "fprintf(stdout,\"\\033[?47h\"); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "RESTORE" THEN
WRITELN "fprintf(stdout,\"\\033[?47l\"); fflush(stdout);" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument for SCREEN at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
END IF
CASE "GOTOXY"
Handle_Gotoxy(statement$)
CASE "RECEIVE"
Handle_Receive(CHOP$(MID$(statement$, INSTR(statement$, "RECEIVE") + 7)))
CASE "SEND"
Handle_Send(MID$(statement$, INSTR(statement$, "SEND") + 4))
CASE "RECORD"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty RECORD at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF ISTRUE(LEN(g_RECORDNAME$)) THEN
EPRINT NL$, "Syntax error: cannot define a record within a record!"
END 1
ELSE
' Determine name
g_RECORDVAR$ = MID$(statement$, INSTR(statement$, "RECORD")+6)
IF INSTR(g_RECORDVAR$, " ARRAY ") THEN
g_RECORDARRAY$ = MID$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "ARRAY")+5)
g_RECORDVAR$ = CHOP$(LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "ARRAY")-1)) & "[" & g_RECORDARRAY$ & "]"
ENDIF
' Translate to C typedef struct
IF ISTRUE(LEN(g_FUNCNAME$)) THEN
g_RECORDNAME$ = LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1) & "_TYPE"
WRITELN "typedef struct {" TO g_CFILE
Save_Func_Var("", g_FUNCNAME$, g_RECORDNAME$)
ELSE
g_RECORDNAME$ = LEFT$(g_RECORDVAR$, INSTR(g_RECORDVAR$, "[")-1) & "_TYPE"
WRITELN "typedef struct {" TO g_HFILE
Save_Main_Var("", g_RECORDNAME$)
ENDIF
ENDIF
CASE "WITH"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty WITH at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELIF ISTRUE(LEN(g_RECORDNAME$)) THEN
EPRINT NL$, "Syntax error: cannot define a WITH within a WITH!"
END 1
ELSE
g_WITHVAR$ = element$[2]
END IF
CASE "SPLIT"
Handle_Split(statement$)
CASE "JOIN"
Handle_Join(statement$)
CASE "SELECT"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SELECT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
INCR g_SELECTVAR_CTR
IF Check_String_Type(MID$(statement$, INSTR(statement$, "SELECT") + 6)) THEN
g_SELECTVAR$[g_SELECTVAR_CTR] = "__b2c__select_" & STR$(g_COUNTER) & g_STRINGSIGN$
IF LEN(g_FUNCNAME$) THEN
g_STRINGARGS$ = g_STRINGARGS$ & " char* " & g_SELECTVAR$[g_SELECTVAR_CTR] & " = NULL;"
g_LOCALSTRINGS$ = g_LOCALSTRINGS$ & " " & g_SELECTVAR$[g_SELECTVAR_CTR]
ELSE
WRITELN "char* ", g_SELECTVAR$[g_SELECTVAR_CTR], " = NULL;" TO g_HFILE
ENDIF
WRITELN "if(" & g_SELECTVAR$[g_SELECTVAR_CTR], ") { free(" & g_SELECTVAR$[g_SELECTVAR_CTR], "); } " & g_SELECTVAR$[g_SELECTVAR_CTR], " = __b2c__strdup((const char*)", MID$(statement$, INSTR(statement$, "SELECT") + 6), ");" TO g_CFILE
ELSE
g_SELECTVAR$[g_SELECTVAR_CTR] = "__b2c__select_" & STR$(g_COUNTER)
WRITELN "double ", g_SELECTVAR$[g_SELECTVAR_CTR], " = 0;" TO g_HFILE
WRITELN g_SELECTVAR$[g_SELECTVAR_CTR], " = (double)", MID$(statement$, INSTR(statement$, "SELECT") + 6), ";" TO g_CFILE
ENDIF
g_IN_CASE[g_SELECTVAR_CTR] = 0
g_CASE_FALL$ = ""
g_CASE_CONT$ =""
END IF
CASE "CASE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty CASE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' In processing of next CASE statements
IF ISTRUE(g_IN_CASE[g_SELECTVAR_CTR]) THEN g_CASE_CONT$ = "} else "
' Create IF
IF Check_String_Type(g_SELECTVAR$[g_SELECTVAR_CTR]) THEN
exp$ = MID$(statement$, INSTR(statement$, "CASE") + 4)
IF RIGHT$(statement$, 1) = ";" THEN
g_CASE_FALL$ = g_CASE_FALL$ & "!__b2c__strcmp(" & g_SELECTVAR$[g_SELECTVAR_CTR] & ", " & LEFT$(exp$, LEN(exp$)-1) & ") ||"
ELSE
WHILE LEN(exp$)
str$ = Mini_Parser$(exp$)
g_CASE_FALL$ = g_CASE_FALL$ & "!__b2c__strcmp(" & g_SELECTVAR$[g_SELECTVAR_CTR] & ", " & str$ & ") "
exp$ = MID$(exp$, LEN(str$)+2)
IF LEN(exp$) THEN g_CASE_FALL$ = g_CASE_FALL$ & "||"
WEND
WRITELN g_CASE_CONT$ & "if (", g_CASE_FALL$, "){" TO g_CFILE
g_IN_CASE[g_SELECTVAR_CTR] = 1
g_CASE_FALL$ = ""
END IF
ELSE
exp$ = MID$(statement$, INSTR(statement$, "CASE") + 4)
IF RIGHT$(statement$, 1) = ";" THEN
g_CASE_FALL$ = g_CASE_FALL$ & "(" & g_SELECTVAR$[g_SELECTVAR_CTR] & ") == (" & LEFT$(exp$, LEN(exp$)-1) & ") ||"
ELSE
WHILE LEN(exp$)
str$ = Mini_Parser$(exp$)
g_CASE_FALL$ = g_CASE_FALL$ & "(" & g_SELECTVAR$[g_SELECTVAR_CTR] & ") == (" & str$ & ")"
exp$ = MID$(exp$, LEN(str$)+2)
IF LEN(exp$) THEN g_CASE_FALL$ = g_CASE_FALL$ & "||"
WEND
WRITELN g_CASE_CONT$ & "if (", g_CASE_FALL$, "){" TO g_CFILE
g_IN_CASE[g_SELECTVAR_CTR] = 1
g_CASE_FALL$ = ""
END IF
END IF
END IF
CASE "DEFAULT"
IF ISTRUE(g_IN_CASE[g_SELECTVAR_CTR]) THEN
WRITELN "} else {" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: cannot use DEFAULT without previous CASE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
g_IN_CASE[g_SELECTVAR_CTR] = 0
g_CASE_FALL$ = ""
CASE "SETENVIRON"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SETENVIRON at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Resolve this with C macro
WRITELN "SETENVIRON(", MID$(statement$, INSTR(statement$, "SETENVIRON") + 10), ");" TO g_CFILE
END IF
CASE "SORT"
Handle_Sort(statement$)
CASE "STOP"
' Check argument
IF dim = 1 THEN
WRITELN "kill(getpid(), SIGSTOP);" TO g_CFILE
ELSE
WRITELN "kill(getpid(),", EXTRACT$(MID$(statement$, INSTR(statement$, "STOP") + 4), CHR$(34)), ");" TO g_CFILE
ENDIF
CASE "TRACE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty TRACE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF element$[2] = "MONITOR" THEN
g_TRACE = 1
WRITELN "fprintf(stderr, \"File '", g_CURFILE$, "' line %d: TRACE ON - press <SPACE> to execute the program step by step, <ESC> to exit.\\n\", ", g_COUNTER, ");" TO g_CFILE
g_MONITOR$ = ""
FOR sym$ IN MID$(statement$, INSTR(statement$, "MONITOR")+7) STEP ","
sym$ = CHOP$(EXTRACT$(sym$,"\\(.*", TRUE))
IF Check_String_Type(sym$) THEN
exp$ = REPLACE$(sym$, g_STRINGSIGN$, "$")
g_MONITOR$ = g_MONITOR$ & "&& (" & sym$ & "== NULL ? fprintf(stderr, \"MONITOR: " & exp$ & " = NULL\\n\") : fprintf(stderr, \"MONITOR: " & exp$ & " = %s\\n\", " & sym$ & ") )"
ELSE
exp$ = REPLACE$(sym$, g_FLOATSIGN$, "#")
exp$ = REPLACE$(exp$, g_LONGSIGN$, "%")
g_MONITOR$ = g_MONITOR$ & "&& fprintf(stderr, \"MONITOR: " & exp$ & " = %s\\n\", STR" & g_STRINGSIGN$ & "(" & sym$ & "))"
ENDIF
NEXT
ELIF element$[2] = "ON" THEN
g_TRACE = 1
WRITELN "fprintf(stderr, \"File '", g_CURFILE$, "' line %d: TRACE ON - press <SPACE> to execute the program step by step, <ESC> to exit.\\n\", ", g_COUNTER, ");" TO g_CFILE
ELIF element$[2] = "OFF" THEN
g_MONITOR$ = ""
g_TRACE = 0
END IF
ENDIF
CASE "OPTION"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty OPTION at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF element$[2] = "BASE" AND dim = 3 THEN
IF REGEX(element$[3], "[0-9]") THEN
g_OPTION_BASE = VAL(element$[3])
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION BASE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "COMPARE" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_compare = ", element$[3], ";" TO g_CFILE
WRITELN "#undef __b2c__STRCMP" TO g_CFILE
IF REGEX(element$[3], "1|TRUE") THEN
WRITELN "#define __b2c__STRCMP __b2c__strcasecmp" TO g_CFILE
ELSE
WRITELN "#define __b2c__STRCMP __b2c__strcmp" TO g_CFILE
ENDIF
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION COMPARE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "QUOTED" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_quoted = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION QUOTED at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "UTF8" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_utf8 = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION UTF8 at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "TLS" AND dim >= 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
IF element$[3] = "1" OR element$[3] = "TRUE" THEN
g_OPTION_TLS = TRUE
WRITELN "__b2c__option_tls = 1;" TO g_CFILE
g_INC_TLS$ = "#include <openssl/ssl.h>" & NL$ & "#include <openssl/err.h>"
g_LIB_TLS$ = CHOP$(EXEC$("pkg-config --libs openssl"))
ELSE
g_OPTION_TLS = FALSE
WRITELN "__b2c__option_tls = 0;" TO g_CFILE
ENDIF
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION TLS at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "EVAL" AND dim >= 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
g_CCFLAGS$ = g_CCFLAGS$ & " " & CHOP$(EXEC$("pkg-config --cflags libmatheval"))
g_LDFLAGS$ = g_LDFLAGS$ & " " & CHOP$(EXEC$("pkg-config --libs libmatheval"))
g_OPTION_EVAL = TRUE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION EVAL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "PROPER" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_proper = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION PROPER at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "ERROR" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_error = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION ERROR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "DELIM" AND dim > 2 THEN
WRITELN "__b2c__option_delim = ", MID$(statement$, INSTR(statement$, "DELIM") + 6), ";" TO g_CFILE
ELIF element$[2] = "INPUT" AND dim > 2 THEN
g_OPTION_INPUT$ = element$[3]
ELIF element$[2] = "DQ" AND dim > 2 THEN
WRITELN "__b2c__option_dq = ", MID$(statement$, INSTR(statement$, "DQ") + 3), "&255;" TO g_CFILE
ELIF element$[2] = "ESC" AND dim > 2 THEN
WRITELN "__b2c__option_esc = ", MID$(statement$, INSTR(statement$, "ESC") + 4), "&255;" TO g_CFILE
ELIF element$[2] = "SOCKET" AND dim = 3 THEN
IF REGEX(element$[3], "[0-9]") THEN
g_OPTION_SOCKET = VAL(element$[3])
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION SOCKET at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "BREAK" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
g_OPTION_BREAK = IIF(element$[3] = "TRUE", 1, VAL(element$[3]))
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION BREAK at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "MEMSTREAM" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_memstream = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION MEMSTREAM at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "MEMTYPE" AND dim > 2 THEN
WRITELN "#undef __b2c__MEMTYPE" TO g_CFILE
WRITELN "#define __b2c__MEMTYPE ", MID$(statement$, INSTR(statement$, "MEMTYPE")+8) TO g_CFILE
ELIF element$[2] = "COLLAPSE" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__collapse = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION COLLAPSE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "DEVICE" AND dim >= 3 THEN
WRITELN "__b2c__option_open = (", element$[3], ");" TO g_CFILE
ELIF element$[2] = "STARTPOINT" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
WRITELN "__b2c__option_startpoint = ", element$[3], ";" TO g_CFILE
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION STARTPOINT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "INTERNATIONAL" AND dim = 3 THEN
IF REGEX(element$[3], "1|TRUE") THEN
WRITELN "#include <libintl.h>" TO g_HFILE
WRITELN "setlocale(LC_ALL, \"\");" TO g_CFILE
WRITELN "if(bindtextdomain(\"", LEFT$(g_SOURCEFILE$, INSTR(g_SOURCEFILE$, ".")-1), "\",\"/usr/share/locale\")==NULL){if(__b2c__trap){ERROR = 6; if(!__b2c__catch_set) RUNTIMEERROR(\"OPTION INTERNATIONAL\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
WRITELN "if(textdomain(\"", LEFT$(g_SOURCEFILE$, INSTR(g_SOURCEFILE$, ".")-1), "\")==NULL){if(__b2c__trap){ERROR = 6; if(!__b2c__catch_set) RUNTIMEERROR(\"OPTION INTERNATIONAL\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION INTERNATIONAL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "NETWORK" AND dim >= 3 THEN
SELECT element$[3]
CASE "TCP"
g_NETWORKTYPE$ = "TCP"
g_SOCKTYPE$ = "SOCK_STREAM"
CASE "UDP"
g_NETWORKTYPE$ = "UDP"
g_SOCKTYPE$ = "SOCK_DGRAM"
CASE "BROADCAST"
g_NETWORKTYPE$ = "BROADCAST"
g_SOCKTYPE$ = "SOCK_DGRAM"
CASE "MULTICAST"
g_NETWORKTYPE$ = "MULTICAST"
g_SOCKTYPE$ = "SOCK_DGRAM"
IF dim = 4 AND REGEX(element$[4], "[0-9]") THEN
g_MULTICAST_TTL = VAL(element$[4])
ENDIF
CASE "SCTP"
g_INCFILES$ = g_INCFILES$ & " <netinet/sctp.h>"
WRITELN "struct sctp_initmsg __b2c__initmsg;" TO g_HFILE
g_NETWORKTYPE$ = "SCTP"
g_SOCKTYPE$ = "SOCK_STREAM"
g_LDFLAGS$ = g_LDFLAGS$ & " -lsctp"
IF dim = 4 AND REGEX(element$[4], "[0-9]") THEN
g_SCTP_STREAMS = VAL(element$[4])
END IF
DEFAULT
EPRINT NL$, "Syntax error: invalid argument to OPTION NETWORK at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END SELECT
ELIF element$[2] = "PARSE" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
g_IGNORE_PARSE$ = element$[3]
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION PARSE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "EXPLICIT" AND dim = 3 THEN
IF REGEX(element$[3], "[0-1]|TRUE|FALSE") THEN
g_OPTION_EXPLICIT$ = element$[3]
ELSE
EPRINT NL$, "Syntax error: invalid argument to OPTION EXPLICIT at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
ELIF element$[2] = "VARTYPE" AND dim > 2 THEN
g_VARTYPE$ = MID$(statement$, INSTR(statement$, "VARTYPE")+8)
ELIF element$[2] = "GUI" AND dim = 3 THEN
IF REGEX(element$[3], "1|TRUE") THEN
WRITELN "#define __b2c__gui_xaw" TO g_GENERIC
WRITELN "#ifdef __b2c__gui_xaw" TO g_HFILE
WRITELN "#include <AllWidgets.h>" TO g_HFILE
WRITELN "#include <AsciiText.h>" TO g_HFILE
WRITELN "#include <Box.h>" TO g_HFILE
WRITELN "#include <Dialog.h>" TO g_HFILE
WRITELN "#include <Command.h>" TO g_HFILE
WRITELN "#include <Form.h>" TO g_HFILE
WRITELN "#include <Grip.h>" TO g_HFILE
WRITELN "#include <List.h>" TO g_HFILE
WRITELN "#include <MenuButton.h>" TO g_HFILE
WRITELN "#include <MultiSink.h>" TO g_HFILE
WRITELN "#include <Paned.h>" TO g_HFILE
WRITELN "#include <Panner.h>" TO g_HFILE
WRITELN "#include <Porthole.h>" TO g_HFILE
WRITELN "#include <Repeater.h>" TO g_HFILE
WRITELN "#include <Scrollbar.h>" TO g_HFILE
WRITELN "#include <SimpleMenu.h>" TO g_HFILE
WRITELN "#include <SmeBSB.h>" TO g_HFILE
WRITELN "#include <SmeLine.h>" TO g_HFILE
WRITELN "#include <StripChart.h>" TO g_HFILE
WRITELN "#include <Tip.h>" TO g_HFILE
WRITELN "#include <Toggle.h>" TO g_HFILE
WRITELN "#include <Tree.h>" TO g_HFILE
WRITELN "#include <Viewport.h>" TO g_HFILE
WRITELN "#include <X11/Intrinsic.h>" TO g_HFILE
WRITELN "#include <X11/Shell.h>" TO g_HFILE
WRITELN "#include <X11/StringDefs.h>" TO g_HFILE
WRITELN "#endif" TO g_HFILE
g_CCFLAGS$ = g_CCFLAGS$ & " -I/usr/include/X11/Xaw"
g_INCLUDE_FILES$ = g_INCLUDE_FILES$ & " " & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".gui.h"
g_LDFLAGS$ = g_LDFLAGS$ & " -lXaw -lXmu -lXt -lX11"
ENDIF
ELSE
EPRINT NL$, "Syntax error: argument to OPTION at line ", g_COUNTER, " in file '", g_CURFILE$, "' not recognized!"
END 1
END IF
END IF
CASE "PROTO"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty PROTO at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = EXTRACT$(LAST$(statement$, 1), CHR$(34))
' Check if ALIAS is there
IF ISTOKEN(exp$, "ALIAS") THEN
WRITELN "#define ", CHOP$(TOKEN$(exp$, 2, "ALIAS")), " ", CHOP$(TOKEN$(exp$, 1, "ALIAS")) TO g_HFILE
g_IMPORTED$ = TOKEN$(exp$, 2, "ALIAS") & " " & g_IMPORTED$
g_IMPORTED$ = TOKEN$(exp$, 1, "ALIAS") & " " & g_IMPORTED$
ELIF ISTOKEN(exp$, "TYPE") THEN
WRITELN TOKEN$(exp$, 2, "TYPE"), " ", TOKEN$(exp$, 1, "TYPE"), ";" TO g_HFILE
ELSE
g_IMPORTED$ = REPLACE$(exp$, ",", " ") & " " & g_IMPORTED$
END IF
END IF
CASE "INCR"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty INCR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Get left side
token$ = Mini_Parser$(statement$)
' Get right side
exp$ = CHOP$(MID$(statement$, LEN(token$)+2))
IF NOT(LEN(exp$)) THEN exp$ = "1"
token$ = CHOP$(MID$(token$, INSTR(token$, " ")))
' Check if there is associative array assignment
IF REGEX(token$, "[a-zA-Z]+\\(.*\\)$") THEN
lft$ = LEFT$(token$, INSTR(token$, "(") - 1)
str$ = INBETWEEN$(token$, "(", ")", 2)
WRITELN "__b2c__assoc_", lft$, "_eval = ", token$, " + (", exp$, "); __b2c__hash_add(__b2c__assoc_", lft$, ", &__b2c__assoc_", lft$, "_eval, ", str$, ");" TO g_CFILE
' Check for relations
Relate_Recurse(lft$, str$, token$ & "+(" & exp$ & ")", -1)
ELSE
' Regular number
IF REGEX(exp$, "[0-9]\\.[0-9]") THEN
Register_Numeric(token$, "double")
ELIF NOT(LEN(Get_Var$(token$, g_FUNCNAME$))) THEN
Register_Numeric(token$, "default")
ENDIF
WRITELN token$, " = ", token$, " + (", exp$, ");" TO g_CFILE
END IF
END IF
CASE "DECR"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty DECR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Get left side
token$ = Mini_Parser$(statement$)
' Get right side
exp$ = CHOP$(MID$(statement$, LEN(token$)+2))
IF NOT(LEN(exp$)) THEN exp$ = "1"
token$ = CHOP$(MID$(token$, INSTR(token$, " ")))
' Check if there is associative array assignment
IF REGEX(token$, "[a-zA-Z]+\\(.*\\)$") THEN
lft$ = LEFT$(token$, INSTR(token$, "(") - 1)
str$ = INBETWEEN$(token$, "(", ")", 2)
WRITELN "__b2c__assoc_", lft$, "_eval = ", token$, " - (", exp$, "); __b2c__hash_add(__b2c__assoc_", lft$, ", &__b2c__assoc_", lft$, "_eval, ", str$, ");" TO g_CFILE
' Check for relations
Relate_Recurse(lft$, str$, token$ & "+(" & exp$ & ")", -1)
ELSE
' Regular number
IF REGEX(exp$, "[0-9]\\.[0-9]") THEN
Register_Numeric(token$, "double")
ELIF NOT(LEN(Get_Var$(token$, g_FUNCNAME$))) THEN
Register_Numeric(token$, "default")
ENDIF
WRITELN token$, " = ", token$, " - (", exp$, ");" TO g_CFILE
END IF
END IF
CASE "ALARM"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty ALARM at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
str$ = EXTRACT$(TOKEN$(statement$, 1, ","), "^ALARM ", TRUE)
exp$ = TOKEN$(statement$, 2, ",")
WRITELN "__b2c__alarm((void*)(uintptr_t)(&", str$, "), ", exp$, ");" TO g_CFILE
END IF
CASE "SIGNAL"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SIGNAL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Walk through commas
SPLIT LAST$(statement$, 1) BY "," TO symbol$ SIZE dim
IF dim = 2 THEN
IF ISTOKEN(symbol$[1], "SIG_DFL") OR ISTOKEN(symbol$[1], "SIG_IGN") THEN
WRITELN "__b2c__signal((void*)(uintptr_t)", symbol$[1], ", ", symbol$[2], ");" TO g_CFILE
ELSE
WRITELN "__b2c__signal((void*)(uintptr_t)(&", symbol$[1], "), ", symbol$[2], ");" TO g_CFILE
ENDIF
ELSE
EPRINT NL$, "Syntax error: missing argument in SIGNAL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
END IF
CASE "CURSOR"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty CURSOR at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = IIF$(dim = 3, element$[3], "1")
IF element$[2] = "ON" THEN
WRITELN "fprintf(stdout,\"\\033[?25h\"); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "OFF" THEN
WRITELN "fprintf(stdout,\"\\033[?25l\"); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "UP" THEN
WRITELN "fprintf(stdout,\"\\033[%ldA\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "DOWN" THEN
WRITELN "fprintf(stdout,\"\\033[%ldB\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "FORWARD" THEN
WRITELN "fprintf(stdout,\"\\033[%ldC\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "BACK" THEN
WRITELN "fprintf(stdout,\"\\033[%ldD\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
END IF
ENDIF
CASE "SCROLL"
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty SCROLL at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = IIF$(dim = 3, element$[3], "1")
IF element$[2] = "UP" THEN
WRITELN "fprintf(stdout,\"\\033[%ldS\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
ELIF element$[2] = "DOWN" THEN
WRITELN "fprintf(stdout,\"\\033[%ldT\", (long)", exp$, "); fflush(stdout);" TO g_CFILE
END IF
END IF
CASE "ALIAS"
Handle_Alias(statement$)
CASE "LOOKUP"
Handle_Lookup(statement$)
CASE "RELATE"
Handle_Relate(CHOP$(MID$(statement$, INSTR(statement$, "RELATE") + 6)))
CASE "TEXTDOMAIN"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty TEXTDOMAIN at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
' Walk through commas
SPLIT CHOP$(MID$(statement$, INSTR(statement$, "TEXTDOMAIN") + 10)) BY "," TO symbol$ SIZE dim
IF dim = 2 THEN
WRITELN "if(bindtextdomain(", symbol$[1], ",", symbol$[2], ")==NULL){if(__b2c__trap){ERROR = 6; if(!__b2c__catch_set) RUNTIMEERROR(\"TEXTDOMAIN\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
WRITELN "if(textdomain(", symbol$[1], ")==NULL){if(__b2c__trap){ERROR = 6; if(!__b2c__catch_set) RUNTIMEERROR(\"TEXTDOMAIN\", ", g_COUNTER, ", \"", g_CURFILE$, "\", ERROR); else if(!setjmp(__b2c__jump)) goto ", g_CATCHGOTO$, ";} }" TO g_CFILE
IF g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT" THEN g_CATCH_USED = 1
ELSE
EPRINT NL$, "Syntax error: missing argument in TEXTDOMAIN at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
END IF
CASE "REDIM"
Handle_Redim(CHOP$(MID$(statement$, INSTR(statement$, "REDIM") + 5)))
CASE "EXIT"
IF LEN(g_FUNCNAME$) = 0 THEN
EPRINT NL$, "Syntax error: EXIT not in FUNCTION or SUB at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
END IF
' Free strings variables if there are any
WRITELN g_STRINGARRAYS$ TO g_CFILE
FOR exp$ IN g_LOCALSTRINGS$
WRITELN "__b2c__STRFREE(", exp$, ");" TO g_CFILE
NEXT
WRITELN "__b2c__catch_set = __b2c__catch_set_backup;" TO g_CFILE
' The actual exit
IF INSTR(g_FUNCNAME$, g_STRINGSIGN$) THEN
WRITELN "return(NULL);" TO g_CFILE
ELSE
WRITELN "return __b2c__exitval;" TO g_CFILE
END IF
CASE "PRAGMA"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty PRAGMA at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
IF element$[2] = "OPTIONS" AND dim >= 3 THEN
FOR i = 3 TO dim
g_CCFLAGS$ = g_CCFLAGS$ & " " & element$[i]
NEXT
ELIF element$[2] = "COMPILER" AND dim = 3 THEN
g_CCNAME$ = element$[3]
ELIF element$[2] = "FRAMEWORK" AND dim >= 3 THEN
FOR i = 3 TO dim
g_LDFLAGS$ = g_LDFLAGS$ & " -framework " & element$[i]
NEXT
ELIF element$[2] = "RE" AND dim >= 3 THEN
g_PRAGMA_REGEX$ = MID$(statement$, INSTR(statement$, "RE")+3)
IF NOT(REGEX(g_PRAGMA_REGEX$, " LDFLAGS ")) THEN
exp$ = HEAD$(g_PRAGMA_REGEX$, 1)
IF INSTR(exp$, "tre") THEN
g_LDFLAGS$ = g_LDFLAGS$ & " " & CHOP$(EXEC$("pkg-config --libs tre"))
ELIF INSTR(exp$, "pcre") THEN
g_LDFLAGS$ = g_LDFLAGS$ & " " & CHOP$(EXEC$("pkg-config --libs libpcreposix"))
ELIF INSTR(exp$, "onig") THEN
g_LDFLAGS$ = g_LDFLAGS$ & " " & CHOP$(EXEC$("pkg-config --libs oniguruma"))
ENDIF
ELSE
exp$ = MID$(g_PRAGMA_REGEX$, INSTR(g_PRAGMA_REGEX$, " LDFLAGS ")+9)
g_LDFLAGS$ = exp$ & " " & g_LDFLAGS$
ENDIF
ELIF element$[2] = "TLS" AND dim >= 3 THEN
g_LIB_TLS$ = MID$(statement$, INSTR(statement$, "TLS")+4)
g_OPTION_TLS = TRUE
WRITELN "__b2c__option_tls = 1;" TO g_CFILE
IF NOT(REGEX(g_LIB_TLS$, " LDFLAGS ")) THEN
exp$ = HEAD$(g_LIB_TLS$, 1)
IF TALLY(exp$, "openssl") THEN
g_LIB_TLS$ = CHOP$(EXEC$("pkg-config --libs openssl"))
g_INC_TLS$ = "#include <openssl/ssl.h>" & NL$ & "#include <openssl/err.h>"
ELIF TALLY(exp$, "gnutls") THEN
g_LIB_TLS$ = CHOP$(EXEC$("pkg-config --libs gnutls")) & " -lgnutls-openssl"
g_INC_TLS$ = "#include <gnutls/openssl.h>"
ELIF INSTR(exp$, "wolfssl") THEN
g_LIB_TLS$ = CHOP$(EXEC$("pkg-config --libs wolfssl"))
g_INC_TLS$ = "#include <wolfssl/options.h>" & NL$ & "#include <wolfssl/openssl/ssl.h>"
ENDIF
ELSE
g_INC_TLS$ = LEFT$(g_LIB_TLS$, INSTR(g_LIB_TLS$, " LDFLAGS ")-1)
g_LIB_TLS$ = MID$(g_LIB_TLS$, INSTR(g_LIB_TLS$, " LDFLAGS ")+9)
ENDIF
ELIF element$[2] = "GUI" AND dim >= 3 THEN
exp$ = MID$(statement$, INSTR(statement$, "GUI")+4)
IF NOT(INSTR(exp$, " LDFLAGS ")) THEN
IF LCASE$(HEAD$(exp$, 1)) = "xaw3d" THEN
WRITELN "#include <ThreeD.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw", "-lXaw3d")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "-I/usr/include/X11/Xaw3d")
ELIF LCASE$(HEAD$(exp$, 1)) = "motif" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <Xm/XmAll.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw", "-lXm")
g_CCFLAGS$ = EXTRACT$(g_CCFLAGS$, "-I/usr/include/X11/Xaw")
ELIF LCASE$(HEAD$(exp$, 1)) = "uil" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#define __b2c__gui_uil" TO g_GENERIC
WRITELN "#include <Xm/XmAll.h>" TO g_HFILE
WRITELN "#include <Mrm/MrmAppl.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw", "-lMrm -lXm")
g_CCFLAGS$ = EXTRACT$(g_CCFLAGS$, "-I/usr/include/X11/Xaw")
ELIF LCASE$(HEAD$(exp$, 1)) = "gtk2" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <gtk/gtk.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw -lXmu -lXt -lX11", "`pkg-config --libs gtk+-2.0`")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "`pkg-config --cflags gtk+-2.0`")
g_WHICH_GUI = 1
ELIF LCASE$(HEAD$(exp$, 1)) = "gtk3" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <gtk/gtk.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw -lXmu -lXt -lX11", "`pkg-config --libs gtk+-3.0`")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "`pkg-config --cflags gtk+-3.0`")
g_WHICH_GUI = 1
ELIF LCASE$(HEAD$(exp$, 1)) = "gtk4" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <gtk/gtk.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw -lXmu -lXt -lX11", "`pkg-config --libs gtk4`")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "`pkg-config --cflags gtk4`")
g_WHICH_GUI = 3
ELIF LCASE$(HEAD$(exp$, 1)) = "cdk" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <cdk.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw -lXmu -lXt -lX11", "-lncurses -lcdk")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "-I/usr/include/cdk")
g_WHICH_GUI = 2
ELIF LCASE$(HEAD$(exp$, 1)) = "tk" THEN
WRITELN "#undef __b2c__gui_xaw" TO g_GENERIC
WRITELN "#include <tcl.h>" TO g_HFILE
WRITELN "#include <tk.h>" TO g_HFILE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw -lXmu -lXt -lX11", "`pkg-config --libs tk tcl`")
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", "`pkg-config --cflags tk tcl`")
g_WHICH_GUI = 4
ENDIF
IF g_WHICH_GUI = 1 THEN
WRITELN "#define GTKINIT gtk_init(NULL,NULL)" TO g_HFILE
WRITELN "#define GTKMAINITERATION gtk_main_iteration()" TO g_HFILE
WRITELN "#define GTKWIDGETSHOW gtk_widget_show_all" TO g_HFILE
WRITELN "#define GTKCONTAINERADD(x,y) gtk_container_add(GTK_CONTAINER(x), GTK_WIDGET(y))" TO g_HFILE
ELIF g_WHICH_GUI = 3 THEN
WRITELN "#define GTKINIT gtk_init()" TO g_HFILE
WRITELN "#define GTKMAINITERATION g_main_context_iteration(NULL,1)" TO g_HFILE
WRITELN "#define GTKWIDGETSHOW gtk_widget_show" TO g_HFILE
WRITELN "#define GTKCONTAINERADD(x,y) (GTK_IS_BOX(x) ? gtk_box_append(GTK_BOX(x), GTK_WIDGET(y)) : g_object_set(GTK_WIDGET(x), \"child\", GTK_WIDGET(y), NULL))" TO g_HFILE
ENDIF
ELSE
g_LDFLAGS$ = REPLACE$(g_LDFLAGS$, "-lXaw", TOKEN$(exp$, 2, " LDFLAGS "))
g_CCFLAGS$ = REPLACE$(g_CCFLAGS$, "-I/usr/include/X11/Xaw", TOKEN$(TOKEN$(exp$, 1, " LDFLAGS "), 2, " OPTIONS "))
ENDIF
ELIF element$[2] = "LDFLAGS" AND dim >= 3 THEN
IF TALLY(TOKEN$(statement$, 2, "LDFLAGS"), "pkg-config") THEN
g_LDFLAGS$ = TOKEN$(statement$, 2, "LDFLAGS") & " " & g_LDFLAGS$
ELSE
FOR i = 3 TO dim
IF element$[i] = "TRUE" THEN
found = TRUE
BREAK
ELIF LEFT$(element$[i], 1) = "-" OR RIGHT$(element$[i], 2) = ".a" THEN
exp$ = exp$ & " " & element$[i]
ELSE
exp$ = exp$ & " -l" & element$[i]
FI
NEXT
IF found THEN
g_LDFLAGS$ = exp$ & " " & g_LDFLAGS$
ELSE
g_LDFLAGS$ = g_LDFLAGS$ & " " & exp$
FI
FI
ELIF element$[2] = "INCLUDE" AND dim >= 3 THEN
FOR i = 3 TO dim
IF LEFT$(element$[i], 1) = "/" OR LEFT$(element$[i], 2) = "./" THEN
g_PRAGMA_INCLUDE$ = g_PRAGMA_INCLUDE$ & NL$ & "#include " & CHR$(34) & element$[i] & CHR$(34)
ELIF LEFT$(element$[i], 1) = "<" THEN
g_PRAGMA_INCLUDE$ = g_PRAGMA_INCLUDE$ & NL$ & "#include " & element$[i]
ELSE
g_PRAGMA_INCLUDE$ = g_PRAGMA_INCLUDE$ & NL$ & "#include " & CHR$(34) & CURDIR$ & "/" & element$[i] & CHR$(34)
ENDIF
NEXT
ELSE
WRITELN "#pragma ", CHOP$(MID$(statement$, INSTR(statement$, "PRAGMA") + 6)) TO g_CFILE
END IF
ENDIF
CASE "SWAP"
Handle_Swap(statement$)
CASE "SETSERIAL"
Handle_Setserial(CHOP$(MID$(statement$, INSTR(statement$, "SETSERIAL") + 9)))
CASE "ENUM"
IF NOT(LEN(g_FUNCNAME$)) THEN
WRITELN "enum {" TO g_HFILE
g_USE_H = 1
ELSE
WRITELN "enum {" TO g_CFILE
g_USE_C = 1
ENDIF
CASE "RUN"
Handle_Run(statement$)
CASE "SAVE"
Handle_Save(0, CHOP$(MID$(statement$, INSTR(statement$, "SAVE") + 4)))
CASE "BSAVE"
Handle_Save(1, CHOP$(MID$(statement$, INSTR(statement$, "BSAVE") + 5)))
CASE "APPEND"
exp$ = MID$(statement$, INSTR(statement$, "APPEND") + 6)
IF NOT(ISTOKEN(exp$, "TO")) AND HASDELIM(exp$, ",") THEN
WRITELN TOKEN$(exp$, 1, ","), "= F_CONCAT", g_STRINGSIGN$, "(", TOKEN$(exp$, 1, ","), ",", exp$, ");" TO g_CFILE
ELSE
Handle_Save(2, CHOP$(MID$(statement$, INSTR(statement$, "APPEND") + 6)))
FI
CASE "BAPPEND"
Handle_Save(3, CHOP$(MID$(statement$, INSTR(statement$, "BAPPEND") + 7)))
CASE "MAP"
Handle_Map(statement$)
CASE "RESET"
WRITELN "fprintf(stdout,\"\\033c\"); fflush(stdout);" TO g_CFILE
CASE "CERTIFICATE"
' Check argument
IF dim = 1 THEN
EPRINT NL$, "Syntax error: empty CERTIFICATE at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ELSE
exp$ = MID$(statement$, INSTR(statement$, "CERTIFICATE") + 11)
token$ = Mini_Parser$(exp$)
WRITELN "#undef __b2c__caprivate" TO g_CFILE
WRITELN "#define __b2c__caprivate ", token$ TO g_CFILE
exp$ = MID$(exp$, LEN(token$)+2)
token$ = Mini_Parser$(exp$)
WRITELN "#undef __b2c__caserver" TO g_CFILE
WRITELN "#define __b2c__caserver ", token$ TO g_CFILE
ENDIF
CASE "TREE"
Handle_Tree(statement$)
CASE "COLLECT"
Handle_Collect(statement$)
CASE "PARSE"
Handle_Parse(statement$)
CASE "GETKEY"
WRITELN "__b2c__getch();" TO g_CFILE
DEFAULT
' Check on imported symbols first
IF INSTR(element$[1], "(") THEN element$[1] = TOKEN$(element$[1], 1, "(")
IF ISTOKEN(g_IMPORTED$, element$[1]) THEN
IF REGEX(statement$, "\\(.*\\)") THEN
WRITELN statement$, ";" TO g_CFILE
ELSE
WRITELN statement$, "();" TO g_CFILE
ENDIF
ELSE
Handle_Let(statement$)
ENDIF
ENDSELECT
END IF
END IF
END SUB
'----------------------------------------------------------------------------------------------
FUNCTION Pre_Tokenize_Functions$(arg$)
LOCAL token$, it$, var$, val$, type$, first$, second$, delim$, intoken$
LOCAL is_escaped, is_string, i, j, mem, nr = 1, many, pos
LOCAL out TYPE FILE*
' These are exceptions for small letter statements
IF REGEX(arg$, "^const[[:space:]]") AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) THEN arg$ = "CONST " & MID$(arg$, 6)
IF REGEX(arg$, "[[:space:]]static$") AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) THEN arg$ = LEFT$(arg$, LEN(arg$)-7) & " STATIC"
' Check if one of these functions are there
IF REGEX(arg$, "TYPEOF\\$|SOURCE\\$|OBTAIN\\$|IIF\\(|IIF\\$\\(|FIND\\(|EVAL\\(|VERIFY|REM|LOOP|COIL\\$|GUIDEFINE|UBOUND|INDEX|INVERT|[^a-zA-Z0-9_]int\\(") THEN
' If so, see if they are not part of a string and perform special treatment
FOR i = 1 TO LEN(arg$)
IF NOT(is_string) THEN
IF MID$(arg$, i, 7) = "TYPEOF$" THEN
it$ = MID$(arg$, i, INSTR(MID$(arg$, i), ")")-1)
token$ = token$ & CHR$(34) & Get_Var$(MID$(it$, INSTR(it$, "(")+1), g_FUNCNAME$) & CHR$(34)
INCR i, LEN(it$)+1
ELIF MID$(arg$, i, 7) = "SOURCE$" THEN
IF NOT(FILEEXISTS(SRCARRAYFILE$)) THEN
mem = BLOAD(g_SOURCEFILE$)
OPTION MEMTYPE unsigned char
OPEN SRCARRAYFILE$ FOR WRITING AS out
WRITELN "char SOURCE", g_STRINGSIGN$, "[]={"; TO out
FOR j = 0 TO FILELEN(g_SOURCEFILE$)-1
IF MOD(j, 16) = 0 THEN WRITELN "" TO out
WRITELN PEEK(mem+j), ","; TO out
NEXT
WRITELN "0 };" TO out
CLOSE FILE out
FREE mem
ENDIF
ELIF MID$(arg$, i, 7) = "OBTAIN$" THEN
pos = INSTR(MID$(arg$, i), "(")
intoken$ = Mini_Parser$(MID$(arg$, i+pos))
intoken$ = REPLACE$(intoken$, "$", g_STRINGSIGN$)
intoken$ = REPLACE$(intoken$, "#", g_FLOATSIGN$)
intoken$ = REPLACE$(intoken$, "%", g_LONGSIGN$)
type$ = Get_Var$("__b2c__assoc_" & intoken$, g_FUNCNAME$)
WRITELN "#undef __b2c__obtain_type_", intoken$ TO g_CFILE
SELECT type$
CASE "char*", "STRING"
WRITELN "#define __b2c__obtain_type_", intoken$, " 0" TO g_CFILE
CASE "double", "FLOATING"
WRITELN "#define __b2c__obtain_type_", intoken$, " 1" TO g_CFILE
CASE "float"
WRITELN "#define __b2c__obtain_type_", intoken$, " 2" TO g_CFILE
CASE "long", "NUMBER"
WRITELN "#define __b2c__obtain_type_", intoken$, " 3" TO g_CFILE
CASE "int"
WRITELN "#define __b2c__obtain_type_", intoken$, " 4" TO g_CFILE
CASE "short"
WRITELN "#define __b2c__obtain_type_", intoken$, " 5" TO g_CFILE
CASE "char"
WRITELN "#define __b2c__obtain_type_", intoken$, " 6" TO g_CFILE
DEFAULT
WRITELN "#define __b2c__obtain_type_", intoken$, " -1" TO g_CFILE
ENDSELECT
token$ = token$ & "OBTAIN$"
INCR i, 7
ELIF MID$(arg$, i, 7) = "VERIFY(" THEN
var$ = MID$(arg$, INSTR(arg$, "(")+1)
intoken$ = Mini_Parser$(var$)
intoken$ = MID$(var$, LEN(intoken$)+2)
WRITELN "#undef __b2c__cacerts" TO g_HFILE
WRITELN "#define __b2c__cacerts ", TOKEN$(intoken$, 1, ")") TO g_HFILE
IF TALLY(g_LIB_TLS$, "wolfssl") THEN
WRITELN "#undef __b2c__capeer" TO g_HFILE
WRITELN "#define __b2c__capeer SSL_VERIFY_PEER" TO g_HFILE
ENDIF
token$ = token$ & "VERIFY("
INCR i, 7
ELIF MID$(arg$, i, 6) = "UBOUND" THEN
it$ = MID$(arg$, i, INSTR(MID$(arg$, i), ")")-1)
INCR i, LEN(it$)+1
it$ = REPLACE$(it$, "$", g_STRINGSIGN$)
it$ = REPLACE$(it$, "#", g_FLOATSIGN$)
it$ = REPLACE$(it$, "%", g_LONGSIGN$)
IF LEN(Get_Var$("__b2c__assoc_" & TOKEN$(it$, 2, "("), g_FUNCNAME$)) THEN
token$ = token$ & "NRKEYS(" & TOKEN$(it$, 2, "(") & ")"
ELIF ISTOKEN(g_DYNAMICARRAYS$, TOKEN$(it$, 2, "(") & "@" & g_FUNCNAME$) THEN
token$ = token$ & TOKEN$(it$, 2, "(") & "__b2c_array"
ELSE
type$ = Get_Var$(TOKEN$(it$, 2, "("), g_FUNCNAME$)
token$ = token$ & "(sizeof(" & TOKEN$(it$, 2, "(") & ")/sizeof(" & type$ & ")-" & STR$(g_OPTION_BASE) & ")"
ENDIF
ELIF MID$(arg$, i, 7) = "INVERT(" THEN
pos = INSTR(MID$(arg$, i), "(")
intoken$ = Mini_Parser$(MID$(arg$, i+pos))
type$ = Get_Var$("__b2c__assoc_" & intoken$, g_FUNCNAME$)
SELECT type$
CASE "char*", "STRING"
nr = 0
CASE "double", "FLOATING"
nr = 1
CASE "float"
nr = 2
CASE "long", "NUMBER"
nr = 3
CASE "int"
nr = 4
CASE "short"
nr = 5
CASE "char"
nr = 6
DEFAULT
nr = -1
ENDSELECT
intoken$ = REPLACE$(intoken$, "$", g_STRINGSIGN$)
intoken$ = REPLACE$(intoken$, "#", g_FLOATSIGN$)
intoken$ = REPLACE$(intoken$, "%", g_LONGSIGN$)
token$ = token$ & "INVERT(" & STR$(nr) & ","
INCR i, 7
ELIF MID$(arg$, i, 6) = "INDEX(" OR MID$(arg$, i, 7) = "INDEX$(" THEN
pos = INSTR(MID$(arg$, i), "(")
intoken$ = Mini_Parser$(MID$(arg$, i+pos))
type$ = Get_Var$("__b2c__assoc_" & intoken$, g_FUNCNAME$)
IF NOT(LEN(type$)) THEN type$ = Get_Var$(intoken$, g_FUNCNAME$)
SELECT type$
CASE "char*", "STRING"
nr = 0
CASE "double", "FLOATING"
nr = 1
CASE "float"
nr = 2
CASE "long", "NUMBER"
nr = 3
CASE "int"
nr = 4
CASE "short"
nr = 5
CASE "char"
nr = 6
DEFAULT
nr = -1
ENDSELECT
intoken$ = REPLACE$(intoken$, "$", g_STRINGSIGN$)
intoken$ = REPLACE$(intoken$, "#", g_FLOATSIGN$)
intoken$ = REPLACE$(intoken$, "%", g_LONGSIGN$)
IF LEN(Get_Var$("__b2c__assoc_" & intoken$, g_FUNCNAME$)) THEN
token$ = token$ & "INDEX$(" & STR$(nr) & ","
INCR i, 7
ELIF ISTOKEN(g_DYNAMICARRAYS$, intoken$ & "@" & g_FUNCNAME$) THEN
token$ = token$ & "INDEX(" & intoken$ & "__b2c_array," & STR$(nr) & ","
INCR i, 6
ELSE
type$ = Get_Var$(intoken$, g_FUNCNAME$)
token$ = token$ & "INDEX(sizeof(" & intoken$ & ")/sizeof(" & type$ & ")-" & STR$(g_OPTION_BASE) & "," & STR$(nr) & ","
INCR i, 6
ENDIF
ELIF MID$(arg$, i, 9) = "GUIDEFINE" THEN
pos = INSTR(MID$(arg$, i), "(")
intoken$ = Mini_Parser$(MID$(arg$, i+pos))
CALL guiGenerate(CHOP$(intoken$, "\n\r\t " & CHR$(34)))
token$ = token$ & "GUIDEFINE"
INCR i, 9
ELIF MID$(arg$, i, 6) = "LOOP$(" OR MID$(arg$, i, 6) = "COIL$(" OR MID$(arg$, i, 5) = "LOOP(" THEN
delim$ = "__b2c__option_delim"
pos = INSTR(MID$(arg$, i), "(")
first$ = Mini_Parser$(MID$(arg$, i+pos))
second$ = Mini_Parser$(MID$(arg$, i+pos+LEN(first$)+1))
IF MID$(arg$, i+pos+LEN(first$)+1+LEN(second$), 1) = "," THEN
intoken$ = Mini_Parser$(MID$(arg$, i+pos+LEN(first$)+1+LEN(second$)+1))
IF MID$(arg$, i+pos+LEN(first$)+1+LEN(second$)+1+LEN(intoken$), 1) = "," THEN
delim$ = Mini_Parser$(MID$(arg$, i+pos+LEN(first$)+1+LEN(second$)+1+LEN(intoken$)+1))
ENDIF
ELSE
intoken$ = second$
second$ = first$
first$ = "_"
ENDIF
IF INSTR(intoken$, "LOOP") OR INSTR(intoken$, "COIL$") OR TALLY(arg$, "LOOP") > 1 OR TALLY(arg$, "COIL$") > 1 THEN
EPRINT NL$, "Syntax error: multiple LOOP$/COIL$/LOOP functions in one statement at line ", g_COUNTER, " in file '", g_CURFILE$, "'!"
END 1
ENDIF
IF MID$(arg$, i, pos) = "LOOP$(" THEN
token$ = Pre_Tokenize_Functions$("IF setjmp(__b2c__loop2) THEN:FOR " & first$ & "=1 TO " & second$ & ":__b2c__loop_result$ = CONCAT$(__b2c__loop_result$, " & intoken$ & "):NEXT:CALL longjmp(__b2c__loop1, 1):ENDIF:" & token$)
ELIF MID$(arg$, i, pos) = "COIL$(" THEN
token$ = Pre_Tokenize_Functions$("IF setjmp(__b2c__loop2) THEN:FOR " & first$ & "=1 TO " & second$ & ":__b2c__loop_result$ = APPEND$(__b2c__loop_result$, 0, " & intoken$ & "," & delim$ & "):NEXT:CALL longjmp(__b2c__loop1, 1):ENDIF:" & token$)
ELSE
token$ = Pre_Tokenize_Functions$("IF setjmp(__b2c__loop2) THEN:FOR " & first$ & "=1 TO " & second$ & ":__b2c__loop_result = __b2c__loop_result + (" & intoken$ & "):NEXT:CALL longjmp(__b2c__loop1, 1):ENDIF:" & token$)
ENDIF
ELIF MID$(arg$, i, 4) = "IIF(" THEN
intoken$ = Mini_Parser$(MID$(arg$, i+4))
IF REGEX(arg$, ".* " & g_RANGEOP1$ & ".*;.*") OR REGEX(arg$, ".* " & g_RANGEOP2$ & ".*;.*") THEN intoken$ = intoken$ & ";" & Mini_Parser$(MID$(arg$, i+4+LEN(intoken$)+1))
INCR i, 4+LEN(intoken$)
token$ = token$ & "IIF(" & Pre_Tokenize_Functions$(Parse_Equation$(intoken$))
ELIF MID$(arg$, i, 5) = "IIF$(" THEN
intoken$ = Mini_Parser$(MID$(arg$, i+5))
IF REGEX(arg$, ".* " & g_RANGEOP1$ & ".*;.*") OR REGEX(arg$, ".* " & g_RANGEOP2$ & ".*;.*") THEN intoken$ = intoken$ & ";" & Mini_Parser$(MID$(arg$, i+5+LEN(intoken$)+1))
INCR i, 5+LEN(intoken$)
token$ = token$ & "IIF$(" & Pre_Tokenize_Functions$(Parse_Equation$(intoken$))
ELIF MID$(arg$, i, 5) = "EVAL(" THEN
IF nr = 1 THEN
var$ = "char *__b2c_evalvars_" & g_FUNCNAME$ & "_" & STR$(g_COUNTER) & "_" & STR$(HASH(token$)>>8) & "[] = {"
val$ = "double __b2c_evalvals_" & g_FUNCNAME$ & "_" & STR$(g_COUNTER) & "_" & STR$(HASH(token$)>>8) & "[] = {"
LOOKUP g_ALL_FUNC_VARS$ TO funcvar$ SIZE many
FOR j = 1 TO many
IF TOKEN$(funcvar$[j], 2) = g_FUNCNAME$ THEN
type$ = Get_Var$(TOKEN$(funcvar$[j], 1), g_FUNCNAME$)
IF NOT(TALLY(type$, "*")) AND REGEX(type$, "double$|FLOATING$") THEN
var$ = var$ & CHR$(34) & TOKEN$(funcvar$[j], 1) & CHR$(34) & ","
val$ = val$ & TOKEN$(funcvar$[j], 1) & ","
INCR nr
ENDIF
ENDIF
NEXT
LOOKUP g_ALL_MAIN_VARS$ TO mainvar$ SIZE many
FOR j = 1 TO many
type$ = Get_Var$(mainvar$[j])
IF NOT(TALLY(type$, "*")) AND REGEX(type$, "double$|FLOATING$") THEN
var$ = var$ & CHR$(34) & TOKEN$(mainvar$[j], 1) & CHR$(34) & ","
val$ = val$ & TOKEN$(mainvar$[j], 1) & ","
INCR nr
ENDIF
NEXT
WRITELN var$, " NULL};" TO g_CFILE
WRITELN val$, " 0};" TO g_CFILE
ENDIF
INCR i, 5
token$ = token$ & "EVAL(__b2c_evalvars_" & g_FUNCNAME$ & "_" & STR$(g_COUNTER) & "_" & STR$(HASH(token$)>>8) & ",__b2c_evalvals_" & g_FUNCNAME$ & "_" & STR$(g_COUNTER) & "_" & STR$(HASH(token$)>>8) & "," & STR$(nr) & "-1,"
ELIF MID$(arg$, i, 5) = "FIND(" THEN
pos = INSTR(MID$(arg$, i), "(")
intoken$ = Mini_Parser$(MID$(arg$, i+pos))
intoken$ = REPLACE$(intoken$, "$", g_STRINGSIGN$)
intoken$ = REPLACE$(intoken$, "#", g_FLOATSIGN$)
intoken$ = REPLACE$(intoken$, "%", g_LONGSIGN$)
type$ = Get_Var$("__b2c__tree_" & intoken$, g_FUNCNAME$)
token$ = token$ & "FIND(" & type$ & ","
INCR i, 5
ELIF REGEX(MID$(arg$, i, 4), "REM[[:space:]]") OR arg$ = "REM" THEN
BREAK
ELIF MID$(arg$, i, 4) = "int(" THEN
token$ = token$ & "INT("
INCR i, 4
ENDIF
ENDIF
SELECT ASC(MID$(arg$, i, 1))
' Escape symbol
CASE 92
token$ = token$ & CHR$(92)
is_escaped = NOT(is_escaped)
' Quote symbol
CASE 34
token$ = token$ & CHR$(34)
IF NOT(is_escaped) THEN is_string = NOT(is_string)
is_escaped = FALSE
DEFAULT
token$ = token$ & MID$(arg$, i, 1)
is_escaped = FALSE
ENDSELECT
NEXT
ELSE
token$ = arg$
END IF
RETURN token$
END FUNCTION
'----------------------------------------------------------------------------------------------
SUB Tokenize(STRING current$)
LOCAL i, is_string, is_escaped, in_func
LOCAL token$, item1$, item2$, result$, element$, txt$, elem$, sep$, str$, exp$
LOCAL j, in_str, in_spac, bracket, direct, inescaped, isquote, sftot
' Verify if there is a class definition or we are in a (multiline) comment
IF LEFT$(current$, 5) = "CLASS" OR g_COMMENT = TRUE THEN
Parse_Line(CHOP$(current$))
EXIT SUB
ENDIF
' In TRACE MODE show linenr and code
IF g_TRACE = 1 THEN
IF NOT(REGEX(CHOP$(current$), "^FUNCTION|^SUB|^ELIF|^ELSE")) AND NOT(LEN(g_TRACE_PREFIX$)) THEN
WRITELN "if(__b2c__getch() == 27) {fprintf(stderr, \"TRACE OFF - exiting trace mode.\\n\"); exit(EXIT_SUCCESS);}" TO g_CFILE
txt$ = REPLACE$(current$, CHR$(34) & CHR$(92), CHR$(39) & CHR$(47), 2)
WRITELN "fprintf(stderr, \"File '", g_CURFILE$, "' line %d: ", txt$, "\\n\", ", g_COUNTER, ");" TO g_CFILE
IF LEN(g_MONITOR$) THEN WRITELN CHOP$(g_MONITOR$, "&&"), ";" TO g_CFILE
ENDIF
g_TRACE_PREFIX$ = ""
END IF
' See if there are special functions which need adjustments during conversion time
current$ = Pre_Tokenize_Functions$(current$)
WHILE TRUE
' Initialize parser
in_func = 0
is_string = FALSE
is_escaped = FALSE
token$ = ""
' See if there are colons
FOR i = 1 TO LEN(current$)
SELECT ASC(MID$(current$, i, 1))
' Separator
CASE 58
IF NOT(is_string) AND ASC(MID$(current$, i+1, 1)) = 58 THEN
INCR i
token$ = token$ & "::"
ELIF NOT(is_string) AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) AND NOT(in_func) THEN
Tokenize(CHOP$(token$))
token$ = ""
ELSE
token$ = token$ & ":"
END IF
' Tab
CASE 9
token$ = token$ & IIF$(NOT(is_string), CHR$(32), CHR$(9))
' String symbol
CASE 36
IF NOT(is_string) OR MATCH(current$, "IMPORT * FROM * TYPE *") THEN
token$ = token$ & g_STRINGSIGN$
is_escaped = FALSE
ELSE
token$ = token$ & "$"
END IF
' Bracket open symbol
CASE 40
IF NOT(is_string) AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) THEN INCR in_func
token$ = token$ & CHR$(40)
' Bracket close symbol
CASE 41
IF NOT(is_string) AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) THEN DECR in_func
token$ = token$ & CHR$(41)
' Question mark
CASE 63
IF NOT(is_string) AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) AND NOT(in_func) THEN token$ = token$ & "PRINT "
ELSE token$ = token$ & CHR$(63)
' Square bracket
CASE 91
IF NOT(is_string) AND MID$(current$, i, 2) <> "[]" AND MID$(current$, i, 11) <> "[(uint64_t)" THEN token$ = token$ & "[(uint64_t)"
ELSE token$ = token$ & CHR$(91)
' Long symbol
CASE 37
IF NOT(is_string) AND REGEX(RIGHT$(token$, 1), "[a-zA-Z0-9_]+") THEN
token$ = token$ & g_LONGSIGN$
is_escaped = FALSE
ELSE
token$ = token$ & "%"
END IF
' Float symbol
CASE 35
IF NOT(is_string) AND REGEX(RIGHT$(token$, 1), "[a-zA-Z0-9_]+") AND i > 1 THEN
token$ = token$ & g_FLOATSIGN$
is_escaped = FALSE
ELSE
token$ = token$ & "#"
END IF
' Escape symbol
CASE 92
token$ = token$ & CHR$(92)
is_escaped = NOT(is_escaped)
' Quote symbol
CASE 34
token$ = token$ & CHR$(34)
IF NOT(is_escaped) THEN
IF NOT(is_string) THEN
is_string = TRUE
ELSE
is_string = FALSE
ENDIF
ENDIF
is_escaped = FALSE
' Ampersand symbol
CASE 38
IF NOT(is_string) AND ISFALSE(g_USE_C) AND ISFALSE(g_USE_H) THEN
' ITEMIZER1: Get item on the left side
item1$ = "" : bracket = 0 : in_spac = 0 : in_str = 0 : direct = 0 : isquote = 0
FOR j = 1 TO LEN(token$)
SELECT ASC(MID$(token$, LEN(token$)-j+1, 1))
' Bracket close
CASE 41, 93
isquote = 0
INCR direct
IF NOT(in_str) THEN
INCR bracket
END IF
' Bracket open
CASE 40, 91
isquote = 0
INCR direct
IF NOT(in_str) THEN
DECR bracket
IF bracket < 0 THEN
BREAK
ENDIF
ENDIF
' Equation: !=, =
CASE 61
isquote = 0
IF NOT(in_str) THEN BREAK
' Equation: <>, > skip the '->' construct
CASE 62
IF ASC(MID$(token$, LEN(token$)-j, 1)) <> 45 THEN
isquote = 0
IF NOT(in_str) THEN BREAK
ENDIF
' Comma
CASE 44
isquote = 0
IF NOT(in_str) AND NOT(bracket) THEN BREAK
' Escape symbol
CASE 92
IF isquote THEN
in_str = 1
END IF
isquote = 0
' Double quote
CASE 34
isquote = 1
INCR direct
in_str = NOT(in_str)
CASE 32
isquote = 0
IF NOT(in_str) AND NOT(bracket) THEN
IF direct > 0 THEN
INCR in_spac
END IF
ENDIF
' Colon
CASE 58
IF NOT(bracket) THEN
isquote = 0
IF NOT(in_str) THEN BREAK
ENDIF
END SELECT
IF MID$(token$, LEN(token$)-j+1, 1) BETWEEN "a" AND "z" OR MID$(token$, LEN(token$)-j+1, 1) BETWEEN "A" AND "Z" THEN
isquote = 0
INCR direct
IF NOT(in_str) AND NOT(bracket) THEN
IF in_spac > 0 THEN
BREAK
ENDIF
END IF
END IF
item1$ = MID$(token$, LEN(token$)-j+1, 1) & item1$
NEXT
' If ITEM is a string element continue
IF Check_String_Type(item1$) THEN
token$ = MID$(token$, 1, LEN(token$)-j+1)
' ITEMIZER2: Get item on the right side
INCR i
item2$ = "" : bracket = 0 : in_str = 0 : inescaped = 0 : in_spac = 0 : direct = 0
FOR j = i TO LEN(current$)
SELECT ASC(MID$(current$, j, 1))
' Bracket open
CASE 40
INCR direct
IF NOT(in_str) THEN INCR bracket
' Bracket close
CASE 41
INCR direct
IF NOT(in_str) THEN
DECR bracket
IF bracket < 0 THEN
BREAK
ENDIF
ENDIF
' Comma, ==, !=, <>
CASE 44, 60, 61, 33
IF NOT(in_str) AND NOT(bracket) THEN BREAK
' Ampersand
CASE 38
IF NOT(in_str) AND NOT(bracket) THEN
in_spac = 0 : direct = 0
END IF
' Escape symbol
CASE 92
inescaped = NOT(inescaped)
' Double quote
CASE 34
INCR direct
IF NOT(inescaped) THEN in_str = NOT(in_str)
inescaped = 0
CASE 32
IF NOT(in_str) AND NOT(bracket) THEN
IF direct > 0 THEN
INCR in_spac
END IF
ENDIF
' Colon and semicolon
CASE 58, 59
IF NOT(in_str) AND NOT(bracket) THEN BREAK
END SELECT
IF MID$(current$, j, 1) BETWEEN "a" AND "z" OR MID$(current$, j, 1) BETWEEN "A" AND "Z" THEN
INCR direct
IF NOT(in_str) AND NOT(bracket) THEN
IF in_spac > 0 THEN
BREAK
ENDIF
END IF
END IF
IF MID$(current$, j, 1) = "$" THEN
IF NOT(in_str) OR MATCH(current$, "IMPORT * FROM * TYPE *") THEN
item2$ = item2$ & g_STRINGSIGN$
ELSE
item2$ = item2$ & "$"
ENDIF
ELIF MID$(current$, j, 1) = "&" THEN
IF NOT(in_str) AND NOT(bracket) THEN
item2$ = item2$ & ","
ELSE
item2$ = item2$ & "&"
END IF
ELSE
item2$ = item2$ & MID$(current$, j, 1)
END IF
NEXT
i = j-1
' Make sure concatenation of literals is done by C - delete comma
exp$ = item1$ & "," & item2$
str$ = ""
' Start miniparser
WHILE LEN(exp$)
elem$ = Mini_Parser$(exp$)
str$ = IIF$(LEN(str$), str$ & "," & elem$, elem$)
exp$ = MID$(exp$, LEN(elem$)+2)
WEND
' Construct concatenation
token$ = token$ & " CONCAT" & g_STRINGSIGN$ & "(" & str$ & ") "
ELSE
token$ = token$ & CHR$(38)
END IF
ELSE
token$ = token$ & CHR$(38)
END IF
is_escaped = FALSE
DEFAULT
token$ = token$ & MID$(current$, i, 1)
is_escaped = FALSE
END SELECT
NEXT
IF token$ = result$ THEN BREAK
result$ = token$
current$ = token$
WEND
' Determine amount of string funcs: substitute string macros
FOR str$ IN OBTAIN$(g_MACRO_STRINGS$)
result$ = REPLACE$(result$, str$, g_MACRO_STRINGS$(str$))
NEXT
' Determine amount of string funcs: count
sftot = TALLY(result$, g_STRINGSIGN$ & "(")
IF sftot > g_STRING_FUNC THEN g_STRING_FUNC = sftot
' Start parsing
Parse_Line(CHOP$(token$))
END SUB
'----------------------------------------------------------------------------------------------
FUNCTION Parse_Equation$(STRING current$)
LOCAL i, is_string, is_escaped, is_equation, opctr, check, is_pointer, flag
LOCAL chunk$, token$, term$, eq$, total$, element$, last$, v1$, v2$, lb$, rb$
LOCAL logop$[32]
' Initialize parser
is_string = FALSE
is_escaped = FALSE
opctr = 1
' First split into separate chunks OR/AND
FOR i = 1 TO LEN(current$)
IF MID$(current$, i, 9) = " " & g_RANGEOP1$ THEN
IF ISFALSE(is_string) THEN
flag = 1
ENDIF
ELIF MID$(current$, i, 8) = " " & g_RANGEOP2$ THEN
IF ISFALSE(is_string) THEN
flag = 1
ENDIF
ELIF MID$(current$, i, 5) = " AND " THEN
IF NOT(flag) THEN
IF ISFALSE(is_string) THEN
chunk$ = chunk$ & CHR$(10)
logop$[opctr] = " AND "
INCR opctr : INCR i, 4
ELSE
chunk$ = chunk$ & " "
END IF
ELSE
flag = 0
chunk$ = chunk$ & " "
ENDIF
ELIF MID$(current$, i, 4) = " OR " THEN
IF ISFALSE(is_string) THEN
chunk$ = chunk$ & CHR$(10)
logop$[opctr] = " OR "
INCR opctr : INCR i, 3
ELSE
chunk$ = chunk$ & " "
END IF
ELIF MID$(current$, i, 1) = CHR$(92) THEN
chunk$ = chunk$ & CHR$(92)
is_escaped = NOT(is_escaped)
ELIF MID$(current$, i, 1) = CHR$(34) THEN
chunk$ = chunk$ & CHR$(34)
IF ISFALSE(is_escaped) THEN is_string = NOT(is_string)
is_escaped = FALSE
ELSE
chunk$ = chunk$ & MID$(current$, i, 1)
is_escaped = FALSE
END IF
NEXT
logop$[opctr] = ""
opctr = 1
' Start parsing
FOR element$ IN chunk$ STEP CHR$(10)
' Initialize for this chunk
eq$ = ""
token$ = ""
lb$ = "" : rb$ = ""
is_equation = 0
is_string = 0
is_escaped = 0
is_pointer = 0
' Check if this is a string
check = Check_String_Type(element$)
' Keep track of surrounding brackets
WHILE LEFT$(element$) = "("
element$ = MID$(element$, 2)
lb$ = lb$ & "("
WEND
WHILE RIGHT$(element$) = ")"
element$ = LEFT$(element$, LEN(element$)-1)
rb$ = rb$ & ")"
WEND
' See if there are equal signs
FOR i = 1 TO LEN(element$)
IF LEN(MID$(element$, i)) > 8 AND MID$(element$, i, 8) = g_RANGEOP1$ THEN
term$ = TOKEN$(element$, 2, g_RANGEOP1$)
v1$ = Mini_Parser$(term$, "AND")
term$ = MID$(term$, LEN(v1$)+1)
IF REGEX(term$, "AND.*") THEN
v2$ = MID$(term$, 4)
ELSE
v2$ = MID$(term$, 2)
ENDIF
IF check THEN
IF REGEX(v2$, "EXCL$") THEN
token$ = "(__b2c__STRCMP(" & lb$ & token$ & ", __b2c__min_str(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & "))" & rb$ & " > 0 && __b2c__STRCMP(" & lb$ & token$ & ", __b2c__max_str(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & "))" & rb$ & " < 0 ? 1 : 0)"
ELSE
token$ = "(__b2c__STRCMP(" & lb$ & token$ & ", __b2c__min_str(" & v1$ & "," & v2$ & "))" & rb$ & " >= 0 && " & "__b2c__STRCMP(" & lb$ & token$ & ", __b2c__max_str(" & v1$ & "," & v2$ & "))" & rb$ & " <= 0 ? 1 : 0)"
END IF
check = 0
ELSE
IF REGEX(v2$, "EXCL$") THEN
token$ = "(" & lb$ & token$ & " > fmin(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & ")" & rb$ & " && " & lb$ & token$ & " < fmax(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & ")" & rb$ & " ? 1 : 0)"
ELSE
token$ = "(" & lb$ & token$ & " >= fmin(" & v1$ & "," & v2$ & ")" & rb$ & " && " & lb$ & token$ & " <= fmax(" & v1$ & "," & v2$ & ")" & rb$ & " ? 1 : 0)"
END IF
ENDIF
lb$ = "" : rb$ = ""
BREAK
ENDIF
IF LEN(MID$(element$, i)) > 7 AND MID$(element$, i, 7) = g_RANGEOP2$ THEN
term$ = TOKEN$(element$, 2, g_RANGEOP2$)
v1$ = Mini_Parser$(term$, "AND")
term$ = MID$(term$, LEN(v1$)+1)
IF REGEX(term$, "AND.*") THEN
v2$ = MID$(term$, 4)
ELSE
v2$ = MID$(term$, 2)
ENDIF
IF check THEN
IF REGEX(v2$, "EXCL$") THEN
token$ = "(__b2c__STRCMP(" & lb$ & token$ & ", __b2c__min_str(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & "))" & rb$ & " > 0 && __b2c__STRCMP(" & lb$ & token$ & ", __b2c__max_str(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & "))" & rb$ & " < 0 ? 0 : 1)"
ELSE
token$ = "(__b2c__STRCMP(" & lb$ & token$ & ", __b2c__min_str(" & v1$ & "," & v2$ & "))" & rb$ & " >= 0 && __b2c__STRCMP(" & lb$ & token$ & ", __b2c__max_str(" & v1$ & "," & v2$ & "))" & rb$ & " <= 0 ? 0 : 1)"
END IF
check = 0
ELSE
IF REGEX(v2$, "EXCL$") THEN
token$ = "(" & lb$ & token$ & " > fmin(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & ")" & rb$ & " && " & lb$ & token$ & " < fmax(" & v1$ & "," & LEFT$(v2$, LEN(v2$)-4) & ")" & rb$ & " ? 0 : 1)"
ELSE
token$ = "(" & lb$ & token$ & " >= fmin(" & v1$ & "," & v2$ & ")" & rb$ & " && " & lb$ & token$ & " <= fmax(" & v1$ & "," & v2$ & ")" & rb$ & " ? 0 : 1)"
END IF
ENDIF
lb$ = "" : rb$ = ""
BREAK
ENDIF
SELECT MID$(element$, i, 2)
CASE "=="
IF ISFALSE(is_string) THEN
element$ = LEFT$(element$, i-1) & "= " & MID$(element$, i+2)
END IF
CASE "<>"
IF ISFALSE(is_string) THEN
element$ = LEFT$(element$, i-1) & "!=" & MID$(element$, i+2)
END IF
END SELECT
SELECT ASC(MID$(element$, i, 1))
' Equation symbol
CASE 61
IF ISFALSE(is_string) THEN
IF check OR Get_Var$(token$, g_FUNCNAME$) = "char*" THEN
IF LEN(eq$) THEN
eq$ = eq$ & "="
ELSE
term$ = token$
token$ = ""
check = TRUE
eq$ = "=="
ENDIF
ELIF NOT(is_equation) THEN
token$ = token$ & "=="
ELSE
token$ = token$ & "="
is_equation = 0
END IF
ELSE
token$ = token$ & "="
END IF
' Negation
CASE 33
IF ISFALSE(is_string) THEN
IF check OR Get_Var$(token$, g_FUNCNAME$) = "char*" THEN
term$ = token$
token$ = ""
check = TRUE
eq$ = "!"
ELIF NOT(is_equation) THEN
token$ = token$ & "!="
INCR i
ELSE
token$ = token$ & "!"
is_equation = 0
END IF
ELSE
token$ = token$ & "!"
END IF
' Comparison symbols
CASE 60
IF ISFALSE(is_string) THEN
IF check OR Get_Var$(token$, g_FUNCNAME$) = "char*" THEN
term$ = token$
token$ = ""
check = TRUE
eq$ = "<"
ELSE
IF is_equation THEN
is_equation = 0
ELSE
is_equation = 1
ENDIF
token$ = token$ & "<"
ENDIF
ELSE
token$ = token$ & "<"
ENDIF
CASE 62
IF NOT(is_string) AND NOT(is_pointer) THEN
IF check OR Get_Var$(token$, g_FUNCNAME$) = "char*" THEN
term$ = token$
token$ = ""
check = TRUE
eq$ = ">"
ELSE
IF is_equation THEN
is_equation = 0
ELSE
is_equation = 1
ENDIF
token$ = token$ & ">"
ENDIF
ELSE
token$ = token$ & ">"
is_pointer = 0
ENDIF
' Minus symbol in pointer
CASE 45
token$ = token$ & CHR$(45)
IF NOT(is_string) AND NOT(is_pointer) THEN
is_pointer = 1
ENDIF
' Escape symbol
CASE 92
token$ = token$ & CHR$(92)
is_escaped = NOT(is_escaped)
' Quote symbol
CASE 34
token$ = token$ & CHR$(34)
IF ISFALSE(is_escaped) THEN is_string = NOT(is_string)
is_escaped = FALSE
DEFAULT
' Handle normal char after '<' or '>' symbol
IF is_equation THEN
is_equation = 0
last$ = RIGHT$(token$, 1)
token$ = "(" & LEFT$(token$, LEN(token$)-1) & ")" & last$
ENDIF
token$ = token$ & MID$(element$, i, 1)
is_escaped = FALSE
is_pointer = FALSE
END SELECT
NEXT
' Construct string equation
IF check THEN
total$ = total$ & lb$ & "__b2c__STRCMP(" & term$ & "," & token$ & ") " & rb$ & eq$ & " 0"
ELSE
total$ = total$ & lb$ & token$ & rb$
ENDIF
' Restore logical operator
total$ = total$ & logop$[opctr]
INCR opctr
NEXT
RETURN total$
END FUNCTION
'----------------------------------------------------------------------------------------------
SUB Download_File(STRING name$)
LOCAL total$, dat$, proxy$, unpw$
LOCAL length, size, mynet
CATCH GOTO network_error
' Get environment variable for proxy
proxy$ = GETENVIRON$("HTTP_PROXY")
IF LEN(proxy$) = 0 THEN proxy$ = GETENVIRON$("http_proxy")
' Parse proxy settings
IF LEN(proxy$) THEN
IF LEFT$(proxy$, 7) <> "http://" THEN
EPRINT "System error: proxy '", proxy$, "' not supported! Redefine to default HTTP proxy or undefine."
END 1
ENDIF
proxy$ = MID$(proxy$, 8)
IF TALLY(proxy$, "@") THEN
unpw$ = B64ENC$(TOKEN$(proxy$, 1, "@"))
proxy$ = TOKEN$(proxy$, 2, "@")
ENDIF
' Setup TCP connection on defined port
OPEN proxy$ FOR NETWORK AS mynet
SEND "CONNECT " & TOKEN$(name$, 1, "/") & ":80 HTTP/1.1" & "\r\n" TO mynet
IF LEN(unpw$) THEN SEND "Proxy-Authorization: Basic " & B64ENC$(unpw$) & "\r\n" TO mynet
SEND "\r\n" TO mynet
' Return should be OK
RECEIVE dat$ FROM mynet
IF NOT(TALLY(dat$, " 200 ")) THEN
EPRINT "System error: proxy '", proxy$, "' returns error: " & dat$
END 1
ENDIF
ELSE
' Open TCP connection on port 80
OPEN TOKEN$(name$, 1, "/") & ":80" FOR NETWORK AS mynet
ENDIF
PRINT "Fetching file...";
SEND "HEAD /" & MID$(name$, INSTR(name$, "/")+1) & " HTTP/1.1\r\nHost: " & TOKEN$(name$, 1, "/") & "\r\n\r\n" TO mynet
RECEIVE dat$ FROM mynet
' Get the filesize from the HTTP header
IF NOT(INSTR(dat$, "Content-Length:")) THEN
EPRINT "System error: file not found! Check URL and try again."
END 1
END IF
dat$ = MID$(dat$, INSTR(dat$, "Content-Length:")+15)
length = VAL(LEFT$(dat$, INSTR(dat$, NL$)))
' As long as there is data, get it
SEND "GET /" & MID$(name$, INSTR(name$, "/")+1) & " HTTP/1.1\r\nHost: " & TOKEN$(name$, 1, "/") & "\r\n\r\n" TO mynet
WHILE WAIT(mynet, 2000)
RECEIVE dat$ FROM mynet CHUNK 128 SIZE size
IF size = 0 THEN BREAK
EPRINT ".";
total$ = total$ & dat$
WEND
CLOSE NETWORK mynet
' Rip off HTTP headers
total$ = MID$(total$, INSTR(total$, "\r\n\r\n")+4)
' Check amount of data
IF LEN(total$) != length THEN
EPRINT "System error: file ", name$, " could not be downloaded probably due to a timeout. Try again later."
END 1
END IF
' Write to file
SAVE total$ TO MID$(name$, INSTRREV(name$, "/")+1)
PRINT "done."
EXIT SUB
LABEL network_error
CLOSE NETWORK mynet
EPRINT "System error: the site http://", LEFT$(name$, INSTR(name$, "/")-1), " is not reachable! Try again later."
END 1
END SUB
'----------------------------------------------------------------------------
SUB Editor_Print_Line(text$, linenr, inverse, int digits)
LOCAL x, in_string, in_line_comment, in_escaped, pos, len, display_columns
LOCAL term$, c1$, c2$
LOCAL in_block_comment = 0 TYPE static int
COLOR RESET
IF inverse THEN COLOR INVERSE
IF Color_Intense THEN COLOR INTENSE
PRINT CL$;
IF Line_Number_Active THEN
display_columns = COLUMNS-digits-1
COLOR FG TO YELLOW
PRINT digits, linenr FORMAT "%*ld "
ELSE
display_columns = COLUMNS
ENDIF
text$ = LEFT$(REPLACE$(text$, CHR$(9), SPC$(4)), display_columns)
len = LEN(text$)
FOR x = 0 TO len-1
c1$ = MID$(text$, x+1, 1)
c2$ = MID$(text$, x+1, 2)
' Got escape sign?
IF c1$ = "\\" AND NOT(in_line_comment) AND NOT(in_block_comment) THEN
IF in_escaped THEN
in_escaped = 0
ELSE
in_escaped = 1
ENDIF
' String
ELIF c1$ = "\"" AND NOT(in_escaped) AND NOT(in_line_comment) AND NOT(in_block_comment) THEN
in_string = 1 - in_string
' Block comment start
ELIF c2$ = "/*" AND NOT(in_string) AND NOT(in_line_comment) THEN
in_block_comment = TRUE
in_escaped = FALSE
' Line comment start
ELIF c1$ = "'" OR REGEX(MID$(text$, x+1, 4), "REM[[:space:]]+") OR (MID$(text$, x+1, 3) = "REM" AND x = LEN(text$)-3) THEN
IF NOT(in_string) AND NOT(in_block_comment) THEN
in_line_comment = TRUE
in_escaped = FALSE
ENDIF
' Line comment end
ELIF c1$ = NL$ AND NOT(in_string) AND NOT(in_block_comment) THEN
in_line_comment = FALSE
in_escaped = FALSE
ELSE
in_escaped = FALSE
ENDIF
' Highlight string
IF in_string THEN
COLOR FG TO Quot_Col
PRINT MID$(text$, x+1, 1);
' Highlight block comments
ELIF in_block_comment THEN
COLOR FG TO Comm_Col
TYPE SET ITALIC
IF MID$(text$, x+1, 2) = "*/" THEN
PRINT MID$(text$, x+1, 2);
in_block_comment = FALSE
INCR x
TYPE UNSET ITALIC
ELSE
PRINT MID$(text$, x+1, 1);
ENDIF
ELIF in_line_comment THEN
COLOR FG TO Comm_Col
TYPE SET ITALIC
PRINT MID$(text$, x+1, 1);
ELIF MID$(text$, x+1, 1) BETWEEN CHR$(48) AND CHR$(57) THEN
COLOR FG TO Num_Col
PRINT MID$(text$, x+1, 1);
ELIF MID$(text$, x+1, 1) = CHR$(34) THEN
COLOR FG TO Quot_Col
PRINT MID$(text$, x+1, 1);
ELIF MID$(text$, x+1, 1) = CHR$(38) THEN
COLOR FG TO Func_Col
PRINT MID$(text$, x+1, 1);
ELSE
pos = REGEX(MID$(text$, x+1), "[[:space:]]|[=,?;:+-/\\(\\)\\*]|\\||\\[|\\]")-1
IF pos < 0 THEN pos = len-x
term$ = "|" & MID$(text$, x+1, pos) & "|"
IF TALLY(Stat$, term$) THEN
COLOR FG TO Stat_Col
ELIF TALLY(EXTRACT$(Func$, "\\"), term$) THEN
COLOR FG TO Func_Col
ELIF TALLY(EXTRACT$(Var$, "\\"), term$) THEN
COLOR FG TO Var_Col
ELIF TALLY(Type$, term$) THEN
COLOR FG TO Type_Col
ELSE
COLOR FG TO Def_Col
ENDIF
PRINT MID$(text$, x+1, pos);
COLOR RESET
IF inverse THEN COLOR INVERSE
IF Color_Intense THEN COLOR INTENSE
PRINT MID$(text$, x+1+pos, 1);
INCR x, pos
ENDIF
NEXT
END SUB
'----------------------------------------------------------------------------
SUB Editor_Print_Text(txt$, line, verticalpos)
LOCAL y, total_lines, digits
LOCAL line$
total_lines = AMOUNT(txt$, NL$)
IF total_lines = 0 THEN total_lines = 1
digits = LEN(STR$(AMOUNT(txt$, NL$)))
CURSOR OFF
FOR y = 1 TO ROWS
GOTOXY 1, y
IF line <= total_lines THEN
line$ = TOKEN$(txt$, line, NL$)
line$ = REPLACE$(line$, CHR$(9), SPC$(4))
Editor_Print_Line(MID$(line$, verticalpos), line, FALSE, digits)
ELSE
PRINT CL$;
ENDIF
INCR line
NEXT
CURSOR ON
ENDSUB
'----------------------------------------------------------------------------
SUB Editor_Restore_Normal
SIGNAL SIG_DFL, SIGINT
SCROLL UP 1
SCREEN RESTORE
GOTOXY g_CURSOR_X, g_CURSOR_Y-1
COLOR RESET
CURSOR ON
SETSERIAL STDIN_FILENO IMODE IXON
SETSERIAL STDIN_FILENO LMODE ECHO
SETSERIAL STDIN_FILENO OTHER VINTR = 3
STOP SIGINT
ENDSUB
'----------------------------------------------------------------------------
SUB Editor_Show_Help
LOCAL mid
mid = (ROWS-24)/2
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
GOTOXY COLUMNS/2-30, mid: PRINT "+--------------------------------------------------------+"
GOTOXY COLUMNS/2-30, mid+1: PRINT "| File <CTRL>+<n>: new file |"
GOTOXY COLUMNS/2-30, mid+2: PRINT "| <CTRL>+<l>: load file |"
GOTOXY COLUMNS/2-30, mid+3: PRINT "| <CTRL>+<s>: save file |"
GOTOXY COLUMNS/2-30, mid+4: PRINT "| Editing <CTRL>+<x>: cut line of text |"
GOTOXY COLUMNS/2-30, mid+5: PRINT "| <CTRL>+<c>: copy line of text |"
GOTOXY COLUMNS/2-30, mid+6: PRINT "| <CTRL>+<v>: paste line of text |"
GOTOXY COLUMNS/2-30, mid+7: PRINT "| <CTRL>+<w> or <CTRL>+<del>: wipe line |"
GOTOXY COLUMNS/2-30, mid+8: PRINT "| Navigation <HOME>: put cursor at start of line |"
GOTOXY COLUMNS/2-30, mid+9: PRINT "| <END>: put cursor at end of line |"
GOTOXY COLUMNS/2-30, mid+10: PRINT "| <PgUp>: move one page upwards |"
GOTOXY COLUMNS/2-30, mid+11: PRINT "| <PgDn>: move page downwards |"
GOTOXY COLUMNS/2-30, mid+12: PRINT "| <cursor keys>: navigate through text |"
GOTOXY COLUMNS/2-30, mid+13: PRINT "| <CTRL>+<f>: find term in code |"
GOTOXY COLUMNS/2-30, mid+14: PRINT "| <CTRL>+<g>: goto line number |"
GOTOXY COLUMNS/2-30, mid+15: PRINT "| Other <CTRL>+<e>: compile and execute program |"
GOTOXY COLUMNS/2-30, mid+16: PRINT "| <CTRL>+<a>: apply indentation |"
GOTOXY COLUMNS/2-30, mid+17: PRINT "| <CTRL>+<r>: toggle line numbers |"
GOTOXY COLUMNS/2-30, mid+18: PRINT "| <CTRL>+<b>: toggle text boldness |"
GOTOXY COLUMNS/2-30, mid+19: PRINT "| <CTRL>+<d>: show context info |"
GOTOXY COLUMNS/2-30, mid+20: PRINT "| <CTRL>+<h>: show this help |"
GOTOXY COLUMNS/2-30, mid+21: PRINT "| <CTRL>+<q>: quit BaCon spartanic editor |"
GOTOXY COLUMNS/2-30, mid+22: PRINT "+--------------------------------------------------------+"
TYPE SET BLINK
GOTOXY COLUMNS/2-13, ROWS
PRINT CL$, "Press a key to continue...";
TYPE UNSET BLINK
GETKEY
ENDSUB
'----------------------------------------------------------------------------
SUB Editor_Handle_Input(file$, text$)
LOCAL visual_xpos = 1, real_xpos = 1, ypos = 1, start = 1, visual_begin_pos = 1, display_columns, Print_Text, Print_Line
LOCAL key, special, cursor, delkey, page, total, line, next, x, myposition, nextposition, label_active, wrap_active, digits, copy_flag = 0
LOCAL line$, prog$, answer$, option$, man$, str$, result$, copy_line$, word$, arg$
' Avoid errors in parsing delimited strings when element consists of strings only
OPTION DQ 1
OPTION COLLAPSE FALSE
' Set ctrl-x for cut, disable all echo from keyboard and redirect ctrl-c to ctrl-q
SETSERIAL STDIN_FILENO IMODE ~IXON
SETSERIAL STDIN_FILENO LMODE ~ECHO
SETSERIAL STDIN_FILENO OTHER VINTR = 17
' Restore ANSI screen when <CTRL>+Q is pressed
SIGNAL Editor_Restore_Normal, SIGINT
' Store X and Y position of cursor
g_CURSOR_X = GETX
g_CURSOR_Y = GETY
' Save the current screen
SCREEN SAVE
CLEAR
Editor_Print_Text(text$, 1, 1)
WHILE TRUE
REPEAT
' Position cursor on screen
IF Line_Number_Active THEN
digits = LEN(STR$(AMOUNT(text$, NL$)))
display_columns = COLUMNS-digits-1
GOTOXY visual_xpos+digits+1, ypos
ELSE
display_columns = COLUMNS
GOTOXY visual_xpos, ypos
ENDIF
' Scan for key and delay at the same time
key = WAIT(STDIN_FILENO, 100)
SELECT key
' No key pressed? Skip
CASE 0
CONTINUE
' Copy line with <CTRL>+<C>
CASE 3
copy_line$ = TOKEN$(text$, start+ypos-1, NL$)
copy_flag = 1
' Cut line with <CTRL>+<X>
CASE 24
copy_line$ = TOKEN$(text$, start+ypos-1, NL$)
text$ = DEL$(text$, start+ypos-1, NL$)
Print_Text = TRUE
copy_flag = 1
' Paste line with <CTRL>+<V>
CASE 22
IF ypos < ROWS AND LEN(copy_line$) THEN
text$ = APPEND$(text$, start+ypos-1, copy_line$, NL$)
Print_Text = TRUE
ENDIF
copy_flag = 0
' Show context documentation with <CTRL>+<D>
CASE 4
myposition = real_xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
WHILE NOT(REGEX(MID$(line$, myposition, 1), "[[:space:]]|[=,?;:+-/\\(\\)\\*]"))
DECR myposition
IF myposition = 0 THEN BREAK
WEND
INCR myposition
total = 1
WHILE NOT(REGEX(MID$(line$, myposition+total, 1), "[[:space:]]|[=,?;:+-/\\(\\)\\*]"))
INCR total
IF myposition+total > LEN(line$) THEN BREAK
WEND
word$ = MID$(line$, myposition, total)
CLEAR
COLOR RESET
GOTOXY 1, 1
IF ISTRUE(LEN(EXEC$("command -v less 2>/dev/null"))) THEN
SCREEN RESTORE
SYSTEM "man bacon | less -P\"[Press space to continue, 'q' to quit.]\" -p '^ " & REPLACE$(word$, "$", "\\$") & "'"
SCREEN SAVE
ELSE
SYSTEM "man bacon | more -d -p +/'^ " & REPLACE$(word$, "$", "\\$") & "'"
ENDIF
Print_Text = TRUE
' Toggle line numbering with <CTRL>+<R>
CASE 18
Line_Number_Active = 1 - Line_Number_Active
IF FILEEXISTS(GETENVIRON$("HOME") & "/.bacon/bacon.cfg" ) THEN
arg$ = COLLAPSE$(LOAD$(GETENVIRON$("HOME") & "/.bacon/bacon.cfg"), NL$)
FOR x = 1 TO AMOUNT(arg$, NL$)
IF REGEX(TOKEN$(arg$, x, NL$), "^linenr") THEN arg$ = DEL$(arg$, x, NL$)
NEXT
SAVE APPEND$(arg$, 0, "linenr " & STR$(Line_Number_Active), NL$) TO GETENVIRON$("HOME") & "/.bacon/bacon.cfg"
ELSE
SAVE "linenr " & STR$(Line_Number_Active) TO GETENVIRON$("HOME") & "/.bacon/bacon.cfg"
ENDIF
Print_Text = TRUE
' Goto line number with <CTRL>+<G>
CASE 7
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
INPUT CL$, "Enter line number... ", key
IF key > AMOUNT(text$, NL$) THEN key = AMOUNT(text$, NL$)
IF key < ROWS THEN
start = 1
ypos = key
ELIF key > AMOUNT(text$, NL$)-(ROWS/2) THEN
start = AMOUNT(text$, NL$)-ROWS
ypos = ROWS - (AMOUNT(text$, NL$)-key)
ELSE
start = key-(ROWS/2)
ypos = key-start+1
ENDIF
GOTOXY visual_xpos, ypos
Print_Text = TRUE
' Indent code with <CTRL>+<A>
CASE 1
GOTOXY COLUMNS/2-18, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
CURSOR OFF
TYPE SET BLINK
PRINT CL$, "Applying indentation, please wait...";
TYPE UNSET BLINK
result$ = ""
myposition = nextposition = label_active = wrap_active = 0
SPLIT text$ BY NL$ TO lines$ SIZE total
FOR x = 1 TO total
myposition = nextposition
lines$[x] = CHOP$(lines$[x])
IF LEN(lines$[x]) = 0 AND label_active THEN
label_active = FALSE
DECR myposition
nextposition = myposition
ENDIF
IF REGEX(lines$[x], "^(CASE|UNTIL)[ \\t]|^(DEFAULT|FI|NEXT|WEND|DONE)|^ELSE$|^ELIF.+THEN$|^END.+") THEN
IF NOT(REGEX(lines$[x], "^END.+[0-9]+")) THEN DECR myposition
IF REGEX(lines$[x], "SELECT$") THEN DECR myposition
IF myposition < 0 THEN myposition = 0
nextposition = myposition
ENDIF
IF REGEX(lines$[x], "^(CASE|ENUM|FOR|FUNCTION|FUNC|GLOBAL RECORD|LABEL|RECORD|SELECT|SUB|WHILE|DOTIMES|WITH)[ \\t]|^(DEFAULT|REPEAT|USEC|USEH|DO$)|^IF.+THEN$|^ELIF.+THEN$|^ELSE$") THEN
INCR nextposition
IF REGEX(lines$[x], "^SELECT") THEN INCR nextposition
IF LEFT$(lines$[x], 5) = "LABEL" THEN label_active = TRUE
ENDIF
IF RIGHT$(lines$[x], 2) = CHR$(32) & CHR$(92) AND NOT(REGEX(lines$[x], "^(REM|')")) THEN
IF NOT(wrap_active) THEN INCR nextposition
wrap_active = TRUE
ELSE
IF wrap_active THEN DECR nextposition
wrap_active = FALSE
ENDIF
IF REGEX(previous$, "^(REM|')") THEN result$ = CHANGE$(result$, x-1, TAB$(myposition) & previous$, NL$)
IF LEN(lines$[x]) THEN
result$ = result$ & TAB$(myposition) & lines$[x] & NL$
ELSE
result$ = result$ & NL$
ENDIF
previous$ = lines$[x]
NEXT
text$ = result$
Editor_Print_Text(text$, start, visual_begin_pos)
CURSOR OFF
TYPE SET BLINK
GOTOXY COLUMNS/2-22, ROWS
PRINT CL$, "Indentation done, press a key to continue...";
key = GETKEY
TYPE UNSET BLINK
CURSOR ON
Print_Text = TRUE
' Execute code with <CTRL>+<E>
CASE 5
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
prog$ = DIRNAME$(file$) & "/" & BASENAME$(file$, 1)
IF FILEEXISTS(prog$) THEN DELETE FILE prog$
SAVE CHOP$(text$) TO file$
PRINT "Current BaCon command line options: ", IIF$(LEN(option$)=0, "<none set>", option$)
PRINT "Do you want to set new options (y/[n]) ? ";
IF GETKEY = ASC("y") THEN INPUT NL$, "Enter new options: ", option$
PRINT NL$, "Executing 'bacon " & option$ & " -d " & DIRNAME$(file$) & " " & file$ & "'..."
SYSTEM "bacon " & option$ & " -d " & DIRNAME$(file$) & " " & file$
IF FILEEXISTS(prog$) THEN
PRINT "Execute ([y]/n) ? ";
key = GETKEY
PRINT
IF key = ASC("y") OR key = 10 THEN
PRINT "Current program arguments: ", IIF$(LEN(arg$)=0, "<none set>", arg$)
PRINT "Do you want to set new program arguments (y/[n]) ? ";
IF GETKEY = ASC("y") THEN INPUT NL$, "Enter new arguments (<enter> means none)... ", arg$
SCREEN RESTORE
GOTOXY 1, GETY
SETSERIAL STDIN_FILENO IMODE IXON
SETSERIAL STDIN_FILENO OTHER VINTR = 3
SYSTEM prog$ & " " & arg$
SETSERIAL STDIN_FILENO IMODE ~IXON
SETSERIAL STDIN_FILENO OTHER VINTR = 17
ENDIF
ENDIF
PRINT CL$, "Press a key to continue...";
key = GETKEY
SCREEN SAVE
Print_Text = TRUE
' Find term with <CTRL>+<F>
CASE 6
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
INPUT CL$, "Enter term... ", word$
PRINT "Searching...";
total = WHERE(text$, start+ypos-1, NL$)+visual_xpos-1
next = INSTR(MID$(text$, total), word$)
WHILE next > 0
line = AMOUNT(MID$(text$, 1, total+next), NL$)
start = IIF(line-ROWS/2 < 1, 1, line-ROWS/2)
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
Editor_Print_Text(text$, start, visual_begin_pos)
ypos = ROWS/2+1
GOTOXY 1, IIF(start = 1, line, ypos)
Editor_Print_Line(TOKEN$(text$, IIF(start = 1, start+line-1, start+ypos-1), NL$), IIF(start = 1, start+line-1, start+ypos-1), TRUE, digits)
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
COLOR INVERSE
PRINT CL$, "Press [n] for next item, any other key to quit...";
IF GETKEY <> ASC("n") THEN
key = 255
BREAK
ENDIF
GOTOXY 1, ROWS
PRINT CL$, "Searching...";
INCR total, next
next = INSTR(MID$(text$, total+1), word$)
WEND
IF key <> 255 THEN
GOTOXY 1, ROWS
PRINT CL$, "Search ended. Press a key to continue...";
key = GETKEY
ENDIF
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
Print_Text = TRUE
' New file with <CTRL>+<N>
CASE 14
start = 1
visual_begin_pos = 1
visual_xpos = 1
ypos = 1
text$ = ""
file$ = ""
Print_Text = TRUE
' Load file with <CTRL>+<L>
CASE 12
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
INPUT CL$, "Enter file name... ", file$
IF NOT(FILEEXISTS(file$)) THEN
COLOR FG TO RED
PRINT "WARNING: File does not exist!"
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
PRINT CL$, "Press a key to continue...";
key = GETKEY
ELSE
text$ = LOAD$(file$)
start = 1
visual_begin_pos = 1
ENDIF
Print_Text = TRUE
' Save file with <CTRL>+<S>
CASE 19
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
IF LEN(file$) THEN
SAVE CHOP$(text$) & NL$ TO file$
GOTOXY 1, ROWS
PRINT CL$, "File '" & BASENAME$(file$) & "' saved!";
ELSE
answer$ = "y"
INPUT CL$, "Enter file name... ", file$
IF FILEEXISTS(file$) THEN INPUT "File '", file$, "' exists! Overwrite ([y]/n) ? ", answer$
GOTOXY 1, ROWS
IF answer$ = "y" THEN
SAVE CHOP$(text$) & NL$ TO file$
PRINT "File '" & BASENAME$(file$) & "' saved!";
ELSE
PRINT "File NOT saved.";
ENDIF
ENDIF
PRINT " Press a key to continue...";
key = GETKEY
Print_Text = TRUE
' Toggle bold text <CTRL>+<B>
CASE 2
Color_Intense = NOT(Color_Intense)
IF FILEEXISTS(GETENVIRON$("HOME") & "/.bacon/bacon.cfg" ) THEN
result$ = COLLAPSE$(LOAD$(GETENVIRON$("HOME") & "/.bacon/bacon.cfg"), NL$)
FOR x = 1 TO AMOUNT(result$, NL$)
IF REGEX(TOKEN$(result$, x, NL$), "^intense") THEN result$ = DEL$(result$, x, NL$)
NEXT
SAVE APPEND$(result$, 0, "intense " & STR$(Color_Intense), NL$) TO GETENVIRON$("HOME") & "/.bacon/bacon.cfg"
ELSE
SAVE "intense " & STR$(Color_Intense) TO GETENVIRON$("HOME") & "/.bacon/bacon.cfg"
ENDIF
Print_Text = TRUE
' Wipe line with <CTRL>+<W> (alternate: <CTRL>+<del>)
CASE 23
text$ = DEL$(text$, start+ypos-1, NL$)
IF ypos > AMOUNT(text$, NL$)-start+1 AND ypos > 1 THEN DECR ypos
Print_Text = TRUE
' Toggle display of Help <CTRL>+<H>
CASE 8
CURSOR OFF
Editor_Show_Help()
CURSOR ON
Print_Text = TRUE
' Special sequence like <cursor up>, <down>, <alt>+<e> etc
CASE 27
special = WAIT(STDIN_FILENO, 100)
SELECT special
' One of the special keys
CASE 79, 91
cursor = WAIT(STDIN_FILENO, 100)
SELECT cursor
' Cursor down
CASE 66
IF start+ypos-1 = AMOUNT(text$, NL$) AND LEN(TOKEN$(text$, start+ypos-1, NL$)) > 0 THEN
text$ = APPEND$(text$, 0, "", NL$)
ypos = AMOUNT(text$, NL$)
IF ypos > ROWS THEN start = AMOUNT(text$, NL$) - ROWS + 1
Print_Text = TRUE
ELIF start+ypos-1 < AMOUNT(text$, NL$) THEN
INCR ypos
ENDIF
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Synchronize visual xpos causing jump effect at TAB
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
' Cursor up
CASE 65
DECR ypos
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Synchronize visual xpos causing jump effect at TAB
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
' Cursor right
CASE 67
line$ = TOKEN$(text$, start+ypos-1, NL$)
INCR visual_xpos, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
' Cursor left
CASE 68
DECR real_xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
DECR visual_xpos, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
'DEL key
CASE 51
' Normal delete
delkey = WAIT(STDIN_FILENO, 100)
line$ = TOKEN$(text$, start+ypos-1, NL$)
IF delkey = 126 THEN
IF real_xpos > LEN(line$) THEN
text$ = CHANGE$(text$, start+ypos-1, line$ & SPC$(real_xpos-LEN(line$)-1) & TOKEN$(text$, start+ypos, NL$), NL$)
text$ = DEL$(text$, start+ypos, NL$)
Print_Text = TRUE
ELSE
line$ = RIP$(line$, real_xpos, 1)
text$ = CHANGE$(text$, start+ypos-1, line$, NL$)
line$ = TOKEN$(text$, start+ypos-1, NL$)
IF real_xpos = LEN(line$)+1 AND real_xpos > 1 THEN DECR real_xpos
' Synchronize visual xpos causing jump effect at TAB
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
Print_Line = TRUE
ENDIF
' Wipe line with <CTRL>+<del> (alternate: <CTRL>+<W>)
ELIF delkey = 59 THEN
' Flush I/O buffer
delkey = WAIT(STDIN_FILENO, 100)
delkey = WAIT(STDIN_FILENO, 100)
text$ = DEL$(text$, start+ypos-1, NL$)
IF ypos > AMOUNT(text$, NL$)-start+1 AND ypos > 1 THEN DECR ypos
Print_Text = TRUE
ENDIF
' Home key
CASE 72, 49
' Flush I/O buffer (Putty)
IF cursor = 49 THEN delkey = WAIT(STDIN_FILENO, 100)
visual_xpos = 1
real_xpos = 1
visual_begin_pos = 1
Print_Text = TRUE
' End key
CASE 70, 52
' Flush I/O buffer (Putty)
IF cursor = 52 THEN delkey = WAIT(STDIN_FILENO, 100)
line$ = TOKEN$(text$, start+ypos-1, NL$)
line$ = REPLACE$(line$, CHR$(9), SPC$(4))
visual_xpos = LEN(line$) - visual_begin_pos + 1
IF visual_xpos > display_columns THEN
visual_begin_pos = LEN(line$) - display_columns + 1
visual_xpos = display_columns
Print_Text = TRUE
ENDIF
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Page up key
CASE 53
page = WAIT(STDIN_FILENO, 100)
IF page = 126 THEN
IF start > ROWS THEN
DECR start, ROWS
ELSE
start = 1
END IF
Print_Text = TRUE
END IF
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Synchronize visual xpos causing jump effect at TAB
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
' Page down key
CASE 54
page = WAIT(STDIN_FILENO, 100)
IF page = 126 THEN
IF start + 2*ROWS - 1 < AMOUNT(text$, NL$) THEN
INCR start, ROWS
ELSE
start = AMOUNT(text$, NL$)-ROWS+1
IF start < 1 THEN start = 1
FI
Print_Text = TRUE
END IF
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Synchronize visual xpos causing jump effect at TAB
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
ENDSELECT
' Make sure not to exceed vertical range
IF ypos < 1 THEN
DECR start
ypos = 1
IF start < 1 THEN
start = 1
ELSE
SCROLL DOWN
line$ = TOKEN$(text$, start, NL$)
Print_Line = TRUE
ENDIF
ENDIF
IF ypos > ROWS THEN
INCR start
ypos = ROWS
IF start+ROWS-1 > AMOUNT(text$, NL$) THEN
start = AMOUNT(text$, NL$) - ROWS + 1
ELSE
SCROLL UP
line$ = TOKEN$(text$, start+ROWS-1, NL$)
Print_Line = TRUE
ENDIF
ENDIF
' Take care of position when reaching 0
IF visual_xpos < 1 THEN
WHILE visual_begin_pos > 1 AND visual_xpos < 1
DECR visual_begin_pos
INCR visual_xpos
WEND
IF visual_begin_pos < 1 THEN visual_begin_pos = 1
visual_xpos = 1
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
Print_Text = TRUE
ENDIF
' Take care of position longer than visible amount of columns
IF visual_xpos > display_columns THEN
INCR visual_begin_pos
visual_xpos = display_columns
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
' Jump effect at TAB
IF visual_begin_pos - 1 + visual_xpos > display_columns AND MID$(line$, real_xpos-1, 1) = CHR$(9) THEN INCR visual_begin_pos, 3
Print_Text = TRUE
ENDIF
ENDSELECT
' Backspace
CASE 127
IF real_xpos > 1 THEN
line$ = TOKEN$(text$, start+ypos-1, NL$)
IF real_xpos <= LEN(line$)+1 THEN
line$ = LEFT$(line$, real_xpos-2) & MID$(line$, real_xpos)
text$ = CHANGE$(text$, start+ypos-1, line$, NL$)
ENDIF
DECR real_xpos
' Synchronize visual xpos causing jump effect at TAB
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
visual_xpos = 1
WHILE x < real_xpos
INCR visual_xpos, IIF(MID$(line$, x, 1) = CHR$(9), 4, 1)
INCR x
WEND
DECR visual_xpos, visual_begin_pos-1
' Scrolled lines
IF visual_xpos < 1 THEN
WHILE visual_begin_pos > 1
DECR visual_begin_pos
INCR visual_xpos
IF visual_xpos = 1 THEN BREAK
WEND
ENDIF
Print_Line = TRUE
ELIF NOT(ypos = 1 AND start = 1) THEN
' Set visual_xpos at end of previous line
line$ = TOKEN$(text$, start+ypos-2, NL$)
line$ = REPLACE$(line$, CHR$(9), SPC$(4))
visual_xpos = LEN(line$) - visual_begin_pos + 2
' Attach current line to previous line
line$ = TOKEN$(text$, start+ypos-1, NL$)
text$ = CHANGE$(text$, start+ypos-2, TOKEN$(text$, start+ypos-2, NL$) & line$, NL$)
text$ = DEL$(text$, start+ypos-1, NL$)
IF AMOUNT(text$, NL$) <= ROWS THEN
INCR ypos, start-1
start = 1
ENDIF
IF ypos > 1 THEN
DECR ypos
ELSE
DECR start, IIF(start > 1, 1, 0)
ENDIF
' Make sure cursor is on the screen
line$ = TOKEN$(text$, start+ypos-1, NL$)
line$ = REPLACE$(line$, CHR$(9), SPC$(4))
IF visual_xpos > display_columns THEN
visual_begin_pos = visual_xpos - display_columns + 1
visual_xpos = display_columns
ENDIF
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
Print_Text = TRUE
ENDIF
' Return key
CASE 10
line$ = TOKEN$(text$, start+ypos-1, NL$)
IF visual_xpos > LEN(line$) THEN
text$ = APPEND$(text$, start+ypos, "", NL$)
ELSE
text$ = CHANGE$(text$, start+ypos-1, LEFT$(line$, real_xpos-1), NL$)
text$ = APPEND$(text$, start+ypos, MID$(line$, real_xpos), NL$)
ENDIF
IF ypos = ROWS THEN INCR start
IF ypos < ROWS THEN INCR ypos
visual_xpos = 1
real_xpos = 1
visual_begin_pos = 1
Print_Text = TRUE
' Other keys
DEFAULT
line$ = TOKEN$(text$, start+ypos-1, NL$)
IF real_xpos > LEN(line$) THEN
line$ = INSERT$(line$, real_xpos, SPC$(real_xpos-LEN(line$)-1) & CHR$(key))
ELSE
line$ = INSERT$(line$, real_xpos, CHR$(key))
ENDIF
text$ = CHANGE$(text$, start+ypos-1, line$, NL$)
' Set position of cursor
IF visual_xpos < display_columns THEN
INCR visual_xpos, IIF(key = 9, 4, 1)
ELSE
INCR visual_begin_pos, IIF(key = 9, 4, 1)
FI
' Synchronize real xpos
line$ = TOKEN$(text$, start+ypos-1, NL$)
x = 1
real_xpos = 1
WHILE x < visual_begin_pos - 1 + visual_xpos
INCR x, IIF(MID$(line$, real_xpos, 1) = CHR$(9), 4, 1)
INCR real_xpos
WEND
IF visual_xpos = display_columns THEN
Print_Text = TRUE
ELSE
Print_Line = TRUE
ENDIF
ENDSELECT
' Print part of text or full text as indicated earlier
IF Print_Text THEN
Editor_Print_Text(text$, start, visual_begin_pos)
ELIF Print_Line THEN
GOTOXY 1, ypos
line$ = REPLACE$(line$, CHR$(9), SPC$(4))
Editor_Print_Line(MID$(line$, visual_begin_pos), start+ypos-1, FALSE, digits)
ENDIF
Print_Text = FALSE
Print_Line = FALSE
' Notion when line is copied
IF copy_flag THEN
GOTOXY COLUMNS/2-15, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
TYPE SET BLINK
PRINT CL$, "---=== line copied to clipboard ===---";
TYPE UNSET BLINK
ENDIF
UNTIL special = 0 AND key = 27
' User pressed <ESC> key
GOTOXY 1, ROWS
COLOR RESET
IF Color_Intense THEN COLOR INTENSE
PRINT CL$, "Press (H) for Help, (Q) to quit, any other key to continue...";
key = GETKEY
SELECT LCASE$(CHR$(key))
CASE "h"
Editor_Show_Help()
CASE "q"
BREAK
ENDSELECT
WEND
' Back to normal screen
CALL Editor_Restore_Normal
END SUB
'----------------------------------------------------------------------------------------------
'
' Main program
'
'----------------------------------------------------------------------------------------------
' Default BACON settings
LET g_MAX_DIGITS = 32
' This is the size for static buffers like getline, read etc.
LET g_BUFFER_SIZE = 512
' Maximum RETURN buffers
LET g_MAX_RBUFFERS = 64
' Defaults for parameters
g_CCNAME$ = ""
g_TEMPDIR$ = ""
g_INCFILES$ = ""
g_CCFLAGS$ = ""
g_BINEXT$ = ""
g_CCNAME_TMP$ = ""
g_TEMPDIR_TMP$ = ""
g_INCFILES_TMP$ = ""
g_LDFLAGS_TMP$ = ""
g_CCFLAGS_TMP$ = ""
LET g_NO_COMPILE = 0
LET g_TMP_PRESERVE = 0
LET g_QUIET = 0
LET g_EXEC = 0
LET g_SEMANTIC = 0
LET g_NO_QUESTION = 0
LET g_CPP = 0
LET g_XGETTEXT = 0
LET g_SAVE_CONFIG = 0
LET g_DEBUG = 0
LET g_LOWERCASE = 0
LET g_USE_C = 0
LET g_USE_H = 0
LET g_MAX_BACKLOG = 5
g_INCLUDE_FILES$ = ""
g_PRAGMA_INCLUDE$ = ""
g_PRAGMA_REGEX$ = ""
LET g_TRACE = 0
LET g_OPTION_BASE = 0
LET g_OPTION_SOCKET = 5
LET g_OPTION_TLS = 0
LET g_OPTION_EVAL = 0
g_INC_TLS$ = ""
g_LIB_TLS$ = ""
g_WHICH_GUI = 0
LET g_OPTION_BREAK = 1
' Some global declarations
DECLARE g_ALL_MAIN_VARS$ ASSOC STRING
DECLARE g_ALL_FUNC_VARS$ ASSOC STRING
DECLARE g_ALL_DIM_VARS$ ASSOC STRING
DECLARE g_SEMANTIC_MEMFREE$ ASSOC STRING
DECLARE g_SEMANTIC_OPENCLOSE$ ASSOC STRING
DECLARE g_MACRO_STRINGS$ ASSOC STRING
g_CURFILE$ = ""
g_FUNCNAME$ = ""
g_SOURCEFILE$ = ""
g_FUNCTYPE$ = ""
g_PROTOTYPE$ = ""
g_TMP_FILES$ = ""
g_LOCALSTRINGS$ = ""
g_STRINGARRAYS$ = ""
g_STRINGARGS$ = ""
g_DYNAMICARRAYS$ = ""
g_STATICARRAYS$ = ""
g_RECORDCACHE$ = ""
LET g_LOOPCTR = 0
g_ERRORTXT$ = ""
g_COMMENT = FALSE
g_TRACE_PREFIX$ = ""
g_IGNORE_PARSE$ = "TRUE"
g_OPTION_EXPLICIT$ = "FALSE"
g_OPTION_INPUT$ = "\"\\n\""
g_VARTYPE$ = "long"
g_OBJ_FILES$ = ""
g_MAKE_LINE$ = ""
g_MONITOR$ = ""
g_STRING_FUNC = 1
g_DOTIMES = 0
g_LOCAL_SBUFFER$ = ""
' Always create a final label
g_CATCHGOTO$ = "__B2C__PROGRAM__EXIT"
g_CATCH_USED = 0
' Records
g_RECORDNAME$ = ""
g_RECORDVAR$ = ""
g_RECORDARRAY$ = ""
g_WITHVAR$ = ""
g_RECORDEND_BODY$ = ""
g_RECORDEND_HEADER$ = ""
' Socket defaults
g_SOCKTYPE$ = "SOCK_STREAM"
g_NETWORKTYPE$ = "TCP"
g_MULTICAST_TTL = 1
g_SCTP_STREAMS = 1
' Select/Case currently 16 levels deep
DECLARE g_SELECTVAR$[16]
DECLARE g_IN_CASE[16]
g_SELECTVAR_CTR = 0
' Relate currently 256
DECLARE g_RELATE$[256]
g_RELATE_CTR = 0
g_FCTR = 0
g_CCTR = 0
' Cursor positions for ASCII editor
g_CURSOR_X = 0
g_CURSOR_Y = 0
' Timer and dir related
DECLARE starttime, ttime, nolex, RETURN_CODE
DECLARE msec_time$, old_curdir$, mapping$
' Read any configfile values
IF NOT(FILEEXISTS(GETENVIRON$("HOME") & "/.bacon/")) THEN MAKEDIR GETENVIRON$("HOME") & "/.bacon/"
IF FILEEXISTS(GETENVIRON$("HOME") & "/.bacon/bacon.cfg" ) THEN
OPEN GETENVIRON$("HOME") & "/.bacon/bacon.cfg" FOR READING AS cfgfile
WHILE NOT(ENDFILE(cfgfile))
READLN line$ FROM cfgfile
SELECT TOKEN$(line$, 1)
CASE "ccname"
g_CCNAME_TMP$ = TOKEN$(line$, 2)
CASE "tempdir"
g_TEMPDIR_TMP$ = TOKEN$(line$, 2)
CASE "incfiles"
g_INCFILES_TMP$ = TOKEN$(line$, 2)
CASE "ldflags"
g_LDFLAGS_TMP$ = TOKEN$(line$, 2)
CASE "ccflags"
g_CCFLAGS_TMP$ = TOKEN$(line$, 2)
CASE "lowercase"
g_LOWERCASE_TMP = VAL(TOKEN$(line$, 2))
CASE "intense"
Color_Intense = VAL(TOKEN$(line$, 2))
CASE "linenr"
Line_Number_Active = VAL(TOKEN$(line$, 2))
CASE "default_color"
Def_Col = VAL(TOKEN$(line$, 2))
CASE "function_color"
Func_Col = VAL(TOKEN$(line$, 2))
CASE "quote_color"
Quot_Col = VAL(TOKEN$(line$, 2))
CASE "number_color"
Num_Col = VAL(TOKEN$(line$, 2))
CASE "type_color"
Type_Col = VAL(TOKEN$(line$, 2))
CASE "variable_color"
Var_Col = VAL(TOKEN$(line$, 2))
CASE "statement_color"
Stat_Col = VAL(TOKEN$(line$, 2))
CASE "comment_color"
Comm_Col = VAL(TOKEN$(line$, 2))
END SELECT
WEND
CLOSE FILE cfgfile
ENDIF
REPEAT
opt = CMDLINE(":c:d:i:l:o:e:xnjfpqrsvwyz@")
SELECT opt
' Compiler option
CASE 99
g_CCNAME$ = ARGUMENT$
' Include option
CASE 105
IF LEFT$(ARGUMENT$) = "/" OR LEFT$(ARGUMENT$, 2) = "./" THEN
g_INCFILES$ = g_INCFILES$ & "#include " & CHR$(34) & ARGUMENT$ & CHR$(34)
ELIF LEFT$(ARGUMENT$) = "<" THEN
g_INCFILES$ = g_INCFILES$ & "#include " & ARGUMENT$
ELSE
g_INCFILES$ = g_INCFILES$ & "#include " & CHR$(34) & CURDIR$ & "/" & ARGUMENT$ & CHR$(34)
END IF
' Library flags
CASE 108
IF LEFT$(ARGUMENT$, 1) = "`" OR LEFT$(ARGUMENT$, 1) = "-" THEN
g_LDFLAGS$ = ARGUMENT$ & " " & g_LDFLAGS$
ELSE
g_LDFLAGS$ = "-l" & ARGUMENT$ & " " & g_LDFLAGS$
ENDIF
' Compiler flags
CASE 111
g_CCFLAGS$ = g_CCFLAGS$ & " " & ARGUMENT$
' Temporary directory
CASE 100
IF NOT(FILEEXISTS(ARGUMENT$)) THEN MAKEDIR ARGUMENT$
g_TEMPDIR$ = ARGUMENT$
' Help option
CASE 104;
CASE 63;
CASE 45
PRINT NL$, "USAGE: bacon [options] program[.bac]"
PRINT NL$, "OPTIONS:"
PRINT NL$, " -c <compiler>", TAB$(1), "Compiler to use (default: cc)"
PRINT " -l <ldflags>", TAB$(1), "Pass libraries to linker"
PRINT " -o <options>", TAB$(1), "Pass compiler options"
PRINT " -i <include>", TAB$(1), "Add include file to C code"
PRINT " -d <tmpdir>", TAB$(1), "Temporary directory (default: .)"
PRINT " -e <file.bac>", TAB$(1), "Use embedded editor"
PRINT " -y ", TAB$(2), "Automatically delete temporary files"
PRINT " -x ", TAB$(2), "Extract gettext strings"
PRINT " -z ", TAB$(2), "Allow lowercase keywords"
PRINT " -f ", TAB$(2), "Create Shared Object"
PRINT " -n ", TAB$(2), "Do not compile, only convert"
PRINT " -j ", TAB$(2), "Invoke C Preprocessor"
PRINT " -p ", TAB$(2), "Preserve temporary files"
PRINT " -q ", TAB$(2), "Show summary after conversion only"
PRINT " -r ", TAB$(2), "Compile and execute in one step"
PRINT " -s ", TAB$(2), "Suppress semantic error warnings"
PRINT " -w ", TAB$(2), "Save options to BaCon configfile"
PRINT " -v ", TAB$(2), "Show version"
PRINT " -h ", TAB$(2), "Show help", NL$
END
' Version option
CASE 118
PRINT NL$, "BaCon version ", g_VERSION$, " on ", OS$, " - (c) Peter van Eerten - MIT License.", NL$
END
' Preserve option
CASE 112
g_TMP_PRESERVE = 1
' Quiet option
CASE 113
g_QUIET = 1
' Run option
CASE 114
g_EXEC = 1
' Suppress semantic errors
CASE 115
g_SEMANTIC = 1
' Gettext option
CASE 120
g_XGETTEXT = 1
' Automatic delete option
CASE 121
g_NO_QUESTION = 1
' No compile option
CASE 110
g_NO_COMPILE = 1
' Goto internal editor
CASE 101
g_SOURCEFILE$ = IIF$(RIGHT$(ARGUMENT$, 4) != ".bac", ARGUMENT$ & ".bac", ARGUMENT$)
IF FILEEXISTS(g_SOURCEFILE$) THEN
Editor_Handle_Input(g_SOURCEFILE$, LOAD$(g_SOURCEFILE$))
ELSE
Editor_Handle_Input(g_SOURCEFILE$, "")
ENDIF
END
' Invoke C Preprocessor
CASE 106
g_CPP = 1
' Allow lowercase keywords
CASE 122
g_LOWERCASE = 1
' Shared library
CASE 102
g_LDFLAGS$ = g_LDFLAGS$ & " -shared -rdynamic"
g_CCFLAGS$ = g_CCFLAGS$ & " -fPIC"
g_BINEXT$ = ".so"
' Write config
CASE 119
g_SAVE_CONFIG = 1
' Debug flag
CASE 64
g_DEBUG = 1
END SELECT
UNTIL opt = -1
' See if configfile must be written
IF g_SAVE_CONFIG = 1 THEN
OPEN GETENVIRON$("HOME") & "/.bacon/bacon.cfg" FOR WRITING AS cfgfile
WRITELN "ccname ", g_CCNAME$ TO cfgfile
WRITELN "tempdir ", g_TEMPDIR$ TO cfgfile
WRITELN "incfiles ", REPLACE$(g_INCFILES$, "#include", "@") TO cfgfile
WRITELN "ldflags ", g_LDFLAGS$ TO cfgfile
WRITELN "ccflags ", g_CCFLAGS$ TO cfgfile
WRITELN "lowercase ", g_LOWERCASE TO cfgfile
WRITELN "intense ", Color_Intense TO cfgfile
WRITELN "linenr ", Line_Number_Active TO cfgfile
CLOSE FILE cfgfile
g_CCNAME_TMP$ = g_CCNAME$
g_TEMPDIR_TMP$ = g_TEMPDIR$
g_INCFILES_TMP$ = REPLACE$(g_INCFILES$, "#include", "@")
g_LDFLAGS_TMP$ = g_LDFLAGS$
g_CCFLAGS_TMP$ = g_CCFLAGS$
g_LOWERCASE_TMP = g_LOWERCASE
ENDIF
' Use the commandline or configfile settings?
IF NOT(LEN(g_CCNAME$)) THEN
g_CCNAME$ = g_CCNAME_TMP$
IF NOT(LEN(g_CCNAME$)) THEN g_CCNAME$ = "cc"
ENDIF
IF NOT(LEN(g_TEMPDIR$)) THEN
g_TEMPDIR$ = g_TEMPDIR_TMP$
IF NOT(LEN(g_TEMPDIR$)) THEN g_TEMPDIR$ = "."
ENDIF
IF NOT(LEN(g_INCFILES$)) THEN g_INCFILES$ = REPLACE$(g_INCFILES_TMP$, "@", "#include")
g_LDFLAGS$ = g_LDFLAGS$ & " " & g_LDFLAGS_TMP$
IF NOT(LEN(g_CCFLAGS$)) THEN g_CCFLAGS$ = g_CCFLAGS_TMP$
IF g_LOWERCASE = 0 THEN g_LOWERCASE = g_LOWERCASE_TMP
IF NOT(LEN(ARGUMENT$)) THEN
IF g_SAVE_CONFIG = 0 THEN EPRINT "System error: no filename? Run with '-h' to see usage."
END 1
ELSE
g_SOURCEFILE$ = ARGUMENT$
ENDIF
IF LEFT$(g_SOURCEFILE$, 7) = "http://" THEN
g_SOURCEFILE$ = MID$(g_SOURCEFILE$, 8)
Download_File(g_SOURCEFILE$)
g_SOURCEFILE$ = MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/")+1)
ELIF RIGHT$(g_SOURCEFILE$, 4) != ".bac" THEN
g_SOURCEFILE$ = CHOP$(g_SOURCEFILE$) & ".bac"
END IF
IF NOT(FILEEXISTS(g_SOURCEFILE$)) THEN
EPRINT "System error: file '", g_SOURCEFILE$, "' not found!"
END 1
ENDIF
' Change the working directory
IF INSTR(g_SOURCEFILE$, "/") AND LEFT$(g_SOURCEFILE$, 1) = "/" THEN CHANGEDIR MID$(g_SOURCEFILE$, 1, INSTRREV(g_SOURCEFILE$, "/")-1)
' Now create the global filenames where to write to
g_CFILE$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".c"
g_HFILE$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".h"
g_GENERIC$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".generic.h"
g_FUNCTIONS$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".functions.h"
STRINGARRAYFILE$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".string.h"
FLOATARRAYFILE$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".float.h"
SRCARRAYFILE$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".src.h"
g_BACONLEXER$ = g_TEMPDIR$ & "/" & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".lex"
' Add to total file list
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_CFILE$ & " " & g_HFILE$ & " " & STRINGARRAYFILE$ & " " & FLOATARRAYFILE$
' Check if previous temporary files exist
total$ = WALK$(g_TEMPDIR$, 1, BASENAME$(g_SOURCEFILE$, 1) & "\\..+\\..+", FALSE)
IF g_NO_QUESTION THEN
FOR tmpfile$ IN total$
DELETE FILE tmpfile$
NEXT
ELSE
IF AMOUNT(total$) THEN
PRINT "WARNING: ", AMOUNT(total$), " temporary files found!", NL$, DELIM$(SORT$(total$), " ", NL$)
INPUT "Do you want to delete them ([y]/n)? ", answer$
IF LEN(answer$) = 0 OR LCASE$(answer$) = "y" THEN
FOR tmpfile$ IN total$
DELETE FILE tmpfile$
NEXT
PRINT "Temporary files were deleted."
ELSE
PRINT "Exiting..."
END 1
ENDIF
ENDIF
ENDIF
' Keep start time
starttime = TIMER
' Create C file
OPEN g_CFILE$ FOR WRITING AS g_CFILE
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO g_CFILE
WRITELN "#include \"", MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1), ".h\"" TO g_CFILE
WRITELN "#include \"", MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1), ".string.h\"" TO g_CFILE
WRITELN "#include \"", MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1), ".float.h\"" TO g_CFILE
' Create H file
OPEN g_HFILE$ FOR WRITING AS g_HFILE
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO g_HFILE
WRITELN "#include " & CHR$(34) & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".generic.h" & CHR$(34) TO g_HFILE
WRITELN "#include " & CHR$(34) & MID$(g_SOURCEFILE$, INSTRREV(g_SOURCEFILE$, "/") + 1) & ".functions.h" & CHR$(34) TO g_HFILE
' Create generic headerfile, functions are converted using macros
OPEN g_GENERIC$ FOR WRITING AS g_GENERIC
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO g_GENERIC
OPEN STRINGARRAYFILE$ FOR WRITING AS STRINGARRAYFILE
WRITELN "char* __b2c__stringarray[] = {" TO STRINGARRAYFILE
OPEN FLOATARRAYFILE$ FOR WRITING AS FLOATARRAYFILE
WRITELN "double __b2c__floatarray[] = {" TO FLOATARRAYFILE
IF INSTR(g_LDFLAGS$, "shared") THEN
WRITELN "/************************************/" TO g_CFILE
WRITELN "/* Init function for shared objects */" TO g_CFILE
WRITELN "/************************************/" TO g_CFILE
WRITELN "#ifdef __GNUC__" TO g_CFILE
WRITELN "static int BaCon_init() __attribute__((constructor));" TO g_CFILE
WRITELN "#endif" TO g_CFILE
WRITELN "int BaCon_init(void){int argc=0; char *argv[2] = { NULL };" TO g_CFILE
ELSE
WRITELN "/****************************/" TO g_CFILE
WRITELN "/* Main program starts here */" TO g_CFILE
WRITELN "/****************************/" TO g_CFILE
WRITELN "int main(int argc, char **argv){" TO g_CFILE
ENDIF
' Set buffering to line oriented
WRITELN "setvbuf(stdout, NULL, _IOLBF, 0);" TO g_CFILE
' Check version
WRITELN "if(argc>0) { __b2c__me_var", g_STRINGSIGN$, " = strdup(argv[0]); }" TO g_CFILE
' See if we have the detector
WRITELN "if(argc==2 && !strcmp(argv[1], \"-bacon\")){fprintf(stderr, \"Converted by %s.\\n\", COMPILED_BY_WHICH_BACON", g_STRINGSIGN$, "); exit(EXIT_SUCCESS);}" TO g_CFILE
' Put arguments into reserved variable ARGUMENT
WRITELN "/* Setup the reserved variable 'ARGUMENT' */" TO g_CFILE
WRITELN "__b2c__argument(&ARGUMENT", g_STRINGSIGN$, ", argc, argv);" TO g_CFILE
WRITELN "/* By default seed random generator */" TO g_CFILE
WRITELN "srandom((unsigned int)time(NULL));" TO g_CFILE
WRITELN "/* Determine current moment and keep it for timer function */" TO g_CFILE
WRITELN "__b2c__timer(1);" TO g_CFILE
WRITELN "/* Setup error signal handling */" TO g_CFILE
WRITELN "signal(SIGILL, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGABRT, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGFPE, __b2c__catch_signal);" TO g_CFILE
WRITELN "signal(SIGSEGV, __b2c__catch_signal);" TO g_CFILE
WRITELN "/* Rest of the program */" TO g_CFILE
' There are no imported symbols yet
LET g_IMPORTED$ = ""
' Define statements
CONST Stat$ = "|ALARM|ALIAS|APPEND|APPENDING|ARRAY|AS|ASSOC|BACK|BAPPEND|BASE|BG|BLACK|BLINK|BLUE|BOLD|BREAK|BROADCAST|BSAVE|BY|CALL|CASE|CATCH|CERTIFICATE|" \
"CHANGEDIR|CHUNK|CLASS|CLEAR|CLOSE|CMODE|COLLAPSE|COLOR|COMPARE|COMPILER|COLLECT|CONST|CONTINUE|COPY|CURRENT|CURSOR|CYAN|DATA|DECLARE|DECR|DEF|DEFAULT|" \
"DELETE|DELIM|DEVICE|DIRECTORY|DO|DONE|DOTIMES|DOWN|DOWNTO|DQ|ELIF|ELSE|END|ENDCLASS|ENDENUM|ENDFORK|ENDFUNCTION|ENDIF|ENDRECORD|ENDSELECT|ENDSUB|ENDUSEC|" \
"ENDUSEH|ENDWITH|ENDFUNC|ENUM|EPRINT|EQ|ESC|EXIT|EXPLICIT|FG|FI|FILE|FN|FOR|FORMAT|FORWARD|FRAMEWORK|FREE|FROM|FTYPE|FUNC|FUNCTION|GE|GETBYTE|GETFILE|GETLINE|" \
"GLOBAL|GOSUB|GOTO|GOTOXY|GREEN|GT|GUI|IF|IMODE|IMPORT|IN|INCLUDE|INCR|INPUT|INTENSE|INTERNATIONAL|INVERSE|IS|ISNOT|ITALIC|JOIN|LABEL|LDFLAGS|LE|LET|LIBRARY|" \
"LMODE|LOCAL|LOOKUP|LT|MAGENTA|MAKEDIR|MAP|MEMREWIND|MEMSTREAM|MEMTYPE|MONITOR|MULTICAST|NE|NETWORK|NEXT|NORMAL|OFF|OFFSET|NODE|OMODE|ON|OPEN|OPTION|OPTIONS|" \
"OTHER|PARSE|POKE|PRAGMA|PRINT|PROPER|PROTO|PULL|PUSH|PUTBYTE|PUTLINE|QUOTED|RE|READ|READING|READLN|READWRITE|RECEIVE|RECORD|RECURSIVE|RED|REDIM|RELATE|REM|" \
"RENAME|REPEAT|RESET|RESIZE|TREE|RESTORE|RESUME|RETURN|REWIND|RUN|SAVE|SCREEN|SCROLL|SCTP|SEED|SEEK|SELECT|SEND|SERVER|SET|SETENVIRON|SETSERIAL|SIGNAL|" \
"SIZE|SLEEP|SOCKET|SORT|SPEED|SPLIT|START|STARTPOINT|STATIC|STEP|STOP|STRIKE|SUB|SWAP|SYSTEM|TCP|TEXTDOMAIN|THEN|TLS|TO|TRACE|TRAP|TYPE|UDP|UNDERLINE|UNSET|" \
"UNTIL|UP|USEC|USEH|UTF8|VAR|VARTYPE|WEND|WHENCE|WHILE|WHITE|WITH|WRITELN|WRITING|YELLOW|"
' Define functions
CONST Func$ = "|ABS|ACCEPT|ACOS|ADDRESS|ALIGN\\$|AMOUNT|AND|APPEND\\$|ASC|ASIN|ATN|ATN2|B64DEC\\$|B64ENC\\$|BASENAME\\$|COIL\\$|BETWEEN|BEYOND|BIN\\$|BIT|BLOAD|" \
"BYTELEN|CEIL|CA\\$|CN\\$|CHANGE\\$|COLLAPSE\\$|CHOP\\$|CHR\\$|CIPHER\\$|CMDLINE|COLUMNS|CONCAT\\$|COS|COUNT|CURDIR\\$|CUT\\$|DAY|DEC|DEG|DEL\\$|DELIM\\$|" \
"DIRNAME\\$|EDITBOM\\$|ENDFILE|EQUAL|ERR\\$|ESCAPE\\$|EVAL|EVEN|EXCHANGE\\$|EXCL|EXEC\\$|EXP|EXPLODE\\$|EXTRACT\\$|FILEEXISTS|FILELEN|FILETIME|FILETYPE|FILL\\$|" \
"FIRST\\$|FLATTEN\\$|FLOOR|FORK|FP|GUIFN|GUIDEFINE|GUIGET|GUISET|GUIEVENT\\$|GUIWIDGET|GETENVIRON\\$|GETKEY|GETPEER\\$|GETX|GETY|HASBOM|HASDELIM|HASH|HEAD\\$|HEX\\$|" \
"HOST\\$|HOSTNAME\\$|HOUR|IIF|IIF\\$|INBETWEEN\\$|INDEX|INDEX\\$|INSERT\\$|INSTR|INSTRREV|INT|INTL\\$|INVERT|ISASCII|ISFALSE|ISKEY|ISTOKEN|ISTRUE|ISUTF8|LAST\\$|" \
"LCASE\\$|LEFT\\$|LEN|LOAD\\$|LOG|LOOP|LOOP\\$|MATCH|MAX|MAX\\$|MAXNUM|ME\\$|MEMCHECK|MEMORY|MEMTELL|MERGE\\$|MID\\$|MIN|MIN\\$|MINUTE|MOD|MONTH|MONTH\\$|" \
"MYPID|NNTL\\$|NOT|NOW|NRKEYS|OBTAIN\\$|ODD|OR|OS\\$|OUTBETWEEN\\$|PEEK|POW|PROPER\\$|RAD|RANDOM|REALPATH\\$|REAP|RIP\\$|REGEX|REPLACE\\$|REV\\$|REVERSE\\$|" \
"RIGHT\\$|RND|ROL|ROR|ROTATE\\$|ROUND|ROWS|RUN\\$|SEARCH|SECOND|SGN|SIN|SIZEOF|FIND|SORT\\$|SPC\\$|SQR|STR\\$|SUM|SUMF|TAB\\$|TAIL\\$|TALLY|TAN|TELL|TIMER|" \
"TIMEVALUE|TOASCII\\$|TOKEN\\$|TYPEOF\\$|UCASE\\$|UBOUND|UCS|ULEN|UNFLATTEN\\$|UNESCAPE\\$|UNIQ\\$|UTF8\\$|VAL|VERIFY|WAIT|WALK\\$|WEEK|WEEKDAY\\$|WHERE|YEAR|"
' Variables
CONST Var$ = "|FALSE|TRUE|PI|MAXRANDOM|ERROR|RETVAL|REGLEN|LINENO|SP|NL\\$|CR\\$|EL\\$|CL\\$|DLE\\$|VERSION\\$|ARGUMENT\\$|SOURCE\\$|NULL|NUMBER|STRING|FLOATING|"
' Types
CONST Type$ = "|const|int|double|float|long|char|short|void|signed|unsigned|static|volatile|struct|extern|public|private|virtual|uint8_t|uint16_t|uint32_t|uint64_t|uintptr_t|int8_t|int16_t|int32_t|int64_t|intptr_t|size_t|"
' Numbers
CONST Num$ = "|0|1|2|3|4|5|6|7|8|9|"
' Comments
CONST Comm$ = "|REM|'|/\\*|"
CONST Mlc$ = "\\*/"
' Allow lowercase statements and functions, exceptions are CONST, STATIC, INT because they're also C types - see Pre_Tokenize
IF ISTRUE(g_LOWERCASE) THEN
FOR kwd$ IN Stat$ STEP "|"
IF kwd$ <> "CONST" AND kwd$ <> "STATIC" THEN mapping$ = mapping$ & " -D" & LCASE$(kwd$) & "=" & kwd$
NEXT
FOR kwd$ IN EXTRACT$(Func$, "\\") STEP "|"
IF kwd$ <> "INT" THEN mapping$ = mapping$ & " -D" & LCASE$(kwd$) & "=" & kwd$
NEXT
FOR kwd$ IN EXTRACT$(Var$, "\\") STEP "|"
mapping$ = mapping$ & " -D" & LCASE$(kwd$) & "=" & kwd$
NEXT
LET g_CPP = 1
ELSE
mapping$ = ""
ENDIF
' Check if the C Preprocessor needs to run
IF ISTRUE(g_CPP) THEN
IF ISTRUE(LEN(EXEC$("command -v cpp 2>/dev/null"))) THEN
PRINT "Preprocessing '", g_SOURCEFILE$, "'... ";
' Change next line marker to overcome C preprocessor interpretation
OPEN g_SOURCEFILE$ & ".tmp" FOR WRITING AS src_tmp
OPEN g_SOURCEFILE$ FOR READING AS src_in
WHILE NOT(ENDFILE(src_in))
READLN line$ FROM src_in
IF LEFT$(line$, 1) = "#" THEN
WRITELN line$ TO src_tmp
ELSE
WRITELN "@" & line$ & "@" TO src_tmp
ENDIF
WEND
CLOSE FILE src_in, src_tmp
SYSTEM "cpp -w -P " & mapping$ & " " & g_SOURCEFILE$ & ".tmp " & g_SOURCEFILE$ & ".cpp"
' Restore next line marker
OPEN g_SOURCEFILE$ & ".cpp" FOR READING AS src_cpp
OPEN g_SOURCEFILE$ & ".bac2" FOR WRITING AS src_out
WHILE NOT(ENDFILE(src_cpp))
READLN line$ FROM src_cpp
WRITELN MID$(line$, 2, LEN(line$)-2) TO src_out
WEND
CLOSE FILE src_out, src_cpp
FEED$ = g_SOURCEFILE$ & ".bac2"
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_SOURCEFILE$ & ".cpp" & " " & g_SOURCEFILE$ & ".tmp" & " " & g_SOURCEFILE$ & ".bac2"
PRINT "done."
ELSE
EPRINT "System error: the C Preprocessor 'cpp' not found on this system! Exiting..."
END 1
END IF
ELSE
FEED$ = g_SOURCEFILE$
END IF
' Set current filename
LET g_CURFILE$ = g_SOURCEFILE$
' Initialize
LET total$ = ""
LET g_COUNTER = 0
LET g_TOTAL_LINES = 0
' Register internal result variables for LOOP, LOOP$, COIL$ functions
Save_Main_Var("__b2c__loop_result" & g_STRINGSIGN$, "char*")
Save_Main_Var("__b2c__loop_result", "long")
' ERROR and '_' variable can be reset manually by user, so register it
Save_Main_Var("ERROR", "int")
Save_Main_Var("_", "long")
' Read source program
OPEN FEED$ FOR READING AS g_SOURCEFILE
' Start walking through program
PRINT "\rConverting '", g_SOURCEFILE$, "'... ";
REPEAT
READLN line$ FROM g_SOURCEFILE
INCR g_COUNTER
IF NOT(g_QUIET) THEN PRINT "\rConverting '", g_SOURCEFILE$, "'... ", g_COUNTER, EL$;
' Line is not empty?
IF LEN(line$) > 0 THEN
IF RIGHT$(line$, 1) = CR$ THEN
EPRINT "\nSystem error: Windows file detected! Remove non-Unix CR line separators first. Exiting..."
END 1
ELIF RIGHT$(line$, 2) = " \\" AND LEFT$(CHOP$(line$), 1) != CHR$(39) THEN
total$ = total$ & LEFT$(line$, LEN(line$) - 2)
ELSE
total$ = CHOP$(total$ & line$)
IF LEFT$(total$, 1) <> "'" THEN
IF g_DEBUG THEN
WRITELN "/* line ", g_COUNTER, " \"", g_SOURCEFILE$, "\" */" TO g_CFILE
WRITELN "/* line ", g_COUNTER, " \"", g_SOURCEFILE$, "\" */" TO g_HFILE
ELSE
WRITELN "#line ", g_COUNTER, " \"", g_SOURCEFILE$, "\"" TO g_CFILE
WRITELN "#line ", g_COUNTER, " \"", g_SOURCEFILE$, "\"" TO g_HFILE
ENDIF
Tokenize(total$)
END IF
LET total$ = ""
END IF
ENDIF
UNTIL ENDFILE(g_SOURCEFILE)
CLOSE FILE g_SOURCEFILE
IF g_DEBUG = 1 THEN Debug_Vars
' Finalize main C-file
IF g_CATCH_USED = 1 THEN WRITELN "__B2C__PROGRAM__EXIT:" TO g_CFILE
WRITELN "return(0);" TO g_CFILE
WRITELN "}" TO g_CFILE
' Finalize STRING ARRAY file for DATA
WRITELN " \"\" };" TO STRINGARRAYFILE
' Finalize FLOAT ARRAY file for DATA
WRITELN " 0.0};" TO FLOATARRAYFILE
INCR g_TOTAL_LINES, g_COUNTER
ttime = TIMER-starttime
PRINT MOD(ttime, 1000) FORMAT "%.3ld" TO msec_time$
PRINT "\rConverting '", g_SOURCEFILE$, "'... done, ", g_TOTAL_LINES, " lines were processed in ", FLOOR(ttime/1000), ".", msec_time$, " seconds."
' Check if generated source file exists
IF FILEEXISTS(SRCARRAYFILE$) THEN
WRITELN "#include \"", SRCARRAYFILE$, "\"" TO g_HFILE
g_TMP_FILES$ = g_TMP_FILES$ & " " & SRCARRAYFILE$
ENDIF
' Include local buffers
IF LEN(g_LOCAL_SBUFFER$) THEN WRITELN g_LOCAL_SBUFFER$ TO g_HFILE
' Include functions and subs
FOR incfiles$ IN g_INCLUDE_FILES$
IF LEN(incfiles$) > 0 THEN WRITELN "#include \"", incfiles$, CHR$(34) TO g_HFILE
NEXT
' Close filehandle
CLOSE FILE g_HFILE
' The rest of all generic definitions
WRITELN g_PRAGMA_INCLUDE$ TO g_GENERIC
' Add user include files
IF LEN(g_INCFILES$) THEN WRITELN REPLACE$(g_INCFILES$, "#include", NL$ & "#include") TO g_GENERIC
WRITELN "#include <stdio.h>" TO g_GENERIC
WRITELN "#include <stdlib.h>" TO g_GENERIC
WRITELN "#include <stdarg.h>" TO g_GENERIC
WRITELN "#include <stdint.h>" TO g_GENERIC
WRITELN "#include <libgen.h>" TO g_GENERIC
WRITELN "#include <limits.h>" TO g_GENERIC
WRITELN "#include <float.h>" TO g_GENERIC
WRITELN "#include <sys/time.h>" TO g_GENERIC
WRITELN "#include <sys/stat.h>" TO g_GENERIC
WRITELN "#include <sys/types.h>" TO g_GENERIC
WRITELN "#include <sys/wait.h>" TO g_GENERIC
WRITELN "#include <sys/socket.h>" TO g_GENERIC
WRITELN "#include <sys/utsname.h>" TO g_GENERIC
WRITELN "#include <sys/ioctl.h>" TO g_GENERIC
WRITELN "#include <dirent.h>" TO g_GENERIC
WRITELN "#include <setjmp.h>" TO g_GENERIC
WRITELN "#include <netdb.h>" TO g_GENERIC
IF INSTR(OS$, "BSD") THEN
WRITELN "#include <netinet/in.h>" TO g_GENERIC
WRITELN "#define strcat(x, y) __b2c_strlcat(x, y)" TO g_GENERIC
WRITELN "#define strcpy(x, y) __b2c_strlcpy(x, y)" TO g_GENERIC
ENDIF
WRITELN "#include <arpa/inet.h>" TO g_GENERIC
WRITELN "#include <signal.h>" TO g_GENERIC
IF LEN(g_PRAGMA_REGEX$) THEN
IF NOT(REGEX(g_PRAGMA_REGEX$, " INCLUDE ")) THEN
kwd$ = HEAD$(g_PRAGMA_REGEX$, 1)
IF INSTR(kwd$, "tre") THEN
WRITELN "#include <tre/regex.h>" TO g_GENERIC
ELIF INSTR(kwd$, "pcre") THEN
WRITELN "#include <pcreposix.h>" TO g_GENERIC
ELIF INSTR(kwd$, "onig") THEN
WRITELN "#include <onigposix.h>" TO g_GENERIC
ENDIF
ELSE
kwd$ = MID$(g_PRAGMA_REGEX$, INSTR(g_PRAGMA_REGEX$, " INCLUDE ")+9)
WRITELN "#include ", HEAD$(kwd$, 1) TO g_GENERIC
ENDIF
ELSE
WRITELN "#include <regex.h>" TO g_GENERIC
ENDIF
' TLS header
IF LEN(g_INC_TLS$) THEN
IF REGEX(g_INC_TLS$, " INCLUDE ") THEN
FOR kwd$ IN MID$(g_INC_TLS$, INSTR(g_INC_TLS$, " INCLUDE ")+9)
WRITELN "#include ", kwd$ TO g_GENERIC
NEXT
ELSE
WRITELN g_INC_TLS$ TO g_GENERIC
ENDIF
ENDIF
WRITELN "#include <fcntl.h>" TO g_GENERIC
WRITELN "#include <math.h>" TO g_GENERIC
WRITELN "#include <unistd.h>" TO g_GENERIC
WRITELN "#include <string.h>" TO g_GENERIC
WRITELN "#include <ctype.h>" TO g_GENERIC
WRITELN "#include <wctype.h>" TO g_GENERIC
WRITELN "#include <locale.h>" TO g_GENERIC
WRITELN "#include <dlfcn.h>" TO g_GENERIC
WRITELN "#include <errno.h>" TO g_GENERIC
WRITELN "#include <termios.h>" TO g_GENERIC
WRITELN "#include <time.h>" TO g_GENERIC
WRITELN "#include <fts.h>" TO g_GENERIC
WRITELN "#define ENTRY ENTRY_libc" TO g_GENERIC
WRITELN "#include <search.h>" TO g_GENERIC
WRITELN "#undef ENTRY" TO g_GENERIC
WRITELN "/* Undefine all symbols which happen to be BaCon keywords */" TO g_GENERIC
FOR kwd$ IN SORT$(Stat$ & EXTRACT$(Func$, "\\") & EXTRACT$(Var$, "\\"), "|") STEP "|"
IF RIGHT$(kwd$, 1) <> "$" AND kwd$ <> "NULL" THEN WRITELN "#undef ", kwd$ TO g_GENERIC
NEXT
WRITELN "/* Declarations for internal variables */" TO g_GENERIC
WRITELN "jmp_buf __b2c__jump;" TO g_GENERIC
WRITELN "int __b2c__trap = 1;" TO g_GENERIC
WRITELN "int __b2c__catch_set_backup = 0, __b2c__catch_set = 0;" TO g_GENERIC
WRITELN "void (*__b2c__error_callback)(char*, char*, long) = NULL;" TO g_GENERIC
WRITELN "int __b2c__option_compare = 0;" TO g_GENERIC
WRITELN "int __b2c__option_quoted = 1;" TO g_GENERIC
WRITELN "int __b2c__option_dq = 34;" TO g_GENERIC
WRITELN "int __b2c__option_esc = 92;" TO g_GENERIC
WRITELN "int __b2c__option_utf8 = 0;" TO g_GENERIC
WRITELN "int __b2c__option_proper = 0;" TO g_GENERIC
WRITELN "int __b2c__option_error = 1;" TO g_GENERIC
WRITELN "int __b2c__option_tls = 0;" TO g_GENERIC
WRITELN "char *__b2c__option_delim = \" \";" TO g_GENERIC
WRITELN "int __b2c__option_memstream = 0;" TO g_GENERIC
WRITELN "int __b2c__option_startpoint = 0;" TO g_GENERIC
WRITELN "int __b2c__option_open = O_RDWR|O_NOCTTY|O_SYNC;" TO g_GENERIC
WRITELN "int __b2c__collapse = 0;" TO g_GENERIC
WRITELN "int __b2c__break_ctr = 0;" TO g_GENERIC
WRITELN "int __b2c__break_flag = 0;" TO g_GENERIC
WRITELN "char __b2c__chop_default[] = \"\\r\\n\\t \";" TO g_GENERIC
WRITELN "int __b2c__stringarray_ptr = 0;" TO g_GENERIC
WRITELN "int __b2c__floatarray_ptr = 0;" TO g_GENERIC
WRITELN "long __b2c__ctr = 0;" TO g_GENERIC
' Save the max amount of parallel string buffers
WRITELN "#define __b2c_STRING_FUNC (", g_STRING_FUNC, ")" TO g_GENERIC
WRITELN "#define __b2c_EMPTYSTRING (char*)\"\"" TO g_GENERIC
WRITELN "jmp_buf __b2c__gosub_buffer[", g_MAX_RBUFFERS, "];" TO g_GENERIC
WRITELN "int __b2c__gosub_buffer_ptr = -1;" TO g_GENERIC
WRITELN "char* __b2c__loop_result", g_STRINGSIGN$, " = NULL;" TO g_GENERIC
WRITELN "long __b2c__loop_result = 0;" TO g_GENERIC
WRITELN "jmp_buf __b2c__data_jump, __b2c__loop1, __b2c__loop2;" TO g_GENERIC
WRITELN "char *__b2c__assign = NULL;" TO g_GENERIC
WRITELN "int __b2c__counter;" TO g_GENERIC
WRITELN "char **__b2c__stack = NULL;" TO g_GENERIC
WRITELN "void **__b2c__twalk_array = NULL; int __b2c__twalk_idx = 0;" TO g_GENERIC
WRITELN "extern char *__b2c__stringarray[];" TO g_GENERIC
WRITELN "extern double __b2c__floatarray[];" TO g_GENERIC
WRITELN "unsigned long __b2c__ptrlow = ULONG_MAX;" TO g_GENERIC
WRITELN "unsigned long __b2c__ptrhgh = 0;" TO g_GENERIC
WRITELN "char *__b2c__me_var", g_STRINGSIGN$, " = NULL;" TO g_GENERIC
WRITELN "unsigned long __b2c__exceptions[0x400000] = { 0 };" TO g_GENERIC
WRITELN "/* Declarations for BaCon variables */" TO g_GENERIC
WRITELN "char *ARGUMENT", g_STRINGSIGN$, " = NULL;" TO g_GENERIC
WRITELN "int ERROR = 0;" TO g_GENERIC
WRITELN "int RETVAL = 0;" TO g_GENERIC
WRITELN "int REGLEN = 0;" TO g_GENERIC
WRITELN "int SP = 0;" TO g_GENERIC
WRITELN "long _ = 0;" TO g_GENERIC
WRITELN "char VERSION", g_STRINGSIGN$, "[] = \"", g_VERSION$, "\";" TO g_GENERIC
' Prototypes for functions
WRITELN "/* Prototypes for internal functions */" TO g_GENERIC
WRITELN "int __b2c__strcmp(const char*, const char*);" TO g_GENERIC
WRITELN "char *__b2c__strdup(const char*);" TO g_GENERIC
WRITELN "char *__b2c__strndup(const char*, size_t);" TO g_GENERIC
WRITELN "void* __b2c_str_realloc_core(char*, size_t, int);" TO g_GENERIC
WRITELN "long __b2c__delim_engine_core(int, long*, char*, char*, long, int);" TO g_GENERIC
IF INSTR(OS$, "BSD") THEN
WRITELN "char *__b2c_strlcat(char*, const char*);" TO g_GENERIC
WRITELN "char *__b2c_strlcpy(char*, const char*);" TO g_GENERIC
ENDIF
WRITELN "/* Prototypes for BaCon functions */" TO g_GENERIC
WRITELN "char *ERR", g_STRINGSIGN$, "(int);" TO g_GENERIC
WRITELN "int __b2c_utf8_conv(int,char*);" TO g_GENERIC
WRITELN "char* __b2c_Copy_String(char*,char*);" TO g_GENERIC
WRITELN "char* __b2c_Swap_String(char**, char**);" TO g_GENERIC
WRITELN "unsigned long __b2c__len(const char*);" TO g_GENERIC
WRITELN "unsigned long __b2c__ulen(int,char*,char*,char*,int);" TO g_GENERIC
WRITELN "unsigned long __b2c__blen(int,char*,char*,char*,long,int);" TO g_GENERIC
WRITELN "unsigned long __b2c__ucs2_clen(int,char*,char*,char*,int);" TO g_GENERIC
WRITELN "/* Internal macro definitions */" TO g_GENERIC
WRITELN "#define __b2c__MEMTYPE char" TO g_GENERIC
WRITELN "#define __b2c__STRCMP __b2c__strcmp" TO g_GENERIC
WRITELN "#define __b2c__BUFOFFSET 13" TO g_GENERIC
WRITELN "#define __b2c__LBUFSIZE(x) (*(uint32_t*)(x-__b2c__BUFOFFSET+8))" TO g_GENERIC
WRITELN "#define __b2c__RBUFSIZE(x) (*(uint32_t*)(x-__b2c__BUFOFFSET+4))" TO g_GENERIC
WRITELN "#define __b2c__INRANGE(x) ((unsigned long)x >= __b2c__ptrlow && (unsigned long)x <= __b2c__ptrhgh ? 1 : 0)" TO g_GENERIC
WRITELN "#define __b2c__SETRANGE(x) if((unsigned long)x > __b2c__ptrhgh) { __b2c__ptrhgh = (unsigned long)(x); } if((unsigned long)x < __b2c__ptrlow) { __b2c__ptrlow = (unsigned long)(x); }" TO g_GENERIC
WRITELN "#define __b2c__STRFREE(x) ( __b2c__FIND_EXCEPTION((unsigned long)x) || ( x!=NULL && (uintptr_t)x&1 ) ? free(x-__b2c__BUFOFFSET-__b2c__LBUFSIZE(x)) : free(x)); __b2c__DEL_EXCEPTION((unsigned long)x)" TO g_GENERIC
WRITELN "#define __b2c__SETLEN(x,y) *(uint32_t*)(x-__b2c__BUFOFFSET) = y;" TO g_GENERIC
WRITELN "#define __b2c__MEMDUP(x, y) memcpy(malloc(x), &y, x)" TO g_GENERIC
WRITELN "#define __b2c__FUNCSELECT2(_1, _2, x, ...) x" TO g_GENERIC
WRITELN "#define __b2c__FUNCSELECT3(_1, _2, _3, x, ...) x" TO g_GENERIC
WRITELN "#define __b2c__FUNCSELECT4(_1, _2, _3, _4, x, ...) x" TO g_GENERIC
WRITELN "#define __b2c__FUNCSELECT5(_1, _2, _3, _4, _5, x, ...) x" TO g_GENERIC
WRITELN "#define __b2c__FUNCSELECT10(_1, _2, _3, _4, _5, _6, _7, _8, _9, _0, x, ...) x" TO g_GENERIC
WRITELN "#define __b2c__ADD_EXCEPTION(a) __b2c__exceptions[a&0x3FFFFF]=a" TO g_GENERIC
WRITELN "#define __b2c__DEL_EXCEPTION(a) __b2c__exceptions[a&0x3FFFFF]=0" TO g_GENERIC
WRITELN "#define __b2c__FIND_EXCEPTION(a) (a!=0 && __b2c__exceptions[a&0x3FFFFF]==a ? 1 : 0)" TO g_GENERIC
WRITELN "#define __b2c_str_realloc(x, y) __b2c_str_realloc_core(x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c_str_realloc_left(x, y) __b2c_str_realloc_core(x, y, 1)" TO g_GENERIC
WRITELN "#define __b2c__delim_engine(x, y, z, a, b) __b2c__delim_engine_core(x, y, z, a, b, 0)" TO g_GENERIC
WRITELN "#define __b2c__delim_engine_cache(x, y, z, a, b) __b2c__delim_engine_core(x, y, z, a, b, 1)" TO g_GENERIC
WRITELN "#if INTPTR_MAX == INT64_MAX" TO g_GENERIC
WRITELN "#define HASH_FUNC (uint64_t)__b2c__HashFNV1a_64" TO g_GENERIC
WRITELN "#elif INTPTR_MAX == INT32_MAX" TO g_GENERIC
WRITELN "#define HASH_FUNC (uint32_t)__b2c__HashFNV1a_32" TO g_GENERIC
WRITELN "#else" TO g_GENERIC
WRITELN "#define HASH_FUNC (uint16_t)__b2c__HashFNV1a_16_new" TO g_GENERIC
WRITELN "#endif" TO g_GENERIC
WRITELN "#define COMPILED_BY_WHICH_BACON", g_STRINGSIGN$, " ", CHR$(34), "BaCon executable ", g_VERSION$, CHR$(34) TO g_GENERIC
WRITELN "#define RUNTIMEERROR(a, x, y, z) do { if(__b2c__option_error) { fprintf(stderr, \"Runtime error: statement '%s' at line %d in '%s': %s\\n\", a, x, y, ERR", g_STRINGSIGN$, "(z)); exit(z); } if(__b2c__error_callback){(*__b2c__error_callback)(a,y,x);} } while(0)" TO g_GENERIC
WRITELN "#define RUNTIMEFERR(a, x, y, z) do { if(__b2c__option_error) { fprintf(stderr, \"Runtime error: function '%s' at line %d in '%s': %s\\n\", a, z, y, ERR", g_STRINGSIGN$, "(x)); exit(x); } if(__b2c__error_callback){(*__b2c__error_callback)(a,y,z);} } while(0)" TO g_GENERIC
WRITELN "#define RUNTIMEDEBUG(x, y, z) (__b2c__getch() == 27 ? fprintf(stderr, \"TRACE OFF - exiting trace mode.\\n\") && __b2c__stop_program() : fprintf(stderr, \"File '%s' line %d: %s\\n\", #x, y, z)", g_MONITOR$, " )" TO g_GENERIC
WRITELN "int __b2c__stop_program(void) { exit(EXIT_SUCCESS); return(1); }" TO g_GENERIC
WRITELN "/* BaCon functions */" TO g_GENERIC
WRITELN "#define ABS(x) (((x) < 0) ? -(x) : (x))" TO g_GENERIC
WRITELN "#define ACOS(x) acos((double)x)" TO g_GENERIC
WRITELN "#define ADDRESS(x) (uintptr_t)(&x)" TO g_GENERIC
WRITELN "#define __b2c__ALIGN3(x, y, z) __b2c__align(__LINE__, __FILE__, x, y, z, 0)" TO g_GENERIC
WRITELN "#define __b2c__ALIGN4(x, y, z, f) __b2c__align(__LINE__, __FILE__, x, y, z, f)" TO g_GENERIC
WRITELN "#define ALIGN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__ALIGN4, __b2c__ALIGN3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__AMOUNT1(x) __b2c__amount(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__AMOUNT2(x, y) __b2c__amount(x, y)" TO g_GENERIC
WRITELN "#define AMOUNT(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__AMOUNT2, __b2c__AMOUNT1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define AND &&" TO g_GENERIC
WRITELN "#define __b2c__APPEND3(x, y, z) __b2c__append(NULL, 0, x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__APPEND4(x, y, z, f) __b2c__append(NULL, 0, x, y, z, f)" TO g_GENERIC
WRITELN "#define APPEND", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__APPEND4, __b2c__APPEND3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__FAPPEND4(s, x, y, z) __b2c__append(&s, 1, x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__FAPPEND5(s, x, y, z, f) __b2c__append(&s, 1, x, y, z, f)" TO g_GENERIC
WRITELN "#define F_APPEND", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT5(__VA_ARGS__, __b2c__FAPPEND5, __b2c__FAPPEND4)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define ASC(x) (x == NULL ? 0 : (unsigned char)*x)" TO g_GENERIC
WRITELN "#define ASIN(x) asin((double)x)" TO g_GENERIC
WRITELN "#define ATN(x) atan((double)x)" TO g_GENERIC
WRITELN "#define ATN2(x,y) atan2((double)x,(double)y)" TO g_GENERIC
WRITELN "#define B64DEC", g_STRINGSIGN$, "(x) __b2c__b64dec(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define __b2c__B64ENC1(x) __b2c__b64enc(x, 0)" TO g_GENERIC
WRITELN "#define __b2c__B64ENC2(x, y) __b2c__b64enc((char*)x, y)" TO g_GENERIC
WRITELN "#define B64ENC", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__B64ENC2, __b2c__B64ENC1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__BASENAME1(x) __b2c__dirname(__LINE__, __FILE__, 1, x, 0)" TO g_GENERIC
WRITELN "#define __b2c__BASENAME2(x, y) __b2c__dirname(__LINE__, __FILE__, 1, x, y)" TO g_GENERIC
WRITELN "#define BASENAME", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__BASENAME2, __b2c__BASENAME1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define BIN", g_STRINGSIGN$, "(x) __b2c__bin(sizeof(__b2c__MEMTYPE), x)" TO g_GENERIC
WRITELN "#define BIT(x) __b2c__bit(x)" TO g_GENERIC
WRITELN "#define BLOAD(x) (void*)__b2c__load(1, __LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define __b2c__BYTELEN2(x, y) __b2c__blen(__LINE__, __FILE__, \"BYTELEN\", x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__BYTELEN3(x, y, z) __b2c__blen(__LINE__, __FILE__, \"BYTELEN\", x, y, z)" TO g_GENERIC
WRITELN "#define BYTELEN(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__BYTELEN3, __b2c__BYTELEN2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define CA", g_STRINGSIGN$, "(x) __b2c__ca(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define CN", g_STRINGSIGN$, "(x) __b2c__cn(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define CIPHER", g_STRINGSIGN$, "(x) __b2c__cipher(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define VERIFY(x, y) ((SSL*)x == NULL ? -1 : (long)SSL_get_verify_result((SSL*)x) )" TO g_GENERIC
WRITELN "#define ACCEPT(x) __b2c__accept(__LINE__, __FILE__, __b2c__caprivate, __b2c__caserver, x)" TO g_GENERIC
WRITELN "#define CEIL(x) (double)ceil(x)" TO g_GENERIC
WRITELN "#define __b2c__CHANGE3(x, y, z) __b2c__change(x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__CHANGE4(x, y, z, f) __b2c__change(x, y, z, f)" TO g_GENERIC
WRITELN "#define CHANGE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__CHANGE4, __b2c__CHANGE3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__CHOP1(x) __b2c__chop(NULL, 0, x, NULL, 0)" TO g_GENERIC
WRITELN "#define __b2c__CHOP2(x, y) __b2c__chop(NULL, 0, x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__CHOP3(x, y, z) __b2c__chop(NULL, 0, x, y, z)" TO g_GENERIC
WRITELN "#define CHOP", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__CHOP3, __b2c__CHOP2, __b2c__CHOP1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__FCHOP2(s, x) __b2c__chop(&s, 1, x, NULL, 0)" TO g_GENERIC
WRITELN "#define __b2c__FCHOP3(s, x, y) __b2c__chop(&s, 1, x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__FCHOP4(s, x, y, z) __b2c__chop(&s, 1, x, y, z)" TO g_GENERIC
WRITELN "#define F_CHOP", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__FCHOP4, __b2c__FCHOP3, __b2c__FCHOP2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define CHR", g_STRINGSIGN$, "(x) __b2c__asc2char(x)" TO g_GENERIC
WRITELN "#define UTF8", g_STRINGSIGN$, "(x) __b2c__asc2utf8(x)" TO g_GENERIC
WRITELN "#define CL", g_STRINGSIGN$, " \"\\033[2K\"" TO g_GENERIC
WRITELN "#define CMDLINE(x) __b2c__getopt(argc, argv, x)" TO g_GENERIC
WRITELN "#define COIL", g_STRINGSIGN$, "(...) ( !setjmp(__b2c__loop1) ? __b2c__loop_helper(__b2c__loop2) : __b2c__loop_result", g_STRINGSIGN$, " )" TO g_GENERIC
WRITELN "#define __b2c__COLLAPSE1(x) __b2c__collapse_func(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__COLLAPSE2(x, y) __b2c__collapse_func(x, y)" TO g_GENERIC
WRITELN "#define COLLAPSE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__COLLAPSE2, __b2c__COLLAPSE1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define COLUMNS __b2c__screen(0)" TO g_GENERIC
WRITELN "#define CONCAT", g_STRINGSIGN$, "(...) __b2c__concat(sizeof((const char*[]) {__VA_ARGS__}) / sizeof(char*), __VA_ARGS__)" TO g_GENERIC
WRITELN "#define F_CONCAT", g_STRINGSIGN$, "(...) __b2c__concat2(sizeof((const char*[]) {__VA_ARGS__}) / sizeof(char*), __VA_ARGS__)" TO g_GENERIC
WRITELN "#define COS(x) cos((double)x)" TO g_GENERIC
WRITELN "#define COUNT(x, y) ((x) != NULL ? __b2c__count(__LINE__, __FILE__, x, y) : 0)" TO g_GENERIC
WRITELN "#define CR", g_STRINGSIGN$, " \"\\r\"" TO g_GENERIC
WRITELN "#define CURDIR", g_STRINGSIGN$, " __b2c__curdir()" TO g_GENERIC
WRITELN "#define __b2c__CUT3(x, y, z) __b2c__cut(x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__CUT4(x, y, z, f) __b2c__cut(x, y, z, f)" TO g_GENERIC
WRITELN "#define CUT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__CUT4, __b2c__CUT3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define DAY(x) __b2c__time(x, 1)" TO g_GENERIC
WRITELN "#define __b2c__DEC1(x) __b2c__hex2dec(__LINE__, __FILE__, x, 0)" TO g_GENERIC
WRITELN "#define __b2c__DEC2(x, y) __b2c__hex2dec(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define DEC(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__DEC2, __b2c__DEC1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define DEG(x) (x*180/PI)" TO g_GENERIC
WRITELN "#define __b2c__DEL2(x, y) __b2c__del(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__DEL3(x, y, z) __b2c__del(x, y, z)" TO g_GENERIC
WRITELN "#define DEL", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__DEL3, __b2c__DEL2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define DELIM", g_STRINGSIGN$, "(x, y, z) __b2c__delim(x, y, z)" TO g_GENERIC
WRITELN "#define DIRNAME", g_STRINGSIGN$, "(x) __b2c__dirname(__LINE__, __FILE__, 2, x, 0)" TO g_GENERIC
WRITELN "#define DLE", g_STRINGSIGN$, " \"\\r\\n\"" TO g_GENERIC
WRITELN "#define EDITBOM", g_STRINGSIGN$, "(x, y) __b2c__editbom(x, y)" TO g_GENERIC
WRITELN "#define EL", g_STRINGSIGN$, " \"\\033[0K\"" TO g_GENERIC
WRITELN "#define ENDFILE(x) feof(x)" TO g_GENERIC
WRITELN "#define EQ ==" TO g_GENERIC
WRITELN "#define EQUAL(x, y) ((x) != NULL && (y) != NULL ? !__b2c__STRCMP(x, y) : 0)" TO g_GENERIC
WRITELN "#define ESCAPE", g_STRINGSIGN$, "(x) __b2c__escape(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define EVAL(x, y, z, q) __b2c__eval(__LINE__, __FILE__, x, y, z, q)" TO g_GENERIC
WRITELN "#define EVEN(x) (((long)(x) % 2 == 0) ? 1 : 0)" TO g_GENERIC
WRITELN "#define __b2c__EXCHANGE3(x, y, z) __b2c__exchange(x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__EXCHANGE4(x, y, z, f) __b2c__exchange(x, y, z, f)" TO g_GENERIC
WRITELN "#define EXCHANGE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__EXCHANGE4, __b2c__EXCHANGE3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__EXEC1(x) __b2c__exec(0, __LINE__, __FILE__, x, NULL, 0)" TO g_GENERIC
WRITELN "#define __b2c__EXEC2(x, y) __b2c__exec(0, __LINE__, __FILE__, x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__EXEC3(x, y, z) __b2c__exec(0, __LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define EXEC", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__EXEC3, __b2c__EXEC2, __b2c__EXEC1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define EXP(x) exp((double)x)" TO g_GENERIC
WRITELN "#define __b2c__EXPLODE1(x) __b2c__explode(__LINE__, __FILE__, x, 1, NULL)" TO g_GENERIC
WRITELN "#define __b2c__EXPLODE2(x, y) __b2c__explode(__LINE__, __FILE__, x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__EXPLODE3(x, y, z) __b2c__explode(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define EXPLODE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__EXPLODE3, __b2c__EXPLODE2, __b2c__EXPLODE1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__EXTRACT2(x, y) __b2c__extract(__LINE__, __FILE__, x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__EXTRACT3(x, y, z) __b2c__extract(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define EXTRACT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__EXTRACT3, __b2c__EXTRACT2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define FALSE 0" TO g_GENERIC
WRITELN "#define FILEEXISTS(x) (x != NULL ? !access(x, F_OK) : 0)" TO g_GENERIC
WRITELN "#define FILELEN(x) __b2c__filelen(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define FILETIME(x, y) __b2c__filetime(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define FILETYPE(x) __b2c__filetype(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define FILL", g_STRINGSIGN$, "(x, y) ((y) >= 0 && (y) <= 0x10FFFF ? __b2c__fill(x, y) : NULL)" TO g_GENERIC
WRITELN "#define FIND(x, y, z) __b2c__find(x, y, (void*)z)" TO g_GENERIC
WRITELN "#define __b2c__FIRST2(x, y) __b2c__first(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__FIRST3(x, y, z) __b2c__first(x, y, z)" TO g_GENERIC
WRITELN "#define FIRST", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__FIRST3, __b2c__FIRST2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__FLATTEN1(x) __b2c__flatten(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__FLATTEN2(x, y) __b2c__flatten(x, y)" TO g_GENERIC
WRITELN "#define FLATTEN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__FLATTEN2, __b2c__FLATTEN1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define FLOATING double" TO g_GENERIC
WRITELN "#define FLOOR(x) (long)floor(x)" TO g_GENERIC
WRITELN "#define FORK fork()" TO g_GENERIC
WRITELN "#define FP(x) (void*)(&x)" TO g_GENERIC
WRITELN "#define GE >=" TO g_GENERIC
WRITELN "#define GETENVIRON", g_STRINGSIGN$, "(x) ((x) != NULL ? __b2c__getenv(x) : (char*)\"null\")" TO g_GENERIC
WRITELN "#define GETKEY __b2c__getch()" TO g_GENERIC
WRITELN "#define GETPEER", g_STRINGSIGN$, "(x) __b2c__getpeer(__LINE__, __FILE__, (uintptr_t)x)" TO g_GENERIC
WRITELN "#define GETX __b2c__getxy(0)" TO g_GENERIC
WRITELN "#define GETY __b2c__getxy(1)" TO g_GENERIC
WRITELN "#define GUIDEFINE(x) __b2c__guiDefine()" TO g_GENERIC
WRITELN "#define __b2c__GUIEVENT1(x) __b2c__guiExecute(x, 0)" TO g_GENERIC
WRITELN "#define __b2c__GUIEVENT2(x, y) __b2c__guiExecute(x, y)" TO g_GENERIC
WRITELN "#define GUIEVENT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__GUIEVENT2, __b2c__GUIEVENT1)(__VA_ARGS__)" TO g_GENERIC
IF g_WHICH_GUI = 4 THEN
WRITELN "#define GUIFN(id, x) Tcl_Eval((Tcl_Interp*)id, x)" TO g_GENERIC
ELSE
WRITELN "#define __b2c__GUIFN1(id, x, func) func(GUIWIDGET(id, x))" TO g_GENERIC
WRITELN "#define __b2c__GUIFN2(id, x, func, ...) func(GUIWIDGET(id, x), __VA_ARGS__)" TO g_GENERIC
WRITELN "#define GUIFN(...) __b2c__FUNCSELECT10(__VA_ARGS__, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN2, __b2c__GUIFN1)(__VA_ARGS__)" TO g_GENERIC
ENDIF
IF g_WHICH_GUI = 2 THEN
WRITELN "#define GUIWIDGET(id, x) __b2c_get_by_name(id, x)" TO g_GENERIC
WRITELN "#define GUIGET(id, x, p, q) (*(q)) = getCDK ## p( ( GUIWIDGET(id, x) == NULL ? (void*)(uintptr_t)fprintf(stderr, \"Runtime error: function 'GUIGET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : GUIWIDGET(id, x) ) )" TO g_GENERIC
WRITELN "#define GUISET(id, x, p, ...) ( GUIWIDGET(id, x) == NULL ? fprintf(stderr, \"Runtime error: function 'GUISET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : setCDK ## p(GUIWIDGET(id, x), __VA_ARGS__) )" TO g_GENERIC
ELIF g_WHICH_GUI = 1 OR g_WHICH_GUI = 3 THEN
WRITELN "#define GUIWIDGET(id, x) __b2c_get_by_name(id, x)" TO g_GENERIC
WRITELN "#define GUIGET(id, x, ...) ( GUIWIDGET(id, x) == NULL ? fprintf(stderr, \"Runtime error: function 'GUIGET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : g_object_get(G_OBJECT(GUIWIDGET(id, x)), __VA_ARGS__, NULL) )" TO g_GENERIC
WRITELN "#define GUISET(id, x, ...) ( GUIWIDGET(id, x) == NULL ? fprintf(stderr, \"Runtime error: function 'GUISET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : g_object_set(G_OBJECT(GUIWIDGET(id, x)), __VA_ARGS__, NULL) )" TO g_GENERIC
ELIF g_WHICH_GUI = 0 THEN
WRITELN "#define GUIWIDGET(id, x) XtNameToWidget((Widget)id, \"*\" x)" TO g_GENERIC
WRITELN "#define GUIGET(id, x, ...) ( GUIWIDGET(id, x) == NULL ? fprintf(stderr, \"Runtime error: function 'GUIGET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : XtVaGetValues(GUIWIDGET(id, x), __VA_ARGS__, NULL) )" TO g_GENERIC
WRITELN "#define GUISET(id, x, ...) ( GUIWIDGET(id, x) == NULL ? fprintf(stderr, \"Runtime error: function 'GUISET' at line %d in '%s': %s\\n\", __LINE__, __FILE__, ERR", g_STRINGSIGN$, "(42)) : XtVaSetValues(GUIWIDGET(id, x), __VA_ARGS__, NULL) )" TO g_GENERIC
ELSE
WRITELN "#define GUIWIDGET(id, x) x" TO g_GENERIC
WRITELN "#define GUIGET(id, x, y) y = __b2c_Copy_String(y, (char*)Tcl_GetVar((Tcl_Interp*)id, x, TCL_GLOBAL_ONLY))" TO g_GENERIC
WRITELN "#define GUISET(id, x, y) Tcl_SetVar((Tcl_Interp*)id, x, y, TCL_GLOBAL_ONLY)" TO g_GENERIC
ENDIF
WRITELN "#define GT >" TO g_GENERIC
WRITELN "#define HASBOM(x) __b2c__hasbom(x)" TO g_GENERIC
WRITELN "#define __b2c__HASDELIM1(x) __b2c__hasdelim(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__HASDELIM2(x, y) __b2c__hasdelim(x, y)" TO g_GENERIC
WRITELN "#define HASDELIM(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__HASDELIM2, __b2c__HASDELIM1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__HASH1(x) HASH_FUNC((char*)x, 0)" TO g_GENERIC
WRITELN "#define __b2c__HASH2(x, y) HASH_FUNC((char*)x, y)" TO g_GENERIC
WRITELN "#define HASH(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__HASH2, __b2c__HASH1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__HEAD2(x, y) __b2c__head(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__HEAD3(x, y, z) __b2c__head(x, y, z)" TO g_GENERIC
WRITELN "#define HEAD", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__HEAD3, __b2c__HEAD2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define HEX", g_STRINGSIGN$, "(x) __b2c__dec2hex(x)" TO g_GENERIC
WRITELN "#define HOST", g_STRINGSIGN$, "(x) __b2c__nethost(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define HOSTNAME", g_STRINGSIGN$, " __b2c__hostname(__LINE__, __FILE__)" TO g_GENERIC
WRITELN "#define HOUR(x) __b2c__time(x, 4)" TO g_GENERIC
WRITELN "#define __b2c__IIF2(x, y) (x ? y : 0)" TO g_GENERIC
WRITELN "#define __b2c__IIF3(x, y, z) (x ? y : z)" TO g_GENERIC
WRITELN "#define IIF(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__IIF3, __b2c__IIF2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__IIFS2(x, y) (char*)(x ? y : NULL)" TO g_GENERIC
WRITELN "#define __b2c__IIFS3(x, y, z) (char*)(x ? y : z)" TO g_GENERIC
WRITELN "#define IIF", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__IIFS3, __b2c__IIFS2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__INBETWEEN3(x, y, z) __b2c__inbetween(0, x, y, z, 0)" TO g_GENERIC
WRITELN "#define __b2c__INBETWEEN4(x, y, z, f) __b2c__inbetween(0, x, y, z, f)" TO g_GENERIC
WRITELN "#define INBETWEEN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__INBETWEEN4, __b2c__INBETWEEN3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__INDEX4(r, t, x, y) __b2c__index(__LINE__, __FILE__, r+", g_OPTION_BASE, ", t, (void*)x, 0, y)" TO g_GENERIC
WRITELN "#define __b2c__INDEX5(r, t, x, y, z) __b2c__index(__LINE__, __FILE__, r+", g_OPTION_BASE, ", t, (void*)x, z, y)" TO g_GENERIC
WRITELN "#define INDEX(...) __b2c__FUNCSELECT5(__VA_ARGS__, __b2c__INDEX5, __b2c__INDEX4)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define INDEX", g_STRINGSIGN$, "(t, x, y) __b2c__index_assoc(__LINE__, __FILE__, t, (__b2c__htable*)__b2c__assoc_ ## x, y)" TO g_GENERIC
WRITELN "#define INSERT", g_STRINGSIGN$, "(x, y, z) __b2c__insert(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define __b2c__INSTR2(x, y) __b2c__instr(__LINE__, __FILE__, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__INSTR3(x, y, z) __b2c__instr(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define INSTR(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__INSTR3, __b2c__INSTR2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__INSTRREV2(x, y) __b2c__instrrev(__LINE__, __FILE__, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__INSTRREV3(x, y, z) __b2c__instrrev(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define INSTRREV(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__INSTRREV3, __b2c__INSTRREV2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define INT(x) lrint((double)x)" TO g_GENERIC
WRITELN "#define INTL", g_STRINGSIGN$, "(x) gettext(x)" TO g_GENERIC
WRITELN "#define INVERT(t, x) __b2c__invert(__LINE__, __FILE__, t, &__b2c__assoc_ ## x)" TO g_GENERIC
WRITELN "#define IS ==" TO g_GENERIC
WRITELN "#define ISASCII(x) __b2c__isascii(x)" TO g_GENERIC
WRITELN "#define ISFALSE(x) ((x) == 0)" TO g_GENERIC
WRITELN "#define ISKEY(x, ...) (__b2c__hash_find_key_do(__b2c__assoc_ ## x, 0, __b2c__KEYCOLLECT(__VA_ARGS__)) == NULL ? 0 : 1)" TO g_GENERIC
WRITELN "#define ISNOT !=" TO g_GENERIC
WRITELN "#define __b2c__ISTOKEN2(x, y) __b2c__istoken(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__ISTOKEN3(x, y, z) __b2c__istoken(x, y, z)" TO g_GENERIC
WRITELN "#define ISTOKEN(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__ISTOKEN3, __b2c__ISTOKEN2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define ISTRUE(x) ((x) != 0)" TO g_GENERIC
WRITELN "#define ISUTF8(x) __b2c__isutf8(x)" TO g_GENERIC
WRITELN "#define LCASE", g_STRINGSIGN$, "(x) __b2c__lcase(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define LE <=" TO g_GENERIC
WRITELN "#define __b2c__LEFT1(x) __b2c__left(__LINE__, __FILE__, x, 1)" TO g_GENERIC
WRITELN "#define __b2c__LEFT2(x, y) __b2c__left(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define LEFT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__LEFT2, __b2c__LEFT1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define LEN(x) (__b2c__option_utf8 ? __b2c__ulen(__LINE__, __FILE__, \"LEN\", (char*)x, -1) : __b2c__len(x))" TO g_GENERIC
WRITELN "#define __b2c__ULEN1(x) __b2c__ulen(__LINE__, __FILE__, \"ULEN\", (char*)x, -1)" TO g_GENERIC
WRITELN "#define __b2c__ULEN2(x, y) __b2c__ulen(__LINE__, __FILE__, \"ULEN\", (char*)x, y)" TO g_GENERIC
WRITELN "#define ULEN(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__ULEN2, __b2c__ULEN1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__LAST2(x, y) __b2c__last(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__LAST3(x, y, z) __b2c__last(x, y, z)" TO g_GENERIC
WRITELN "#define LAST", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__LAST3, __b2c__LAST2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define LINENO __LINE__" TO g_GENERIC
WRITELN "#define LOAD", g_STRINGSIGN$, "(x) __b2c__load(0, __LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define LOG(x) log((double)x)" TO g_GENERIC
WRITELN "#define LOOP", g_STRINGSIGN$, "(...) ( !setjmp(__b2c__loop1) ? __b2c__loop_helper(__b2c__loop2) : __b2c__loop_result", g_STRINGSIGN$, " )" TO g_GENERIC
WRITELN "#define LOOP(...) ( !setjmp(__b2c__loop1) ? __b2c__loop_helper2(__b2c__loop2) : __b2c__loop_result )" TO g_GENERIC
WRITELN "#define LT <" TO g_GENERIC
WRITELN "#define __b2c__MATCH2(x, y) __b2c__match(x, y, -1, NULL)" TO g_GENERIC
WRITELN "#define __b2c__MATCH3(x, y, z) __b2c__match(x, y, z, NULL)" TO g_GENERIC
WRITELN "#define __b2c__MATCH4(x, y, z, f) __b2c__match(x, y, z, f)" TO g_GENERIC
WRITELN "#define MATCH(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__MATCH4, __b2c__MATCH3, __b2c__MATCH2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define MAX(x, y) fmax(x, y)" TO g_GENERIC
WRITELN "#define MAX", g_STRINGSIGN$, "(x, y) __b2c__max_str(x, y)" TO g_GENERIC
WRITELN "#define MAXNUM(x) (x)POW(2, SIZEOF(x)*8)" TO g_GENERIC
IF INSTR(OS$, "SunOS") OR INSTR(OS$, "OSF1") THEN
WRITELN "#define MAXRANDOM 2147483647" TO g_GENERIC
ELSE
WRITELN "#define MAXRANDOM RAND_MAX" TO g_GENERIC
END IF
WRITELN "#define ME", g_STRINGSIGN$, " __b2c__me_var", g_STRINGSIGN$ TO g_GENERIC
WRITELN "#define MEMCHECK(x) __b2c__memory__check((char*)x, sizeof(__b2c__MEMTYPE))" TO g_GENERIC
WRITELN "#define MEMORY(x) (calloc(x+__b2c__option_memstream, sizeof(__b2c__MEMTYPE)))" TO g_GENERIC
WRITELN "#define MEMTELL(x) (long)x" TO g_GENERIC
WRITELN "#define __b2c__MERGE1(x) __b2c__merge(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__MERGE2(x, y) __b2c__merge(x, y)" TO g_GENERIC
WRITELN "#define MERGE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__MERGE2, __b2c__MERGE1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__MID2(x, y) __b2c__mid(__LINE__, __FILE__, NULL, 0, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__MID3(x, y, z) __b2c__mid(__LINE__, __FILE__, NULL, 0, x, y, z)" TO g_GENERIC
WRITELN "#define MID", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__MID3, __b2c__MID2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__FMID3(s, x, y) __b2c__mid(__LINE__, __FILE__, &s, 1, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__FMID4(s, x, y, z) __b2c__mid(__LINE__, __FILE__, &s, 1, x, y, z)" TO g_GENERIC
WRITELN "#define F_MID", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__FMID4, __b2c__FMID3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define MIN(x, y) fmin(x, y)" TO g_GENERIC
WRITELN "#define MIN", g_STRINGSIGN$, "(x, y) __b2c__min_str(x, y)" TO g_GENERIC
WRITELN "#define MINUTE(x) __b2c__time(x, 5)" TO g_GENERIC
WRITELN "#define MOD(x, y) ((long)(x) % (long)(y))" TO g_GENERIC
WRITELN "#define MONTH(x) __b2c__time(x, 2)" TO g_GENERIC
WRITELN "#define MONTH", g_STRINGSIGN$, "(x) __b2c__datename(x, 2)" TO g_GENERIC
WRITELN "#define MYPID getpid()" TO g_GENERIC
WRITELN "#define NE !=" TO g_GENERIC
WRITELN "#define NL", g_STRINGSIGN$, " \"\\n\"" TO g_GENERIC
WRITELN "#define NNTL", g_STRINGSIGN$, "(x,y,z) ngettext(x,y,z)" TO g_GENERIC
WRITELN "#define NOT(x) (!(x))" TO g_GENERIC
WRITELN "#define NOW (long)time(NULL)" TO g_GENERIC
WRITELN "#define NRKEYS(x) __b2c__hash_nrkeys(__b2c__assoc_ ## x)" TO g_GENERIC
WRITELN "#define NUMBER long" TO g_GENERIC
WRITELN "#define __b2c__OBTAIN1(x) __b2c__hash_obtain(__b2c__assoc_ ## x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__OBTAIN2(x, y) __b2c__hash_obtain(__b2c__assoc_ ## x, y)" TO g_GENERIC
WRITELN "#define __b2c__OBTAIN3(x, y, z) __b2c__hash_obtain_by_sort(__LINE__, __FILE__, __b2c__assoc_ ## x, y, z, __b2c__obtain_type_ ## x)" TO g_GENERIC
WRITELN "#define OBTAIN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__OBTAIN3, __b2c__OBTAIN2, __b2c__OBTAIN1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define ODD(x) (((long)(x) % 2 != 0) ? 1 : 0)" TO g_GENERIC
WRITELN "#define OR ||" TO g_GENERIC
WRITELN "#define OS", g_STRINGSIGN$, " __b2c__os(__LINE__, __FILE__)" TO g_GENERIC
WRITELN "#define __b2c__OUTBETWEEN3(x, y, z) __b2c__inbetween(1, x, y, z, 0)" TO g_GENERIC
WRITELN "#define __b2c__OUTBETWEEN4(x, y, z, f) __b2c__inbetween(1, x, y, z, f)" TO g_GENERIC
WRITELN "#define OUTBETWEEN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__OUTBETWEEN4, __b2c__OUTBETWEEN3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define PEEK(x) (__b2c__peek_check(__LINE__, __FILE__, (char*)x, sizeof(__b2c__MEMTYPE)) == 0 ? *(__b2c__MEMTYPE *)(x) : 0)" TO g_GENERIC
WRITELN "#define PI 3.14159265358979323846" TO g_GENERIC
WRITELN "#define POW(x, y) pow((double)x, (double)y)" TO g_GENERIC
WRITELN "#define __b2c__PROPER1(x) __b2c__proper(__LINE__, __FILE__, x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__PROPER2(x, y) __b2c__proper(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define PROPER", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__PROPER2, __b2c__PROPER1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define RAD(x) (x*PI/180)" TO g_GENERIC
WRITELN "#define RANDOM(x) ((x) != 0 ? random()/(MAXRANDOM/(x)) : 0)" TO g_GENERIC
WRITELN "#define REALPATH", g_STRINGSIGN$, "(x) __b2c__dirname(__LINE__, __FILE__, 0, x, 0)" TO g_GENERIC
WRITELN "#define REAP(x) waitpid(x, NULL, WNOHANG)" TO g_GENERIC
WRITELN "#define REGEX(x, y) __b2c__regex(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define __b2c__REPLACE3(x, y, z) __b2c__replace(__LINE__, __FILE__, x, y, z, 0)" TO g_GENERIC
WRITELN "#define __b2c__REPLACE4(x, y, z, f) __b2c__replace(__LINE__, __FILE__, x, y, z, f)" TO g_GENERIC
WRITELN "#define REPLACE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT4(__VA_ARGS__, __b2c__REPLACE4, __b2c__REPLACE3)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__REV1(x) __b2c__rev(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__REV2(x, y) __b2c__rev(x, y)" TO g_GENERIC
WRITELN "#define REV", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__REV2, __b2c__REV1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define REVERSE", g_STRINGSIGN$, "(x) __b2c__reverse(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define __b2c__RIGHT1(x) __b2c__right(__LINE__, __FILE__, x, 1)" TO g_GENERIC
WRITELN "#define __b2c__RIGHT2(x, y) __b2c__right(__LINE__, __FILE__, x, y)" TO g_GENERIC
WRITELN "#define RIGHT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__RIGHT2, __b2c__RIGHT1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__RIP2(x, y) __b2c__rip(__LINE__, __FILE__, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__RIP3(x, y, z) __b2c__rip(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define RIP", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__RIP3, __b2c__RIP2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define RND random()" TO g_GENERIC
WRITELN "#define ROL(x) __b2c__rol(sizeof(__b2c__MEMTYPE), x)" TO g_GENERIC
WRITELN "#define ROR(x) __b2c__ror(sizeof(__b2c__MEMTYPE), x)" TO g_GENERIC
WRITELN "#define __b2c__ROTATE2(x, y) __b2c__rotate(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__ROTATE3(x, y, z) __b2c__rotate(x, y, z)" TO g_GENERIC
WRITELN "#define ROTATE", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__ROTATE3, __b2c__ROTATE2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define ROUND(x) lrint((double)x)" TO g_GENERIC
WRITELN "#define ROWS __b2c__screen(1)" TO g_GENERIC
WRITELN "#define __b2c__RUN1(x) __b2c__exec(1, __LINE__, __FILE__, x, NULL, 0)" TO g_GENERIC
WRITELN "#define __b2c__RUN2(x, y) __b2c__exec(1, __LINE__, __FILE__, x, y, 0)" TO g_GENERIC
WRITELN "#define __b2c__RUN3(x, y, z) __b2c__exec(1, __LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define RUN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__RUN3, __b2c__RUN2, __b2c__RUN1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__SEARCH2(x, y) __b2c__search(__LINE__, __FILE__, x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__SEARCH3(x, y, z) __b2c__search(__LINE__, __FILE__, x, y, z)" TO g_GENERIC
WRITELN "#define SEARCH(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__SEARCH3, __b2c__SEARCH2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define SECOND(x) __b2c__time(x, 6)" TO g_GENERIC
WRITELN "#define SETENVIRON(x, y) if((x) != NULL && (y) != NULL) setenv(x, y, 1)" TO g_GENERIC
WRITELN "#define SGN(x) ((x) == 0 ? 0 : ((x) < 0 ? -1 : 1))" TO g_GENERIC
WRITELN "#define SIN(x) sin((double)x)" TO g_GENERIC
WRITELN "#define SIZEOF(x) sizeof(x)" TO g_GENERIC
WRITELN "#define __b2c__SORT1(x) __b2c__sort(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__SORT2(x, y) __b2c__sort(x, y)" TO g_GENERIC
WRITELN "#define SORT", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__SORT2, __b2c__SORT1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define SPC", g_STRINGSIGN$, "(x) ((x) >= 0 ? __b2c__spc(x) : NULL)" TO g_GENERIC
WRITELN "#define SQR(x) sqrt((double)(x))" TO g_GENERIC
WRITELN "#define STR", g_STRINGSIGN$, "(x) __b2c__str(x)" TO g_GENERIC
WRITELN "#define STRING char*" TO g_GENERIC
WRITELN "#define SUM(x,...) __b2c__sum(", g_OPTION_BASE, ", x, __VA_ARGS__, LONG_MAX)" TO g_GENERIC
WRITELN "#define SUMF(x,...) __b2c__sumf(", g_OPTION_BASE, ", x, __VA_ARGS__, DBL_MAX)" TO g_GENERIC
WRITELN "#define SYSTEM(x) do {if (x != NULL) {RETVAL = system(x); if(WIFEXITED(RETVAL)) RETVAL = WEXITSTATUS(RETVAL);} else RETVAL=0;} while(0)" TO g_GENERIC
WRITELN "#define TAB", g_STRINGSIGN$, "(x) ((x) >= 0 ? __b2c__tab(x) : NULL)" TO g_GENERIC
WRITELN "#define __b2c__TAIL2(x, y) __b2c__tail(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__TAIL3(x, y, z) __b2c__tail(x, y, z)" TO g_GENERIC
WRITELN "#define TAIL", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__TAIL3, __b2c__TAIL2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__TALLY2(x, y) __b2c__tally(x, y, -1)" TO g_GENERIC
WRITELN "#define __b2c__TALLY3(x, y, z) __b2c__tally(x, y, z)" TO g_GENERIC
WRITELN "#define TALLY(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__TALLY3, __b2c__TALLY2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define TAN(x) tan((double)x)" TO g_GENERIC
WRITELN "#define TELL(x) ftell(x)" TO g_GENERIC
WRITELN "#define TIMER __b2c__timer(0)" TO g_GENERIC
WRITELN "#define TIMEVALUE(x,y,z,a,b,c) __b2c__epoch(x,y,z,a,b,c)" TO g_GENERIC
WRITELN "#define TOASCII", g_STRINGSIGN$, "(x) __b2c__toascii(x)" TO g_GENERIC
WRITELN "#define __b2c__TOKEN2(x, y) __b2c__token(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__TOKEN3(x, y, z) __b2c__token(x, y, z)" TO g_GENERIC
WRITELN "#define TOKEN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__TOKEN3, __b2c__TOKEN2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define TRUE 1" TO g_GENERIC
WRITELN "#define UCASE", g_STRINGSIGN$, "(x) __b2c__ucase(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define UCS(x) (unsigned int)__b2c__utf8toasc(x)" TO g_GENERIC
WRITELN "#define UNESCAPE", g_STRINGSIGN$, "(x) __b2c__unescape(__LINE__, __FILE__, x)" TO g_GENERIC
WRITELN "#define __b2c__UNFLATTEN1(x) __b2c__unflatten(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__UNFLATTEN2(x, y) __b2c__unflatten(x, y)" TO g_GENERIC
WRITELN "#define UNFLATTEN", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__UNFLATTEN2, __b2c__UNFLATTEN1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define __b2c__UNIQ1(x) __b2c__uniq(x, NULL)" TO g_GENERIC
WRITELN "#define __b2c__UNIQ2(x, y) __b2c__uniq(x, y)" TO g_GENERIC
WRITELN "#define UNIQ", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT2(__VA_ARGS__, __b2c__UNIQ2, __b2c__UNIQ1)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define VAL(x) ((x) != NULL ? atof(x) : 0)" TO g_GENERIC
WRITELN "#define WAIT(x, y) __b2c__netpeek(__LINE__, __FILE__, (uintptr_t)x, y)" TO g_GENERIC
WRITELN "#define __b2c__WALK4(x, y, z, q) __b2c__walk(__LINE__, __FILE__, x, y, z, q, NULL)" TO g_GENERIC
WRITELN "#define __b2c__WALK5(x, y, z, q, f) __b2c__walk(__LINE__, __FILE__, x, y, z, q, f)" TO g_GENERIC
WRITELN "#define WALK", g_STRINGSIGN$, "(...) __b2c__FUNCSELECT5(__VA_ARGS__, __b2c__WALK5, __b2c__WALK4)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define WEEK(x) __b2c__time(x, 7)" TO g_GENERIC
WRITELN "#define WEEKDAY", g_STRINGSIGN$, "(x) __b2c__datename(x, 1)" TO g_GENERIC
WRITELN "#define __b2c__WHERE2(x, y) __b2c__where(x, y, NULL)" TO g_GENERIC
WRITELN "#define __b2c__WHERE3(x, y, z) __b2c__where(x, y, z)" TO g_GENERIC
WRITELN "#define WHERE(...) __b2c__FUNCSELECT3(__VA_ARGS__, __b2c__WHERE3, __b2c__WHERE2)(__VA_ARGS__)" TO g_GENERIC
WRITELN "#define YEAR(x) __b2c__time(x, 3)" TO g_GENERIC
WRITELN "#define __b2c__cacerts NULL" TO g_GENERIC
WRITELN "#define __b2c__capeer 0" TO g_GENERIC
WRITELN "#define __b2c__caprivate NULL" TO g_GENERIC
WRITELN "#define __b2c__caserver NULL" TO g_GENERIC
CLOSE FILE g_GENERIC, g_CFILE, FLOATARRAYFILE, STRINGARRAYFILE
' Check presence of lex
IF LEN(EXEC$("command -v flex 2>/dev/null")) THEN
g_LEX$ = "flex"
ELIF LEN(EXEC$("command -v lex 2>/dev/null")) THEN
g_LEX$ = "lex"
ELSE
PRINT "WARNING: neither 'lex' nor 'flex' was found on this system!"
PRINT "Generated binary cannot be optimized."
ENDIF
' Create the lexer
IF LEN(g_LEX$) THEN
' Create lexer file to see which functions are needed, so the resulting binary can be optimized
OPEN g_BACONLEXER$ FOR WRITING AS g_BACONLEXER
WRITELN "%{" TO g_BACONLEXER
WRITELN "#include <stdio.h>" TO g_BACONLEXER
WRITELN "%}" TO g_BACONLEXER
WRITELN "%x text escaped comment multi" TO g_BACONLEXER
WRITELN "WS [ \\n\\r\\t]+" TO g_BACONLEXER
WRITELN "%%" TO g_BACONLEXER
WRITELN "\"ALARM\"{WS} printf(\"alarm \");" TO g_BACONLEXER
WRITELN "\"ALIGN$(\" printf(\"align delimengine \");" TO g_BACONLEXER
WRITELN "\"AMOUNT(\" printf(\"amount delimengine \");" TO g_BACONLEXER
WRITELN "\"APPEND\"{WS} printf(\"save concat \");" TO g_BACONLEXER
WRITELN "\"APPEND$(\" printf(\"append delimengine \");" TO g_BACONLEXER
WRITELN "\"ASSOC\"{WS} printf(\"hash sortstr sortnr \");" TO g_BACONLEXER
WRITELN "\"B64DEC$(\" printf(\"base64 \");" TO g_BACONLEXER
WRITELN "\"B64ENC$(\" printf(\"base64 \");" TO g_BACONLEXER
WRITELN "\"BASENAME$(\" printf(\"dirname \");" TO g_BACONLEXER
WRITELN "\"BIT(\" printf(\"binary \");" TO g_BACONLEXER
WRITELN "\"BIN$(\" printf(\"binary \");" TO g_BACONLEXER
WRITELN "\"BLOAD(\" printf(\"load \");" TO g_BACONLEXER
WRITELN "\"CA$(\" printf(\"cipher \");" TO g_BACONLEXER
WRITELN "\"CHANGE$(\" printf(\"change delimengine \");" TO g_BACONLEXER
WRITELN "\"CHOP$(\" printf(\"chop \");" TO g_BACONLEXER
WRITELN "\"CHR$(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"CIPHER$(\" printf(\"cipher \");" TO g_BACONLEXER
WRITELN "\"CMDLINE(\" printf(\"cmdline \");" TO g_BACONLEXER
WRITELN "\"CN$(\" printf(\"cipher \");" TO g_BACONLEXER
WRITELN "\"COIL$(\" printf(\"append delimengine \");" TO g_BACONLEXER
WRITELN "\"COLLAPSE$(\" printf(\"collapsefunc delimengine \");" TO g_BACONLEXER
WRITELN "\"COLLECT\"{WS} printf(\"collect \");" TO g_BACONLEXER
WRITELN "\"COLUMNS\" printf(\"screen \");" TO g_BACONLEXER
WRITELN "\"&\" printf(\"concat \");" TO g_BACONLEXER
WRITELN "\"CONCAT$(\" printf(\"concat \");" TO g_BACONLEXER
WRITELN "\"COPY\"{WS} printf(\"copy \");" TO g_BACONLEXER
WRITELN "\"COUNT(\" printf(\"count chrstr \");" TO g_BACONLEXER
WRITELN "\"CURDIR$\" printf(\"curdir \");" TO g_BACONLEXER
WRITELN "\"CUT$(\" printf(\"cut delimengine \");" TO g_BACONLEXER
WRITELN "\"DAY(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"DEC(\" printf(\"dec \");" TO g_BACONLEXER
WRITELN "\"DEL$(\" printf(\"delstr delimengine \");" TO g_BACONLEXER
WRITELN "\"DELIM$(\" printf(\"delimstr delimengine \");" TO g_BACONLEXER
WRITELN "\"DIRNAME$(\" printf(\"dirname \");" TO g_BACONLEXER
WRITELN "\"EDITBOM$(\" printf(\"bom \");" TO g_BACONLEXER
WRITELN "\"ESCAPE$(\" printf(\"doescape chrstr \");" TO g_BACONLEXER
WRITELN "\"EVAL(\" printf(\"eval \");" TO g_BACONLEXER
WRITELN "\"EXCHANGE$(\" printf(\"exchange delimengine \");" TO g_BACONLEXER
WRITELN "\"EXEC$(\" printf(\"exec \");" TO g_BACONLEXER
WRITELN "\"EXPLODE$(\" printf(\"explode delimengine \");" TO g_BACONLEXER
WRITELN "\"EXTRACT$(\" printf(\"extract hash \");" TO g_BACONLEXER
WRITELN "\"FILELEN(\" printf(\"filelen \");" TO g_BACONLEXER
WRITELN "\"FILETIME(\" printf(\"filetime \");" TO g_BACONLEXER
WRITELN "\"FILETYPE(\" printf(\"filetype \");" TO g_BACONLEXER
WRITELN "\"FILL$(\" printf(\"fill \");" TO g_BACONLEXER
WRITELN "\"FIND(\" printf(\"find \");" TO g_BACONLEXER
WRITELN "\"FIRST$(\" printf(\"first delimengine \");" TO g_BACONLEXER
WRITELN "\"FLATTEN$(\" printf(\"flatten \");" TO g_BACONLEXER
WRITELN "\"FOR\"{WS} printf(\"for delimengine \");" TO g_BACONLEXER
WRITELN "\"GETENVIRON$(\" printf(\"getenviron \");" TO g_BACONLEXER
WRITELN "\"GETFILE\"{WS} printf(\"getfile \");" TO g_BACONLEXER
WRITELN "\"GETKEY\" printf(\"getkey \");" TO g_BACONLEXER
WRITELN "\"GETLINE\"{WS} printf(\"getline \");" TO g_BACONLEXER
WRITELN "\"GETPEER$(\" printf(\"getpeer \");" TO g_BACONLEXER
WRITELN "\"GETX\" printf(\"getxy \");" TO g_BACONLEXER
WRITELN "\"GETY\" printf(\"getxy \");" TO g_BACONLEXER
WRITELN "\"HASBOM(\" printf(\"bom \");" TO g_BACONLEXER
WRITELN "\"HASDELIM(\" printf(\"hasdelim delimengine \");" TO g_BACONLEXER
WRITELN "\"HASH(\" printf(\"hash sortstr sortnr \");" TO g_BACONLEXER
WRITELN "\"HEAD$(\" printf(\"head delimengine \");" TO g_BACONLEXER
WRITELN "\"HEX$(\" printf(\"hex \");" TO g_BACONLEXER
WRITELN "\"HOST$(\" printf(\"host \");" TO g_BACONLEXER
WRITELN "\"HOSTNAME$\" printf(\"hostname \");" TO g_BACONLEXER
WRITELN "\"HOUR(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"INBETWEEN$(\" printf(\"between delimengine \");" TO g_BACONLEXER
WRITELN "\"INDEX(\" printf(\"indexarray sortnr sortstr \");" TO g_BACONLEXER
WRITELN "\"INDEX$(\" printf(\"indexassoc hash \");" TO g_BACONLEXER
WRITELN "\"INPUT\"{WS} printf(\"input \");" TO g_BACONLEXER
WRITELN "\"INSERT$(\" printf(\"insert \");" TO g_BACONLEXER
WRITELN "\"INSTR(\" printf(\"instring \");" TO g_BACONLEXER
WRITELN "\"INSTRREV(\" printf(\"instrrev \");" TO g_BACONLEXER
WRITELN "\"INVERT(\" printf(\"invert hash \");" TO g_BACONLEXER
WRITELN "\"ISASCII(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"ISTOKEN(\" printf(\"istok delimengine \");" TO g_BACONLEXER
WRITELN "\"ISUTF8(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"JOIN\"{WS} printf(\"join \");" TO g_BACONLEXER
WRITELN "\"LAST$(\" printf(\"last delimengine \");" TO g_BACONLEXER
WRITELN "\"LCASE$(\" printf(\"lcase \");" TO g_BACONLEXER
WRITELN "\"LEFT$(\" printf(\"left \");" TO g_BACONLEXER
WRITELN "\"LOAD$(\" printf(\"load \");" TO g_BACONLEXER
WRITELN "\"LOOKUP\"{WS} printf(\"lookup hash sortnr sortstr \");" TO g_BACONLEXER
WRITELN "\"LOOP$(\" printf(\"concat \");" TO g_BACONLEXER
WRITELN "\"MAKEDIR\"{WS} printf(\"makedir delimengine \");" TO g_BACONLEXER
WRITELN "\"MATCH(\" printf(\"match delimengine \");" TO g_BACONLEXER
WRITELN "\"MERGE$(\" printf(\"merge delimengine \");" TO g_BACONLEXER
WRITELN "\"MID$(\" printf(\"mid \");" TO g_BACONLEXER
WRITELN "\"MINUTE(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"MONTH(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"MONTH$(\" printf(\"datename \");" TO g_BACONLEXER
WRITELN "\"NETWORK\"{WS} printf(\"network delimengine \");" TO g_BACONLEXER
WRITELN "\"OBTAIN$(\" printf(\"obtain hash sortnr sortstr \");" TO g_BACONLEXER
WRITELN "\"OS$\" printf(\"os \");" TO g_BACONLEXER
WRITELN "\"OUTBETWEEN$(\" printf(\"between delimengine \");" TO g_BACONLEXER
WRITELN "\"PARSE\"{WS} printf(\"parse delimengine \");" TO g_BACONLEXER
WRITELN "\"PEEK(\" printf(\"peek \");" TO g_BACONLEXER
WRITELN "\"PROPER$(\" printf(\"proper delimengine \");" TO g_BACONLEXER
WRITELN "\"READLN\"{WS} printf(\"readln \");" TO g_BACONLEXER
WRITELN "\"REALPATH$(\" printf(\"dirname \");" TO g_BACONLEXER
WRITELN "\"RECURSIVE\"{WS} printf(\"recursive \");" TO g_BACONLEXER
WRITELN "\"REGEX(\" printf(\"regex hash \");" TO g_BACONLEXER
WRITELN "\"REPLACE$(\" printf(\"replace hash \");" TO g_BACONLEXER
WRITELN "\"RETURN\"{WS} printf(\"return \");" TO g_BACONLEXER
WRITELN "\"REV$(\" printf(\"revstr delimengine \");" TO g_BACONLEXER
WRITELN "\"REVERSE$(\" printf(\"reverse \");" TO g_BACONLEXER
WRITELN "\"RIGHT$(\" printf(\"right \");" TO g_BACONLEXER
WRITELN "\"RIP$(\" printf(\"rip \");" TO g_BACONLEXER
WRITELN "\"ROL(\" printf(\"binary \");" TO g_BACONLEXER
WRITELN "\"ROR(\" printf(\"binary \");" TO g_BACONLEXER
WRITELN "\"ROTATE$(\" printf(\"rotate delimengine \");" TO g_BACONLEXER
WRITELN "\"ROWS\" printf(\"screen \");" TO g_BACONLEXER
WRITELN "\"RUN$(\" printf(\"exec \");" TO g_BACONLEXER
WRITELN "\"SAVE\"{WS} printf(\"save \");" TO g_BACONLEXER
WRITELN "\"SEARCH(\" printf(\"search \");" TO g_BACONLEXER
WRITELN "\"SECOND(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"SERVER\"{WS} printf(\"server delimengine \");" TO g_BACONLEXER
WRITELN "\"SETSERIAL\"{WS} printf(\"setserial \");" TO g_BACONLEXER
WRITELN "\"SIGNAL\"{WS} printf(\"signal \");" TO g_BACONLEXER
WRITELN "\"SORT\"{WS} printf(\"sortassoc lookup sortnr sortstr hash \");" TO g_BACONLEXER
WRITELN "\"SORT$(\" printf(\"sortdelim sortstr delimengine \");" TO g_BACONLEXER
WRITELN "\"SPC$(\" printf(\"spc \");" TO g_BACONLEXER
WRITELN "\"SPLIT\"{WS} printf(\"split delimengine \");" TO g_BACONLEXER
WRITELN "\"SUM(\" printf(\"sum \");" TO g_BACONLEXER
WRITELN "\"SUMF(\" printf(\"sum \");" TO g_BACONLEXER
WRITELN "\"TAB$(\" printf(\"tab \");" TO g_BACONLEXER
WRITELN "\"TAIL$(\" printf(\"tail delimengine \");" TO g_BACONLEXER
WRITELN "\"TALLY(\" printf(\"tally \");" TO g_BACONLEXER
WRITELN "\"TIMER\" printf(\"timer \");" TO g_BACONLEXER
WRITELN "\"TIMEVALUE(\" printf(\"epoch \");" TO g_BACONLEXER
WRITELN "\"TOASCII$(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"TOKEN$(\" printf(\"token delimengine \");" TO g_BACONLEXER
WRITELN "\"TRACE\"{WS} printf(\"getkey \");" TO g_BACONLEXER
WRITELN "\"TREE\"{WS} printf(\"tree sortnr sortstr \");" TO g_BACONLEXER
WRITELN "\"UCASE$(\" printf(\"ucase \");" TO g_BACONLEXER
WRITELN "\"UCS(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"UNESCAPE$(\" printf(\"unescape \");" TO g_BACONLEXER
WRITELN "\"UNFLATTEN$(\" printf(\"flatten \");" TO g_BACONLEXER
WRITELN "\"UNIQ$(\" printf(\"uniq obtain delimengine hash sortnr sortstr \");" TO g_BACONLEXER
WRITELN "\"UTF8$(\" printf(\"chrstr \");" TO g_BACONLEXER
WRITELN "\"WAIT(\" printf(\"wait \");" TO g_BACONLEXER
WRITELN "\"WALK$(\" printf(\"walk hash \");" TO g_BACONLEXER
WRITELN "\"WEEK(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\"WEEKDAY$(\" printf(\"datename \");" TO g_BACONLEXER
WRITELN "\"WHERE(\" printf(\"where delimengine \");" TO g_BACONLEXER
WRITELN "\"YEAR(\" printf(\"chrono \");" TO g_BACONLEXER
WRITELN "\\\" BEGIN(text);" TO g_BACONLEXER
WRITELN "<text>\\\\ BEGIN(escaped);" TO g_BACONLEXER
WRITELN "<text>\\\" BEGIN(INITIAL);" TO g_BACONLEXER
WRITELN "<text>. /* Do nothing */" TO g_BACONLEXER
WRITELN "<escaped>\\n\\\" BEGIN(INITIAL);" TO g_BACONLEXER
WRITELN "<escaped>\\n /* Do nothing */" TO g_BACONLEXER
WRITELN "<escaped>. BEGIN(text);" TO g_BACONLEXER
WRITELN "\\\' BEGIN(comment);" TO g_BACONLEXER
WRITELN "<comment>\\n BEGIN(INITIAL);" TO g_BACONLEXER
WRITELN "<comment>. /* Do nothing */" TO g_BACONLEXER
WRITELN "\"/*\" BEGIN(multi);" TO g_BACONLEXER
WRITELN "<multi>[^*]* /* Eat anything that's not a '*' */" TO g_BACONLEXER
WRITELN "<multi>\"*\"+[^*/]* /* Eat up '*'s not followed by '/' */" TO g_BACONLEXER
WRITELN "<multi>\"*\"+\"/\" BEGIN(INITIAL);" TO g_BACONLEXER
WRITELN "{WS} /* Skip whitespace */" TO g_BACONLEXER
WRITELN ". /* Skip anything else */" TO g_BACONLEXER
WRITELN "<<EOF>> yyterminate();" TO g_BACONLEXER
WRITELN "%%" TO g_BACONLEXER
WRITELN "int main(int argc, char *argv[]) { printf(\"argument error malloc memcheck minmax str timer utf8 \"); yylex(); return(0); } int yywrap(void) { return(1); }" TO g_BACONLEXER
CLOSE FILE g_BACONLEXER
PRINT "Creating lexical analyzer using ", g_LEX$, "... ";
SYSTEM g_LEX$ & " -o " & g_BACONLEXER$ & ".c " & g_BACONLEXER$
SYSTEM g_CCNAME$ & " " & g_BACONLEXER$ & ".c -o " & g_BACONLEXER$ & ".exe"
PRINT "done."
' Create list of required functions
total$ = EXEC$(g_BACONLEXER$ & ".exe", LOAD$(FEED$))
FOR tmpfile$ IN g_TMP_FILES$
IF REGEX(tmpfile$, ".bac$") THEN total$ = total$ & EXEC$(g_BACONLEXER$ & ".exe", LOAD$(tmpfile$))
NEXT
IF g_DEBUG = 1 THEN PRINT "Analyzing dependencies... ", SORT$(UNIQ$(total$))
nolex = FALSE
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_GENERIC$ & " " & g_FUNCTIONS$ & " " & g_BACONLEXER$ & " " & g_BACONLEXER$ & ".c " & g_BACONLEXER$ & ".exe"
ELSE
nolex = TRUE
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_GENERIC$ & " " & g_FUNCTIONS$
ENDIF
' Generate functions
OPEN g_FUNCTIONS$ FOR WRITING AS g_FUNCTIONS
WRITELN "/* Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License */" TO g_FUNCTIONS
IF TALLY(total$, "base64") OR nolex THEN
WRITELN "/* Portions of this code based on Bob Trower's C implementation at http://base64.sourceforge.net - MIT licensed */ static const char cd64[]=\"|$$$}rstuvwxyz{$$$$$$$>?@ABCDEFGHIJKLMNOPQRSTUVW$$$$$$XYZ[\\\\]^_`abcdefghijklmnopq\";" TO g_FUNCTIONS
WRITELN "static const char cb64[]=\"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"; static void __b2c__encodeblock( unsigned char *in, unsigned char *out, int len)" TO g_FUNCTIONS
WRITELN "{ out[0] = (unsigned char) cb64[ (int)(in[0] >> 2) ]; out[1] = (unsigned char) cb64[ (int)(((in[0] & 0x03) << 4) | ((in[1] & 0xf0) >> 4)) ];" TO g_FUNCTIONS
WRITELN "out[2] = (unsigned char) (len > 1 ? cb64[ (int)(((in[1] & 0x0f) << 2) | ((in[2] & 0xc0) >> 6)) ] : '='); out[3] = (unsigned char) (len > 2 ? cb64[ (int)(in[2] & 0x3f) ] : '='); }" TO g_FUNCTIONS
WRITELN "char * __b2c__b64enc (char* src, int len) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned char in[4], out[4]; int i, j, cur = 0, posit = 0; if (src == NULL) { return(NULL); }" TO g_FUNCTIONS
WRITELN "if (len == 0) { len = __b2c__len (src); } if (len == 0) { return (NULL); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], ((len + 2) / 3) * 4 + 1);" TO g_FUNCTIONS
WRITELN "while( cur < len ){ for( i = 0; i < 3 && (cur + i < len); i++ ){ in[i] = (unsigned char) src[cur+i]; } in[i] = 0; cur += i; if( i > 0 ) { __b2c__encodeblock( in, out, i );" TO g_FUNCTIONS
WRITELN "for( j = 0; j < 4; j++ ) { buf[idx][posit+j] = out[j]; } posit += 4; } } buf[idx][posit] = '\\0'; __b2c__SETLEN (buf[idx], posit); return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "static void __b2c__decodeblock(unsigned char in[4], unsigned char out[3]) { out[0] = (unsigned char ) (in[0] << 2 | in[1] >> 4); out[1] = (unsigned char)(in[1] << 4 | in[2] >> 2);" TO g_FUNCTIONS
WRITELN "out[2] = (unsigned char ) (((in[2] << 6) & 0xc0) | in[3]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__b64dec(int l, char *k, char *src) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned char in[4], out[3], v; int i = 0, stlen, dec_len, len, cur = 0, posit = 0; if(src == NULL){ return (NULL); }" TO g_FUNCTIONS
WRITELN "stlen = __b2c__len (src); if (stlen == 0) { return (NULL); } if(stlen % 4) { ERROR = 5; RUNTIMEFERR (\"B64DEC$\", ERROR, k, l); return(NULL); } dec_len = 3*stlen/4; while(src[stlen+i-1] == 61) { dec_len--; i--; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], dec_len + 4); while(cur < stlen){ for (len = 0, i = 0; i < 4 && (cur < stlen); i++) { v = 0; while (cur < stlen && v == 0){ v = (unsigned char) src[cur]; cur++; v = (unsigned char) ((v < 43 || v > 122) ? 0 : cd64[ v - 43 ]);" TO g_FUNCTIONS
WRITELN "if (v) {v = (unsigned char) ((v == '$') ? 0 : v - 61);} } if(cur <= stlen){ len++; if (v) { in[i] = (unsigned char)(v - 1); } else { in[i] = 0; } } } if(len){ __b2c__decodeblock(in, out);" TO g_FUNCTIONS
WRITELN "for(i = 0; i < len - 1; i++) { buf[idx][posit + i] = out[i]; } buf[idx][posit + i] = '\\0'; posit += len - 1; } } __b2c__SETLEN(buf[idx], dec_len); return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "binary") OR nolex THEN
WRITELN "unsigned long __b2c__bit(long x) { return(x ? 2<<(x-1) : 1); } unsigned long __b2c__rol(int type, long x)" TO g_FUNCTIONS
WRITELN "{ return((x)&lrint(pow(2, type*8-1)) ? (((x)<<1)|1)&lrint(pow(2, type*8)-1) : ((x)<<1)&lrint(pow(2, type*8)-1)); }" TO g_FUNCTIONS
WRITELN "unsigned long __b2c__ror(int type, long x) { return((x)&1 ? (((x)>>1)&lrint(pow(2, type*8)-1))|lrint(pow(2, type*8-1)) : ((x)>>1)&lrint(pow(2, type*8)-1)); }" TO g_FUNCTIONS
WRITELN "char *__b2c__bin(int type, long x) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long i; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], type*8+1); for(i = 0; i<type*8; i++) { if(x&1) { buf[idx][type*8-1-i] = 49; } else { buf[idx][type*8-1-i] = 48; }" TO g_FUNCTIONS
WRITELN "x = x>>1; } buf[idx][type*8] = '\\0'; __b2c__SETLEN(buf[idx], type*8); return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "chop") OR nolex THEN
WRITELN "char *__b2c__chop(char **swap, int type, char *source, char *string, int location) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *tmp; long length; if (source == NULL || *source == '\\0') { if (type == 1) { *swap = __b2c_Copy_String(*swap, NULL); } return (NULL); } if (string == NULL) { string = (char *) __b2c__chop_default; }" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } length = __b2c__len(string); if (location == 0 || location == 1) { while (*source != '\\0') { if(memchr(string, *source, length)) { source++; } else { break; } } if (*source == '\\0'){ if (type == 1) { *swap = __b2c_Copy_String (*swap, NULL); } return(NULL); } } tmp = source + strlen(source) - 1;" TO g_FUNCTIONS
WRITELN "if(location == 0 || location == 2) { while (tmp >= source && *tmp != '\\0') { if(memchr(string, *tmp, length)) { tmp--; } else { break; } } } tmp++; buf[idx] = (char*)__b2c_str_realloc(buf[idx], tmp-source+1); memmove(buf[idx], source, tmp - source);" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], tmp - source); buf[idx][tmp - source] = '\\0'; if (type == 1) { return(__b2c_Swap_String(swap, &buf[idx])); } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "chrstr") OR nolex THEN
WRITELN "char *__b2c__asc2char (int i) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int len; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], 2); len = snprintf(buf[idx], 2, \"%c\", i); __b2c__SETLEN(buf[idx], len); return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__asc2utf8 (int i) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int len; char buffer[5]; len = __b2c_utf8_conv(i, buffer); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); memcpy(buf[idx], buffer, len); __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "unsigned int __b2c__utf8toasc(char* ptr) { unsigned int result = 0; if((*ptr&0xF0)==0xF0) { result = (*ptr&0x07)<<2; ptr++; result = result | ((*ptr&0x30)>>4); result = result << 8; result = result | ((*ptr&0x0F)<<4);" TO g_FUNCTIONS
WRITELN "ptr++; result = result | ((*ptr&0x3C)>>2); result = result << 8; result = result | ((*ptr&0x03)<<6); ptr++; result = result | (*ptr&0x3F); } else if((*ptr&0xE0)==0xE0) { result = (*ptr&0x0F)<<4; ptr++;" TO g_FUNCTIONS
WRITELN "result = result | ((*ptr&0x3C)>>2); result = result << 8; result = result | ((*ptr&0x03)<<6); ptr++; result = result | (*ptr&0x3F); } else if((*ptr&0xC0)==0xC0) { result = (*ptr&0x1C)>>2; result = result << 8;" TO g_FUNCTIONS
WRITELN "result = result | ((*ptr&0x03)<<6); ptr++; result = result | (*ptr&0x3F); } else if((*ptr&0x80) == 0) { result = (*ptr&0x7F); } return (result); }" TO g_FUNCTIONS
WRITELN "unsigned char __b2c__isascii(const char *ptr) { long x; for(x=0; *(ptr+x); x++) { if(*(ptr+x)&128) return(0); } return(1); }" TO g_FUNCTIONS
WRITELN "unsigned char __b2c__isutf8(const char *ptr) { int result = 1; if (ptr == NULL) { return (0); } while (*ptr) { if ((*ptr & 0xF0) == 0xF0)" TO g_FUNCTIONS
WRITELN "{ if ((*(ptr + 1) & 0xC0) != 0x80 || (*(ptr + 2) & 0xc0) != 0x80 || (*(ptr + 3) & 0xc0) != 0x80 ) { result = 0; break; } ptr += 4; } else if ((*ptr & 0xE0) == 0xE0)" TO g_FUNCTIONS
WRITELN "{ if ((*(ptr + 1) & 0xc0) != 0x80 || (*(ptr + 2) & 0xc0) != 0x80 ) { result = 0; break; } ptr += 3; } else if ((*ptr & 0xC0) == 0xC0) { if ((*(ptr + 1) & 0xc0) != 0x80 )" TO g_FUNCTIONS
WRITELN "{ result = 0; break; } ptr += 2; } else if ((*ptr & 0x80) == 0) { ptr++; } else { result = 0; break; } } return (result); }" TO g_FUNCTIONS
WRITELN "char *__b2c__toascii(char *ptr) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int len, x; len = __b2c__len (ptr); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len); for(x = 0; x < len; x++) { *(buf[idx] + x) = *(ptr + x) & 0x7f; } __b2c__SETLEN (buf[idx], len); buf[idx][len] = '\\0'; return((char*)buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "cmdline") OR nolex THEN
WRITELN "int __b2c__getopt(int argc, char **argv, char* str){int opt; extern char *optarg; extern int optind, opterr; opterr = 0; opt = getopt(argc, argv, str); __b2c__STRFREE(ARGUMENT", g_STRINGSIGN$, ");" TO g_FUNCTIONS
WRITELN "if(opt != -1) { ARGUMENT", g_STRINGSIGN$, " = __b2c__strdup(optarg); } else { ARGUMENT", g_STRINGSIGN$, " = argv[optind]; } return(opt);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "concat") OR nolex THEN
WRITELN "char *__b2c__concat(int n, ...) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long length = 0, buflen = 0, cnew; char *next; va_list ap; if (n == 0) { return (NULL); } idx++;" TO g_FUNCTIONS
WRITELN "if (idx == __b2c_STRING_FUNC) { idx = 0; } va_start (ap, n); if(buf[idx]) { buflen = __b2c__RBUFSIZE(buf[idx]); } while (n) { next = va_arg (ap, char *); if (next) { cnew = __b2c__len (next);" TO g_FUNCTIONS
WRITELN "if(length+cnew >= buflen) { buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + cnew); buflen = __b2c__RBUFSIZE(buf[idx]); } memcpy(buf[idx] + length, next, cnew); length += cnew; }" TO g_FUNCTIONS
WRITELN "n--; } va_end (ap); if (buf[idx]) { __b2c__SETLEN (buf[idx], length); buf[idx][length] = '\\0'; } return ((char *) buf[idx]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__concat2 (int total, ...) { char *iter, *result, *first, *next, *offset; int n_copy = 0, pos = 0, length = 0, cnew, flen = 0, stage = 0; uint32_t lbufsize = 0, rbufsize = 0; va_list ap_copy, ap; va_start (ap, total);" TO g_FUNCTIONS
WRITELN "first = result = offset = va_arg (ap, char *); total--; if (total == 0) { return (NULL); } va_copy (ap_copy, ap); if(first) { n_copy = total; } while (n_copy) { iter = va_arg (ap_copy, char *); if (iter == first) { flen = __b2c__len (first); break; }" TO g_FUNCTIONS
WRITELN "pos += __b2c__len (iter); n_copy--; } va_end (ap_copy); if (__b2c__FIND_EXCEPTION ((unsigned long) result) || (((uintptr_t) result & 1) && __b2c__INRANGE (result))) { lbufsize = __b2c__LBUFSIZE (result); rbufsize = __b2c__RBUFSIZE (result); }" TO g_FUNCTIONS
WRITELN "else { rbufsize = __b2c__len (first); } if (n_copy) { if (pos >= lbufsize) { result = (char *) __b2c_str_realloc_left(result, lbufsize + rbufsize + pos); offset = result; } if (__b2c__FIND_EXCEPTION ((unsigned long) result)) { __b2c__DEL_EXCEPTION ((unsigned long) result); }" TO g_FUNCTIONS
WRITELN "memmove (result - __b2c__BUFOFFSET - pos, result - __b2c__BUFOFFSET, __b2c__BUFOFFSET); result -= pos; if (((uintptr_t) result & 1) == 0) { __b2c__ADD_EXCEPTION ((unsigned long) result); } __b2c__LBUFSIZE (result) -= pos; __b2c__RBUFSIZE (result) += pos;" TO g_FUNCTIONS
WRITELN "__b2c__SETRANGE (result); rbufsize = __b2c__RBUFSIZE (result); } next = va_arg (ap, char *); total--;" TO g_FUNCTIONS
WRITELN "while (total >= 0) { if (next) { if (next == first) { cnew = flen; } else { cnew = __b2c__len (next); } if (cnew + flen + length >= rbufsize) { result = (char *) __b2c_str_realloc (result, cnew + flen + length); rbufsize = __b2c__RBUFSIZE (result); offset = result + pos; }" TO g_FUNCTIONS
WRITELN "if (next != first) { memmove (result + length, next, cnew); } else { if (stage == 0) { stage = 1; } else { memmove (result + length, offset, cnew); } } length += cnew; } next = va_arg (ap, char *); total--; } va_end (ap); if(result) { __b2c__SETLEN (result, length);" TO g_FUNCTIONS
WRITELN "result[length] = '\\0'; } return ((char *) result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "count") OR nolex THEN
WRITELN "long __b2c__count (int l, char *k, char *x, unsigned int y) { long i, z = 0; if (__b2c__option_utf8) { while (*x) { if (__b2c__utf8toasc (x) == y) { z++; } if ((*x & 0xF0) == 0xF0) { x += 4; }" TO g_FUNCTIONS
WRITELN "else if ((*x & 0xE0) == 0xE0) { x += 3; } else if ((*x & 0xC0) == 0xC0) { x += 2; } else if ((*x & 0x80) == 0) { x++; } else { ERROR = 38; RUNTIMEFERR (\"COUNT\", ERROR, k, l); return(0); } } } else " TO g_FUNCTIONS
WRITELN "{ for (i = 0; x[i] != '\\0'; i++) { if (x[i] == y) { z++; } } } return z; }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "curdir") OR nolex THEN
WRITELN "char *__b2c__curdir (void) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_BUFFER_SIZE, ");" TO g_FUNCTIONS
WRITELN "buf[idx] = getcwd(buf[idx], ", g_BUFFER_SIZE, "); __b2c__SETLEN(buf[idx], strlen(buf[idx])); buf[idx][", g_BUFFER_SIZE, "-1] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "datename") OR nolex THEN
WRITELN "char* __b2c__datename(time_t now, int which) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; struct tm *ts; int len = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_MAX_DIGITS, "); ts = localtime (&now); switch (which) { case 1: len = strftime(buf[idx], ", g_MAX_DIGITS, ", \"%A\", ts); break;" TO g_FUNCTIONS
WRITELN "case 2: len = strftime(buf[idx], ", g_MAX_DIGITS, ", \"%B\", ts); break; } __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "dec") OR nolex THEN
WRITELN "uint64_t __b2c__hex2dec (int l, char *k, char *h, int flag) { uint64_t j=0; char *status = NULL; if(h == NULL) { return(0); } if(flag == 1) { flag = 2; } else if(flag > 36) {ERROR = 5; RUNTIMEFERR (\"DEC\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
WRITELN "if(flag == 0) { j = strtol(h, &status, 16); if(*status != '\\0' && __b2c__trap) { ERROR = 5; RUNTIMEFERR (\"DEC\", ERROR, k, l); return(0); } } else { j = strtol(h, &status, flag);" TO g_FUNCTIONS
WRITELN "if(*status != '\\0') { ERROR = 5; RUNTIMEFERR (\"DEC\", ERROR, k, l); return(0); } } return(uint64_t)(j); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "dirname") OR nolex THEN
WRITELN "#ifndef PATH_MAX" TO g_FUNCTIONS
WRITELN "#define PATH_MAX 4096" TO g_FUNCTIONS
WRITELN "#endif" TO g_FUNCTIONS
WRITELN "char *__b2c__dirname(int l, char *k, int x, char *y, long arg) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long i; char *dup; if(y == NULL || __b2c__len(y) == 0){ return(NULL); }" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], PATH_MAX*sizeof(char)); dup = __b2c__strdup(y); switch(x) {case 0: if ((realpath(y, buf[idx])) == NULL) { if (__b2c__trap) { ERROR = 26; RUNTIMEFERR(\"REALPATH$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "else strncpy(buf[idx], \"Error getting real path\",", g_BUFFER_SIZE, "); } break; case 1: if(strncpy(buf[idx], basename(dup), PATH_MAX) == NULL) {if (__b2c__trap) { ERROR = 26; RUNTIMEFERR(\"BASENAME$\", ERROR, k, l); return(NULL); } else strncpy (buf[idx], \"Error getting basename\",", g_BUFFER_SIZE, ");}" TO g_FUNCTIONS
WRITELN "break; case 2: if (strncpy(buf[idx], dirname(dup), PATH_MAX) == NULL) {if(__b2c__trap) { ERROR = 26; RUNTIMEFERR(\"DIRNAME$\", ERROR, k, l); return(NULL); } else strncpy(buf[idx], \"Error getting dirname\",", g_BUFFER_SIZE, "); " TO g_FUNCTIONS
WRITELN "} break;} free(dup); __b2c__SETLEN(buf[idx], strlen(buf[idx])); buf[idx][PATH_MAX - 1] = '\\0'; if(arg && x==1){ for(i=__b2c__len(buf[idx]); i>=0; i--) { if(buf[idx][i] == 46) break; }" TO g_FUNCTIONS
WRITELN "if(i >= 0){ if(arg == 1) {buf[idx][i] = '\\0'; __b2c__SETLEN(buf[idx], i);} if(arg == 2){ i++; memmove(buf[idx], buf[idx]+i, __b2c__len(buf[idx])-i+1);" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], __b2c__len(buf[idx])-i);} } else if(arg == 2) {buf[idx][0] = '\\0'; __b2c__SETLEN(buf[idx], 0);} } return(char*)(buf[idx]);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "epoch") OR nolex THEN
WRITELN "unsigned long __b2c__epoch(int year, int month, int day, int hour, int minute, int second){struct tm tm; time_t t; tm.tm_year = year - 1900; tm.tm_mon = month - 1; tm.tm_mday = day;" TO g_FUNCTIONS
WRITELN "tm.tm_hour = hour; tm.tm_min = minute; tm.tm_sec = second; tm.tm_isdst = -1; t = mktime(&tm); if (t == -1) return (0); return(long) t; }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "error") OR nolex THEN
WRITELN "char *ERR", g_STRINGSIGN$, "(int nr){ static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long flen = 0, slen = 0; char *first = NULL, *second = NULL; switch (nr)" TO g_FUNCTIONS
WRITELN "{ case 0: first = \"Success\"; break; case 1: first = \"Trying to access illegal memory: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 2: first = \"Error opening file: \"; second = strerror (errno); break; case 3: first = \"Could not open library.\"; break;" TO g_FUNCTIONS
WRITELN "case 4: first = \"Symbol not found in library.\"; break; case 5: first = \"Wrong value: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 6: first = \"Unable to claim memory.\"; break; case 7: first = \"Unable to delete file: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 8: first = \"Could not open directory: \"; second = strerror(errno); break; case 9: first = \"Unable to rename file: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 10: first = \"NETWORK argument should contain colon with port number\"; break; case 11: first = \"Could not resolve hostname!\"; break;" TO g_FUNCTIONS
WRITELN "case 12: first = \"Socket error: \"; second = strerror(errno); break; case 13: first = \"Unable to open address: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 14: first = \"Error reading from socket: \"; second = strerror(errno); break; case 15: first = \"Error sending to socket: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 16: first = \"Error checking socket: \"; second = strerror(errno); break; case 17: first = \"Unable to bind the specified socket address: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 18: first = \"Unable to listen to socket address: \"; second = strerror(errno); break; case 19: first = \"Cannot accept incoming connection: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 20: first = \"Unable to remove directory: \"; second = strerror(errno); break; case 21: first = \"Unable to create directory: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 22: first = \"Unable to change to directory: \"; second = strerror(errno); break; case 23: first = \"GETENVIRON argument does not exist as environment variable\"; break;" TO g_FUNCTIONS
WRITELN "case 24: first = \"Unable to stat file: \"; second = strerror(errno); break; case 25: first = \"Search contains illegal string\"; break;" TO g_FUNCTIONS
WRITELN "case 26: first = \"Cannot return name: \"; second = strerror(errno); break; case 27: first = \"Illegal regex expression\"; break;" TO g_FUNCTIONS
WRITELN "case 28: first = \"Unable to create bidirectional pipes: \"; second = strerror(errno); break; case 29: first = \"Unable to fork process: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 30: first = \"Cannot read from pipe: \"; second = strerror(errno); break; case 31: first = \"Gosub nesting too deep!\"; break;" TO g_FUNCTIONS
WRITELN "case 32: first = \"Could not open device: \"; second = strerror(errno); break; case 33: first = \"Error configuring serial port: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 34: first = \"Error accessing device: \"; second = strerror(errno); break; case 35: first = \"Error in INPUT: \"; second = strerror(errno); break;" TO g_FUNCTIONS
WRITELN "case 36: first = \"Illegal value in SORT dimension!\"; break; case 37: first = \"Illegal option for SEARCH!\"; break;" TO g_FUNCTIONS
WRITELN "case 38: first = \"Invalid UTF8 string!\"; break; case 39: first = \"Illegal EVAL expression!\"; break;" TO g_FUNCTIONS
WRITELN "case 40: first = \"SSL file descriptor error!\"; break; case 41: first = \"Error loading certificate!\"; break;" TO g_FUNCTIONS
WRITELN "case 42: first = \"Widget not found!\"; ERROR = 42; break; case 43: first = \"Unsupported array type!\"; break; };" TO g_FUNCTIONS
WRITELN "if(first) { flen = strlen(first); } if(second) { slen = strlen(second); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], flen+slen+1);if(first)" TO g_FUNCTIONS
WRITELN "{ memmove(buf[idx], first, flen); } if(second) { memmove(buf[idx]+flen, second, slen); } __b2c__SETLEN(buf[idx], flen+slen); buf[idx][flen+slen] = '\\0'; return((char*)buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "exec") OR nolex THEN
WRITELN "static char ** __b2c__Get_Args (char *line) { char **ptr = NULL; char *arg; int in_string = 0, x = 0; arg = line; while (*line != '\\0') { switch (*line) { case 34: in_string = 1 - in_string; line++; break;" TO g_FUNCTIONS
WRITELN "case 32: if (!in_string) { ptr = (char **) realloc (ptr, (x + 1) * sizeof (char *)); if(*arg == 34) arg++; if(*(line-1) == 34) line--; ptr[x] = __b2c__strndup(arg, line-arg); while (isspace (*line) && *line != '\\0'){ line++; } arg = line; x++; }" TO g_FUNCTIONS
WRITELN "else {line++;} break; default: line++; } } ptr = (char **) realloc (ptr, (x + 2) * sizeof (char *)); if(*arg == 34) arg++; if(*(line-1) == 34) line--; ptr[x] = __b2c__strndup (arg, line - arg); ptr[x+1] = NULL; return (ptr); }" TO g_FUNCTIONS
WRITELN "char * __b2c__exec(int t, int l, char *k, char *cmd, char *str, int out) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int forking, length, dnull; ssize_t result = 0; int wpipe[2], rpipe[2]; char **args; char *ans = NULL;" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], sizeof(char)); if (pipe (rpipe) < 0 || pipe (wpipe) < 0) { if (__b2c__trap) { ERROR = 29; RUNTIMEFERR(\"EXEC$\", ERROR, k, l); return(NULL); } } if ((forking = fork ()) < 0) { if (__b2c__trap) { ERROR = 29; RUNTIMEFERR(\"EXEC$\", ERROR, k, l); return(NULL); } }" TO g_FUNCTIONS
WRITELN "else if (forking == 0) { fflush(stdout); close (wpipe[1]); close (rpipe[0]); dup2 (wpipe[0], STDIN_FILENO); close (wpipe[0]); dnull = open(\"/dev/null\", O_RDWR); if(out == 1) { dup2 (rpipe[1], STDOUT_FILENO); dup2(dnull, STDERR_FILENO); } else if (out == 2) { dup2(dnull, STDOUT_FILENO);" TO g_FUNCTIONS
WRITELN "dup2(rpipe[1], STDERR_FILENO); } else { dup2(rpipe[1], STDOUT_FILENO); dup2(rpipe[1], STDERR_FILENO); } close (rpipe[1]); if(t == 0) { forking = system (cmd); if (WIFEXITED (forking)) result = WEXITSTATUS (forking); }" TO g_FUNCTIONS
WRITELN "else { args = __b2c__Get_Args(cmd); if(execvp(args[0], args) < 0 ) { if (__b2c__trap) { ERROR = 29; RUNTIMEFERR (\"EXEC$\", ERROR, k, l); return(NULL); } } } close(dnull); _exit(result); } else { close (wpipe[0]); close (rpipe[1]); ans = (char*)malloc(", g_BUFFER_SIZE, ");" TO g_FUNCTIONS
WRITELN "length = 0; if (str != NULL) result = write (wpipe[1], str, __b2c__len(str)); close (wpipe[1]); do { result = read (rpipe[0], ans, ", g_BUFFER_SIZE, "); if (result == -1 && __b2c__trap) { ERROR = 30; RUNTIMEFERR(\"EXEC$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "if (result == 0) { break; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], length + result + 1); if(buf[idx] == NULL && __b2c__trap) { ERROR = 6; RUNTIMEFERR(\"EXEC$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "memcpy(buf[idx] + length, ans, (size_t)labs(result)); length += result; } while (result > 0); __b2c__SETLEN(buf[idx], length); buf[idx][length] = '\\0';" TO g_FUNCTIONS
WRITELN "close (rpipe[0]); free (ans); wait (&RETVAL); RETVAL = WEXITSTATUS (RETVAL); } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "filelen") OR nolex THEN
WRITELN "long __b2c__filelen(int l, char *k, const char *x) {struct stat buf; if(stat(x, &buf) < 0 && __b2c__trap){ERROR = 24; RUNTIMEFERR(\"FILELEN\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
WRITELN "if(x == NULL || stat(x, &buf) < 0) return -1; else return(long)(buf.st_size);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "filetime") OR nolex THEN
WRITELN "long __b2c__filetime(int l, char *k, const char *x, int y) {struct stat buf; if(stat(x, &buf) < 0 && __b2c__trap){ERROR = 24; RUNTIMEFERR(\"FILETIME\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
WRITELN "if(x == NULL || stat(x, &buf) < 0 || y < 0 || y > 2) { return -1; } switch(y) {case 0: return(long)(buf.st_atime); break;" TO g_FUNCTIONS
WRITELN "case 1: return(long)(buf.st_mtime); break;} return(long)(buf.st_ctime);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "filetype") OR nolex THEN
WRITELN "int __b2c__filetype(int l, char *k, const char *file) { int type = 0; struct stat buf = { 0 }; if(file == NULL) { return(0); } if(lstat (file, &buf) < 0 && __b2c__trap) { ERROR = 24; RUNTIMEFERR (\"FILETYPE\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
WRITELN "switch (buf.st_mode & S_IFMT) { case S_IFBLK: type = 4; break; case S_IFCHR: type = 3; break; case S_IFDIR: type = 2; break; case S_IFIFO: type = 5; break; case S_IFLNK: type = 6; break;" TO g_FUNCTIONS
WRITELN "case S_IFREG: type = 1; break; case S_IFSOCK: type = 7; break; default: if(__b2c__trap) { ERROR = 24; RUNTIMEFERR(\"FILETYPE\", ERROR, k, l); return(0); } break; } return(type); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "fill") OR nolex THEN
WRITELN "char * __b2c__fill (unsigned long amount, unsigned int txt) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char bf[5]; int x, len; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } if (__b2c__option_utf8) { len = __b2c_utf8_conv (txt, bf);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], amount*len+1); for (x = 0; x < (amount * len); x += len) { memcpy(buf[idx] + x, bf, len); } __b2c__SETLEN(buf[idx], amount * len); buf[idx][amount * len] = '\\0'; } else" TO g_FUNCTIONS
WRITELN "{ buf[idx] = (char*)__b2c_str_realloc(buf[idx], amount+1); memset(buf[idx], txt, amount); __b2c__SETLEN(buf[idx], amount); buf[idx][amount] = '\\0'; } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "flatten") OR nolex THEN
WRITELN "char *__b2c__flatten(char *src, char *meta) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char quote[1]; long len, x, pos=0, escaped=0; quote[0] = __b2c__option_dq; if(src == NULL) { return(src); }" TO g_FUNCTIONS
WRITELN "if (meta == NULL) { meta = quote; } len = __b2c__len(src); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx], src, len); buf[idx][len] = '\\0'; for(x = 0; src[x] != 0; x++) { if(src[x] == meta[0]) { if(!escaped) { memmove(buf[idx]+pos, src+x+1, len-x-1); }" TO g_FUNCTIONS
WRITELN "else { pos++; escaped = 0; } } else { if(src[x] == __b2c__option_esc) { if(!escaped) { memmove(buf[idx]+pos, src+x+1, len-x-1); escaped = 1; } else { pos++; } }" TO g_FUNCTIONS
WRITELN "else { pos++; escaped = 0; } } } __b2c__SETLEN(buf[idx], pos); buf[idx][pos] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "char * __b2c__unflatten (char *src, char *meta) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char quote[1]; long x, pos = 1; quote[0] = __b2c__option_dq; if (src == NULL) { return (src); }" TO g_FUNCTIONS
WRITELN "if (meta == NULL) { meta = quote; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], 2*__b2c__len(src)+1); buf[idx][0] = meta[0];" TO g_FUNCTIONS
WRITELN "for (x = 0; src[x] != 0; x++) { if (src[x] == meta[0]) { buf[idx][pos++] = __b2c__option_esc; buf[idx][pos++] = src[x]; } else {buf[idx][pos++] = src[x];} } buf[idx][pos++] = meta[0];" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], pos); buf[idx][pos] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getenviron") OR nolex THEN
WRITELN "char *__b2c__getenv (char *env) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *result; long len; result = getenv (env); if(result == NULL) { return(NULL); } len = strlen(result); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], (len+1)*sizeof(char)); strncpy(buf[idx], result, len); __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getkey") OR nolex THEN
WRITELN "long __b2c__getch(void){long ch; struct termios oldt, newt; tcgetattr(STDIN_FILENO, &oldt); newt = oldt; newt.c_lflag &= ~(ICANON | ECHO); newt.c_cc[VMIN]=1;" TO g_FUNCTIONS
WRITELN "newt.c_cc[VTIME]=0; tcsetattr(STDIN_FILENO, TCSANOW, &newt); ch = getchar(); tcsetattr(STDIN_FILENO, TCSANOW, &oldt); return(ch);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getpeer") OR nolex THEN
IF INSTR(OS$, "OSF1") THEN
line$ = "int"
ELSE
line$ = "unsigned int"
ENDIF
WRITELN "char * __b2c__getpeer(int l, char *k, uintptr_t remote) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; struct sockaddr_in *peer; ", line$, " length = sizeof (peer); char port[6]; int desc = 0; peer = (struct sockaddr_in*)calloc (1, sizeof(*peer));" TO g_FUNCTIONS
IF g_OPTION_TLS THEN
IF TALLY(g_LIB_TLS$, "gnutls") THEN
WRITELN "if(__b2c__option_tls) { BIO_get_fd(((SSL*)remote)->gnutls_state, &desc); }" TO g_FUNCTIONS
ELSE
WRITELN "if(__b2c__option_tls) { desc = SSL_get_fd((SSL*)remote); }" TO g_FUNCTIONS
ENDIF
ENDIF
WRITELN "if(!__b2c__option_tls) { desc = remote; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_BUFFER_SIZE, "*sizeof(char));" TO g_FUNCTIONS
WRITELN "if (getpeername(desc, (struct sockaddr *) peer, &length) < 0) { if (__b2c__trap) { ERROR = 16; RUNTIMEFERR(\"GETPEER$\", ERROR, k, l); return(NULL); } else strncpy(buf[idx], \"Peer not found\", ", g_BUFFER_SIZE, "); }" TO g_FUNCTIONS
WRITELN "else { strncpy(buf[idx], inet_ntoa (peer->sin_addr), ", g_BUFFER_SIZE, "-7); strcat(buf[idx], \":\"); snprintf (port, 6, \"%d\", ntohs (peer->sin_port)); strcat(buf[idx], port); }" TO g_FUNCTIONS
WRITELN "free (peer); __b2c__SETLEN(buf[idx], strlen(buf[idx])); buf[idx][", g_BUFFER_SIZE, "-1] = '\\0'; return(char*)(buf[idx]);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getxy") OR nolex THEN
WRITELN "long __b2c__getxy(int type){char asw[", g_BUFFER_SIZE, "]; struct termios old, cnew; int len, x = 0, y = 0; tcgetattr(STDIN_FILENO, &old); cnew = old; cnew.c_lflag &= ~(ICANON | ECHO); tcsetattr(STDIN_FILENO, TCSANOW, &cnew);" TO g_FUNCTIONS
WRITELN "if(write(STDOUT_FILENO, \"\\033[6n\", 4)>=0){len = read(STDIN_FILENO, asw, ", g_BUFFER_SIZE, "); asw[len] = '\\0'; tcsetattr(STDIN_FILENO, TCSANOW, &old); sscanf(asw, \"\\033[%d;%dR\", &y, &x);} if (!type) return(long)x; return(long)y;}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "sortnr") OR nolex THEN
WRITELN "int __b2c__sortnrd(const void *a, const void *b) {if (*(double*)a==*(double*)b) return(0); else if (*(double*)a < *(double*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrd_wrap(const void *a, const void *b) { return(__b2c__sortnrd(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrd_down(const void *a, const void *b) {if (*(double*)a==*(double*)b) return(0); else if (*(double*)a < *(double*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrd_wrap_down(const void *a, const void *b) { return(__b2c__sortnrd_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrf(const void *a, const void *b) {if (*(float*)a==*(float*)b) return(0); else if (*(float*)a < *(float*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrf_wrap(const void *a, const void *b) { return(__b2c__sortnrf(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrf_down(const void *a, const void *b) {if (*(float*)a==*(float*)b) return(0); else if (*(float*)a < *(float*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrf_wrap_down(const void *a, const void *b) { return(__b2c__sortnrf_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrl(const void *a, const void *b) {if (*(long*)a==*(long*)b) return(0); else if (*(long*)a < *(long*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrl_wrap(const void *a, const void *b) { return(__b2c__sortnrl(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrl_down(const void *a, const void *b) {if (*(long*)a==*(long*)b) return(0); else if (*(long*)a < *(long*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrl_wrap_down(const void *a, const void *b) { return(__b2c__sortnrl_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnri(const void *a, const void *b) {if (*(int*)a==*(int*)b) return(0); else if (*(int*)a < *(int*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnri_wrap(const void *a, const void *b) { return(__b2c__sortnri(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnri_down(const void *a, const void *b) {if (*(int*)a==*(int*)b) return(0); else if (*(int*)a < *(int*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnri_wrap_down(const void *a, const void *b) { return(__b2c__sortnri_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrs(const void *a, const void *b) {if (*(short*)a==*(short*)b) return(0); else if (*(short*)a < *(short*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrs_wrap(const void *a, const void *b) { return(__b2c__sortnrs(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrs_down(const void *a, const void *b) {if (*(short*)a==*(short*)b) return(0); else if (*(short*)a < *(short*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrs_wrap_down(const void *a, const void *b) { return(__b2c__sortnrs_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrc(const void *a, const void *b) {if (*(char*)a==*(char*)b) return(0); else if (*(char*)a < *(char*)b) return(-1); else return(1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrc_wrap(const void *a, const void *b) { return(__b2c__sortnrc(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrc_down(const void *a, const void *b) {if (*(char*)a==*(char*)b) return(0); else if (*(char*)a < *(char*)b) return(1); else return(-1);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortnrc_wrap_down(const void *a, const void *b) { return(__b2c__sortnrc_down(*(void**)a, *(void**)b)); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "sortstr") OR nolex THEN
WRITELN "int __b2c__sortstr(const void *a, const void *b)" TO g_FUNCTIONS
WRITELN "{if(*(char **)a == NULL) return(-1); if(*(char **)b == NULL) return(1); return strcmp(*(char **)a, *(char **)b);}" TO g_FUNCTIONS
WRITELN "int __b2c__sortstr_down(const void *a, const void *b)" TO g_FUNCTIONS
WRITELN "{if(*(char **)a == NULL) return(-1); if(*(char **)b == NULL) return(1); return strcmp(*(char **)b, *(char **)a);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "malloc") OR nolex THEN
WRITELN "char *__b2c__strdup(const char *s) { if(s == NULL) { return(NULL); } return(strdup(s)); }" TO g_FUNCTIONS
WRITELN "char *__b2c__strndup(const char *s, size_t n) { if(s == NULL) { return(NULL); } return(strndup(s, n)); }" TO g_FUNCTIONS
WRITELN "int __b2c__strcmp(const char *__b2c__s1, const char *__b2c__s2){if(__b2c__s1 == NULL && __b2c__s2 == NULL) { return(0); }" TO g_FUNCTIONS
WRITELN "if(__b2c__s1 == NULL) { __b2c__s1 = __b2c_EMPTYSTRING; } if(__b2c__s2 == NULL) { __b2c__s2 = __b2c_EMPTYSTRING; } return(strcmp(__b2c__s1, __b2c__s2));}" TO g_FUNCTIONS
WRITELN "int __b2c__strcasecmp(const char *__b2c__s1, const char *__b2c__s2){if(__b2c__s1 == NULL && __b2c__s2 == NULL) { return(0); }" TO g_FUNCTIONS
WRITELN "if(__b2c__s1 == NULL) { __b2c__s1 = __b2c_EMPTYSTRING; } if(__b2c__s2 == NULL) { __b2c__s2 = __b2c_EMPTYSTRING; } return(strcasecmp(__b2c__s1, __b2c__s2));}" TO g_FUNCTIONS
WRITELN "void *__b2c_str_realloc_core (char *ptr, size_t size, int action) { char *next; uint32_t lbufsize = 0, rbufsize = 0; if (__b2c__FIND_EXCEPTION ((unsigned long) ptr)) { lbufsize = __b2c__LBUFSIZE (ptr); rbufsize = __b2c__RBUFSIZE (ptr); __b2c__DEL_EXCEPTION ((unsigned long) ptr); if(action == 0)" TO g_FUNCTIONS
WRITELN "{ next = (char *) realloc (ptr - __b2c__BUFOFFSET - lbufsize, __b2c__BUFOFFSET + lbufsize + 1 + rbufsize + size * 2 + 1); memmove (next + lbufsize + 1, next + lbufsize, __b2c__BUFOFFSET + rbufsize); ptr = next + lbufsize + 1;" TO g_FUNCTIONS
WRITELN "*(uint32_t *) ((char *) ptr + 4) = rbufsize + size * 2 + 1; *(uint32_t *) ((char *) ptr + 8) = lbufsize + 1; } else { next = (char *) realloc (ptr - __b2c__BUFOFFSET - lbufsize, __b2c__BUFOFFSET + lbufsize + 1 + size * 2 + rbufsize);" TO g_FUNCTIONS
WRITELN "memmove (next + lbufsize + 1 + size*2, next + lbufsize, __b2c__BUFOFFSET + rbufsize); ptr = next + lbufsize + 1 + size*2; *(uint32_t *) ((char *) ptr + 4) = rbufsize; *(uint32_t *) ((char *) ptr + 8) = lbufsize + size * 2 + 1; } }" TO g_FUNCTIONS
WRITELN "else if (((uintptr_t) ptr & 1) && __b2c__INRANGE (ptr)) { lbufsize = __b2c__LBUFSIZE (ptr); rbufsize = __b2c__RBUFSIZE (ptr); if (action == 0) { if (rbufsize <= size) { next = (char *) realloc (ptr - __b2c__BUFOFFSET - lbufsize, __b2c__BUFOFFSET + lbufsize + rbufsize + size * 2 + 1);" TO g_FUNCTIONS
WRITELN "ptr = next + lbufsize; *(uint32_t *) ((char *) ptr + 4) = size * 2 + 1 + rbufsize; } else { return (ptr); } } else { if (lbufsize <= size) { next = (char *) realloc (ptr - __b2c__BUFOFFSET - lbufsize, __b2c__BUFOFFSET + lbufsize + rbufsize + size * 2); memmove (next + lbufsize + size * 2, next + lbufsize, __b2c__BUFOFFSET + rbufsize);" TO g_FUNCTIONS
WRITELN "ptr = next + size * 2 + lbufsize; *(uint32_t *) ((char *) ptr + 8) = size * 2 + lbufsize; } else { return (ptr); } } } else { rbufsize = __b2c__len (ptr); next = (char *) calloc (__b2c__BUFOFFSET + rbufsize + size * 2 + 1, sizeof (char)); if (action == 0) { if (ptr) { memcpy (next + __b2c__BUFOFFSET, ptr, rbufsize); free (ptr); }" TO g_FUNCTIONS
WRITELN "ptr = next; *(uint32_t *) ((char *) ptr) = rbufsize; *(uint32_t *) ((char *) ptr + 4) = rbufsize + size * 2 + 1; } else { if (ptr) { memcpy (next + size * 2 + __b2c__BUFOFFSET, ptr, rbufsize); free (ptr); } ptr = next + size * 2; *(uint32_t *) ((char *) ptr) = rbufsize; *(uint32_t *) ((char *) ptr + 4) = rbufsize + 1;" TO g_FUNCTIONS
WRITELN "*(uint32_t *) ((char *) ptr + 8) = size * 2; }} ptr += __b2c__BUFOFFSET; __b2c__SETRANGE (ptr); return (ptr); }" TO g_FUNCTIONS
WRITELN "char *__b2c_Copy_String (char *x, char *y) { long ylen; if (y == NULL) { __b2c__STRFREE(x); return (NULL); }" TO g_FUNCTIONS
WRITELN "ylen = __b2c__len(y); x = (char*)__b2c_str_realloc(x, ylen); memmove (x, y, ylen); __b2c__SETLEN (x, ylen); x[ylen] = '\\0'; return(x); }" TO g_FUNCTIONS
WRITELN "char *__b2c_Swap_String(char **x, char **y) { char *ptr; ptr = *x; *x = *y; *y = ptr; return(*x); }" TO g_FUNCTIONS
WRITELN "unsigned long __b2c__len (const char *ptr) { if (ptr == NULL) { return (0); } if(__b2c__FIND_EXCEPTION((unsigned long)ptr) || (((uintptr_t)ptr&1) && __b2c__INRANGE(ptr))) { return (*(uint32_t *) (ptr - __b2c__BUFOFFSET)); } return ((unsigned long) strlen (ptr)); }" TO g_FUNCTIONS
WRITELN "char *__b2c__loop_helper(jmp_buf buf) { if(__b2c__loop_result", g_STRINGSIGN$, " != NULL) { __b2c__SETLEN (__b2c__loop_result", g_STRINGSIGN$, ", 0); __b2c__loop_result", g_STRINGSIGN$, " = __b2c_Copy_String(__b2c__loop_result", g_STRINGSIGN$, ", NULL); } longjmp(buf, 1); return(NULL); }" TO g_FUNCTIONS
WRITELN "long __b2c__loop_helper2(jmp_buf buf) { __b2c__loop_result = 0; longjmp(buf, 1); return(0); }" TO g_FUNCTIONS
WRITELN "void __b2c__free_str_array_members(char ***array, int base, int size) { int i; if(*array != NULL) { for(i=0; i < size; i++){ __b2c__STRFREE((*array)[i+base]); (*array)[i+base] = NULL; } } }" TO g_FUNCTIONS
IF INSTR(OS$, "BSD") THEN
WRITELN "char *__b2c_strlcat(char *dest, const char *src) { strlcat(dest, src, __b2c__len(dest)+__b2c__len(src)+1); return(dest); }" TO g_FUNCTIONS
WRITELN "char *__b2c_strlcpy(char *dest, const char *src) { strlcpy(dest, src, __b2c__len(src)+1); return(dest); }" TO g_FUNCTIONS
ENDIF
ENDIF
IF TALLY(total$, "hash") OR nolex THEN
WRITELN "typedef struct __b2c__htable { char *key[65536]; void *value[65536]; char *index[65536]; int total; struct __b2c__htable *next; } __b2c__htable;" TO g_FUNCTIONS
WRITELN "const char *__b2c__hash_key_collect(int n, const char *first, ...) { static char *keys[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long length = 0, buflen = 0, cnew; char *next; va_list ap; if (n == 0) { return (NULL); } if (n == 1) { return (first); }" TO g_FUNCTIONS
WRITELN "idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } if (keys[idx]) { buflen = __b2c__RBUFSIZE(keys[idx]); } cnew = __b2c__len(first); if(cnew >= buflen) { keys[idx] = (char *) __b2c_str_realloc(keys[idx], cnew); buflen = __b2c__RBUFSIZE(keys[idx]); }" TO g_FUNCTIONS
WRITELN "memcpy(keys[idx], first, cnew); length += cnew; n--; va_start (ap, first); while (n) { next = va_arg (ap, char *); if (next) { cnew = __b2c__len (next); if(length + cnew + 1 >= buflen) { keys[idx] = (char *) __b2c_str_realloc(keys[idx], (length + cnew + 1 + 1) * sizeof (char));" TO g_FUNCTIONS
WRITELN "buflen = __b2c__RBUFSIZE(keys[idx]); } keys[idx][length] = 32; length++; memmove (keys[idx] + length, next, cnew); length += cnew; } n--; } va_end (ap); __b2c__SETLEN(keys[idx], length); keys[idx][length] = '\\0'; return ((char *) keys[idx]); }" TO g_FUNCTIONS
WRITELN "#define __b2c__KEYCOLLECT(...) __b2c__hash_key_collect(sizeof((const char*[]){__VA_ARGS__}) / sizeof(char*), __VA_ARGS__, NULL)" TO g_FUNCTIONS
WRITELN "uint64_t __b2c__HashFNV1a_64(const char *key, int len){ uint64_t hash = 14695981039346656037UL; if(key==NULL) { return(0); } if(len) { while(len) { hash = 1099511628211 * (hash ^ *key); key++; len--; } } else { while(*key) { hash = 1099511628211 * (hash ^ *key); key++; } } return(hash); }" TO g_FUNCTIONS
WRITELN "uint32_t __b2c__HashFNV1a_32(const char *key, int len){ uint32_t hash = 2166136261UL; if(key==NULL) { return(0); } if(len) { while(len) { hash = 16777619 * (hash ^ *key); key++; len--; } } else { while(*key) { hash = 16777619 * (hash ^ *key); key++; } } return(hash); }" TO g_FUNCTIONS
WRITELN "#define __b2c__HashFNV1a_16(x) __b2c__HashFNV1a_16_new(x, 0)" TO g_FUNCTIONS
WRITELN "uint16_t __b2c__HashFNV1a_16_new(const char *key, int len) { uint32_t hash = 2166136261UL; if (key == NULL) { return (0); } if (len) { while(len) { hash = 16777619 * (hash ^ *key); key++; len--; } } else" TO g_FUNCTIONS
WRITELN "{ while (*key) { hash = 16777619 * (hash ^ *key); key++; } } return ((hash >> 16) ^ (hash & 0xffff)); }" TO g_FUNCTIONS
WRITELN "__b2c__htable *__b2c__hash_new(void) { __b2c__htable *name; name = (__b2c__htable*)calloc(1, sizeof(__b2c__htable)); name->next = NULL; name->total = 0; return(name); }" TO g_FUNCTIONS
WRITELN "__b2c__htable* __b2c__hash_find_key_do(__b2c__htable *name, unsigned short hash, const char *key) { if(key == NULL || name == NULL) { return(NULL); } if(hash == 0) { hash = __b2c__HashFNV1a_16(key); } do" TO g_FUNCTIONS
WRITELN "{ if(name->key[hash] && !strcmp(name->key[hash], key)) { return(name); } name = name->next; } while(name); return(NULL); }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_find_key(x, y, ...) __b2c__hash_find_key_do(x, y, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "void *__b2c__hash_find_value_do(__b2c__htable *name, const char *key) { __b2c__htable *table; unsigned short pos; if(name == NULL || key == NULL) { return(NULL); } pos = __b2c__HashFNV1a_16(key); table = __b2c__hash_find_key(name, pos, key);" TO g_FUNCTIONS
WRITELN "if(table) { return(table->value[pos]); } return(NULL); }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_find_value(x, ...) __b2c__hash_find_value_do(x, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "void __b2c__hash_add_do(__b2c__htable *name, const void *value, int flag, unsigned int len, const char *key) { unsigned short hash; if(name == NULL || value == NULL || key == NULL) { return; } hash = __b2c__HashFNV1a_16(key);" TO g_FUNCTIONS
WRITELN "while(1) { if(name->key[hash] == NULL) { name->total++; break; } if(!strcmp(name->key[hash], key)) { if(flag != 2) { break; } } if(name->next) { name = name->next; } else { name->next = __b2c__hash_new(); name = name->next;} }" TO g_FUNCTIONS
WRITELN "if(!name->key[hash]) { name->key[hash] = strdup(key); name->index[name->total-1] = name->key[hash]; } if(flag == 0) { if(!name->value[hash]) { name->value[hash] = calloc(1, sizeof(void*)); } memcpy(name->value[hash], value, sizeof(void*)); }" TO g_FUNCTIONS
WRITELN "else if(flag == 3) { name->value[hash] = realloc(name->value[hash], len); memcpy(name->value[hash], value, len); } else { name->value[hash] = realloc(name->value[hash], __b2c__len((char*)value)+1); strcpy((char*)name->value[hash], (const char*)value); } }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_add(x, y, ...) __b2c__hash_add_do(x, y, 0, 0, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_add_str(x, y, ...) __b2c__hash_add_do(x, y, 1, 0, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_add_redundant(x, y, ...) __b2c__hash_add_do(x, y, 2, 0, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_add_data(x, y, len, ...) __b2c__hash_add_do(x, y, 3, len, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "void *__b2c__hash_realloc_str_value_do(__b2c__htable *name, int len, const char *key) { __b2c__htable *table; unsigned short pos; if (name == NULL || key == NULL) { return (NULL); } __b2c__hash_add_str(name, \"\", key); pos = __b2c__HashFNV1a_16(key);" TO g_FUNCTIONS
WRITELN "table = __b2c__hash_find_key(name, pos, key); table->value[pos] = realloc(table->value[pos], len); return (table->value[pos]); }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_realloc_str_value(x, y, ...) __b2c__hash_realloc_str_value_do(x, y, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "void __b2c__hash_del_do(__b2c__htable *name, int rebuild, const char *key) { __b2c__htable *found; unsigned short pos; int i, which; if(name == NULL) { return; } pos = __b2c__HashFNV1a_16(key); found = __b2c__hash_find_key(name, pos, key);" TO g_FUNCTIONS
WRITELN "if(found) { if (rebuild) { for (i = 0; i < found->total; i++) { which = __b2c__HashFNV1a_16(found->index[i]); if (which == pos) { if(i != found->total-1) { found->index[i] = found->index[found->total-1]; } found->index[found->total-1] = NULL; break; } } }" TO g_FUNCTIONS
WRITELN "free(found->key[pos]); found->key[pos] = NULL; if(found->value[pos]) { free(found->value[pos]); } found->value[pos] = NULL; found->total -= 1; } }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_del(x, ...) __b2c__hash_del_do(x, 1, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_del_norebuild(x, ...) __b2c__hash_del_do(x, 0, __b2c__KEYCOLLECT(__VA_ARGS__))" TO g_FUNCTIONS
WRITELN "void __b2c__hash_clear_do(__b2c__htable *name) { __b2c__htable *orig, *next; int i; orig = name; while(name) { for(i = 0; i < 65536; i++) { if(name->key[i]) { free(name->key[i]); } name->key[i] = NULL;" TO g_FUNCTIONS
WRITELN "if(name->value[i]) { free(name->value[i]); } name->value[i] = NULL; } next = name->next; name->next = NULL; name->total = 0; if(name != orig) { free(name); } name = next; } }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_clear(x) __b2c__hash_clear_do(x)" TO g_FUNCTIONS
WRITELN "int __b2c__hash_nrkeys(__b2c__htable *name) { int total = 0; while(name) { total += name->total; name = name->next; } return(total); }" TO g_FUNCTIONS
WRITELN "void __b2c__hash_dup_do(__b2c__htable *from, __b2c__htable *to, int flag) { int i; char *value; while(from) { for(i = 0; i < 65536; i++) { if(from->key[i]) { value = (char*)__b2c__hash_find_value(from, from->key[i]); if(flag==0) { __b2c__hash_add(to, value, from->key[i]); } " TO g_FUNCTIONS
WRITELN "else { __b2c__hash_add_str(to, value, from->key[i]); } } } from = from->next; if(to->next == NULL) { to->next = __b2c__hash_new(); } to = to->next; } }" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_dup(x, y) __b2c__hash_dup_do(x, y, 0)" TO g_FUNCTIONS
WRITELN "#define __b2c__hash_dup_str(x, y) __b2c__hash_dup_do(x, y, 1)" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "obtain") OR nolex THEN
WRITELN "char *__b2c__hash_obtain(__b2c__htable *name, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long ctr, dlen, len, total = 0; if(name == NULL) { return (NULL); } if(delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "if(name->total == 0) { return (NULL); } dlen = __b2c__len(delim); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], dlen); do { for(ctr=0; ctr < name->total; ctr++) { len = __b2c__len(name->index[ctr]);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], total+len+dlen); memmove(buf[idx] + total, name->index[ctr], len); total += len; memmove(buf[idx] + total, delim, dlen); total += dlen; } name = name->next; }" TO g_FUNCTIONS
WRITELN "while(name); __b2c__SETLEN(buf[idx], total-dlen); buf[idx][total-dlen] = '\\0'; return((char*)buf[idx]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__hash_obtain_by_sort(int l, char *k, __b2c__htable * name, char *delim, int up_down, int type) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; void **values = { NULL }; char **keys = { NULL }; void **dups = { NULL }; __b2c__htable *ptr, *inv; int i, j, pos = 0, start = 0, cur = 0; long dlen, len, total = 0;" TO g_FUNCTIONS
WRITELN "unsigned short loc; char *value; char bf[", g_MAX_DIGITS, " + 1] = { 0 }; if (name == NULL || name->total == 0) { return (NULL); } if (delim == NULL) { delim = __b2c__option_delim; } values = (void **) calloc (__b2c__hash_nrkeys (name), sizeof (char *)); inv = __b2c__hash_new (); ptr = name; do { for(i = 0; i < ptr->total; i++) { loc = __b2c__HashFNV1a_16(ptr->index[i]); switch(type)" TO g_FUNCTIONS
WRITELN "{ case 0: value = (char*)ptr->value[loc]; break; case 1: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(double *) ptr->value[loc]); value = bf; break; case 2: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(float *) ptr->value[loc]); value = bf; break;" TO g_FUNCTIONS
WRITELN "case 3: snprintf (bf, ", g_MAX_DIGITS, ", \"%ld\", *(long *) ptr->value[loc]); value = bf; break; case 4: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(int *) ptr->value[loc]); value = bf; break; case 5: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(short *) ptr->value[loc]); value = bf; break;" TO g_FUNCTIONS
WRITELN "case 6: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(char *) ptr->value[loc]); value = bf; break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR(\"OBTAIN$\", ERROR, k, l); return(NULL); } } __b2c__hash_add_redundant(inv, ptr->index[i], value); values[pos++] = ptr->value[loc]; } ptr = ptr->next; } while (ptr);" TO g_FUNCTIONS
WRITELN "switch (type) { case 0: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortstr); } else { qsort (&values[0], pos, sizeof (void *), __b2c__sortstr_down); } break; case 1: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrd_wrap); }" TO g_FUNCTIONS
WRITELN "else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrd_wrap_down); } break; case 2: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrf_wrap); } else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrf_wrap_down); } break;" TO g_FUNCTIONS
WRITELN "case 3: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrl_wrap); } else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrl_wrap_down); } break; case 4: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnri_wrap); }" TO g_FUNCTIONS
WRITELN "else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnri_wrap_down); } break; case 5: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrs_wrap); } else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrs_wrap_down); } break;" TO g_FUNCTIONS
WRITELN "case 6: if (up_down) { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrc_wrap); } else { qsort (&values[0], pos, sizeof (void *), __b2c__sortnrc_wrap_down); } break; } dlen = __b2c__len (delim); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], dlen);" TO g_FUNCTIONS
WRITELN "keys = (char**)calloc(__b2c__hash_nrkeys(name), sizeof(char*)); dups = (void**)calloc(__b2c__hash_nrkeys(name), sizeof(void*)); for(i = 0; i < pos; i++) { if(type > 0) { keys[i] = (char*)calloc(", g_MAX_DIGITS, ", sizeof(char)); } switch (type)" TO g_FUNCTIONS
WRITELN "{ case 0: keys[i] = __b2c__strdup((char*)values[i]); break; case 1: snprintf (keys[i], ", g_MAX_DIGITS, ", \"%g\", *(double *) values[i]); break; case 2: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%g\", *(float*)values[i]); break;" TO g_FUNCTIONS
WRITELN "case 3: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%ld\", *(long *) values[i]); break; case 4: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(int *) values[i]); break; case 5: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(short*)values[i]); break; case 6:" TO g_FUNCTIONS
WRITELN "snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(char *) values[i]); break; } dups[i] = __b2c__strdup((char*)__b2c__hash_find_value_do (inv, keys[i])); __b2c__hash_del_norebuild (inv, keys[i]); }" TO g_FUNCTIONS
WRITELN "do { if(type == 0) { while(cur < pos-1 && !strcmp(keys[cur], keys[cur+1])) { cur++; } } else { while(cur < pos-1 && !memcmp(keys[cur], keys[cur+1], sizeof(void*))) { cur++; } } qsort (&dups[start], cur-start+1, sizeof (char *), __b2c__sortstr);" TO g_FUNCTIONS
WRITELN "for (j = start; j <= cur; j++) { len = __b2c__len ((char *) dups[j]); buf[idx] = (char*)__b2c_str_realloc(buf[idx], total + len + dlen);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + total, dups[j], len); free(dups[j]); free(keys[j]); total += len; memmove(buf[idx] + total, delim, dlen); total += dlen; } cur++; start = cur; } while(cur < pos);" TO g_FUNCTIONS
WRITELN "__b2c__hash_clear (inv); free(inv); free(values); free(dups); free(keys); total -= dlen; __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return((char*)buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "lookup") OR nolex THEN
WRITELN "int __b2c__lookup_by_order(__b2c__htable *name, char ***array, int size, int base) { int i, count = 0; if(name) { if(*array) { __b2c__free_str_array_members (&(*array), base, size); free(*array); } *array = (char **)calloc(__b2c__hash_nrkeys(name)+base, sizeof(char*));" TO g_FUNCTIONS
WRITELN "count = base; do { for(i = 0; i < name->total; i++) { (*array)[count++] = __b2c__strdup(name->index[i]); } name = name->next; } while(name); count -= base; } return(count); }" TO g_FUNCTIONS
WRITELN "int __b2c__lookup_by_sort (__b2c__htable * name, char ***array, int size, int base, int type, int (*compare)(const void*, const void*)) { void **values = { NULL }; char **keys = { NULL }; __b2c__htable *ptr, *inv; char *value; int i, j, pos = 0, count = 0, cur = 0, start = 0; unsigned short loc; char buf[", g_MAX_DIGITS, " + 1] = { 0 };" TO g_FUNCTIONS
WRITELN "if (*array) { __b2c__free_str_array_members (&(*array), base, size); free (*array); } if (name) { values = (void **) calloc (__b2c__hash_nrkeys (name), sizeof (char *)); inv = __b2c__hash_new (); ptr = name; do" TO g_FUNCTIONS
WRITELN "{ for (i = 0; i < ptr->total; i++) { loc = __b2c__HashFNV1a_16 (ptr->index[i]); switch (type) { case 0: value = (char*)ptr->value[loc]; break; case 1: snprintf (buf, ", g_MAX_DIGITS, ", \"%g\", *(double *) ptr->value[loc]); value = buf; break; case 2: snprintf (buf, ", g_MAX_DIGITS, ", \"%g\", *(float *) ptr->value[loc]); value = buf;" TO g_FUNCTIONS
WRITELN "break; case 3: snprintf (buf, ", g_MAX_DIGITS, ", \"%ld\", *(long *) ptr->value[loc]); value = buf; break; case 4: snprintf (buf, ", g_MAX_DIGITS, ", \"%d\", *(int *) ptr->value[loc]); value = buf; break; case 5: snprintf (buf, ", g_MAX_DIGITS, ", \"%d\", *(short *) ptr->value[loc]); value = buf; break; case 6: snprintf (buf, ", g_MAX_DIGITS, ", \"%d\", *(char *) ptr->value[loc]);" TO g_FUNCTIONS
WRITELN "value = buf; break; } __b2c__hash_add_redundant(inv, ptr->index[i], value); values[pos++] = ptr->value[loc]; } ptr = ptr->next; } while (ptr); qsort (&values[0], pos, sizeof (void *), compare); *array = (char**)calloc(__b2c__hash_nrkeys(name) + base, sizeof(char*)); keys = (char**)calloc(__b2c__hash_nrkeys(name) + base, sizeof(char*));" TO g_FUNCTIONS
WRITELN "count = base; for (i = 0; i < pos; i++) { if(type > 0) { keys[i] = (char*)calloc(", g_MAX_DIGITS, ", sizeof(char)); } switch (type) { case 0: keys[i] = __b2c__strdup((char*)values[i]); break; case 1: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%g\", *(double *) values[i]); break; case 2: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%g\", *(float *) values[i]); break;" TO g_FUNCTIONS
WRITELN "case 3: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%ld\", *(long *) values[i]); break; case 4: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(int *) values[i]); break; case 5: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(short *) values[i]); break; case 6: snprintf(keys[i], ", g_MAX_DIGITS, ", \"%d\", *(char *) values[i]); break; }" TO g_FUNCTIONS
WRITELN "value = (char*)__b2c__hash_find_value_do(inv, keys[i]); (*array)[count++] = __b2c__strdup (value); __b2c__hash_del_norebuild (inv, keys[i]); } do { if (type == 0) { while (cur < pos - 1 && !strcmp (keys[cur], keys[cur + 1])) { cur++; } } else { while (cur < pos - 1 && !memcmp (keys[cur], keys[cur + 1], sizeof(void*))) { cur++; }}" TO g_FUNCTIONS
WRITELN "qsort(&(*array)[start+base], cur - start + 1, sizeof(char*), __b2c__sortstr); for (j = start; j <= cur; j++) { free (keys[j]); } cur++; start = cur; } while (cur < pos); __b2c__hash_clear (inv); free (inv); free (values);" TO g_FUNCTIONS
WRITELN "free (keys); count -= base; } return (count); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "hex") OR nolex THEN
WRITELN "char *__b2c__dec2hex(int nr) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int len; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_MAX_DIGITS, ");" TO g_FUNCTIONS
WRITELN "len = snprintf(buf[idx], ", g_MAX_DIGITS, ", \"%X\", nr); __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "host") OR nolex THEN
WRITELN "char *__b2c__nethost(int l, char *k, char *host) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int y, flag = 0; struct hostent *he = NULL; unsigned char bf[sizeof(struct sockaddr_in*)]; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_BUFFER_SIZE, "); for (y = 0; host[y] != '\\0'; y++) { if (isalpha (*(host + y))) { flag = 1; break; } } if (flag){ he = gethostbyname (host); strncpy(buf[idx], inet_ntoa(*((struct in_addr*)he->h_addr)), ", g_BUFFER_SIZE, "); }" TO g_FUNCTIONS
WRITELN "else { if (inet_pton(AF_INET, host, bf) <= 0) { if (__b2c__trap) { ERROR = 11; RUNTIMEFERR (\"HOST$\", ERROR, k, l); return(NULL); } else { strncpy(buf[idx], \"Host not found\", ", g_BUFFER_SIZE, "); } }" TO g_FUNCTIONS
WRITELN "else { he = gethostbyaddr(bf, sizeof(struct sockaddr_in*), AF_INET); if(he == NULL) { if (__b2c__trap) { ERROR = 11; RUNTIMEFERR (\"HOST$\", ERROR, k, l); return(NULL); } else { strncpy(buf[idx], \"Host not found\", ", g_BUFFER_SIZE, "); } } else { strncpy(buf[idx], he->h_name, ", g_BUFFER_SIZE, "); } } }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], strlen(buf[idx])); buf[idx][", g_BUFFER_SIZE, "-1] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "hostname") OR nolex THEN
WRITELN "char *__b2c__hostname(int l, char *k) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], ", g_BUFFER_SIZE, " * sizeof (char));" TO g_FUNCTIONS
WRITELN "if(gethostname(buf[idx], ", g_BUFFER_SIZE, ")) { if (__b2c__trap) { ERROR = 26; RUNTIMEFERR(\"HOSTNAME$\", ERROR, k, l); return(NULL); } else strncpy (buf[idx], \"Error getting hostname\", ", g_BUFFER_SIZE, "); }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], strlen(buf[idx])); buf[idx][", g_BUFFER_SIZE, "-1] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "indexarray") OR nolex THEN
WRITELN "int __b2c__index (int line, char *k, size_t range, int type, void *array, int flag, ...) { int result = 0 + ", g_OPTION_BASE, "; double d; float f; long l; int i; short s; char c; char *term; void *index; int len = 0; va_list ap; va_start (ap, flag); if (flag == 0) { switch (type)" TO g_FUNCTIONS
WRITELN "{ case 0: term = va_arg(ap, char*); if ((index = lfind (&term, array, &range, sizeof (char *), __b2c__sortstr)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (char *) + 1; } break; case 1: d = va_arg (ap, double); if ((index = lfind (&d, array, &range, sizeof (double), __b2c__sortnrd)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (double) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 2: f = va_arg (ap, double); if ((index = lfind (&f, array, &range, sizeof (float), __b2c__sortnrf)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (float) + 1; } break; case 3: l = va_arg (ap, long); if ((index = lfind (&l, array, &range, sizeof (long), __b2c__sortnrl)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (long) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 4: i = va_arg (ap, int); if ((index = lfind (&i, array, &range, sizeof (int), __b2c__sortnri)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (int) + 1; } break; case 5: s = va_arg (ap, int); if ((index = lfind (&s, array, &range, sizeof (short), __b2c__sortnrs)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (short) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 6: c = va_arg (ap, int); if ((index = lfind (&c, array, &range, sizeof (char), __b2c__sortnrc)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (char) + 1; } break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INDEX\", ERROR, k, line); return(0); } } } else { switch (type)" TO g_FUNCTIONS
WRITELN "{ case 0: term = va_arg(ap, char*); if ((index = bsearch (&term, array, range, sizeof (char *), __b2c__sortstr)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (char *) + 1; } break; case 1: d = va_arg (ap, double); if ((index = bsearch (&d, array, range, sizeof (double), __b2c__sortnrd)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (double) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 2: f = va_arg (ap, double); if ((index = bsearch (&f, array, range, sizeof (float), __b2c__sortnrf)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (float) + 1; } break; case 3: l = va_arg (ap, long); if ((index = bsearch (&l, array, range, sizeof (long), __b2c__sortnrl)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (long) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 4: i = va_arg (ap, int); if ((index = bsearch (&i, array, range, sizeof (int), __b2c__sortnri)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (int) + 1; } break; case 5: s = va_arg (ap, int); if ((index = bsearch (&s, array, range, sizeof (short), __b2c__sortnrs)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (short) + 1; } break;" TO g_FUNCTIONS
WRITELN "case 6: c = va_arg (ap, int); if ((index = bsearch (&c, array, range, sizeof (char), __b2c__sortnrc)) != NULL) { result = ((uintptr_t) index - (uintptr_t) array) / sizeof (char) + 1; } break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INDEX\", ERROR, k, line); return(0); } } } va_end (ap); return (result - ", g_OPTION_BASE, "); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "indexassoc") OR nolex THEN
WRITELN "char *__b2c__index_assoc (int l, char *k, int type, __b2c__htable * name, ...) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; __b2c__htable *inv; unsigned short pos; char *value, *result; char bf[", g_MAX_DIGITS, " + 1] = { 0 }; int i, len; va_list ap; if(name == NULL || name->total == 0) { return (NULL); } inv = __b2c__hash_new (); do { for(i = 0; i < name->total; i++) { pos = __b2c__HashFNV1a_16(name->index[i]); switch(type) { case 0: value = (char*)name->value[pos];" TO g_FUNCTIONS
WRITELN "break; case 1: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(double *) name->value[pos]); value = bf; break; case 2: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(float *) name->value[pos]); value = bf; break; case 3: snprintf (bf, ", g_MAX_DIGITS, ", \"%ld\", *(long *) name->value[pos]); value = bf; break; case 4: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(int *) name->value[pos]); value = bf; break; case 5: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(short *) name->value[pos]); value = bf; break;" TO g_FUNCTIONS
WRITELN "case 6: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(char *) name->value[pos]); value = bf; break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INDEX$\", ERROR, k, l); return(NULL); } } __b2c__hash_add_redundant (inv, name->index[i], value); } name = name->next; } while (name); va_start (ap, name); switch (type) { case 0: value = va_arg (ap, char *); break; case 1: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", va_arg (ap, double)); value = bf; break;" TO g_FUNCTIONS
WRITELN "case 2: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", va_arg (ap, double)); value = bf; break; case 3: snprintf (bf, ", g_MAX_DIGITS, ", \"%ld\", va_arg (ap, long)); value = bf; break; case 4: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", va_arg (ap, int)); value = bf; break; case 5: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", va_arg (ap, int)); value = bf; break; case 6: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", va_arg (ap, int)); value = bf; break;" TO g_FUNCTIONS
WRITELN "default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INDEX$\", ERROR, k, l); return(NULL); } } va_end (ap); result = (char *) __b2c__hash_find_value_do (inv, value); idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } len = __b2c__len (result); buf[idx] = (char *) __b2c_str_realloc (buf[idx], len + 1); memmove (buf[idx], result, len); __b2c__SETLEN (buf[idx], len); buf[idx][len] = '\\0'; __b2c__hash_clear (inv); free (inv); return ((char *) buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "invert") OR nolex THEN
WRITELN "int __b2c__invert (int line, char *k, int type, __b2c__htable ** name) { __b2c__htable *inv, *ptr; char bf[", g_MAX_DIGITS, " + 1] = { 0 }; unsigned short pos; char *swap = NULL; int j, coll = 0; double d; float f; int i; long l; short s; char c; if (*name == NULL || (*name)->total == 0) { return (0); } inv = __b2c__hash_new (); ptr = *name; do { for (j = 0; j < ptr->total; j++) { pos = __b2c__HashFNV1a_16(ptr->index[j]); switch (type) { case 0: swap = (char*)ptr->value[pos]; break;" TO g_FUNCTIONS
WRITELN "case 1: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(double *) ptr->value[pos]); d = atof(ptr->index[j]); break; case 2: snprintf (bf, ", g_MAX_DIGITS, ", \"%g\", *(float *) ptr->value[pos]); f = atof(ptr->index[j]); break; case 3: snprintf (bf, ", g_MAX_DIGITS, ", \"%ld\", *(long *) ptr->value[pos]); l = atol(ptr->index[j]); break; case 4: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(int *) ptr->value[pos]); i = atoi(ptr->index[j]); break;" TO g_FUNCTIONS
WRITELN "case 5: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(short *) ptr->value[pos]); s = atoi(ptr->index[j]); break; case 6: snprintf (bf, ", g_MAX_DIGITS, ", \"%d\", *(char *) ptr->value[pos]); c = atoi(ptr->index[j]); break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INVERT\", ERROR, k, line); return(0); } } if(__b2c__hash_find_value_do(inv, bf) || __b2c__hash_find_value_do(inv, swap)) { coll++; } switch(type) { case 0: __b2c__hash_add_str(inv, ptr->index[j], swap); break;" TO g_FUNCTIONS
WRITELN "case 1: __b2c__hash_add(inv, &d, bf); break; case 2: __b2c__hash_add(inv, &f, bf); break; case 3: __b2c__hash_add(inv, &l, bf); break; case 4: __b2c__hash_add(inv, &i, bf); break; case 5: __b2c__hash_add(inv, &s, bf); break; case 6: __b2c__hash_add(inv, &c, bf); break; default: if (__b2c__trap) { ERROR = 43; RUNTIMEFERR (\"INVERT\", ERROR, k, line); return(0); } } } ptr = ptr->next; } while (ptr); __b2c__hash_clear (*name);" TO g_FUNCTIONS
WRITELN "free(*name); *name = inv; return(coll); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "insert") OR nolex THEN
WRITELN "char * __b2c__insert (int l, char *k, char *src, int pos, char *str) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len, tot, blen; if (str == NULL) { return (src); } if (src == NULL) { src = __b2c_EMPTYSTRING; } len = __b2c__len (src); tot = __b2c__len (str);" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+tot+1); pos--; if (pos <= 0) { memmove(buf[idx], str, tot); memmove(buf[idx] + tot, src, len); } else if (pos > len) { memmove(buf[idx], src, len);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + len, str, tot); } else { if (__b2c__option_utf8) { blen = __b2c__blen (l, k, \"INSERT$\", src, pos, 0); memmove(buf[idx], src, blen); memmove(buf[idx] + blen, str, tot);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + blen + tot, src + blen, len - blen); } else { memmove(buf[idx], src, pos); memmove(buf[idx] + pos, str, tot); memmove(buf[idx] + pos + tot, src + pos, len - pos); } }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], len + tot); buf[idx][len + tot] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "instring") OR nolex THEN
WRITELN "long __b2c__instr(int l, char *k, char *first, char *tmp, int pos) { char *result; if (first == NULL) { return (0); } if (tmp == NULL || __b2c__len (tmp) == 0) { return (0); } if (pos <= 0) { pos = 1; }" TO g_FUNCTIONS
WRITELN "result = strstr (first + pos - 1, tmp); if(result == NULL) { return (0); } if (__b2c__option_utf8) { return (long) __b2c__ucs2_clen (l, k, \"INSTR\", first, result - first + 1); } return (long) (result - first + 1); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "instrrev") OR nolex THEN
WRITELN "long __b2c__instrrev(int m, char *k, char *first, char *tmp, int pos) { char *result, *found; long l; if (first == NULL){ return (0);} if (tmp == NULL || __b2c__len (tmp) == 0) { return (0); } if (pos < 0) { pos = 0; }" TO g_FUNCTIONS
WRITELN "l = __b2c__len (first); found = first; do { result = strstr (found, tmp); if (result != NULL && result <= first + l - pos) { found = result + 1; continue; } if (result > first + l - pos) result = NULL; } while (result != NULL);" TO g_FUNCTIONS
WRITELN "if (__b2c__option_startpoint) { if (l - (found - first) + 1 > l) { return(0); } if (__b2c__option_utf8) { return (long) (__b2c__ulen (l, k, \"INSTRREV\", first, -1) - __b2c__ucs2_clen (l, k, \"INSTRREV\", first, found - first) + 1); }" TO g_FUNCTIONS
WRITELN "return (long) (l - (found - first) + 1); } if (__b2c__option_utf8) { return (long) __b2c__ucs2_clen (m, k, \"INSTRREV\", first, found - first); } return (long) (found - first); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "lcase") OR nolex THEN
WRITELN "char * __b2c__lcase(int l, char *k, char *src) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len, i; size_t mbslen; wchar_t *wcs, *wp; char *local; if (src == NULL) { return (NULL); } len = __b2c__len (src); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len+1); if (__b2c__option_utf8) { local = setlocale (LC_ALL, \"\"); if ((mbslen = mbstowcs (NULL, src, 0)) == (size_t) - 1) { ERROR = 38; RUNTIMEFERR (\"LCASE$\", ERROR, k, l); return(NULL); } wcs = (wchar_t*)calloc (mbslen + 1, sizeof (wchar_t));" TO g_FUNCTIONS
WRITELN "if(mbstowcs(wcs, src, mbslen + 1) == (size_t)-1) { ERROR = 38; RUNTIMEFERR (\"LCASE$\", ERROR, k, l); return(NULL); } for (wp = wcs; *wp != 0; wp++) { *wp = towlower (*wp); } if(wcstombs(buf[idx], wcs, len) == (size_t)-1) { ERROR = 38; RUNTIMEFERR (\"LCASE$\", ERROR, k, l); return(NULL); } free (wcs);" TO g_FUNCTIONS
WRITELN "setlocale (LC_ALL, local); } else { for (i = 0; i < len; i++) { buf[idx][i] = tolower(src[i]); } } __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "left") OR nolex THEN
WRITELN "char * __b2c__left(int l, char *k, char *src, unsigned long n) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned long length; if (src == NULL) { return (NULL); } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } length = __b2c__len (src);" TO g_FUNCTIONS
WRITELN "if (n > (__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"LEFT$\", src, length) : length)) { return(src); } else { if (__b2c__option_utf8)" TO g_FUNCTIONS
WRITELN "{ n = __b2c__blen (l, k, \"LEFT$\", src, n, 0); } buf[idx] = (char *) __b2c_str_realloc (buf[idx], n+1); memmove(buf[idx], src, n); __b2c__SETLEN (buf[idx], n); buf[idx][n] = '\\0'; } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "load") OR nolex THEN
WRITELN "char* __b2c__load(int flag, int l, char *k, char *file) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; FILE *handle; struct stat bf; void* mem; handle = fopen ((const char*)file, \"r\"); if(handle == NULL && __b2c__trap)" TO g_FUNCTIONS
WRITELN "{ ERROR = 2; RUNTIMEFERR (\"LOAD$/BLOAD\", ERROR, k, l); return(NULL); } if(stat(file, &bf) < 0 && __b2c__trap) { ERROR = 24; RUNTIMEFERR (\"LOAD$/BLOAD\", ERROR, k, l); return(NULL); } if(flag) { mem = calloc(bf.st_size+__b2c__option_memstream, sizeof(char));" TO g_FUNCTIONS
WRITELN "if(fread (mem, sizeof (char), bf.st_size, handle) != (size_t)bf.st_size && __b2c__trap) { ERROR = 2; RUNTIMEFERR(\"BLOAD\", ERROR, k, l); return(NULL); } fclose(handle); return(char*)(mem); } else" TO g_FUNCTIONS
WRITELN "{ idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], bf.st_size + 1); if(fread(buf[idx], sizeof (char), bf.st_size, handle) != (size_t)bf.st_size && __b2c__trap)" TO g_FUNCTIONS
WRITELN "{ ERROR = 2; RUNTIMEFERR (\"LOAD$\", ERROR, k, l); return(NULL); } __b2c__SETLEN(buf[idx], bf.st_size); buf[idx][bf.st_size] = '\\0'; fclose(handle); return(char*)(buf[idx]); } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "memcheck") OR nolex THEN
WRITELN "void __b2c__catch_signal(int sig){" TO g_FUNCTIONS
WRITELN "switch (sig) {case SIGABRT: fprintf(stderr, \"ERROR: signal ABORT received - internal error. Try to compile the program with TRAP LOCAL to find the cause.\\n\"); break;" TO g_FUNCTIONS
WRITELN "case SIGFPE: fprintf(stderr, \"ERROR: signal for FPE received - division by zero? Examine the calculations in the program.\\n\"); break;" TO g_FUNCTIONS
WRITELN "case SIGSEGV: fprintf(stderr, \"ERROR: signal for SEGMENTATION FAULT received - memory invalid or array out of bounds? Try to compile the program with TRAP LOCAL to find the cause.\\n\"); break;" TO g_FUNCTIONS
WRITELN "case SIGILL: fprintf(stderr, \"ERROR: signal for ILLEGAL INSTRUCTION received - executing the program on other hardware? Try to recompile the program from scratch.\\n\"); break;} exit(sig);}" TO g_FUNCTIONS
WRITELN "void __b2c__segv(int sig){ longjmp(__b2c__jump, 1); }" TO g_FUNCTIONS
WRITELN "int __b2c__memory__check (char *x, int size) { volatile char c; unsigned int i, illegal = 1; struct sigaction osa, psa; sigaction(SIGSEGV, NULL, &osa); if (osa.sa_handler != SIG_IGN)" TO g_FUNCTIONS
WRITELN "{ memset(&psa, 0, sizeof(psa)); psa.sa_flags = SA_NODEFER|SA_RESTART; psa.sa_handler = __b2c__segv; sigaction(SIGSEGV, &psa, NULL); } if (!setjmp (__b2c__jump))" TO g_FUNCTIONS
WRITELN "{ for (i = 0; i < size; i++) { c = *(char*)(x+i); /* Use c to avoid warning */ if(c) {;} } } else { illegal = 0; } sigaction(SIGSEGV, &osa, NULL); return (illegal); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "mid") OR nolex THEN
WRITELN "char *__b2c__mid(int l, char *k, char **swap, int type, char *src, long pos, long length) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long src_len; if (src == NULL) { if (type == 1) { *swap = __b2c_Copy_String (*swap, NULL); } return(NULL); }" TO g_FUNCTIONS
WRITELN "idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } src_len = __b2c__len (src); pos -= 1; if (pos < 0) { pos = (__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"MID$\", src, src_len) : src_len) + 1 + pos; } if (__b2c__option_utf8) { pos = __b2c__blen (l, k, \"MID$\", src, pos, 0); }" TO g_FUNCTIONS
WRITELN "if (pos > src_len) { if (type == 1) { *swap = __b2c_Copy_String (*swap, NULL); } return(NULL); } if (__b2c__option_utf8 && length >= 0) { length = __b2c__blen (l, k, \"MID$\", src + pos, length, 0); } if (length < 0 || pos + length > src_len) { length = src_len - pos; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], length + 1); memmove (buf[idx], src + pos, length); __b2c__SETLEN (buf[idx], length); buf[idx][length] = '\\0'; if (type == 1) { return (__b2c_Swap_String (swap, &buf[idx])); } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "minmax") OR nolex THEN
WRITELN "char* __b2c__min_str(char* x, char* y) {if(strcmp(x, y) < 0) { return(x); } return(y);}" TO g_FUNCTIONS
WRITELN "char* __b2c__max_str(char* x, char* y) {if(strcmp(x, y) > 0) { return(x); } return(y);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "os") OR nolex THEN
WRITELN "char *__b2c__os(int l, char *k) { static char *result = NULL ; struct utsname bf; unsigned int len = 0; if(!result) { result = (char*)__b2c_str_realloc(result, 256 * sizeof (char)); if (uname(&bf) < 0 && __b2c__trap)" TO g_FUNCTIONS
WRITELN "{ ERROR = 26; RUNTIMEFERR(\"OS$\", ERROR, k, l); return(NULL); } strncpy(result, bf.sysname, 64); len += strlen(bf.sysname); strncat(result, \" \", 2); len++; strncat(result, bf.machine, 128);" TO g_FUNCTIONS
WRITELN "len += strlen(bf.machine); __b2c__SETLEN(result, len); result[len] = '\\0'; } return(char*)result; }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "peek") OR nolex THEN
WRITELN "int __b2c__peek_check(int l, char *k, char* x, int size) {if(__b2c__trap) {if(!__b2c__memory__check((char*)x, size)) {ERROR=1; RUNTIMEFERR(\"PEEK\", ERROR, k, l); return(0); } } return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "recursive") OR nolex THEN
WRITELN "int __b2c__rmrecursive(int l, char *k, char *dir){DIR *mydir; char *path, *item = NULL; struct stat buf = { 0 }; struct dirent *next = { NULL }; mydir = opendir(dir); if(mydir == NULL) {if(__b2c__trap) {ERROR = 8; RUNTIMEFERR(\"DELETE RECURSIVE\", ERROR, k, l); return(0); } }" TO g_FUNCTIONS
WRITELN "while (1) { if (item != NULL) free(item); next = readdir(mydir); if(next != NULL) { item = (char*)calloc((strlen (next->d_name) + 1), sizeof(char));" TO g_FUNCTIONS
WRITELN "strcpy(item, next->d_name); } else { break; } if (!strcmp (item, \".\") || !strcmp(item, \"..\") ) continue; path = (char*)calloc(strlen(dir)+strlen(item)+2, sizeof(char));" TO g_FUNCTIONS
WRITELN "strcpy(path, dir); strcat(path, \"/\"); strcat(path, item); lstat(path, &buf); if(S_ISDIR (buf.st_mode)) { __b2c__rmrecursive(l, k, path); } else { if(remove(path) < 0)" TO g_FUNCTIONS
WRITELN "{ if(__b2c__trap) { ERROR = 7; RUNTIMEFERR(\"DELETE RECURSIVE\", ERROR, k, l); return(0); } } } if(path != NULL) free(path); } closedir(mydir); if(remove(dir) < 0)" TO g_FUNCTIONS
WRITELN "{ if(__b2c__trap) { ERROR = 7; RUNTIMEFERR(\"DELETE RECURSIVE\", ERROR, k, l); return(0); } } return(0);}" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "reverse") OR nolex THEN
WRITELN "char *__b2c__reverse(int l, char *k, char *src) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long i, length, len, blen; if (src == NULL) { return (NULL); } length = __b2c__len (src); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], length+1); if(__b2c__option_utf8) { len = length; while (len > 0) { blen = __b2c__blen (l, k, \"REVERSE$\", src, 1, 0); memcpy(buf[idx] + len - blen, src, blen); src += blen; len -= blen; } } else" TO g_FUNCTIONS
WRITELN "{ for (i = 0; i < length; i++) { buf[idx][i] = src[length-i-1]; } } __b2c__SETLEN(buf[idx], length); buf[idx][length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "right") OR nolex THEN
WRITELN "char * __b2c__right (int l, char *k, char *src, unsigned long n) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; unsigned long length; if (src == NULL) { return (NULL); } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } length = __b2c__len (src);" TO g_FUNCTIONS
WRITELN "if (n > (__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"RIGHT$\", src, length) : length)) { return(src); } else { if (__b2c__option_utf8)" TO g_FUNCTIONS
WRITELN "{ n = __b2c__blen (l, k, \"RIGHT$\", src, n, 1); } buf[idx] = (char*)__b2c_str_realloc(buf[idx], n+1); memmove(buf[idx], src + length - n, n); __b2c__SETLEN(buf[idx], n); buf[idx][n] = '\\0'; } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "rip") OR nolex THEN
WRITELN "char *__b2c__rip(int l, char *k, char *src, long pos, long length) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long src_len; if (src == NULL) { return (NULL); } src_len = __b2c__len (src); pos -= 1;" TO g_FUNCTIONS
WRITELN "if (pos < 0) { pos = (__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"RIP$\", src, src_len) : src_len) + 1 + pos; } if (__b2c__option_utf8) { pos = __b2c__blen (l, k, \"RIP$\", src, pos, 0); } if (pos > src_len)" TO g_FUNCTIONS
WRITELN "{ return (NULL); } if (__b2c__option_utf8 && length >= 0) { length = __b2c__blen (l, k, \"RIP$\", src + pos, length, 0); } if (length < 0 || pos + length > src_len)" TO g_FUNCTIONS
WRITELN "{ length = src_len - pos; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], src_len); memmove(buf[idx], src, pos); memmove(buf[idx]+pos, src+pos+length, src_len-pos-length);" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], src_len-length); buf[idx][src_len-length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "screen") OR nolex THEN
WRITELN "long __b2c__screen(int type){long x; struct winsize tmp; ioctl(STDOUT_FILENO, TIOCGWINSZ, &tmp); if(type) { x = tmp.ws_row; } else { x = tmp.ws_col; } return(x); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "search") OR nolex THEN
WRITELN "long __b2c__search (int l, char *k, FILE * x, char *y, int whence) { long off, pos=0, org_pos; int flag = 0; char *ptr; if (x == NULL && __b2c__trap)" TO g_FUNCTIONS
WRITELN "{ ERROR = 2; RUNTIMEFERR (\"SEARCH\", ERROR, k, l); return(0); } if (y == NULL && __b2c__trap) { ERROR = 25; RUNTIMEFERR (\"SEARCH\", ERROR, k, l); return(0); } org_pos = ftell (x); ptr = (char *) malloc (__b2c__len (y) + 1);" TO g_FUNCTIONS
WRITELN "switch(whence) { case -1: case 0: off = 1; break; case 1: off = 1; break; case 2: off = -1; break; case 3: off = -1; break; default: ERROR = 37; RUNTIMEFERR (\"SEARCH\", ERROR, k, l); return(0); } do { switch(whence) { case -1: case 0: fseek (x, pos, SEEK_SET);" TO g_FUNCTIONS
WRITELN "break; case 1: fseek (x, org_pos+pos, SEEK_SET);break; case 2: flag = fseek (x, org_pos- __b2c__len (y)+pos, SEEK_SET); break; case 3: fseek (x, pos-__b2c__len (y), SEEK_END); break; }" TO g_FUNCTIONS
WRITELN "if (fread (ptr, sizeof (char), __b2c__len (y), x) <= 0) { if (__b2c__trap) { ERROR = 2; RUNTIMEFERR (\"SEARCH\", ERROR, k, l); return(0); } } pos += off; } while (!feof (x) && !flag && memcmp (ptr, y, __b2c__len (y)));" TO g_FUNCTIONS
WRITELN "if (memcmp (ptr, y, __b2c__len (y))) { pos = -1; } else {pos = ftell(x)-__b2c__len (y); } fseek (x, org_pos, SEEK_SET); free (ptr); return(pos); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "spc") OR nolex THEN
WRITELN "char *__b2c__spc(int amount) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], amount+1);" TO g_FUNCTIONS
WRITELN "memset(buf[idx], 32, amount); __b2c__SETLEN(buf[idx], amount); buf[idx][amount] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "str") OR nolex THEN
WRITELN "char * __b2c__str(double nr) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int len; idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc (buf[idx], ", g_MAX_DIGITS, "); if(floor(nr) == nr)" TO g_FUNCTIONS
WRITELN "{ len = snprintf(buf[idx], ", g_MAX_DIGITS, ", \"%ld\", (long)nr); } else { len = snprintf(buf[idx], ", g_MAX_DIGITS, ", \"%g\", (double)nr); } __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "sum") OR nolex THEN
WRITELN "long __b2c__sum(int base, long *array, long nr, ...) { va_list ap; long limit = 0, total = 0; int x; va_start (ap, nr); limit = va_arg (ap, long); va_end (ap);" TO g_FUNCTIONS
WRITELN "for(x = base; x < nr+base; x++) { if(limit == LONG_MAX){ total += array[x]; } else { if(array[x]>limit) { total += array[x]; } } } return(total); }" TO g_FUNCTIONS
WRITELN "double __b2c__sumf(int base, double *array, double nr, ...) { va_list ap; double limit = 0, total = 0; int x; va_start (ap, nr); limit = va_arg (ap, double); va_end (ap);" TO g_FUNCTIONS
WRITELN "for(x = base; x < nr+base; x++) { if(limit == DBL_MAX){ total += array[x]; } else { if(array[x]>limit) { total += array[x]; } } } return(total); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "tab") OR nolex THEN
WRITELN "char *__b2c__tab(int amount) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], amount+1);" TO g_FUNCTIONS
WRITELN "memset(buf[idx], 9, amount); __b2c__SETLEN(buf[idx], amount); buf[idx][amount] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "tally") OR nolex THEN
WRITELN "long __b2c__tally(char *haystack, char *needle, int pos) { char *res; long total = 0; if (haystack == NULL) { return (0); }" TO g_FUNCTIONS
WRITELN "if (needle == NULL || __b2c__len(needle) == 0) { return (0); } if (pos <= 0) { pos = 1; }" TO g_FUNCTIONS
WRITELN "haystack+=pos-1; while((res = strstr(haystack, needle)) != NULL) { haystack = res+1; total++; } return((long)total); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "chrono") OR nolex THEN
WRITELN "long __b2c__time (time_t now, int which){ long result; char *buffer; struct tm *ts; buffer = (char*)calloc(", g_MAX_DIGITS, ", sizeof (char)); ts = localtime (&now); switch (which) {" TO g_FUNCTIONS
WRITELN "case 1: strftime (buffer, ", g_MAX_DIGITS, ", \"%d\", ts); break; case 2: strftime (buffer, ", g_MAX_DIGITS, ", \"%m\", ts); break; case 3: strftime (buffer, ", g_MAX_DIGITS, ", \"%Y\", ts); break;" TO g_FUNCTIONS
WRITELN "case 4: strftime (buffer, ", g_MAX_DIGITS, ", \"%H\", ts); break; case 5: strftime (buffer, ", g_MAX_DIGITS, ", \"%M\", ts); break; case 6: strftime (buffer, ", g_MAX_DIGITS, ", \"%S\", ts); break;" TO g_FUNCTIONS
WRITELN "case 7: strftime (buffer, ", g_MAX_DIGITS, ", \"%W\", ts); break; } result = atol(buffer); free(buffer); return(result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "timer") OR nolex THEN
WRITELN "unsigned long __b2c__timer(int init) { struct timeval time; static time_t elapsed_secs = 0; static int elapsed_usecs = 0; if(init) { gettimeofday(&time, NULL); elapsed_usecs = time.tv_usec; elapsed_secs = time.tv_sec; return(0); }" TO g_FUNCTIONS
WRITELN "else { gettimeofday(&time, NULL); if(difftime(time.tv_sec, elapsed_secs) < 1) { return((unsigned long) (time.tv_usec-elapsed_usecs)/1000); }" TO g_FUNCTIONS
WRITELN "else { return((unsigned long) (difftime(time.tv_sec, elapsed_secs)-1)*1000+((1000000-elapsed_usecs)+time.tv_usec)/1000); } } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "delimengine") OR nolex THEN
WRITELN "/* API >>>> nr == 0, use_cache == 0 : rebuild cache | nr != 0, use_cache == 0 : dynamic calc member | nr != 0, use_cache == 1 : use member from cache */" TO g_FUNCTIONS
WRITELN "long __b2c__delim_engine_core (int type, long *returned_value, char *string, char *delim, long nr, int use_cache) { static long *cache = NULL, cache_tot = 0, cnt = 0; long x, len, pos = 0, start = 0; int in_string = 0, is_escaped = 0; *returned_value = 0; if (string == NULL || string[0] == 0) { return (0); }" TO g_FUNCTIONS
WRITELN "if (delim == NULL) { delim = __b2c__option_delim; } len = __b2c__len (delim); if(!use_cache) { cnt = 0; for (x = 0; string[x] != 0; x++) { if (!in_string) { if (len == 1 ? string[x] == delim[0] : !strncmp (string + x, delim, len)) { if (__b2c__collapse == 0 || x > start) { cnt++; if (cnt > cache_tot)" TO g_FUNCTIONS
WRITELN "{ cache = (long*)realloc(cache, (cnt*2+2) * sizeof(long)); cache_tot = cnt; } cache[cnt * 2] = x - start; cache[cnt * 2 + 1] = start; } if(nr && nr == cnt) { break; } start = x + len; } } if (string[x] == __b2c__option_esc) { if (!is_escaped) { is_escaped = 1; } else { is_escaped = 0; } } else if (string[x] == __b2c__option_dq)" TO g_FUNCTIONS
WRITELN "{ if (!is_escaped && __b2c__option_quoted) { in_string = 1 - in_string; } is_escaped = 0; } else { is_escaped = 0; } } if (__b2c__collapse == 0 || x > start) { cnt++; if (cnt > cache_tot) { cache = (long*)realloc(cache, (cnt*2+2) * sizeof(long)); cache_tot = cnt; } cache[cnt * 2] = x - start;" TO g_FUNCTIONS
WRITELN "cache[cnt * 2 + 1] = start; } } if (nr <= cnt) { if (type == 1) { *returned_value = cache[nr*2]; pos = cache[nr*2+1]; } else { *returned_value = cnt; pos = cache[nr*2+1]; } } return(pos); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "argument") OR nolex THEN
WRITELN "void __b2c__argument(char **arg, int total, char **data) { long x, dlen, slen, pos, tot_len = 0; char quote[] = { 34, 0 }; if (total == 0) { *arg = NULL; } else { dlen = __b2c__len (__b2c__option_delim); for (pos = 0; pos < total; pos++)" TO g_FUNCTIONS
WRITELN "{ slen = strlen(data[pos]); *arg = (char *) realloc (*arg, tot_len + slen * 2 + dlen + 1); if (strstr (data[pos], \" \") || strstr (data[pos], \"\\\"\")) { (*arg)[tot_len++] = 34; for (x = 0; data[pos][x] != 0; x++) { if (data[pos][x] == quote[0])" TO g_FUNCTIONS
WRITELN "{ (*arg)[tot_len++] = __b2c__option_esc; } (*arg)[tot_len++] = data[pos][x]; } (*arg)[tot_len++] = 34; } else { memmove (*arg + tot_len, data[pos], slen); tot_len += slen; } if (pos < total - 1) { memmove (*arg + tot_len, __b2c__option_delim, dlen);" TO g_FUNCTIONS
WRITELN "tot_len += dlen; } } *(*arg + tot_len) = '\\0'; } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "token") OR nolex THEN
WRITELN "char *__b2c__token(char *string, long nr, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start; long length = 0; if (string == NULL || nr < 1) { return (NULL); }" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine(1, &length, string, delim, nr); if(length == 0) { return(NULL); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], length+1); memmove(buf[idx], string + start, length); __b2c__SETLEN(buf[idx], length); buf[idx][length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "where") OR nolex THEN
WRITELN "long __b2c__where(char *string, long nr, char *delim) { long result = 0, length = 0; if (string == NULL || nr < 1) { return (0); } result = __b2c__delim_engine (1, &length, string, delim, nr); return(result+1); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "amount") OR nolex THEN
WRITELN "long __b2c__amount(char *string, char *delim) { long amount = 0; if (string == NULL) { return (0); } __b2c__delim_engine(2, &amount, string, delim, 0); return(amount); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "hasdelim") OR nolex THEN
WRITELN "int __b2c__hasdelim (char *string, char *delim) { long length = 0; long start = 0; if (string == NULL) { return (0); }" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine (2, &length, string, delim, 2); if(start == 0) { return (0); } if (delim == NULL) { delim = __b2c__option_delim; } return (start-__b2c__len (delim)+1); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "exchange") OR nolex THEN
WRITELN "char *__b2c__exchange (char *string, int index1, int index2, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long tmp, tlen, len1, len2, start1 = 0, start2 = 0; long length = 0;" TO g_FUNCTIONS
WRITELN "if (string == NULL || index1 <= 0 || index2 <= 0) { return (string); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start1 = __b2c__delim_engine(1, &length, string, delim, index1);" TO g_FUNCTIONS
WRITELN "len1 = length; length = 0; start2 = __b2c__delim_engine(1, &length, string, delim, index2); len2 = length; if (start1 == start2) { return (string); } else if (start2 < start1)" TO g_FUNCTIONS
WRITELN "{ tmp = start2; start2 = start1; start1 = tmp; tmp = len2; len2 = len1; len1 = tmp; } tlen = __b2c__len (string); buf[idx] = (char*)__b2c_str_realloc(buf[idx], tlen+1); memmove(buf[idx], string, start1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + start1, string + start2, len2); memmove(buf[idx] + start1 + len2, string + start1 + len1, start2 - (start1 + len1));" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + start1 + len2 + start2 - (start1 + len1), string + start1, len1); memmove(buf[idx] + start1 + len2 + start2 - (start1 + len1) + len1, string + start2 + len2, tlen - (start2 + len2));" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], tlen); buf[idx][tlen] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "change") OR nolex THEN
WRITELN "char *__b2c__change(char *string, int index, char *cnew, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long tlen, start, len, nlen; long length = 0; if (string == NULL || index <= 0)" TO g_FUNCTIONS
WRITELN "{ return (string); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine(1, &length, string, delim, index); len = length; tlen = __b2c__len(string); nlen = __b2c__len(cnew);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], tlen-len+nlen+1); memmove(buf[idx], string, start); memmove(buf[idx] + start, cnew, nlen); memmove(buf[idx] + start + nlen, string + start + len, tlen - (start + len));" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], tlen - len + nlen); buf[idx][tlen-len+nlen] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "istok") OR nolex THEN
WRITELN "long __b2c__istoken(char *string, char *token, char *delim) { long len, start, x, result = 0; long length = 0, amount = 0; if(string == NULL) { return(0); } if(delim == NULL)" TO g_FUNCTIONS
WRITELN "{ delim = __b2c__option_delim; } len = __b2c__len(token); if(len==0) { return(0); } start = __b2c__delim_engine (2, &amount, string, delim, 0); for(x = 0; x < amount; x++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine_cache(1, &length, string, delim, x+1); if(len == length && memcmp(string + start, token, len) == 0) { result = x+1; break; } } return (result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "uniq") OR nolex THEN
WRITELN "char *__b2c__uniq(char *string, char *delim) { long x, start, amount = 0, length = 0; int t = 1; __b2c__htable *table; char *item, *result; if(string == NULL) { return (string); }" TO g_FUNCTIONS
WRITELN "if(delim == NULL) { delim = __b2c__option_delim; } start = __b2c__delim_engine (2, &amount, string, delim, 0); if(amount <= 1) { return (string); }" TO g_FUNCTIONS
WRITELN "table = __b2c__hash_new(); for (x = 0; x < amount; x++) { start = __b2c__delim_engine_cache(1, &length, string, delim, x+1); item = __b2c__strndup(string+start, length);" TO g_FUNCTIONS
WRITELN "if(!__b2c__hash_find_key(table, 0, item)) { __b2c__hash_add(table, &t, item); } free(item); } result = __b2c__hash_obtain(table, delim);" TO g_FUNCTIONS
WRITELN "__b2c__hash_clear(table); free(table); return(result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "sortdelim") OR nolex THEN
WRITELN "char *__b2c__sort(char *string, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char **array; char *buffer, *backup; long start, total = 0, x, len, dlen; long amount = 0; long length = 0;" TO g_FUNCTIONS
WRITELN "if(string == NULL) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } dlen = __b2c__len (delim); buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len(string)+1);" TO g_FUNCTIONS
WRITELN "buffer = __b2c__strdup (string); backup = buffer; start = __b2c__delim_engine (2, &amount, buffer, delim, 0); array = (char **) calloc(amount, sizeof (char *)); for (x = 0; x < amount; x++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine (1, &length, string, delim, 1); buffer[start + length] = '\\0'; if(buffer[start] == 34 && buffer[start+length-1] == 34) { buffer[start + length-1] = '\\0';" TO g_FUNCTIONS
WRITELN "array[x] = buffer + start + 1; } else { array[x] = buffer + start; } string += (start + length + dlen); buffer += (start + length + dlen); } qsort (&array[0], amount, sizeof (char *), __b2c__sortstr);" TO g_FUNCTIONS
WRITELN "for (x = 0; x < amount; x++) { len = strlen (array[x]); if(strstr(array[x], delim)) { buf[idx][total] = 34; memmove(buf[idx] + total+1, array[x], len);" TO g_FUNCTIONS
WRITELN "buf[idx][total+len+1] = 34; total += len+2;} else { memmove(buf[idx] + total, array[x], len); total += len; } if (x < amount - 1) { memmove(buf[idx] + total, delim, dlen);" TO g_FUNCTIONS
WRITELN "total += dlen; } } free (backup); free (array); __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "sortassoc") OR nolex THEN
WRITELN "void __b2c__assoc_sort(__b2c__htable **name, int type, int (*compare) (const void *, const void *)) { char **results = { NULL }; int total; char *value; __b2c__htable *ptr; int i; total = __b2c__lookup_by_sort(*name, &results, 0, 0, type, compare);" TO g_FUNCTIONS
WRITELN "ptr = __b2c__hash_new(); for (i = 0; i < total; i++) { value = (char *) __b2c__hash_find_value_do(*name, results[i]); if(type == 0) { __b2c__hash_add_str(ptr, value, results[i]); } else { __b2c__hash_add(ptr, value, results[i]); } } __b2c__hash_clear (*name); free (*name); *name = ptr;" TO g_FUNCTIONS
WRITELN "if(results) { __b2c__free_str_array_members(&results, 0, total); free(results); } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "revstr") OR nolex THEN
WRITELN "char *__b2c__rev(char *string, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, total, x, len, dlen; long amount = 0; long length = 0; if (string == NULL) { return (string); }" TO g_FUNCTIONS
WRITELN "len = __b2c__len (string); if (delim == NULL) { delim = __b2c__option_delim; } dlen = __b2c__len (delim); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + 1); total = len; for (x = 0; x < amount; x++) { start = __b2c__delim_engine_cache(1, &length, string, delim, x+1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + total-length, string + start, length); total -= length; if (x < amount-1) { memmove(buf[idx] + total-dlen, delim, dlen); total -= dlen; } }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "delimstr") OR nolex THEN
WRITELN "char *__b2c__delim(char *string, char *from, char *to) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, total = 0, x, tlen, dlen; long amount = 0; long length = 0; if (string == NULL) { return (string); }" TO g_FUNCTIONS
WRITELN "if(from == NULL) { from = __b2c__option_delim; } if(to == NULL) { to = __b2c__option_delim; } dlen = __b2c__len (from); tlen = __b2c__len (to); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, from, 0);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len(string)+amount*tlen+1); for (x = 0; x < amount; x++) { start = __b2c__delim_engine (1, &length, string, from, 1); memmove(buf[idx] + total, string + start, length);" TO g_FUNCTIONS
WRITELN "total += length; if (x < amount-1) { memmove(buf[idx] + total, to, tlen); total += tlen; } string += (start + length + dlen); } __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "head") OR nolex THEN
WRITELN "char *__b2c__head (char *string, long pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start; long amount = 0; long length = 0; if (string == NULL)" TO g_FUNCTIONS
WRITELN "{ return (string); } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0);" TO g_FUNCTIONS
WRITELN "if(amount < 1 || pos < 1) { return (NULL); } if (pos > amount) { pos = amount; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len(string)+1); start = __b2c__delim_engine_cache(1, &length, string, delim, pos);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx], string, start + length); __b2c__SETLEN(buf[idx], start + length); buf[idx][start + length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "tail") OR nolex THEN
WRITELN "char *__b2c__tail(char *string, long pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, slen; long amount = 0; long length = 0; if (string == NULL)" TO g_FUNCTIONS
WRITELN "{ return (string); } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0);" TO g_FUNCTIONS
WRITELN "if (amount < 1 || pos < 1) { return (NULL); } if (amount - pos + 1 < 1) { pos = 1; } else { pos = amount - pos + 1; } slen = __b2c__len (string); buf[idx] = (char*)__b2c_str_realloc(buf[idx], slen+1);" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine_cache(1, &length, string, delim, pos); memmove(buf[idx], string + start, slen-start); __b2c__SETLEN(buf[idx], slen-start); buf[idx][slen-start] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "append") OR nolex THEN
WRITELN "char *__b2c__append(char **swap, int type, char *string, long pos, char *cnew, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, dlen, slen, nlen, total = 0; long amount = 0; long length = 0; if (cnew == NULL || pos < 0)" TO g_FUNCTIONS
WRITELN "{ if (type == 1) { *swap = __b2c_Copy_String(*swap, string); } return (string); } if (string == NULL) { string = __b2c_EMPTYSTRING; } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0);" TO g_FUNCTIONS
WRITELN "dlen = __b2c__len (delim); nlen = __b2c__len (cnew); slen = __b2c__len (string); buf[idx] = (char *) __b2c_str_realloc (buf[idx], slen + nlen + dlen + 1); if (pos == 0 || pos > amount) { if (__b2c__collapse == 0 || (__b2c__collapse == 1 && slen > 0)) { memmove (buf[idx], string, slen);" TO g_FUNCTIONS
WRITELN "total += slen; } if (__b2c__collapse == 0 || (__b2c__collapse == 1 && nlen > 0)) { if(__b2c__collapse == 0 || total) { memmove (buf[idx] + total, delim, dlen); total += dlen; } memmove (buf[idx] + total, cnew, nlen); total += nlen; } } else { start = __b2c__delim_engine_cache (1, &length, string, delim, pos);" TO g_FUNCTIONS
WRITELN "memmove (buf[idx], string, start); total += start; memmove (buf[idx] + total, cnew, nlen); total += nlen; memmove (buf[idx] + total, delim, dlen); total += dlen; memmove (buf[idx] + total, string + start, slen - start); total += (slen - start); } __b2c__SETLEN (buf[idx], total);" TO g_FUNCTIONS
WRITELN "buf[idx][total] = '\\0'; if (type == 1) { return(__b2c_Swap_String(swap, &buf[idx])); } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "delstr") OR nolex THEN
WRITELN "char *__b2c__del(char *string, long pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, slen, dlen, total = 0; long amount = 0; long length = 0; if (string == NULL)" TO g_FUNCTIONS
WRITELN "{ return (string); } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0); if (pos < 1 || pos > amount)" TO g_FUNCTIONS
WRITELN "{ return(string); } dlen = __b2c__len (delim); slen = __b2c__len (string); buf[idx] = (char*)__b2c_str_realloc(buf[idx], slen + 1); start = __b2c__delim_engine_cache(1, &length, string, delim, pos); memmove(buf[idx], string, start);" TO g_FUNCTIONS
WRITELN "total += start; if (pos < amount) { memmove(buf[idx] + total, string + start + length + dlen, slen-(start + length + dlen)); total += slen-(start + length + dlen); }" TO g_FUNCTIONS
WRITELN "else { if(total >= dlen) { total -= dlen; } } __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "cut") OR nolex THEN
WRITELN "char *__b2c__cut(char *string, long pos1, long pos2, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start1, start2, tmp, total = 0; long amount = 0; long length = 0; if (string == NULL)" TO g_FUNCTIONS
WRITELN "{ return (string); } if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } if (pos1 > pos2) { tmp = pos1; pos1 = pos2; pos2 = tmp; } __b2c__delim_engine (2, &amount, string, delim, 0);" TO g_FUNCTIONS
WRITELN "if(pos1 < 1) { pos1 = 1; } if(pos2 > amount) { pos2 = amount; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len(string)+1); start1 = __b2c__delim_engine (1, &length, string, delim, pos1);" TO g_FUNCTIONS
WRITELN "start2 = __b2c__delim_engine (1, &length, string, delim, pos2); memmove(buf[idx], string + start1, start2-start1+length); total += (start2-start1+length); __b2c__SETLEN(buf[idx], total);" TO g_FUNCTIONS
WRITELN "buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "align") OR nolex THEN
WRITELN "char *__b2c__align (int l, char *k, char *str, unsigned long width, int mode, int indent) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, dlen, x, y, left, line_start = 0, paragraph_end = 0, last_write_pos, write_pos = 0, characters, last_read_pos, read_pos = 0, wtotal = 0, ctotal = 0, found = 0, tab, pos, spaces;" TO g_FUNCTIONS
WRITELN "int quoted, collapse, utf8, preserve = 0; long amount = 0, length = 0, total, lw; char *string = NULL, *backup, *concat, *wrap, *line; if (str == NULL) { return (str); } if (width < 1) { return (NULL); } collapse = __b2c__collapse; quoted = __b2c__option_quoted; utf8 = __b2c__option_utf8; __b2c__option_quoted = 0; backup = string = __b2c__strdup (str);" TO g_FUNCTIONS
WRITELN "if ((unsigned char) string[0] == 0xEF && (unsigned char) string[1] == 0xBB && (unsigned char) string[2] == 0xBF) { string += 3; __b2c__option_utf8 = 1; preserve = 1; } for (x = 0; string[x]; x++) { if (string[x] == 10 && string[x + 1] == 10) x++; else if (string[x] == 10) string[x] = 32; }" TO g_FUNCTIONS
WRITELN "dlen = 1; __b2c__collapse = 1; start = __b2c__delim_engine (2, &amount, string, \" \", 0); concat = (char *) calloc (x + amount + 1, sizeof (char)); for (x = 0; x < amount; x++) { start = __b2c__delim_engine_cache (1, &length, string, \" \", x+1); memmove (concat + ctotal, string + start, length); ctotal += length;" TO g_FUNCTIONS
WRITELN "if (x < amount - 1) { memset (concat + ctotal, 32, 1); ctotal += 1; } } free (backup); backup = wrap = (char *) calloc (ctotal + ctotal / width + 1, sizeof (char)); while (read_pos < ctotal) { if (*(concat + read_pos) == 32) { if (write_pos == 0) { read_pos++; continue; } else" TO g_FUNCTIONS
WRITELN "{ last_write_pos = wtotal; last_read_pos = read_pos; found = 1; } } memmove (wrap + wtotal, concat + read_pos, 1); write_pos++; wtotal++; if (*(concat + read_pos) == 10) { write_pos = 0; line_start = wtotal; } else if ((__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"ALIGN$\", wrap + line_start, write_pos) : write_pos) > width)" TO g_FUNCTIONS
WRITELN "{ if (found) { memset (wrap + last_write_pos, 10, 1); wtotal = last_write_pos + 1; read_pos = last_read_pos; if (*(concat + read_pos + 1) == 10) { read_pos++; } } else { memset (wrap + wtotal, 10, 1); wtotal += 1; } found = 0; write_pos = 0; line_start = wtotal; } read_pos++; } __b2c__collapse = 0;" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine (2, &amount, wrap, \"\\n\", 0); line_start = 0; idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char *) __b2c_str_realloc (buf[idx], amount * indent + amount * width * 4 + 3 + 1); if(preserve) { buf[idx][0] = 0xEF; buf[idx][1] = 0xBB; buf[idx][2] = 0xBF;" TO g_FUNCTIONS
WRITELN "line_start += 3; } line = (char *) calloc (width * 4, sizeof (char)); for (x = 1; x <= amount; x++) { __b2c__collapse = 0; paragraph_end = 0; start = __b2c__delim_engine (1, &length, wrap, \"\\n\", 1); if(length && (*(wrap + start + length + 1) == 10 || x == amount )) { paragraph_end = 1; } characters = (__b2c__option_utf8 ? __b2c__ucs2_clen (l, k, \"ALIGN$\", wrap + start, length) : length);" TO g_FUNCTIONS
WRITELN "switch (mode) { case 0: memset (buf[idx] + line_start, 32, indent); line_start += indent; memmove (buf[idx] + line_start, wrap + start, length); line_start += length; memset (buf[idx] + line_start, 32, width - characters); line_start += (width - characters); if (x < amount) { memset (buf[idx] + line_start, '\\n', 1); line_start++; } break;" TO g_FUNCTIONS
WRITELN "case 1: memset (buf[idx] + line_start, 32, indent); line_start += indent; memset (buf[idx] + line_start, 32, width - characters); line_start += (width - characters); memmove (buf[idx] + line_start, wrap + start, length); line_start += length; if (x < amount) { memset (buf[idx] + line_start, '\\n', 1); line_start++; } break;" TO g_FUNCTIONS
WRITELN "case 2: tab = (width - characters) / 2; memset (buf[idx] + line_start, 32, indent + tab); line_start += (indent + tab); memmove (buf[idx] + line_start, wrap + start, length); line_start += length; memset (buf[idx] + line_start, 32, tab + (width - characters) % 2); line_start += (tab + (width - characters) % 2); if (x < amount)" TO g_FUNCTIONS
WRITELN "{ memset (buf[idx] + line_start, '\\n', 1); line_start++; } break; case 3: memmove (line, wrap + start, length); line[length] = '\\0'; pos = __b2c__delim_engine (2, &total, line, \" \", 0); left = width - characters; spaces = total - 1; memset (buf[idx] + line_start, 32, indent); line_start += indent; for (y = 1; y <= total; y++)" TO g_FUNCTIONS
WRITELN "{ pos = __b2c__delim_engine_cache (1, &lw, line, \" \", y); memmove (buf[idx] + line_start, line + pos, lw); line_start += lw; if(y<total) { memset (buf[idx] + line_start, 32, 1); line_start++; if (left && total > 1 && !paragraph_end && y > (spaces/2)-(left/2)) { tab = (left < spaces ? 1 : left / spaces); memset (buf[idx] + line_start, 32, tab); left -= tab;" TO g_FUNCTIONS
WRITELN "spaces--; line_start += tab; } } } if (x < amount) { memset (buf[idx] + line_start, '\\n', 1); line_start++; } break; } wrap += (start + length + 1); } free (backup); free (concat); free (line); __b2c__option_quoted = quoted; __b2c__collapse = collapse; __b2c__option_utf8 = utf8; __b2c__SETLEN (buf[idx], line_start); buf[idx][line_start] = '\\0'; return (char *) (buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "bom") OR nolex THEN
WRITELN "int __b2c__hasbom(char *string) { if (string == NULL || __b2c__len(string) < 3) { return (0); } if ((unsigned char) string[0] == 0xEF && (unsigned char) string[1] == 0xBB && (unsigned char) string[2] == 0xBF) { return(1); } return(0); }" TO g_FUNCTIONS
WRITELN "char *__b2c__editbom(char *string, int edit) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int slen; if (string == NULL) { return (0); } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } slen = __b2c__len(string);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char *) __b2c_str_realloc (buf[idx], 3+slen+1); if(edit) { if ((unsigned char)string[0] == 0xEF && (unsigned char)string[1] == 0xBB && (unsigned char)string[2] == 0xBF) { return (string); } buf[idx][0] = 0xEF; buf[idx][1] = 0xBB;" TO g_FUNCTIONS
WRITELN "buf[idx][2] = 0xBF; memcpy(buf[idx]+3, string, slen); __b2c__SETLEN(buf[idx], slen+3); buf[idx][slen+3] = '\\0'; } else { if ((unsigned char)string[0] != 0xEF || (unsigned char)string[1] != 0xBB || (unsigned char)string[2] != 0xBF) { return(string); }" TO g_FUNCTIONS
WRITELN "memcpy(buf[idx], string+3, slen-3); __b2c__SETLEN(buf[idx], slen-3); buf[idx][slen-3] = '\\0'; } return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "proper") OR nolex THEN
WRITELN "char * __b2c__proper(int l, char *k, char *string, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *local; long start, total = 0, x, y, dlen, blen; long amount = 0; long length = 0; wchar_t wcs[8] = { 0 }; if (string == NULL) { return (string); }" TO g_FUNCTIONS
WRITELN "if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } dlen = __b2c__len (delim); start = __b2c__delim_engine (2, &amount, string, delim, 0); buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len (string)+1); if(__b2c__option_utf8)" TO g_FUNCTIONS
WRITELN "{ local = setlocale (LC_ALL, \"\"); for (x = 0; x < amount; x++) { start = __b2c__delim_engine (1, &length, string, delim, 1); blen = __b2c__blen (l, k, \"PROPER$\", string + start, 1, 0); if (mbtowc (wcs, string + start, blen) == (int) - 1) { ERROR = 38; RUNTIMEFERR (\"PROPER$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "*wcs = towupper (*wcs); if (wctomb(buf[idx] + total, *wcs) == (int) - 1) { ERROR = 38; RUNTIMEFERR (\"PROPER$\", ERROR, k, l); return(NULL); } for (y = blen; y < length; y += blen) { blen = __b2c__blen (l, k, \"PROPER$\", string + start + y, 1, 0); if (mbtowc (wcs, string + start + y, blen) == (int) - 1)" TO g_FUNCTIONS
WRITELN "{ ERROR = 38; RUNTIMEFERR (\"PROPER$\", ERROR, k, l); return(NULL); } if(__b2c__option_proper == 0) { *wcs = towlower (*wcs); } if (wctomb(buf[idx] + total + y, *wcs) == (int) - 1) { ERROR = 38; RUNTIMEFERR (\"PROPER$\", ERROR, k, l); return(NULL); } } total += length; if (x < amount-1) { memmove(buf[idx] + total, delim, dlen);" TO g_FUNCTIONS
WRITELN "total += dlen; } string += (start + length + dlen); } setlocale (LC_ALL, local); } else { for (x = 0; x < amount; x++) { start = __b2c__delim_engine (1, &length, string, delim, 1); *(buf[idx] + total) = toupper(*(string+start)); for (y = 1; y < length; y ++) { *(buf[idx]+total+y) = (__b2c__option_proper == 0 ? tolower(*(string+start+y)) : *(string+start+y)); } " TO g_FUNCTIONS
WRITELN "total += length; if (x < amount-1) { memmove(buf[idx] + total, delim, dlen); total += dlen; } string += (start + length + dlen); } } __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "rotate") OR nolex THEN
WRITELN "char *__b2c__rotate (char *string, int pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, total = 0, x, dlen; long amount = 0, length = 0; char *next; if (string == NULL) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } dlen = __b2c__len (delim); start = __b2c__delim_engine (2, &amount, string, delim, 0); if (amount <= 1) { return (string); } if (abs (pos) >= amount) { pos = pos % amount; } if (pos == 0) { return (string); } if (pos < 0)" TO g_FUNCTIONS
WRITELN "{ pos = amount + pos; } next = string; buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len (string) + 1); start = __b2c__delim_engine (1, &length, string, delim, amount-pos+1); string += start; for (x = amount - pos; x < amount; x++) { start = __b2c__delim_engine (1, &length, string, delim, 1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + total, string + start, length); total += length; memmove(buf[idx] + total, delim, dlen); total += dlen; string += (start + length + dlen); } for (x = 0; x < amount - pos; x++) { start = __b2c__delim_engine (1, &length, next, delim, 1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx] + total, next + start, length); total += length; if (x < amount - pos - 1) { memmove(buf[idx] + total, delim, dlen); total += dlen; } next += (start + length + dlen); }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN(buf[idx], total);buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "last") OR nolex THEN
WRITELN "char *__b2c__last (char *string, int pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, slen; long amount = 0; long length = 0; if (string == NULL) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0); if (pos <= 0) { return (string); } if (amount < 1 || pos >= amount) { return (NULL); } slen = __b2c__len (string); buf[idx] = (char*)__b2c_str_realloc(buf[idx], slen + 1);" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine_cache(1, &length, string, delim, pos+1); memmove(buf[idx], string + start, slen-start); __b2c__SETLEN(buf[idx], slen-start); buf[idx][slen-start] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "first") OR nolex THEN
WRITELN "char * __b2c__first (char *string, int pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long dlen, end; long amount = 0; long length = 0; if (string == NULL) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } end = __b2c__delim_engine (2, &amount, string, delim, 0); if (pos <= 0) { return (string); } if (amount < 1 || pos >= amount) { return (NULL); } buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len(string)+1);" TO g_FUNCTIONS
WRITELN "end = __b2c__delim_engine_cache(1, &length, string, delim, amount-pos+1); dlen = __b2c__len (delim); memmove(buf[idx], string, end-dlen); __b2c__SETLEN(buf[idx], end-dlen); buf[idx][end-dlen] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "match") OR nolex THEN
WRITELN "int __b2c__match(char *string1, char *string2, long count, char *delim) { long dlen, start1, start2, amount1, amount2, length1, length2, tmplen; int x, found = 1, wildcard = 0, after = 0; if (string1 == NULL && string2 == NULL) { return (1); }" TO g_FUNCTIONS
WRITELN "if (count == 0) { return (1); } if (delim == NULL) { delim = __b2c__option_delim; } start1 = __b2c__delim_engine (2, &amount1, string1, delim, 0); if (count > amount1) { return (0); } if(count == -1) { count = amount1; } dlen = __b2c__len (delim);" TO g_FUNCTIONS
WRITELN "for (x = 0; x < count; x++) { start1 = __b2c__delim_engine (1, &length1, string1, delim, 1); start2 = __b2c__delim_engine (1, &length2, string2, delim, 1); if (length1 == 0) { found = wildcard; break; } if (length2 == 0)" TO g_FUNCTIONS
WRITELN "{ found = wildcard; break; } if (strncmp (string2, \"?\", 1)) { if (!strncmp (string2, \"*\", 1)) { wildcard = 1; __b2c__delim_engine (2, &amount2, string2+1, delim, 0); if(amount2) { after = 1; string2+=1+dlen; } else { after = 0; found = wildcard; break; } }" TO g_FUNCTIONS
WRITELN "else { if (!strncmp (string2, \"\\\\?\", 2) || !strncmp (string2, \"\\\\*\", 2)) { string2++; length2--; } } __b2c__delim_engine (1, &tmplen, string2, delim, 1); if(length1 != tmplen || memcmp (string1, string2, tmplen)) { if (wildcard == 0) { found = 0; break; } else { string2 = string2-1-dlen; } }" TO g_FUNCTIONS
WRITELN "else { wildcard = 0; after = 0; } if(wildcard == 0) { string2 += (start2 + length1 + dlen); } } else { string2 += (start2 + length2 + dlen); } string1 += (start1 + length1 + dlen); } if(after) { found = 0; } return (found); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "explode") OR nolex THEN
WRITELN "char *__b2c__explode (int l, char *k, char *string, int pos, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long x, dlen, len, blen, ctr=0, where = 0, escaped = 0, in_string = 0; if (string == NULL || pos <= 0 || pos >= (len = __b2c__len (string)) ) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "dlen = __b2c__len (delim); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } blen = pos; buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + (len - 1) * dlen + 1); for (x = 0; x < len; x += blen) { if (__b2c__option_utf8) { blen = __b2c__blen(l, k, \"EXPLODE$\", string + x, pos, 0); } if(*(string+x) == __b2c__option_esc) { escaped = 1 - escaped; } if(*(string+x) == 34)" TO g_FUNCTIONS
WRITELN "{ if(!escaped && __b2c__option_quoted) { in_string = 1 - in_string; } escaped = 0; } else { escaped = 0; } memmove(buf[idx] + where, string + x, blen); where+=blen; if (x < (len - blen) && !in_string) { memmove(buf[idx] + where, delim, dlen); where+=dlen; ctr+=dlen; } } __b2c__SETLEN(buf[idx], len+ctr); buf[idx][len+ctr] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "merge") OR nolex THEN
WRITELN "char *__b2c__merge(char *string, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, total = 0, x; long amount = 0; long length = 0; if (string == NULL) { return (string); }" TO g_FUNCTIONS
WRITELN "if (delim == NULL) { delim = __b2c__option_delim; } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &amount, string, delim, 0); buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len (string) + 1); for(x = 1; x <= amount; x++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine_cache(1, &length, string, delim, x); memmove(buf[idx] + total, string + start, length); total += length; } __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "between") OR nolex THEN
WRITELN "char *__b2c__inbetween(int flag, char *haystack, char *lm, char *rm, int greedy) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *l, *pos; int collapse; long len, start, end=0, in, w1, w2; long length = 0;" TO g_FUNCTIONS
WRITELN "if (haystack == NULL || lm == NULL || rm == NULL) { return (NULL); } collapse = __b2c__collapse; __b2c__collapse = 0; idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } start = __b2c__delim_engine (2, &length, haystack, lm, 2);" TO g_FUNCTIONS
WRITELN "if (start == 0) { __b2c__collapse = collapse; return (NULL); } if (greedy == 0) { in = __b2c__delim_engine (2, &length, haystack+start+end, rm, 2); if (in == 0) { __b2c__collapse = collapse; return (NULL); }" TO g_FUNCTIONS
WRITELN "l = haystack+start-__b2c__len(lm); pos = haystack+start+in-__b2c__len(rm); } else if (greedy == 1) { while (1) { in = __b2c__delim_engine (2, &length, haystack+start+end, rm, 2); if(in) { end += in; } else { break; } }" TO g_FUNCTIONS
WRITELN "if (end == 0) { __b2c__collapse = collapse; return (NULL); } l = haystack+start-__b2c__len(lm); pos = haystack+start+end-__b2c__len(rm); } else { w1 = start; w2 = start;" TO g_FUNCTIONS
WRITELN "while (1) { end = __b2c__delim_engine (2, &length, haystack + w1, rm, 2); if (end == 0) { __b2c__collapse = collapse; return (NULL); } in = __b2c__delim_engine (2, &length, haystack + w2, lm, 2); if (in && ((w2 + in) < (w1 + end)))" TO g_FUNCTIONS
WRITELN "{ w1 = w1 + end; w2 = w2 + in; } else { break; } } l = haystack + start - __b2c__len (lm); pos = haystack + w1 + end - __b2c__len (rm); } if (flag) { pos += strlen (rm); len = strlen (pos); buf[idx] = (char*)__b2c_str_realloc(buf[idx], (l - haystack) + len + 1);" TO g_FUNCTIONS
WRITELN "memmove(buf[idx], haystack, l - haystack); memmove(buf[idx] + (l - haystack), pos, len); __b2c__SETLEN(buf[idx], (l - haystack) + len); buf[idx][(l - haystack) + len] = '\\0'; } else" TO g_FUNCTIONS
WRITELN "{ l += strlen (lm); buf[idx] = (char*)__b2c_str_realloc(buf[idx], pos - l + 1); memmove(buf[idx], l, pos - l); __b2c__SETLEN(buf[idx], pos - l); buf[idx][pos - l] = '\\0'; } __b2c__collapse = collapse; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "ucase") OR nolex THEN
WRITELN "char * __b2c__ucase(int l, char *k, char *src) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len, i; size_t mbslen; wchar_t *wcs, *wp; char *local; if (src == NULL) { return (NULL); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } len = __b2c__len (src);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + 1); if(__b2c__option_utf8) { local = setlocale (LC_ALL, \"\"); if ((mbslen = mbstowcs (NULL, src, 0)) == (size_t) - 1) { ERROR = 38; RUNTIMEFERR (\"UCASE$\", ERROR, k, l); return(NULL); } wcs = (wchar_t*)calloc (mbslen + 1, sizeof (wchar_t)); if (mbstowcs (wcs, src, mbslen + 1) == (size_t) - 1)" TO g_FUNCTIONS
WRITELN "{ ERROR = 38; RUNTIMEFERR (\"UCASE$\", ERROR, k, l); return(NULL); } for (wp = wcs; *wp != 0; wp++) { *wp = towupper (*wp); } if(wcstombs(buf[idx], wcs, len) == (size_t) - 1) { ERROR = 38; RUNTIMEFERR (\"UCASE$\", ERROR, k, l); return(NULL); } free (wcs);" TO g_FUNCTIONS
WRITELN "setlocale(LC_ALL, local); } else { for (i = 0; i < len; i++) { buf[idx][i] = toupper (src[i]); } } __b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "utf8") OR nolex THEN
WRITELN "int __b2c_utf8_conv(int txt, char* utf8) { unsigned char b1, b2, b3; int len; if (txt > 0xFFFF) { b1 = txt & 0x0000FF; b2 = (txt & 0x00FF00) >> 8; b3 = (txt & 0xFF0000) >> 16;" TO g_FUNCTIONS
WRITELN "len = snprintf (utf8, 5, \"%c%c%c%c\", 0xF0 | (b3 >> 2), 0x80 | ((b3 & 0x03) << 4) | ((b2 & 0xF0) >> 4), 0x80 | ((b2 & 0x0F) << 2) | ((b1 & 0xC0) >> 6)," TO g_FUNCTIONS
WRITELN "0x80 | (b1 & 0x3F)); } else if (txt > 0x07FF) { b1 = txt & 0x00FF; b2 = (txt & 0xFF00) >> 8; len = snprintf (utf8, 4, \"%c%c%c\", 0xE0 | ((b2 & 0xF0) >> 4)," TO g_FUNCTIONS
WRITELN "0x80 | ((b2 & 0x0F) << 2) | ((b1 & 0xC0) >> 6), 0x80 | (b1 & 0x3F)); } else if (txt > 0x007F) { b1 = txt & 0x00FF; b2 = (txt & 0xFF00) >> 8; len = snprintf (utf8, 3, \"%c%c\"," TO g_FUNCTIONS
WRITELN "0xC0 | (b2 << 2) | ((b1 & 0xC0) >> 6), 0x80 | (b1 & 0x3F)); } else { len = snprintf (utf8, 2, \"%c\", txt & 0x7F); } return(len); }" TO g_FUNCTIONS
WRITELN "unsigned long __b2c__ulen (int l, char *k, char *func, char *ptr, int pos) { long len = 0; if (ptr == NULL) { return(0); } if(pos < 0) { while(*ptr){ if((*ptr&0xF0) == 0xF0) { len++; ptr += 4; } else if((*ptr&0xE0) == 0xE0) { len++; ptr += 3; }" TO g_FUNCTIONS
WRITELN "else if((*ptr&0xC0) == 0xC0) { len++; ptr += 2; } else if((*ptr&0x80) == 0) { len++; ptr++; } else { ERROR = 38; RUNTIMEFERR(func, ERROR, k, l); return(0); } } } else { len = __b2c__ucs2_clen(l, k, \"ULEN\", ptr, pos); } return(len); }" TO g_FUNCTIONS
WRITELN "unsigned long __b2c__blen (int l, char *k, char *func, char *ptr, long c, int flag) { char *org = ptr; if (ptr == NULL){ return (0); }" TO g_FUNCTIONS
WRITELN "if(flag) { c = __b2c__ulen (l, k, \"BYTELEN\", org, -1)-c; } while (*ptr && c > 0) { if ((*ptr & 0xF0) == 0xF0) { ptr += 4; } else if ((*ptr & 0xE0) == 0xE0) { ptr += 3; } else if ((*ptr & 0xC0) == 0xC0) { ptr += 2; } else if ((*ptr & 0x80) == 0)" TO g_FUNCTIONS
WRITELN "{ ptr++; } else { ERROR = 38; fprintf (stderr, \"Cannot decode UTF-8 string: '%s'\\n\", org); RUNTIMEFERR (func, ERROR, k, l); return(0); } c--; } if(flag) { return (__b2c__len(org) - (ptr - org)); } else { return (ptr - org); } }" TO g_FUNCTIONS
WRITELN "unsigned long __b2c__ucs2_clen (int l, char* k, char *func, char *ptr, int c) { int len = 0; char *org; if (ptr == NULL) return (0); org = ptr; while (*ptr && c > 0) { if ((*ptr & 0xF0) == 0xF0) { ptr += 4; c -= 4; } else if ((*ptr & 0xE0) == 0xE0)" TO g_FUNCTIONS
WRITELN "{ ptr += 3; c -= 3; } else if ((*ptr & 0xC0) == 0xC0) { ptr += 2; c -= 2; } else if ((*ptr & 0x80) == 0) { ptr++; c--; } else { ERROR = 38; fprintf(stderr, \"Cannot decode UTF-8 string: '%s'\\n\", org); RUNTIMEFERR (func, ERROR, k, l); return(0); } len++; } return (len); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "wait") OR nolex THEN
WRITELN "long __b2c__netpeek(int l, char *k, uintptr_t fd, int usec){fd_set rfds; struct timeval tv; int desc = 0; long retval; struct termios oldt = { 0 }, newt = { 0 }; if(fd == STDIN_FILENO){tcgetattr(STDIN_FILENO, &oldt);" TO g_FUNCTIONS
WRITELN "newt = oldt; newt.c_lflag &= ~(ICANON | ECHO); newt.c_cc[VMIN]=1; newt.c_cc[VTIME]=0; tcsetattr(STDIN_FILENO, TCSANOW, &newt);} tv.tv_usec = (usec%1000)*1000; tv.tv_sec = usec/1000; FD_ZERO(&rfds);" TO g_FUNCTIONS
WRITELN "if(fd == STDIN_FILENO) { desc = fd; } else {" TO g_FUNCTIONS
IF g_OPTION_TLS THEN
IF TALLY(g_LIB_TLS$, "gnutls") THEN
WRITELN "if(__b2c__option_tls) { BIO_get_fd(((SSL*)fd)->gnutls_state, &desc); }" TO g_FUNCTIONS
ELSE
WRITELN "if(__b2c__option_tls) { desc = SSL_get_fd((SSL*)fd); }" TO g_FUNCTIONS
ENDIF
ENDIF
WRITELN "if(!__b2c__option_tls) { desc = fd; } }" TO g_FUNCTIONS
WRITELN "FD_SET(desc, &rfds); retval = select(desc + 1, &rfds, NULL, NULL, &tv); if(retval == -1 && __b2c__trap) { ERROR = 16; RUNTIMEFERR(\"WAIT\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
WRITELN "if(fd == STDIN_FILENO){ if(retval) if(read(fd, &retval, 1)==0) { retval=0; } tcsetattr(STDIN_FILENO, TCSANOW, &oldt);} return(retval); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "extract") OR nolex THEN
WRITELN "char *__b2c__extract (int l, char *k, char *src, char *needle, int flag) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; int reti = 0, len, pos = 0; char *tmp; regex_t regex; char __b2c__buf[100]; regmatch_t where[1];" TO g_FUNCTIONS
WRITELN "static __b2c__htable *table_icase = NULL, *table_normal = NULL; void *found = NULL; if (src == NULL || needle == NULL) { return (src); } if (__b2c__len (src) == 0 || __b2c__len (needle) == 0) { return (src); } idx++; if (idx == __b2c_STRING_FUNC)" TO g_FUNCTIONS
WRITELN "{ idx = 0; } buf[idx] = (char *) __b2c_str_realloc (buf[idx], __b2c__len (src) + 1); if (flag > 0) { if (__b2c__option_compare == 0) { if (table_normal == NULL) { table_normal = __b2c__hash_new(); } found = __b2c__hash_find_value_do(table_normal, needle);" TO g_FUNCTIONS
WRITELN "if(!found) { reti = regcomp(®ex, needle, REG_EXTENDED); if (reti == 0) { __b2c__hash_add_data(table_normal, (void *) ®ex, sizeof(regex), needle); } } else { regex = *(regex_t*)found; } } else { if (table_icase == NULL) { table_icase = __b2c__hash_new(); }" TO g_FUNCTIONS
WRITELN "found = __b2c__hash_find_value_do(table_icase, needle); if (!found) { reti = regcomp (®ex, needle, REG_EXTENDED|REG_ICASE); if (reti == 0) { __b2c__hash_add_data (table_icase, (void *) ®ex, sizeof (regex), needle); } } else { regex = *(regex_t*)found; } }" TO g_FUNCTIONS
WRITELN "if (__b2c__trap && reti) { ERROR = 27; regerror (reti, ®ex, __b2c__buf, sizeof (__b2c__buf)); fprintf (stderr, \"%s\\n\", __b2c__buf); RUNTIMEFERR(\"EXTRACT$\", ERROR, k, l); return (NULL); } while ((reti = regexec (®ex, src, 1, where, 0)) == 0)" TO g_FUNCTIONS
WRITELN "{ memcpy (buf[idx] + pos, src, (size_t) where[0].rm_so); pos += where[0].rm_so; src += (long) where[0].rm_eo; } len = strlen (src); memcpy (buf[idx] + pos, src, len); pos += len; } else { while ((tmp = strstr (src, needle)) != NULL)" TO g_FUNCTIONS
WRITELN "{ memcpy (buf[idx] + pos, src, (size_t) (tmp - src)); pos += tmp - src; src = tmp + __b2c__len (needle); } len = strlen (src); memcpy (buf[idx] + pos, src, len); pos += len; } __b2c__SETLEN (buf[idx], pos); buf[idx][pos] = '\\0'; return (char *) (buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "regex") OR nolex THEN
WRITELN "long __b2c__regex (int l, char *k, char *x, char *y) { regex_t reg; int reti = 0; char buf[100]; regmatch_t where[1]; static __b2c__htable *table_icase = NULL, *table_normal = NULL; void *found = NULL; if (x == NULL || y == NULL) { return (0); }" TO g_FUNCTIONS
WRITELN "if (__b2c__option_compare == 0) { if (table_normal == NULL) { table_normal = __b2c__hash_new(); } found = __b2c__hash_find_value_do (table_normal, y); if (!found) { reti = regcomp (®, y, REG_EXTENDED); if (reti == 0) { __b2c__hash_add_data (table_normal, (void *) ®, sizeof (reg), y); } }" TO g_FUNCTIONS
WRITELN "else { reg = *(regex_t*)found; } } else { if (table_icase == NULL) { table_icase = __b2c__hash_new(); } found = __b2c__hash_find_value_do (table_icase, y); if (!found) { reti = regcomp (®, y, REG_EXTENDED | REG_ICASE); if (reti == 0) { __b2c__hash_add_data (table_icase, (void *) ®, sizeof (reg), y); } }" TO g_FUNCTIONS
WRITELN "else { reg = *(regex_t*)found; } } if (__b2c__trap && reti) { ERROR = 27; regerror (reti, ®, buf, sizeof (buf)); fprintf(stderr, \"%s\\n\", buf); RUNTIMEFERR(\"REGEX\", ERROR, k, l); return (0); } reti = regexec (®, x, 1, where, 0); if (!reti) { REGLEN = where[0].rm_eo - where[0].rm_so;" TO g_FUNCTIONS
WRITELN "return (where[0].rm_so + 1); } else { REGLEN = 0; return (0); } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "replace") OR nolex THEN
WRITELN "char *__b2c__replace (int l, char *k, char *haystack, char *needle, char *replace, int flag) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; char *tmp; long replen, hstlen, ndllen, length = 0; regex_t regex; int i, reti = 0; char buffer[100]; regmatch_t where[1];" TO g_FUNCTIONS
WRITELN "static __b2c__htable *table_icase = NULL, *table_normal = NULL; void *found = NULL; if (haystack == NULL || needle == NULL) { return (haystack); } if (replace == NULL) { replace = __b2c_EMPTYSTRING; } ndllen = __b2c__len (needle); hstlen = __b2c__len (haystack); if (hstlen == 0 || ndllen == 0)" TO g_FUNCTIONS
WRITELN "{ return (haystack); } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } if (flag == 2) { buf[idx] = (char *) __b2c_str_realloc (buf[idx], hstlen + 1); strncpy (buf[idx], haystack, hstlen); for (i = 0; i < hstlen; i++) { if ((tmp = strchr (needle, buf[idx][i])) != NULL) { buf[idx][i] = replace[tmp - needle]; } }" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN (buf[idx], i); buf[idx][i] = '\\0'; return (char *) (buf[idx]); } buf[idx] = (char *) __b2c_str_realloc (buf[idx], sizeof (char)); buf[idx][0] = '\\0'; replen = __b2c__len (replace); if (flag == 1) { if (__b2c__option_compare == 0) { if (table_normal == NULL) { table_normal = __b2c__hash_new (); }" TO g_FUNCTIONS
WRITELN "found = __b2c__hash_find_value_do(table_normal, needle); if (!found) { reti = regcomp (®ex, needle, REG_EXTENDED); if (reti == 0) { __b2c__hash_add_data (table_normal, (void *) ®ex, sizeof (regex), needle); } } else { regex = *(regex_t*)found; } } else { if (table_icase == NULL)" TO g_FUNCTIONS
WRITELN "{ table_icase = __b2c__hash_new (); } found = __b2c__hash_find_value_do(table_icase, needle); if (!found) { reti = regcomp (®ex, needle, REG_EXTENDED | REG_ICASE); if (reti == 0) { __b2c__hash_add_data (table_icase, (void *) ®ex, sizeof (regex), needle); } } else { regex = *(regex_t*)found; } }" TO g_FUNCTIONS
WRITELN "if (__b2c__trap && reti) { ERROR = 27; regerror (reti, ®ex, buffer, sizeof (buffer)); fprintf (stderr, \"%s\\n\", buffer); RUNTIMEFERR (\"REPLACE$\", ERROR, k, l); return (NULL); } while ((reti = regexec (®ex, haystack, 1, where, 0)) == 0) { buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + where[0].rm_so + replen + 1);" TO g_FUNCTIONS
WRITELN "memcpy (buf[idx] + length, haystack, (size_t) where[0].rm_so); length += where[0].rm_so; memcpy (buf[idx] + length, replace, replen); length += replen; haystack += (long) where[0].rm_eo; }} else { while ((tmp = strstr (haystack, needle)) != NULL) { buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + tmp - haystack + replen + 1);" TO g_FUNCTIONS
WRITELN "memcpy (buf[idx] + length, haystack, (size_t) (tmp - haystack)); length += tmp - haystack; memcpy (buf[idx] + length, replace, replen); length += replen; haystack = tmp + ndllen; }} hstlen = strlen (haystack); buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + hstlen + 1); memcpy (buf[idx] + length, haystack, hstlen);" TO g_FUNCTIONS
WRITELN "length += hstlen; __b2c__SETLEN (buf[idx], length); buf[idx][length] = '\\0'; return (char *) (buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "walk") OR nolex THEN
WRITELN "#ifndef PATH_MAX" TO g_FUNCTIONS
WRITELN "#define PATH_MAX 4096" TO g_FUNCTIONS
WRITELN "#endif" TO g_FUNCTIONS
WRITELN "static int __b2c__walk_filter_file(regex_t reg, char *file, int type, struct stat bf) { regmatch_t where[1]; if (regexec(®, file, 1, where, 0) == 0) { if (((type & 1) && S_ISREG(bf.st_mode)) || ((type & 2) && S_ISDIR(bf.st_mode)) || ((type & 4) && S_ISCHR(bf.st_mode)) || ((type & 8) && S_ISBLK(bf.st_mode)) ||" TO g_FUNCTIONS
WRITELN " ((type & 16) && S_ISFIFO(bf.st_mode)) || ((type & 32) && S_ISLNK(bf.st_mode)) || ((type & 64) && S_ISSOCK(bf.st_mode))) { return(1); } } return(0); }" TO g_FUNCTIONS
WRITELN "static int __b2c__walk_each_file_recurse(regex_t reg, char **buf, char *dir, int type, char *delim) { FTS *fts; FTSENT *ent; struct stat bf; char *item[2]; int dlen, flen, total = 0, result = 0; item[0] = dir; item[1] = NULL; fts = fts_open(item, FTS_PHYSICAL | FTS_NOCHDIR | FTS_XDEV, NULL); if(fts == NULL)" TO g_FUNCTIONS
WRITELN "{ return(-1); } dlen = __b2c__len(delim); while(1) { ent = fts_read(fts); if(ent == NULL) { break; } if (lstat(ent->fts_path, &bf) < 0 && __b2c__trap) { result = -1; break; } if(__b2c__walk_filter_file(reg, ent->fts_path, type, bf))" TO g_FUNCTIONS
WRITELN "{ if(ent->fts_info != FTS_D) { flen = __b2c__len(ent->fts_path); *buf = (char*)__b2c_str_realloc(*buf, total+flen+dlen+1); memcpy(*buf+total, ent->fts_path, flen); memcpy(*buf+total+flen, delim, dlen);" TO g_FUNCTIONS
WRITELN "total += flen + dlen; } } } if(total == 0) { dlen = 0; } __b2c__SETLEN(*buf, total-dlen); (*buf)[total - dlen] = '\\0'; fts_close(fts); return (result); }" TO g_FUNCTIONS
WRITELN "static int __b2c__walk_each_file_dir (regex_t reg, char **buf, const char *dir, int type, char *delim) { DIR *here; struct dirent *item; struct stat bf; int dlen, flen, plen, total = 0, result = 0; char path[PATH_MAX] = { 0 }; here = opendir (dir); if (here == NULL) { return (-1); } dlen = __b2c__len(delim); plen = strlen(dir);" TO g_FUNCTIONS
WRITELN "if (plen >= PATH_MAX) { return (-1); } strncpy (path, dir, PATH_MAX - 1); plen++; if (plen >= PATH_MAX) { return (-1); } strncat (path, \"/\", PATH_MAX - plen - 1); while (1) { item = readdir (here); if (item == NULL) { break; } if (!strcmp (item->d_name, \".\") || !strcmp (item->d_name, \"..\")) { continue; } memset (path + plen, 0, 1);" TO g_FUNCTIONS
WRITELN "flen = strlen(item->d_name); if (plen + flen >= PATH_MAX) { return (-1); } strncat (path, item->d_name, PATH_MAX - plen - 1); flen += plen; if (lstat (path, &bf) < 0 && __b2c__trap) { result = -1; break; } if (__b2c__walk_filter_file (reg, path, type, bf)) { *buf = (char*)__b2c_str_realloc(*buf, total + flen + dlen + 1);" TO g_FUNCTIONS
WRITELN "memcpy(*buf+total, path, flen); memcpy(*buf+total+flen, delim, dlen); total += flen + dlen; } } if(total == 0) { dlen = 0; } __b2c__SETLEN(*buf, total - dlen); (*buf)[total - dlen] = '\\0'; closedir (here); return (result); }" TO g_FUNCTIONS
WRITELN "char *__b2c__walk (int l, char *k, char *dir, int type, char *exp, int recurse, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; regex_t reg; char buffer[100]; int reti = 0; static __b2c__htable *table_icase = NULL, *table_normal = NULL; void *found = NULL; if (dir == NULL || exp == NULL)" TO g_FUNCTIONS
WRITELN "{ return (NULL); } if (delim == NULL) { delim = __b2c__option_delim; } if ((type < 1 || type > 127) && __b2c__trap) { ERROR = 5; RUNTIMEFERR(\"WALK$\", ERROR, k, l); return (NULL); } if (__b2c__option_compare == 0) { if (table_normal == NULL) { table_normal = __b2c__hash_new (); } found = __b2c__hash_find_value_do (table_normal, exp);" TO g_FUNCTIONS
WRITELN "if (!found) { reti = regcomp (®, exp, REG_EXTENDED); if (reti == 0) { __b2c__hash_add_data (table_normal, (void *) ®, sizeof (reg), exp); } } else { reg = *(regex_t*)found; } } else { if (table_icase == NULL) { table_icase = __b2c__hash_new (); } found = __b2c__hash_find_value_do (table_icase, exp); if (!found)" TO g_FUNCTIONS
WRITELN "{ reti = regcomp (®, exp, REG_EXTENDED | REG_ICASE); if (reti == 0) { __b2c__hash_add_data (table_icase, (void *) ®, sizeof (reg), exp); } } else { reg = *(regex_t*)found; } } if (__b2c__trap && reti) { ERROR = 27; regerror (reti, ®, buffer, sizeof (buffer)); fprintf(stderr, \"%s\\n\", buffer); RUNTIMEFERR(\"WALK$\", ERROR, k, l);" TO g_FUNCTIONS
WRITELN "return (NULL); } idx++; if (idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char *) __b2c_str_realloc (buf[idx], PATH_MAX * sizeof (char)); if (recurse) { if (__b2c__walk_each_file_recurse (reg, &buf[idx], dir, type, delim) == -1) { ERROR = 24; RUNTIMEFERR(\"WALK$\", ERROR, k, l); return (NULL); } } else" TO g_FUNCTIONS
WRITELN "{ if (__b2c__walk_each_file_dir (reg, &buf[idx], dir, type, delim) == -1) { ERROR = 24; RUNTIMEFERR (\"WALK$\", ERROR, k, l); return (NULL); } } return (char *) (buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "eval") OR g_OPTION_EVAL THEN
WRITELN "#include <matheval.h>" TO g_FUNCTIONS
WRITELN "double __b2c__eval(int l, char *k, char **vars, double *vals, int nr, char *expr) { void *f; double result; if (expr == NULL) return (0); f = evaluator_create(expr);" TO g_FUNCTIONS
WRITELN "if(f) { result = evaluator_evaluate(f, nr, vars, vals); } else if (__b2c__trap) { ERROR = 39; RUNTIMEFERR(\"EVAL\", ERROR, k, l); return(0); } evaluator_destroy(f); return(result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getfile") OR nolex THEN
WRITELN "void __b2c__getfile(int l, char *k, char **result, DIR * from, int *type) { struct dirent *dir; *type = -1; dir = readdir (from); if (dir != NULL) { *result = __b2c__strdup (dir->d_name);\n#ifdef _DIRENT_HAVE_D_TYPE\nswitch (dir->d_type) { case DT_UNKNOWN: *type = 0; break;" TO g_FUNCTIONS
WRITELN "case DT_REG: *type = 1; break; case DT_DIR: *type = 2; break; case DT_FIFO: *type = 5; break; case DT_SOCK: *type = 7; break; case DT_CHR: *type = 3; break; case DT_BLK: *type = 4; break; case DT_LNK: *type = 6; break; default: if(__b2c__trap)" TO g_FUNCTIONS
WRITELN "{ ERROR = 24; RUNTIMEFERR(\"GETFILE\", ERROR, k, l); return; } }\n#endif\n } else { *result = NULL; } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "copy") OR nolex THEN
WRITELN "int __b2c__copy(const char *from, const char *to) { char buffer[", g_BUFFER_SIZE, "]; FILE *in, *out; size_t size; in = fopen(from, \"r\"); out = fopen(to, \"w\"); if(in == NULL || out == NULL) { return(1); }" TO g_FUNCTIONS
WRITELN "while((size = fread(buffer, sizeof(char), ", g_BUFFER_SIZE, ", in)) > 0) { if(fwrite(buffer, sizeof(char), size, out) != size) { return(1); } } fclose(in); fclose(out); return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "input") OR nolex THEN
WRITELN "void __b2c__input(int l, char *k, char **result, char *sep) { size_t size; ssize_t total; size = ", g_BUFFER_SIZE, "; *result = (char*)calloc(", g_BUFFER_SIZE, ", sizeof(char));" TO g_FUNCTIONS
WRITELN "total = getdelim(&(*result), &size, ASC(sep), stdin); if(total >= 0 && (*result)[total-1] == ASC(sep)) { (*result)[total-1] = '\\0'; } else if (__b2c__trap) { ERROR = 2; RUNTIMEFERR(\"INPUT\", ERROR, k, l); } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "readln") OR nolex THEN
WRITELN "void __b2c__readln(char **result, FILE *from) { size_t size; ssize_t total; size = ", g_BUFFER_SIZE, "; *result = (char*)calloc(", g_BUFFER_SIZE, ", sizeof(char));" TO g_FUNCTIONS
WRITELN "total = getline(&(*result), &size, from); if(total > 0 && (*result)[total-1] == '\\n') { (*result)[total-1] = '\\0'; } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "return") OR nolex THEN
WRITELN "char *__b2c__return (char *data) { static char *rbuffer[64] = { NULL }; static int rbuffer_ptr = 0; size_t size; rbuffer_ptr++; if (rbuffer_ptr >= 64) { rbuffer_ptr = 0; }" TO g_FUNCTIONS
WRITELN "size = __b2c__len (data); if(size == 0) { data = __b2c_EMPTYSTRING; } rbuffer[rbuffer_ptr] = (char *) __b2c_str_realloc (rbuffer[rbuffer_ptr], size + 1); memcpy (rbuffer[rbuffer_ptr], data, size + 1);" TO g_FUNCTIONS
WRITELN "__b2c__SETLEN (rbuffer[rbuffer_ptr], size); rbuffer[rbuffer_ptr][size] = '\\0'; return (rbuffer[rbuffer_ptr]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "join") OR nolex THEN
WRITELN "void __b2c__join (char **result, char **array, int base, int size, char *by) { long dlen, i, slen, total; dlen = __b2c__len (by); total = __b2c__len (array[0 + base]);" TO g_FUNCTIONS
WRITELN "*result = (char*)calloc(total, sizeof(char)+1); memmove(*result, array[0 + base], total); for (i = 1; i < size; i++) { if (array[i + base] != NULL) { slen = __b2c__len (array[i + base]);" TO g_FUNCTIONS
WRITELN "*result = (char *) realloc (*result, (total + dlen + slen + 1) * sizeof (char)); memmove (*result + total, by, dlen); total += dlen; memmove (*result + total, array[i + base], slen);" TO g_FUNCTIONS
WRITELN "total += slen; } } (*result)[total] = '\\0'; }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "network") OR nolex THEN
IF TALLY(g_LIB_TLS$, "gnutls") THEN
WRITELN "#define SSL_set_tlsext_host_name(connection, name) gnutls_server_name_set(((SSL*)connection)->gnutls_state, GNUTLS_NAME_DNS, name, LEN(name))" TO g_FUNCTIONS
WRITELN "#undef VERIFY" TO g_FUNCTIONS
WRITELN "long VERIFY(uintptr_t ssl, char* pem) { int result = 0; gnutls_certificate_credentials_t cred = 0; if((SSL*)ssl == NULL) { return(-1); }" TO g_FUNCTIONS
WRITELN "gnutls_certificate_allocate_credentials(&cred); gnutls_certificate_set_x509_trust_file(cred, pem, GNUTLS_X509_FMT_PEM);" TO g_FUNCTIONS
WRITELN "if(gnutls_credentials_set(((SSL*)ssl)->gnutls_state, GNUTLS_CRD_CERTIFICATE, cred) != 0) { return(-1); } if(gnutls_certificate_verify_peers2(((SSL*)ssl)->gnutls_state, &result) !=0) { return(-1); }" TO g_FUNCTIONS
WRITELN "gnutls_certificate_free_credentials(cred); return(result); }" TO g_FUNCTIONS
WRITELN "SSL_METHOD *TLS_client_method(void) { SSL_METHOD *tls; tls = calloc(1, sizeof(SSL_METHOD)); strncpy(tls->priority_string, \"NONE:PFS:+VERS-ALL:+VERS-DTLS-ALL:+MAC-ALL:+MAC-GOST-ALL:+KX-GOST-ALL:+CIPHER-GOST-ALL:+GROUP-ALL\", 256); tls->connend = 2; return(tls); }" TO g_FUNCTIONS
ENDIF
WRITELN "int __b2c__network_init(uintptr_t *handle, char *site, char *org, int sock_type, int sock_opt, char *nw_type, int multicast_ttl, int sctp_streams, int capeer, char *cacerts) { struct sockaddr_in *addr, *from; struct hostent *he;" TO g_FUNCTIONS
WRITELN "long amount = 0; long length = 0; char data_client[", g_BUFFER_SIZE, "]; char *host, *local, *port, *from_client; struct timeval tval; int sock, i, yes = 1; long start; char ttl = 1; __b2c__delim_engine (2, &amount, site, \",\", 0);" TO g_FUNCTIONS
WRITELN "addr = (struct sockaddr_in*)calloc(amount, sizeof(*addr)); for(i = 0; i < amount; i++) { start = __b2c__delim_engine (1, &length, site, \",\", i+1); if(length >= ", g_BUFFER_SIZE, ") { return(5); } memset(data_client, 0, ", g_BUFFER_SIZE, ");" TO g_FUNCTIONS
WRITELN "strncpy(data_client, site+start, length); if(strstr(data_client, \":\") == NULL) { return(10); } host = strtok(data_client, \":\"); port = strtok(NULL, \":\"); he = gethostbyname(host); if(he == NULL || he->h_addr == NULL) { return(11); }" TO g_FUNCTIONS
WRITELN "addr[i].sin_family = AF_INET; addr[i].sin_port = htons((long)atol(port)); addr[i].sin_addr = *((struct in_addr *) he->h_addr); }" TO g_FUNCTIONS
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "sock = socket(AF_INET, sock_type, IPPROTO_SCTP);" TO g_FUNCTIONS
ELSE
WRITELN "sock = socket(AF_INET, sock_type, 0);" TO g_FUNCTIONS
ENDIF
WRITELN "if(sock == -1) { return(12); } tval.tv_sec = sock_opt; tval.tv_usec = 0; setsockopt(sock, SOL_SOCKET, SO_SNDTIMEO, &tval, sizeof (struct timeval));" TO g_FUNCTIONS
WRITELN "setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof (int)); if(org) { __b2c__delim_engine (2, &amount, org, \",\", 0); from = (struct sockaddr_in*)calloc(amount, sizeof(*from));" TO g_FUNCTIONS
WRITELN "for(i = 0; i < amount; i++) { start = __b2c__delim_engine (1, &length, site, \",\", i+1); from_client = __b2c__strndup(org+start, length); if(strstr(from_client, \":\"))" TO g_FUNCTIONS
WRITELN "{ local = strtok(from_client, \":\"); port = strtok(NULL, \":\"); } else { local = from_client; port = NULL; } he = gethostbyname(local); if(he == NULL || he->h_addr == NULL) { return(11); }" TO g_FUNCTIONS
WRITELN "from[i].sin_family = AF_INET; if(port) { from[i].sin_port = htons((long)atol(port)); } from[i].sin_addr = *((struct in_addr *)he->h_addr); free(from_client); }" TO g_FUNCTIONS
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "if(sctp_bindx(sock, (struct sockaddr *)from, 1, SCTP_BINDX_ADD_ADDR) < 0) { return(17); } free(from); }" TO g_FUNCTIONS
WRITELN "struct sctp_initmsg initmsg; memset (&initmsg, 0, sizeof (initmsg)); initmsg.sinit_max_attempts = 3; initmsg.sinit_num_ostreams = sctp_streams; initmsg.sinit_max_instreams = sctp_streams;" TO g_FUNCTIONS
WRITELN "setsockopt(sock, IPPROTO_SCTP, SCTP_INITMSG, &initmsg, sizeof (initmsg));", NL$, "#ifdef SCTP_SOCKOPT_CONNECTX_OLD", NL$, "if(sctp_connectx(sock, (struct sockaddr *) addr, 1, NULL) < 0) { return(13); }" TO g_FUNCTIONS
WRITELN "#else", NL$, "if(sctp_connectx(sock, (struct sockaddr *) addr, 1) < 0) { return(13); }", NL$, "#endif" TO g_FUNCTIONS
ELSE
WRITELN "if(bind(sock, (struct sockaddr *)from, sizeof(struct sockaddr)) < 0) { return(17); } free(from); }" TO g_FUNCTIONS
WRITELN "if (!strcmp(nw_type, \"BROADCAST\")) { setsockopt(sock, SOL_SOCKET, SO_BROADCAST, &yes, sizeof(int)); } if(!strcmp(nw_type, \"MULTICAST\")) { setsockopt(sock, IPPROTO_IP, IP_MULTICAST_LOOP, &yes, sizeof(int));" TO g_FUNCTIONS
WRITELN "ttl = multicast_ttl; setsockopt(sock, IPPROTO_IP, IP_MULTICAST_TTL, &ttl, sizeof(unsigned char)); }" TO g_FUNCTIONS
WRITELN "if(connect(sock, (struct sockaddr*)addr, sizeof(struct sockaddr)) < 0) { return(13); }" TO g_FUNCTIONS
ENDIF
WRITELN "*handle = sock;" TO g_FUNCTIONS
IF g_OPTION_TLS THEN
WRITELN "if(__b2c__option_tls) { int ret; static SSL_CTX *ssl_context = NULL; SSL *ssl_sock; SSL_library_init(); if(ssl_context == NULL) { ssl_context = SSL_CTX_new(TLS_client_method()); } SSL_CTX_set_verify(ssl_context, capeer, NULL);" TO g_FUNCTIONS
IF NOT(TALLY(g_LIB_TLS$, "gnutls")) THEN WRITELN "SSL_CTX_load_verify_locations(ssl_context, cacerts, NULL);" TO g_FUNCTIONS
IF NOT(TALLY(g_LIB_TLS$, "gnutls")) AND NOT(TALLY(g_LIB_TLS$, "wolfssl")) THEN WRITELN "SSL_CTX_set_options(ssl_context, SSL_OP_LEGACY_SERVER_CONNECT);" TO g_FUNCTIONS
WRITELN "SSL_CTX_set_options(ssl_context, SSL_OP_ALL); ssl_sock = SSL_new(ssl_context); SSL_set_tlsext_host_name(ssl_sock, host); if(SSL_set_fd(ssl_sock, *handle) == 0) { return(40); }" TO g_FUNCTIONS
WRITELN "if((ret = SSL_connect(ssl_sock)) <= 0) { fprintf(stderr, \"SSL CONNECT error: %s\\n\", ERR_error_string(SSL_get_error(ssl_sock, ret), NULL)); return(40); }" TO g_FUNCTIONS
WRITELN "*handle = (uintptr_t)ssl_sock; }" TO g_FUNCTIONS
ENDIF
WRITELN "free(addr); return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "server") OR nolex THEN
IF TALLY(g_LIB_TLS$, "gnutls") THEN WRITELN "SSL_METHOD *TLS_server_method(void) { SSL_METHOD *tls; tls = calloc(1, sizeof(SSL_METHOD)); strncpy(tls->priority_string, \"NONE:PFS:+VERS-ALL:+VERS-DTLS-ALL:+CIPHER-ALL:+CIPHER-GOST-ALL:+MAC-ALL:+MAC-GOST-ALL\", 256); tls->connend = 1; return(tls); }" TO g_FUNCTIONS
WRITELN "int __b2c__server_init(uintptr_t *handle, char *site, int sock_type, int sock_opt, int sctp_streams) { struct sockaddr_in *addr; struct hostent *he; long amount = 0; long length = 0; char *host, *port;" TO g_FUNCTIONS
WRITELN "char data_client[", g_BUFFER_SIZE, "]; struct timeval tval; int fd, i, yes = 1; long start; __b2c__delim_engine (2, &amount, site, \",\", 0); addr = (struct sockaddr_in*)calloc(amount, sizeof(*addr)); for(i = 0; i < amount; i++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine(1, &length, site, \",\", i + 1); if (length >= ", g_BUFFER_SIZE, ") { return (5); } memset (data_client, 0, ", g_BUFFER_SIZE, "); strncpy(data_client, site + start, length);" TO g_FUNCTIONS
WRITELN "if(strstr(data_client, \":\") == NULL) { return(10); } host = strtok(data_client, \":\"); port = strtok(NULL, \":\"); if(strstr(site, \"INADDR_ANY:\") || strstr(site, \"*:\")) { addr[i].sin_addr.s_addr = htonl(INADDR_ANY); }" TO g_FUNCTIONS
WRITELN "else { he = gethostbyname(host); if(he == NULL || he->h_addr == NULL) { return(11); } addr[i].sin_addr = *((struct in_addr*)he->h_addr); }" TO g_FUNCTIONS
WRITELN "addr[i].sin_family = AF_INET; addr[i].sin_port = htons((long)atol(port)); }" TO g_FUNCTIONS
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "fd = socket(AF_INET, sock_type, IPPROTO_SCTP);" TO g_FUNCTIONS
WRITELN "struct sctp_initmsg initmsg; memset(&initmsg, 0, sizeof(initmsg)); initmsg.sinit_max_attempts = 3;" TO g_FUNCTIONS
WRITELN "initmsg.sinit_num_ostreams = sctp_streams; initmsg.sinit_max_instreams = sctp_streams;" TO g_FUNCTIONS
WRITELN "setsockopt(fd, IPPROTO_SCTP, SCTP_INITMSG, &initmsg, sizeof(initmsg));" TO g_FUNCTIONS
ELSE
WRITELN "fd = socket(AF_INET, sock_type, 0);" TO g_FUNCTIONS
ENDIF
WRITELN "if(fd == -1) { return(12); } tval.tv_sec = sock_opt; tval.tv_usec = 0; setsockopt(fd, SOL_SOCKET, SO_SNDTIMEO, &tval, sizeof(struct timeval));" TO g_FUNCTIONS
WRITELN "setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof(int));" TO g_FUNCTIONS
IF g_NETWORKTYPE$ = "SCTP" THEN
WRITELN "if(sctp_bindx(fd, (struct sockaddr *)addr, 1, SCTP_BINDX_ADD_ADDR) < 0) { return(17); }" TO g_FUNCTIONS
ELSE
WRITELN "if(bind(fd, (struct sockaddr *)addr, sizeof(struct sockaddr)) < 0) { return(17); }" TO g_FUNCTIONS
ENDIF
IF g_NETWORKTYPE$ = "MULTICAST" THEN
WRITELN "struct ip_mreq imreq; imreq.imr_multiaddr.s_addr = inet_addr(host); imreq.imr_interface.s_addr = INADDR_ANY;" TO g_FUNCTIONS
WRITELN "setsockopt(fd, IPPROTO_IP, IP_ADD_MEMBERSHIP, &imreq, sizeof(imreq));" TO g_FUNCTIONS
ENDIF
IF g_NETWORKTYPE$ <> "UDP" AND g_NETWORKTYPE$ <> "BROADCAST" AND g_NETWORKTYPE$ <> "MULTICAST" THEN
WRITELN "if(listen(fd, ", g_MAX_BACKLOG, ") < 0) { return(18); }" TO g_FUNCTIONS
ENDIF
WRITELN "*handle = fd; free(addr); return(0); }" TO g_FUNCTIONS
WRITELN "uintptr_t __b2c__accept(int l, char *k, char *priv, char *cert, uintptr_t fd) { uintptr_t handle; int desc, result; desc = accept(fd, NULL, 0); if(desc < 0){ ERROR = 19; RUNTIMEFERR(\"ACCEPT\", ERROR, k, l); return(0); }" TO g_FUNCTIONS
IF g_OPTION_TLS THEN
WRITELN "if(__b2c__option_tls) { static SSL_CTX *ssl_context = NULL; SSL *ssl_sock = NULL; if(ssl_context == NULL) { SSL_library_init(); ssl_context = SSL_CTX_new(TLS_server_method());" TO g_FUNCTIONS
WRITELN "if(SSL_CTX_use_PrivateKey_file(ssl_context, priv, SSL_FILETYPE_PEM) <= 0) { return(41); } if(SSL_CTX_use_certificate_file(ssl_context, cert, SSL_FILETYPE_PEM) <= 0) { return(41); } }" TO g_FUNCTIONS
WRITELN "ssl_sock = SSL_new(ssl_context); SSL_set_fd(ssl_sock, desc); if((result = SSL_accept(ssl_sock)) <= 0){ fprintf(stderr, \"SSL ACCEPT error: %s\\n\", ERR_error_string(SSL_get_error(ssl_sock, result), NULL));" TO g_FUNCTIONS
WRITELN "SSL_shutdown((SSL*)ssl_sock); SSL_free((SSL*)ssl_sock); return(-1); } handle = (uintptr_t)ssl_sock; }" TO g_FUNCTIONS
ELSE
WRITELN "if(!__b2c__option_tls) { handle = (uintptr_t)desc; }" TO g_FUNCTIONS
ENDIF
WRITELN "return(handle); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "save") OR nolex THEN
WRITELN "int __b2c__save(int mode, size_t size, char *file, ...) { FILE *outfile; va_list args; char *item; switch(mode){ case 0: case 1: outfile = fopen((const char *) file, \"w\"); break;" TO g_FUNCTIONS
WRITELN "case 2: case 3: outfile = fopen((const char *) file, \"a\"); break; } if (outfile == NULL) { return(2); } switch(mode) { case 0: case 2: va_start(args, file); while((item = va_arg(args, char*)) != NULL)" TO g_FUNCTIONS
WRITELN "{ fprintf(outfile, \"%s\", item); } va_end(args); break; case 1: case 3: va_start(args, file); if(fwrite(va_arg(args, void*), 1, size, outfile) != size){ return(2); } va_end(args); break; } fclose (outfile); return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "setserial") OR nolex THEN
WRITELN "int __b2c_setserial(int device, int mode, int param, int value, int donot) { struct termios tty; memset(&tty, 0, sizeof(tty)); if(tcgetattr(device, &tty) != 0) { return(33); } switch(mode)" TO g_FUNCTIONS
WRITELN "{ case 0: if(donot) { tty.c_iflag &= value; } else { tty.c_iflag |= value; } break; case 1: if(donot) { tty.c_oflag &= value; } else { tty.c_oflag |= value; } break; case 2: if(donot) { tty.c_cflag &= value; }" TO g_FUNCTIONS
WRITELN "else { tty.c_cflag |= value; } break; case 3: if(donot) { tty.c_lflag &= value; } else { tty.c_lflag |= value; } break; case 4: tty.c_cc[param] = value; break; case 5: cfsetospeed(&tty, value); cfsetispeed(&tty, value);" TO g_FUNCTIONS
WRITELN "break; } if(tcsetattr(device, TCSANOW, &tty) != 0) { return(33); } return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "getline") OR nolex THEN
WRITELN "char *__b2c__getline(char **handle) { char *pos, *result; if(*handle == NULL || (*handle)[0] == '\\0') { return(NULL); } else { pos = strchr(*handle, '\\n'); if(pos)" TO g_FUNCTIONS
WRITELN "{ result = __b2c__strndup(*handle, (size_t)(pos - *handle)); } else { result = __b2c__strdup(*handle); } *handle += __b2c__len(result); if((*handle)[0] == '\\n') { (*handle)++; } } return(result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "split") OR nolex THEN
WRITELN "void __b2c__split_by(char ***array, int base, long *amount, char *string, char *by) { long length, i, start; __b2c__free_str_array_members(&(*array), base, *amount); free(*array);" TO g_FUNCTIONS
WRITELN "*array = NULL; start = __b2c__delim_engine(2, amount, string, by, 0); *array = (char**)realloc(*array, (*amount+base) * sizeof(char*)); for (i = 0; i < *amount; i++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine_cache(1, &length, string, by, i+1); (*array)[i + base] =__b2c__strndup(string + start, (size_t)length); } }" TO g_FUNCTIONS
WRITELN "void __b2c__split_with(char ***array, int base, long *amount, char *string, int counter) { long length, i; __b2c__free_str_array_members (&(*array), base, *amount); free(*array); *array = NULL;" TO g_FUNCTIONS
WRITELN "length = __b2c__len(string); if (counter > length) { counter = length; } *amount = (length / counter) + (length % counter != 0 ? 1 : 0); *array = (char**)realloc(*array, (*amount+base)*sizeof(char*));" TO g_FUNCTIONS
WRITELN "if (counter > 0) { for (i = 0; i < *amount; i++) { (*array)[i + base] = __b2c__strndup(string + i*counter, (size_t)counter); } } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "for") OR nolex THEN
WRITELN "long __b2c__for_amount(char *string, char *step) { long amount = 0; __b2c__delim_engine(2, &amount, string, step, 0); return(amount); }" TO g_FUNCTIONS
WRITELN "void __b2c__for_item(char **string, char *step, char **result) { long length = 0; long start; start = __b2c__delim_engine (1, &length, *string, step, 1);" TO g_FUNCTIONS
WRITELN "*result = (char*)__b2c_str_realloc(*result, length + 1); memmove(*result, *string + start, length); __b2c__SETLEN (*result, length); (*result)[length] = '\\0'; *string += (start + length + __b2c__len(step)); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "makedir") OR nolex THEN
WRITELN "int __b2c__makedir(char *newdir) { long start, amount = 0, length = 0; int item, collapse; char *dir; if (newdir != NULL && *newdir != 0) { collapse = __b2c__collapse; __b2c__collapse = 0; dir = (char*)calloc(__b2c__len(newdir)+1, sizeof(char));" TO g_FUNCTIONS
WRITELN "start = __b2c__delim_engine(2, &amount, newdir, \"/\", 0); for(item = 1; item <= amount; item++) { start = __b2c__delim_engine(1, &length, newdir, \"/\", item); if(length) { strncat(dir, newdir+start, length);" TO g_FUNCTIONS
WRITELN "if(mkdir(dir, S_IRWXU | S_IRGRP | S_IXGRP | S_IROTH | S_IXOTH) < 0 && errno != EEXIST && errno != 0) { return(21); } } if(item < amount) { strcat(dir, \"/\"); } } free(dir); __b2c__collapse = collapse; } return(0); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "alarm") OR nolex THEN
WRITELN "void __b2c__alarm(void *func, long time) { void(*target)(int); struct itimerval alarm; struct sigaction psa; memset(&psa, 0, sizeof(psa)); psa.sa_flags = SA_RESETHAND|SA_RESTART;" TO g_FUNCTIONS
WRITELN "*((void**)&target) = func; psa.sa_handler = target; sigaction(SIGALRM, &psa, NULL); alarm.it_value.tv_sec = (long)(time)/1000; alarm.it_value.tv_usec = ((time)%1000)*1000;" TO g_FUNCTIONS
WRITELN "alarm.it_interval.tv_sec = 0; alarm.it_interval.tv_usec = 0; setitimer(ITIMER_REAL, &alarm, NULL); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "signal") OR nolex THEN
WRITELN "void __b2c__signal(void *func, int action) { void(*target)(int); struct sigaction psa; memset(&psa, 0, sizeof(psa)); *((void**)&target) = func; psa.sa_flags = SA_RESETHAND|SA_RESTART; psa.sa_handler = target; sigaction(action, &psa, NULL); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "cipher") OR g_OPTION_TLS THEN
WRITELN "char *__b2c__ca(int l, char *k, uintptr_t desc) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len; char buffer[4096] = { 0 }; X509 *cert; X509_NAME *name; if((SSL*)desc == NULL) { ERROR = 40; RUNTIMEFERR(\"CA$\", ERROR, k, l); return(NULL); } cert = (X509*)SSL_get_peer_certificate((SSL*)desc); if(cert==NULL) { ERROR = 41; RUNTIMEFERR(\"CA$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "name = X509_get_issuer_name(cert); X509_NAME_oneline(name, buffer, 4095); len = strlen(buffer); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + 1); memmove(buf[idx], buffer, len);__b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0';" TO g_FUNCTIONS
IF TALLY(g_LIB_TLS$, "gnutls") THEN WRITELN "free(name);" TO g_FUNCTIONS
WRITELN "X509_free(cert); return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__cn(int l, char *k, uintptr_t desc) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len; char buffer[4096] = { 0 }; X509 *cert; X509_NAME *name; if((SSL*)desc == NULL) { ERROR = 40; RUNTIMEFERR(\"CN$\", ERROR, k, l); return(NULL); } cert = (X509*)SSL_get_peer_certificate((SSL*)desc); if(cert==NULL) { ERROR = 41; RUNTIMEFERR(\"CA$\", ERROR, k, l); return(NULL); }" TO g_FUNCTIONS
WRITELN "name = X509_get_subject_name(cert); X509_NAME_oneline(name, buffer, 4095); len = strlen(buffer); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + 1); memmove(buf[idx], buffer, len);__b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0';" TO g_FUNCTIONS
IF TALLY(g_LIB_TLS$, "gnutls") THEN WRITELN "free(name);" TO g_FUNCTIONS
WRITELN "X509_free(cert); return(char*)(buf[idx]); }" TO g_FUNCTIONS
WRITELN "char *__b2c__cipher(int l, char *k, uintptr_t desc) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len; char buffer[4096] = { 0 }; if((SSL*)desc == NULL) { ERROR = 40; RUNTIMEFERR(\"CIPHER$\", ERROR, k, l); return(NULL); } SSL_CIPHER_description(SSL_get_current_cipher((SSL*)desc), buffer, 4095);" TO g_FUNCTIONS
WRITELN "len = strlen(buffer); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], len + 1); memmove(buf[idx], buffer, len);__b2c__SETLEN(buf[idx], len); buf[idx][len] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "doescape") OR nolex THEN
WRITELN "char *__b2c__escape(int l, char *k, char *string) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long slen, length = 0; unsigned int current; if (string == NULL) { return (string); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], sizeof(char));" TO g_FUNCTIONS
WRITELN "while(*string) { current = __b2c__utf8toasc(string); if(current > 0xffff) { buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + 11); snprintf(buf[idx]+length, 11, \"\\\\U%08X\", current); length += 10; } else if(current > 0x7f)" TO g_FUNCTIONS
WRITELN "{ buf[idx] = (char *) __b2c_str_realloc(buf[idx], length + 7); snprintf(buf[idx]+length, 7, \"\\\\u%04X\", current); length += 6; } else { buf[idx] = (char *) __b2c_str_realloc(buf[idx], length + 2);" TO g_FUNCTIONS
WRITELN "switch(current) { case 7: snprintf(buf[idx]+length, 3, \"\\\\a\"); length+=2; break; case 8: snprintf(buf[idx]+length, 3, \"\\\\b\"); length+=2; break; case 27: snprintf(buf[idx]+length, 3, \"\\\\e\"); length+=2; break;" TO g_FUNCTIONS
WRITELN "case 12: snprintf(buf[idx]+length, 3, \"\\\\f\"); length+=2; break; case 10: snprintf(buf[idx]+length, 3, \"\\\\n\"); length+=2; break; case 13: snprintf(buf[idx]+length, 3, \"\\\\r\"); length+=2; break;" TO g_FUNCTIONS
WRITELN "case 9: snprintf(buf[idx]+length, 3, \"\\\\t\"); length+=2; break; case 11: snprintf(buf[idx]+length, 3, \"\\\\v\"); length+=2; break; case 92: snprintf(buf[idx]+length, 3, \"\\\\\\\\\"); length+=2; break;" TO g_FUNCTIONS
WRITELN "case 39: snprintf(buf[idx]+length, 3, \"\\\\'\"); length+=2; break; case 34: snprintf(buf[idx]+length, 3, \"\\\\\\\"\"); length+=2; break; case 63: snprintf(buf[idx]+length, 3, \"\\\\?\"); length+=2; break;" TO g_FUNCTIONS
WRITELN "default: snprintf(buf[idx]+length, 2, \"%c\", current); length+=1; } } slen = __b2c__blen(l, k, \"ESCAPE$\", string, 1, 0); if(slen == 0) { break; } else {string += slen; } } __b2c__SETLEN(buf[idx], length); buf[idx][length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "unescape") OR nolex THEN
WRITELN "char *__b2c__unescape(int l, char *k, char *string) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long len, tlen, length = 0; char *pos, *status = NULL; char hex[9], buffer[9]; uint32_t byte; if (string == NULL) { return (string); } idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; }" TO g_FUNCTIONS
WRITELN "buf[idx] = (char*)__b2c_str_realloc(buf[idx], sizeof(char)); while((pos = strchr (string, 92)) != NULL) { switch (*(pos + 1)) { case 'u': case 'U': buf[idx] = (char *) __b2c_str_realloc (buf[idx], length + (pos - string)); memcpy(buf[idx] + length, string, (size_t) (pos - string));" TO g_FUNCTIONS
WRITELN "length += (uintptr_t) (pos - string); string = pos + 2; if (*(pos + 1) == 'u') { tlen = 4; } else { tlen = 8; } if (strlen (string) < tlen) { ERROR = 5; RUNTIMEFERR(\"UNESCAPE$\", ERROR, k, l); return(NULL); } strncpy (hex, string, tlen); hex[tlen] = '\\0';" TO g_FUNCTIONS
WRITELN "byte = strtol (hex, &status, 16); len = __b2c_utf8_conv (byte, buffer); buf[idx] = (char*)__b2c_str_realloc(buf[idx], length + len); memcpy(buf[idx] + length, buffer, len); string += tlen; length += len;" TO g_FUNCTIONS
WRITELN "break; default: buf[idx] = (char*)__b2c_str_realloc(buf[idx], length + (pos - string) + 1); memcpy(buf[idx] + length, string, (size_t) (pos - string)); length += (uintptr_t) (pos - string);" TO g_FUNCTIONS
WRITELN "switch (*(pos + 1)) { case 'a': byte = 7; string = pos + 2; break; case 'b': byte = 8; string = pos + 2; break; case 'e': byte = 27; string = pos + 2; break; case 'f': byte = 12; string = pos + 2; break; case 'n': byte = 10; string = pos + 2; break;" TO g_FUNCTIONS
WRITELN "case 'r': byte = 13; string = pos + 2; break; case 't': byte = 9; string = pos + 2; break; case 'v': byte = 11; string = pos + 2; break; case 92: byte = 92; string = pos + 2; break; case 39: byte = 39; string = pos + 2; break;" TO g_FUNCTIONS
WRITELN "case 34: byte = 34; string = pos + 2; break; case 63: byte = 63; string = pos + 2; break; default: byte = (uint8_t)(*(pos)); string = pos + 1; } buf[idx][length] = (uint8_t) byte; length += 1; } } len = strlen (string);" TO g_FUNCTIONS
WRITELN "buf[idx] = (char *) __b2c_str_realloc(buf[idx], length + len + 1); memcpy(buf[idx] + length, string, len); length += len; __b2c__SETLEN(buf[idx], length); buf[idx][length] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "tree") OR nolex THEN
WRITELN "void __b2c__treestr(void *node, char *str, void **tree, int(*func)(const void*, const void*)) { void *result; if(node) { result = tsearch(node, tree, func); if(*(uintptr_t**)result != (uintptr_t*)node) { free(str); free(node); } } }" TO g_FUNCTIONS
WRITELN "void __b2c__treenr(void *node, void **tree, int(*func)(const void*, const void*)) { void *result; if(node) { result = tsearch(node, tree, func); if(*(uintptr_t**)result != (uintptr_t*)node) { free(node); } } }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "find") OR nolex THEN
WRITELN "void *__b2c__find(int (*func)(const void*, const void*), void* tree, void* node) { void *result; result = tfind((void*)&node, &tree, func); if(result == NULL) { return(NULL); } return((void*)*(uintptr_t**)result); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "collect") OR nolex THEN
WRITELN "static void __b2c__collect_do(const void *node, VISIT which, int depth) { switch (which) { case postorder: case leaf: __b2c__twalk_idx++; __b2c__twalk_array = (void**)realloc(__b2c__twalk_array, sizeof(void*)*__b2c__twalk_idx);" TO g_FUNCTIONS
WRITELN "__b2c__twalk_array[__b2c__twalk_idx-1] = *(uintptr_t**)node; break; } }" TO g_FUNCTIONS
WRITELN "int __b2c__collect(void *tree, void ***array, int base) { int i, count; if(__b2c__twalk_array) { free(__b2c__twalk_array); __b2c__twalk_array = NULL; } __b2c__twalk_idx = 0; twalk(tree, __b2c__collect_do); count = base;" TO g_FUNCTIONS
WRITELN "*array = (void**)calloc(__b2c__twalk_idx, sizeof(void*)); for (i = 0; i < __b2c__twalk_idx; i++) { (*array)[count++] = *(uintptr_t**)__b2c__twalk_array[i]; } return (count-base); }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "parse") OR nolex THEN
WRITELN "void __b2c__parse(char ***array, int base, long *amount1, char *string, char *with, char *delim) { long dlen, start1, start2, amount2, length1, length2, tmplen, sublen = 0; int x, i = 0, wildcard = 0, next = 0; char *pos = NULL;" TO g_FUNCTIONS
WRITELN "__b2c__free_str_array_members (&(*array), base, *amount1); free (*array); *array = NULL; if (string == NULL && with == NULL) { *amount1 = 0; return; } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "start1 = __b2c__delim_engine (2, amount1, string, delim, 0); if(*amount1 == 0) { return; } *array = (char **) realloc (*array, (*amount1 + base) * sizeof (char *)); dlen = __b2c__len (delim);" TO g_FUNCTIONS
WRITELN "for (x = 0; x < *amount1; x++) { start1 = __b2c__delim_engine (1, &length1, string, delim, 1); start2 = __b2c__delim_engine (1, &length2, with, delim, 1); if(!strncmp (with, \"?\", 1))" TO g_FUNCTIONS
WRITELN "{ (*array)[i + base] = __b2c__strndup (string, (size_t) length1); i++; string += (start1 + length1 + dlen); with += (start2 + length2 + dlen); } else { next = 0; if(!strncmp (with, \"*\", 1))" TO g_FUNCTIONS
WRITELN "{ wildcard = 1; if(!pos) { pos = string; } __b2c__delim_engine (2, &amount2, with + 1, delim, 0); if(amount2) { next = 1 + dlen; } else { next = 1; } } else if(!strncmp(with, \"\\\\*\", 2) || !strncmp(with, \"\\\\?\", 2))" TO g_FUNCTIONS
WRITELN "{ with++; length2--; } __b2c__delim_engine (1, &tmplen, with + next, delim, 1); if(length1 != tmplen || memcmp(string, with+next, tmplen)) { if (wildcard == 1) { if(sublen == 0) { sublen += length1; } else { sublen += length1 + dlen; } }" TO g_FUNCTIONS
WRITELN "else { __b2c__free_str_array_members (&(*array), base, i); free (*array); *array = NULL; i = 0; break; } } else { if(wildcard) { (*array)[i + base] = __b2c__strndup(pos, (size_t)sublen); pos = NULL; sublen = 0; i++; } wildcard = 0; }" TO g_FUNCTIONS
WRITELN "string += (start1 + length1 + dlen); if (wildcard == 0) { with += (start2 + length1 + dlen + next); } } } if (wildcard) { (*array)[i + base] = __b2c__strndup (pos, (size_t) sublen); i++; } *amount1 = i; }" TO g_FUNCTIONS
ENDIF
IF TALLY(total$, "collapsefunc") OR nolex THEN
WRITELN "char *__b2c__collapse_func(char *string, char *delim) { static char *buf[__b2c_STRING_FUNC] = { NULL }; static int idx = 0; long start, dlen, option, x, total = 0; long amount = 0, length = 0; if (string == NULL) { return (string); } if (delim == NULL) { delim = __b2c__option_delim; }" TO g_FUNCTIONS
WRITELN "option = __b2c__collapse; __b2c__collapse = 1; dlen = __b2c__len (delim); idx++; if(idx == __b2c_STRING_FUNC) { idx = 0; } buf[idx] = (char*)__b2c_str_realloc(buf[idx], __b2c__len (string) + 1); __b2c__delim_engine(2, &amount, string, delim, 0); for (x = 0; x < amount; x++)" TO g_FUNCTIONS
WRITELN "{ start = __b2c__delim_engine (1, &length, string, delim, 1); memmove(buf[idx] + total, string + start, length); total += length; if (x < amount - 1) { memmove(buf[idx] + total, delim, dlen); total += dlen; }" TO g_FUNCTIONS
WRITELN "string += (start + length); } __b2c__collapse = option; __b2c__SETLEN(buf[idx], total); buf[idx][total] = '\\0'; return(char*)(buf[idx]); }" TO g_FUNCTIONS
ENDIF
CLOSE FILE g_FUNCTIONS
' Check MEMORY/FREE
IF g_SEMANTIC = 0 THEN
LOOKUP g_SEMANTIC_MEMFREE$ TO semantic$ SIZE COUNTER
WHILE COUNTER > 0
IF LEN(g_SEMANTIC_MEMFREE$(semantic$[COUNTER])) THEN EPRINT "WARNING: no FREE for the memory address ", g_SEMANTIC_MEMFREE$(semantic$[COUNTER]), "!"
DECR COUNTER
WEND
ENDIF
' Check OPEN/CLOSE handles
IF g_SEMANTIC = 0 THEN
LOOKUP g_SEMANTIC_OPENCLOSE$ TO semantic$ SIZE COUNTER
WHILE COUNTER > 0
IF LEN(g_SEMANTIC_OPENCLOSE$(semantic$[COUNTER])) THEN EPRINT "WARNING: no CLOSE for the OPEN handle ", g_SEMANTIC_OPENCLOSE$(semantic$[COUNTER]), "!"
DECR COUNTER
WEND
ENDIF
' Show error in case function has no end
IF LEN(g_FUNCNAME$) THEN
EPRINT "Syntax error: the SUB/FUNCTION '", g_FUNCNAME$, "' has no END in file '", g_CURFILE$, "'!"
END 1
ENDIF
' Start indentation
IF ISTRUE(g_TMP_PRESERVE) THEN
IF ISTRUE(LEN(EXEC$("command -v indent 2>/dev/null"))) THEN
PRINT "Applying indentation... ";
FOR tmpfile$ IN g_TMP_FILES$
IF NOT(REGEX(tmpfile$, ".*\\.cpp")) AND NOT(REGEX(tmpfile$, ".*\\.tmp")) AND NOT(REGEX(tmpfile$, ".*\\.bac$")) AND NOT(REGEX(tmpfile$, ".*\\.lex$")) AND NOT(REGEX(tmpfile$, ".*\\.exe$")) THEN
IF ISTRUE(INSTR(OS$, "Darwin")) OR ISTRUE(INSTR(OS$, "BSD")) THEN
RENAME tmpfile$ TO tmpfile$ & ".BAK"
SYSTEM "indent " & tmpfile$ & ".BAK " & tmpfile$
DELETE FILE tmpfile$ & ".BAK"
ELSE
'SYSTEM "indent " & tmpfile$
SYSTEM "indent -bad -bap -bli0 -cli4 -cbi0 -nbc -nbfda -nsc -nprs -bls -blf -lp -ts4 -ppi2 -npsl -i4 -il4 -l140 -nbbo " & tmpfile$
DELETE FILE tmpfile$ & "~"
END IF
END IF
NEXT
PRINT "done."
ELSE
PRINT "WARNING: 'indent' not found on this system!"
PRINT "Generated source code cannot be beautified."
END IF
END IF
' Check if we need to run xgettext
IF g_XGETTEXT THEN
IF ISTRUE(LEN(EXEC$("command -v xgettext 2>/dev/null"))) THEN
PRINT "Executing xgettext... ";
SYSTEM "xgettext --keyword=INTL" & g_STRINGSIGN$ & " --keyword=NNTL" & g_STRINGSIGN$ & ":1,2 -d " & BASENAME$(g_SOURCEFILE$, 1) & " -s -o " & BASENAME$(g_SOURCEFILE$, 1) & ".pot " & g_TMP_FILES$
IF FILEEXISTS(BASENAME$(g_SOURCEFILE$, 1) & ".pot") THEN
PRINT "done."
ELSE
PRINT "WARNING: catalog file not created!"
END IF
ELSE
PRINT "WARNING: 'xgettext' not found on this system!"
END IF
END IF
' Creation of the Makefile
OPEN g_TEMPDIR$ & "/Makefile.bacon" FOR WRITING AS makefile
WRITELN "# Created with BaCon ", g_VERSION$, " - (c) Peter van Eerten - MIT License", NL$ TO makefile
WRITELN BASENAME$(g_SOURCEFILE$, 1), g_BINEXT$, ": ", BASENAME$(g_SOURCEFILE$), ".o" TO makefile
WRITELN TAB$(1), g_CCNAME$, " -o ", BASENAME$(g_SOURCEFILE$, 1), g_BINEXT$, " ", BASENAME$(g_SOURCEFILE$), ".o ", g_LDFLAGS$, " ", g_LIB_TLS$, " -lm" TO makefile
WRITELN BASENAME$(g_SOURCEFILE$), ".o: ", BASENAME$(g_SOURCEFILE$), ".c" TO makefile
WRITELN TAB$(1), g_CCNAME$, " ", g_CCFLAGS$, " -c ", BASENAME$(g_SOURCEFILE$), ".c" TO makefile
WRITELN NL$, ".PHONY: clean" TO makefile
WRITELN "clean:" TO makefile
WRITELN TAB$(1), "rm -f *.o *.c ", BASENAME$(g_SOURCEFILE$, 1), g_BINEXT$, " ", BASENAME$(g_SOURCEFILE$, 1), ".*.* Makefile.bacon" TO makefile
CLOSE FILE makefile
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_TEMPDIR$ & "/Makefile.bacon"
' Start compilation
IF ISFALSE(g_NO_COMPILE) THEN
IF ISFALSE(LEN(EXEC$("command -v " & g_CCNAME$ & " 2>/dev/null"))) THEN
EPRINT "ERROR: '", g_CCNAME$, "' not found on this system!"
EPRINT "Generated source code cannot be compiled."
END 0
END IF
PRINT "Compiling '", g_SOURCEFILE$, "'... ";
' Make sure GCC uses English localization
SETENVIRON "LANG", "C"
old_curdir$ = CURDIR$
CHANGEDIR g_TEMPDIR$
SYSTEM "make -f Makefile.bacon 2>" & BASENAME$(g_SOURCEFILE$) & ".log"
RETURN_CODE = RETVAL
' Go back to working directory
CHANGEDIR old_curdir$
' Add temp file
g_TMP_FILES$ = g_TMP_FILES$ & " " & g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$) & ".log " & g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$) & ".o"
IF ISFALSE(FILELEN(g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$) & ".log")) THEN
PRINT "Done, program '", BASENAME$(g_SOURCEFILE$, 1), g_BINEXT$, "' ready."
IF g_EXEC THEN SYSTEM g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$, 1)
ELSE
FOR line$ IN LOAD$(g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$) & ".log") STEP NL$
IF REGEX(line$, "\\.generic\\.h") THEN CONTINUE
IF REGEX(line$, "error:|warning:|note:") THEN
line$ = REPLACE$(line$, g_STRINGSIGN$, "$")
line$ = REPLACE$(line$, g_FLOATSIGN$, "#")
line$ = REPLACE$(line$, g_LONGSIGN$, "%")
EPRINT line$
BREAK
ENDIF
NEXT
IF NOT(g_QUIET) THEN
INPUT NL$, "INFO: see full error report (y/[n])? ", answer$
IF LCASE$(answer$) = "y" THEN
line$ = LOAD$(g_TEMPDIR$ & "/" & BASENAME$(g_SOURCEFILE$) & ".log")
line$ = REPLACE$(line$, g_STRINGSIGN$, "$")
line$ = REPLACE$(line$, g_FLOATSIGN$, "#")
line$ = REPLACE$(line$, g_LONGSIGN$, "%")
EPRINT line$
ENDIF
ENDIF
' Preserve temp files
g_TMP_PRESERVE = 1
END IF
END IF
' Cleanup
IF ISFALSE(g_TMP_PRESERVE) THEN
FOR tmpfile$ IN g_TMP_FILES$
IF FILEEXISTS(tmpfile$) AND NOT(REGEX(tmpfile$, ".bac$")) THEN DELETE FILE tmpfile$
NEXT
END IF
END RETURN_CODE