extern int32 parse_routine(char *source, int embedded_flag, char *name,
int veneer_flag, int r_symbol)
{ int32 packed_address;
int i;
int debug_flag = FALSE;
int switch_clause_made = FALSE, default_clause_made = FALSE,
switch_label = 0;
debug_location_beginning beginning_debug_location =
get_token_location_beginning();
/* (switch_label needs no initialisation here, but it prevents some
compilers from issuing warnings) */
if ((source != lexical_source) || (veneer_flag))
{ lexical_source = source;
restart_lexer(lexical_source, name);
}
no_locals = 0;
for (i=0; i<MAX_LOCAL_VARIABLES-1; i++) local_variables.keywords[i] = "";
do
{ statements.enabled = TRUE;
dont_enter_into_symbol_table = TRUE;
get_next_token();
dont_enter_into_symbol_table = FALSE;
if ((token_type == SEP_TT) && (token_value == TIMES_SEP)
&& (no_locals == 0) && (!debug_flag))
{ debug_flag = TRUE;
continue;
}
if (token_type != DQ_TT)
{ if ((token_type == SEP_TT)
&& (token_value == SEMICOLON_SEP)) break;
ebf_error("local variable name or ';'", token_text);
panic_mode_error_recovery();
break;
}
if (strlen(token_text) > MAX_IDENTIFIER_LENGTH)
{ error_named("Local variable identifier too long:", token_text);
panic_mode_error_recovery();
break;
}
if (no_locals == MAX_LOCAL_VARIABLES-1)
{ error_numbered("Too many local variables for a routine; max is",
MAX_LOCAL_VARIABLES-1);
panic_mode_error_recovery();
break;
}
for (i=0; i<no_locals; i++)
if (strcmpcis(token_text, local_variables.keywords[i])==0)
error_named("Local variable defined twice:", token_text);
local_variables.keywords[no_locals++] = token_text;
} while(TRUE);
construct_local_variable_tables();
if ((trace_fns_setting==3)
|| ((trace_fns_setting==2) && (veneer_mode==FALSE))
|| ((trace_fns_setting==1) && (is_systemfile()==FALSE)))
debug_flag = TRUE;
if ((embedded_flag == FALSE) && (veneer_mode == FALSE) && debug_flag)
sflags[r_symbol] |= STAR_SFLAG;
packed_address = assemble_routine_header(no_locals, debug_flag,
name, embedded_flag, r_symbol);
do
{ begin_syntax_line(TRUE);
get_next_token();
if (token_type == EOF_TT)
{ ebf_error("']'", token_text);
assemble_routine_end
(embedded_flag,
get_token_location_end(beginning_debug_location));
put_token_back();
break;
}
if ((token_type == SEP_TT)
&& (token_value == CLOSE_SQUARE_SEP))
{ if (switch_clause_made && (!default_clause_made))
assemble_label_no(switch_label);
directives.enabled = TRUE;
sequence_point_follows = TRUE;
get_next_token();
assemble_routine_end
(embedded_flag,
get_token_location_end(beginning_debug_location));
put_token_back();
break;
}
if ((token_type == STATEMENT_TT) && (token_value == SDEFAULT_CODE))
{ if (default_clause_made)
error("Multiple 'default' clauses defined in same 'switch'");
default_clause_made = TRUE;
if (switch_clause_made)
{ if (!execution_never_reaches_here)
{ sequence_point_follows = FALSE;
if (!glulx_mode)
assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
else
assembleg_1(return_gc,
((embedded_flag)?zero_operand:one_operand));
}
assemble_label_no(switch_label);
}
switch_clause_made = TRUE;
get_next_token();
if ((token_type == SEP_TT) &&
(token_value == COLON_SEP)) continue;
ebf_error("':' after 'default'", token_text);
panic_mode_error_recovery();
continue;
}
/* Only check for the form of a case switch if the initial token
isn't double-quoted text, as that would mean it was a print_ret
statement: this is a mild ambiguity in the grammar.
Action statements also cannot be cases. */
if ((token_type != DQ_TT) && (token_type != SEP_TT))
{ get_next_token();
if (switch_sign() > 0)
{ assembly_operand AO;
if (default_clause_made)
error("'default' must be the last 'switch' case");
if (switch_clause_made)
{ if (!execution_never_reaches_here)
{ sequence_point_follows = FALSE;
if (!glulx_mode)
assemblez_0((embedded_flag)?rfalse_zc:rtrue_zc);
else
assembleg_1(return_gc,
((embedded_flag)?zero_operand:one_operand));
}
assemble_label_no(switch_label);
}
switch_label = next_label++;
switch_clause_made = TRUE;
put_token_back();
put_token_back();
if (!glulx_mode) {
INITAOTV(&AO, VARIABLE_OT, 249);
}
else {
INITAOTV(&AO, GLOBALVAR_OT, MAX_LOCAL_VARIABLES+6); /* sw__var */
}
parse_switch_spec(AO, switch_label, TRUE);
continue;
}
else
{ put_token_back();
put_token_back();
get_next_token();
sequence_point_follows = TRUE;
}
}
parse_statement(-1, -1);
} while (TRUE);
return packed_address;
}
extern int symbol_index(char *p, int hashcode)
{
/* Return the index in the symbs/svals/sflags/stypes arrays of symbol
"p", creating a new symbol with that name if it isn't already there.
New symbols are created with fundamental type UNKNOWN_CONSTANT_FT,
value 0x100 (a 2-byte quantity in Z-machine terms) and type
CONSTANT_T.
The string "p" is undamaged. */
int32 new_entry, this, last; char *r;
if (hashcode == -1) hashcode = hash_code_from_string(p);
this = start_of_list[hashcode]; last = -1;
do
{ if (this == -1) break;
r = (char *)symbs[this];
new_entry = strcmpcis(r, p);
if (new_entry == 0) return this;
if (new_entry > 0) break;
last = this;
this = next_entry[this];
} while (this != -1);
if (no_symbols >= MAX_SYMBOLS)
memoryerror("MAX_SYMBOLS", MAX_SYMBOLS);
if (last == -1)
{ next_entry[no_symbols]=start_of_list[hashcode];
start_of_list[hashcode]=no_symbols;
}
else
{ next_entry[no_symbols]=this;
next_entry[last]=no_symbols;
}
if (symbols_free_space+strlen(p)+1 >= symbols_ceiling)
{ symbols_free_space
= my_malloc(SYMBOLS_CHUNK_SIZE, "symbol names chunk");
symbols_ceiling = symbols_free_space + SYMBOLS_CHUNK_SIZE;
/* If we've passed MAX_SYMBOL_CHUNKS chunks, we print an error
message telling the user to increase SYMBOLS_CHUNK_SIZE.
That is the correct cure, even though the error comes out
worded inaccurately. */
if (no_symbol_name_space_chunks >= MAX_SYMBOL_CHUNKS)
memoryerror("SYMBOLS_CHUNK_SIZE", SYMBOLS_CHUNK_SIZE);
symbol_name_space_chunks[no_symbol_name_space_chunks++]
= (char *) symbols_free_space;
}
strcpy((char *) symbols_free_space, p);
symbs[no_symbols] = (int32 *) symbols_free_space;
symbols_free_space += strlen((char *)symbols_free_space) + 1;
svals[no_symbols] = 0x100; /* ###-wrong? Would this fix the
unbound-symbol-causes-asm-error? */
sflags[no_symbols] = UNKNOWN_SFLAG;
stypes[no_symbols] = CONSTANT_T;
slines[no_symbols] = ErrorReport.line_number
+ 0x10000*ErrorReport.file_number;
return(no_symbols++);
}
