12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036 |
- /* ------------------------------------------------------------------------- */
- /* "expressp" : The expression parser */
- /* */
- /* Part of Inform 6.33 */
- /* copyright (c) Graham Nelson 1993 - 2014 */
- /* */
- /* ------------------------------------------------------------------------- */
- #include "header.h"
- /* --- Interface to lexer -------------------------------------------------- */
- static char separators_to_operators[103];
- static char conditionals_to_operators[7];
- static char token_type_allowable[301];
- #define NOT_AN_OPERATOR (char) 0x7e
- static void make_lexical_interface_tables(void)
- { int i;
- for (i=0;i<103;i++)
- separators_to_operators[i] = NOT_AN_OPERATOR;
- for (i=0;i<NUM_OPERATORS;i++)
- if (operators[i].token_type == SEP_TT)
- separators_to_operators[operators[i].token_value] = i;
- for (i=0;i<7;i++) /* 7 being the size of keyword_group "conditions" */
- conditionals_to_operators[i] = NOT_AN_OPERATOR;
- for (i=0;i<NUM_OPERATORS;i++)
- if (operators[i].token_type == CND_TT)
- conditionals_to_operators[operators[i].token_value] = i;
- for (i=0;i<301;i++) token_type_allowable[i] = 0;
- token_type_allowable[VARIABLE_TT] = 1;
- token_type_allowable[SYSFUN_TT] = 1;
- token_type_allowable[DQ_TT] = 1;
- token_type_allowable[DICTWORD_TT] = 1;
- token_type_allowable[SUBOPEN_TT] = 1;
- token_type_allowable[SUBCLOSE_TT] = 1;
- token_type_allowable[SMALL_NUMBER_TT] = 1;
- token_type_allowable[LARGE_NUMBER_TT] = 1;
- token_type_allowable[ACTION_TT] = 1;
- token_type_allowable[SYSTEM_CONSTANT_TT] = 1;
- token_type_allowable[OP_TT] = 1;
- }
- static token_data current_token, previous_token, heldback_token;
- static int comma_allowed, arrow_allowed, superclass_allowed,
- bare_prop_allowed,
- array_init_ambiguity, action_ambiguity,
- etoken_count, inserting_token, bracket_level;
- extern int *variable_usage;
- int system_function_usage[32];
- static int get_next_etoken(void)
- { int v, symbol, mark_symbol_as_used = FALSE,
- initial_bracket_level = bracket_level;
- etoken_count++;
- if (inserting_token)
- { current_token = heldback_token;
- inserting_token = FALSE;
- }
- else
- { get_next_token();
- current_token.text = token_text;
- current_token.value = token_value;
- current_token.type = token_type;
- current_token.marker = 0;
- current_token.symtype = 0;
- current_token.symflags = -1;
- }
- switch(current_token.type)
- { case LOCAL_VARIABLE_TT:
- current_token.type = VARIABLE_TT;
- variable_usage[current_token.value] = TRUE;
- break;
- case DQ_TT:
- current_token.marker = STRING_MV;
- break;
- case SQ_TT:
- { int32 unicode = text_to_unicode(token_text);
- if (token_text[textual_form_length] == 0)
- {
- if (!glulx_mode) {
- current_token.value = unicode_to_zscii(unicode);
- if (current_token.value == 5)
- { unicode_char_error("Character can be printed \
- but not used as a value:", unicode);
- current_token.value = '?';
- }
- if (current_token.value >= 0x100)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- current_token.value = unicode;
- if (current_token.value >= 0x8000
- || current_token.value < -0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- }
- else
- { current_token.type = DICTWORD_TT;
- current_token.marker = DWORD_MV;
- }
- }
- break;
- case SYMBOL_TT:
- ReceiveSymbol:
- symbol = current_token.value;
- mark_symbol_as_used = TRUE;
- v = svals[symbol];
- current_token.symtype = stypes[symbol];
- current_token.symflags = sflags[symbol];
- switch(stypes[symbol])
- { case ROUTINE_T:
- current_token.marker = IROUTINE_MV;
- break;
- case GLOBAL_VARIABLE_T:
- current_token.marker = VARIABLE_MV;
- break;
- case OBJECT_T:
- case CLASS_T:
- /* All objects must be backpatched in Glulx. */
- if (module_switch || glulx_mode)
- current_token.marker = OBJECT_MV;
- break;
- case ARRAY_T:
- current_token.marker = ARRAY_MV;
- break;
- case INDIVIDUAL_PROPERTY_T:
- if (module_switch) current_token.marker = IDENT_MV;
- break;
- case CONSTANT_T:
- if (sflags[symbol] & (UNKNOWN_SFLAG + CHANGE_SFLAG))
- { current_token.marker = SYMBOL_MV;
- if (module_switch) import_symbol(symbol);
- v = symbol;
- }
- else current_token.marker = 0;
- break;
- case LABEL_T:
- error_named("Label name used as value:", token_text);
- break;
- default:
- current_token.marker = 0;
- break;
- }
- if (sflags[symbol] & SYSTEM_SFLAG)
- current_token.marker = 0;
- current_token.value = v;
- if (!glulx_mode) {
- if (((current_token.marker != 0)
- && (current_token.marker != VARIABLE_MV))
- || (v < 0) || (v > 255))
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (((current_token.marker != 0)
- && (current_token.marker != VARIABLE_MV))
- || (v < -0x8000) || (v >= 0x8000))
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- if (stypes[symbol] == GLOBAL_VARIABLE_T)
- { current_token.type = VARIABLE_TT;
- variable_usage[current_token.value] = TRUE;
- }
- break;
- case NUMBER_TT:
- if (!glulx_mode) {
- if (current_token.value >= 256)
- current_token.type = LARGE_NUMBER_TT;
- else
- current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (current_token.value < -0x8000
- || current_token.value >= 0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else
- current_token.type = SMALL_NUMBER_TT;
- }
- break;
- case SEP_TT:
- switch(current_token.value)
- { case ARROW_SEP:
- if (!arrow_allowed)
- current_token.type = ENDEXP_TT;
- break;
- case COMMA_SEP:
- if ((bracket_level==0) && (!comma_allowed))
- current_token.type = ENDEXP_TT;
- break;
- case SUPERCLASS_SEP:
- if ((bracket_level==0) && (!superclass_allowed))
- current_token.type = ENDEXP_TT;
- break;
- case GREATER_SEP:
- get_next_token();
- if ((token_type == SEP_TT)
- &&((token_value == SEMICOLON_SEP)
- || (token_value == GREATER_SEP)))
- current_token.type = ENDEXP_TT;
- put_token_back();
- break;
- case OPENB_SEP:
- bracket_level++;
- if (expr_trace_level>=3)
- { printf("Previous token type = %d\n",previous_token.type);
- printf("Previous token val = %d\n",previous_token.value);
- }
- if ((previous_token.type == OP_TT)
- || (previous_token.type == SUBOPEN_TT)
- || (previous_token.type == ENDEXP_TT)
- || (array_init_ambiguity)
- || ((bracket_level == 1) && (action_ambiguity)))
- current_token.type = SUBOPEN_TT;
- else
- { inserting_token = TRUE;
- heldback_token = current_token;
- current_token.text = "<call>";
- bracket_level--;
- }
- break;
- case CLOSEB_SEP:
- bracket_level--;
- if (bracket_level < 0)
- current_token.type = ENDEXP_TT;
- else current_token.type = SUBCLOSE_TT;
- break;
- case SEMICOLON_SEP:
- current_token.type = ENDEXP_TT; break;
- case MINUS_SEP:
- if ((previous_token.type == OP_TT)
- || (previous_token.type == SUBOPEN_TT)
- || (previous_token.type == ENDEXP_TT))
- current_token.value = UNARY_MINUS_SEP; break;
- case INC_SEP:
- if ((previous_token.type == VARIABLE_TT)
- || (previous_token.type == SUBCLOSE_TT)
- || (previous_token.type == LARGE_NUMBER_TT)
- || (previous_token.type == SMALL_NUMBER_TT))
- current_token.value = POST_INC_SEP; break;
- case DEC_SEP:
- if ((previous_token.type == VARIABLE_TT)
- || (previous_token.type == SUBCLOSE_TT)
- || (previous_token.type == LARGE_NUMBER_TT)
- || (previous_token.type == SMALL_NUMBER_TT))
- current_token.value = POST_DEC_SEP; break;
- case HASHHASH_SEP:
- token_text = current_token.text + 2;
- ActionUsedAsConstant:
- current_token.type = ACTION_TT;
- current_token.text = token_text;
- current_token.value = 0;
- current_token.marker = ACTION_MV;
- break;
- case HASHADOLLAR_SEP:
- obsolete_warning("'#a$Act' is now superseded by '##Act'");
- token_text = current_token.text + 3;
- goto ActionUsedAsConstant;
- case HASHGDOLLAR_SEP:
- /* This form generates the position of a global variable
- in the global variables array. So Glob is the same as
- #globals_array --> #g$Glob */
- current_token.text += 3;
- current_token.type = SYMBOL_TT;
- symbol = symbol_index(current_token.text, -1);
- if (stypes[symbol] != GLOBAL_VARIABLE_T) {
- ebf_error(
- "global variable name after '#g$'",
- current_token.text);
- current_token.value = 0;
- current_token.type = SMALL_NUMBER_TT;
- current_token.marker = 0;
- break;
- }
- mark_symbol_as_used = TRUE;
- current_token.value = svals[symbol] - MAX_LOCAL_VARIABLES;
- current_token.marker = 0;
- if (!glulx_mode) {
- if (current_token.value >= 0x100)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- else {
- if (current_token.value >= 0x8000
- || current_token.value < -0x8000)
- current_token.type = LARGE_NUMBER_TT;
- else current_token.type = SMALL_NUMBER_TT;
- }
- break;
- case HASHNDOLLAR_SEP:
- /* This form is still needed for constants like #n$a (the
- dictionary address of the word "a"), since 'a' means
- the ASCII value of 'a' */
- if (strlen(token_text) > 4)
- obsolete_warning(
- "'#n$word' is now superseded by ''word''");
- current_token.type = DICTWORD_TT;
- current_token.value = 0;
- current_token.text = token_text + 3;
- current_token.marker = DWORD_MV;
- break;
- case HASHRDOLLAR_SEP:
- /* This form -- #r$Routinename, to return the routine's */
- /* packed address -- is needed far less often in Inform 6, */
- /* where just giving the name Routine returns the packed */
- /* address. But it's used in a lot of Inform 5 code. */
- obsolete_warning(
- "'#r$Routine' can now be written just 'Routine'");
- current_token.text += 3;
- current_token.type = SYMBOL_TT;
- current_token.value = symbol_index(current_token.text, -1);
- goto ReceiveSymbol;
- case HASHWDOLLAR_SEP:
- error("The obsolete '#w$word' construct has been removed");
- break;
- case HASH_SEP:
- system_constants.enabled = TRUE;
- get_next_token();
- system_constants.enabled = FALSE;
- if (token_type != SYSTEM_CONSTANT_TT)
- { ebf_error(
- "'r$', 'n$', 'g$' or internal Inform constant name after '#'",
- token_text);
- break;
- }
- else
- { current_token.type = token_type;
- current_token.value = token_value;
- current_token.text = token_text;
- current_token.marker = INCON_MV;
- }
- break;
- }
- break;
- case CND_TT:
- v = conditionals_to_operators[current_token.value];
- if (v != NOT_AN_OPERATOR)
- { current_token.type = OP_TT; current_token.value = v;
- }
- break;
- }
- if (current_token.type == SEP_TT)
- { v = separators_to_operators[current_token.value];
- if (v != NOT_AN_OPERATOR)
- { if ((veneer_mode)
- || ((v!=MESSAGE_OP) && (v!=MPROP_NUM_OP) && (v!=MPROP_NUM_OP)))
- { current_token.type = OP_TT; current_token.value = v;
- if (array_init_ambiguity &&
- ((v==MINUS_OP) || (v==UNARY_MINUS_OP)) &&
- (initial_bracket_level == 0) &&
- (etoken_count != 1))
- warning("Without bracketing, the minus sign '-' is ambiguous");
- }
- }
- }
- /* A feature of Inform making it annoyingly hard to parse left-to-right
- is that there is no clear delimiter for expressions; that is, the
- legal syntax often includes sequences of expressions with no
- intervening markers such as commas. We therefore need to use some
- internal context to determine whether an end is in sight... */
- if (token_type_allowable[current_token.type]==0)
- { if (expr_trace_level >= 3)
- { printf("Discarding as not allowable: '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- current_token.type = ENDEXP_TT;
- }
- else
- if ((!((initial_bracket_level > 0)
- || (previous_token.type == ENDEXP_TT)
- || ((previous_token.type == OP_TT)
- && (operators[previous_token.value].usage != POST_U))
- || (previous_token.type == SYSFUN_TT)))
- && ((current_token.type != OP_TT)
- || (operators[current_token.value].usage == PRE_U)))
- { if (expr_trace_level >= 3)
- { printf("Discarding as no longer part: '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- current_token.type = ENDEXP_TT;
- }
- else
- { if (mark_symbol_as_used) sflags[symbol] |= USED_SFLAG;
- if (expr_trace_level >= 3)
- { printf("Expr token = '%s' ", current_token.text);
- describe_token(current_token);
- printf("\n");
- }
- }
- if ((previous_token.type == ENDEXP_TT)
- && (current_token.type == ENDEXP_TT)) return FALSE;
- previous_token = current_token;
- return TRUE;
- }
- /* --- Operator precedences ------------------------------------------------ */
- #define LOWER_P 101
- #define EQUAL_P 102
- #define GREATER_P 103
- #define e1 1 /* Missing operand error */
- #define e2 2 /* Unexpected close bracket */
- #define e3 3 /* Missing operator error */
- #define e4 4 /* Expression ends with an open bracket */
- #define e5 5 /* Associativity illegal error */
- const int prec_table[] = {
- /* a .......... ( ) end op term */
- /* b ( */ LOWER_P, e3, LOWER_P, LOWER_P, e3,
- /* . ) */ EQUAL_P, GREATER_P, e2, GREATER_P, GREATER_P,
- /* . end */ e4, GREATER_P, e1, GREATER_P, GREATER_P,
- /* . op */ LOWER_P, GREATER_P, LOWER_P, -1, GREATER_P,
- /* . term */ LOWER_P, e3, LOWER_P, LOWER_P, e3
- };
- static int find_prec(token_data a, token_data b)
- {
- /* We are comparing the precedence of tokens a and b
- (where a occurs to the left of b). If the expression is correct,
- the only possible values are GREATER_P, LOWER_P or EQUAL_P;
- if it is malformed then one of e1 to e5 results.
- Note that this routine is not symmetrical and that the relation
- is not trichotomous.
- If a and b are equal (and aren't brackets), then
- a LOWER_P a if a right-associative
- a GREATER_P a if a left-associative
- */
- int i, j, l1, l2;
- switch(a.type)
- { case SUBOPEN_TT: i=0; break;
- case SUBCLOSE_TT: i=1; break;
- case ENDEXP_TT: i=2; break;
- case OP_TT: i=3; break;
- default: i=4; break;
- }
- switch(b.type)
- { case SUBOPEN_TT: i+=0; break;
- case SUBCLOSE_TT: i+=5; break;
- case ENDEXP_TT: i+=10; break;
- case OP_TT: i+=15; break;
- default: i+=20; break;
- }
- j = prec_table[i]; if (j != -1) return j;
- l1 = operators[a.value].precedence;
- l2 = operators[b.value].precedence;
- if (operators[b.value].usage == PRE_U) return LOWER_P;
- if (operators[a.value].usage == POST_U) return GREATER_P;
- /* Anomalous rule to resolve the function call precedence, which is
- different on the right from on the left, e.g., in:
- alpha.beta(gamma)
- beta(gamma).alpha
- */
- if ((l1 == 11) && (l2 > 11)) return GREATER_P;
- if (l1 < l2) return LOWER_P;
- if (l1 > l2) return GREATER_P;
- switch(operators[a.value].associativity)
- { case L_A: return GREATER_P;
- case R_A: return LOWER_P;
- case 0: return e5;
- }
- return GREATER_P;
- }
- /* --- Converting token to operand ----------------------------------------- */
- /* Must match the switch statement below */
- int z_system_constant_list[] =
- { adjectives_table_SC,
- actions_table_SC,
- classes_table_SC,
- identifiers_table_SC,
- preactions_table_SC,
- largest_object_SC,
- strings_offset_SC,
- code_offset_SC,
- actual_largest_object_SC,
- static_memory_offset_SC,
- array_names_offset_SC,
- readable_memory_offset_SC,
- cpv__start_SC,
- cpv__end_SC,
- ipv__start_SC,
- ipv__end_SC,
- array__start_SC,
- array__end_SC,
- highest_attribute_number_SC,
- attribute_names_array_SC,
- highest_property_number_SC,
- property_names_array_SC,
- highest_action_number_SC,
- action_names_array_SC,
- highest_fake_action_number_SC,
- fake_action_names_array_SC,
- highest_routine_number_SC,
- routine_names_array_SC,
- routines_array_SC,
- routine_flags_array_SC,
- highest_global_number_SC,
- global_names_array_SC,
- globals_array_SC,
- global_flags_array_SC,
- highest_array_number_SC,
- array_names_array_SC,
- array_flags_array_SC,
- highest_constant_number_SC,
- constant_names_array_SC,
- highest_class_number_SC,
- class_objects_array_SC,
- highest_object_number_SC,
- -1 };
- static int32 value_of_system_constant_z(int t)
- { switch(t)
- { case adjectives_table_SC:
- return adjectives_offset;
- case actions_table_SC:
- return actions_offset;
- case classes_table_SC:
- return class_numbers_offset;
- case identifiers_table_SC:
- return identifier_names_offset;
- case preactions_table_SC:
- return preactions_offset;
- case largest_object_SC:
- return 256 + no_objects - 1;
- case strings_offset_SC:
- return strings_offset/scale_factor;
- case code_offset_SC:
- return code_offset/scale_factor;
- case actual_largest_object_SC:
- return no_objects;
- case static_memory_offset_SC:
- return static_memory_offset;
- case array_names_offset_SC:
- return array_names_offset;
- case readable_memory_offset_SC:
- return Write_Code_At;
- case cpv__start_SC:
- return prop_values_offset;
- case cpv__end_SC:
- return class_numbers_offset;
- case ipv__start_SC:
- return individuals_offset;
- case ipv__end_SC:
- return variables_offset;
- case array__start_SC:
- return variables_offset + (MAX_GLOBAL_VARIABLES*WORDSIZE);
- case array__end_SC:
- return static_memory_offset;
- case highest_attribute_number_SC:
- return no_attributes-1;
- case attribute_names_array_SC:
- return attribute_names_offset;
- case highest_property_number_SC:
- return no_individual_properties-1;
- case property_names_array_SC:
- return identifier_names_offset + 2;
- case highest_action_number_SC:
- return no_actions-1;
- case action_names_array_SC:
- return action_names_offset;
- case highest_fake_action_number_SC:
- return ((grammar_version_number==1)?256:4096) + no_fake_actions-1;
- case fake_action_names_array_SC:
- return fake_action_names_offset;
- case highest_routine_number_SC:
- return no_named_routines-1;
- case routine_names_array_SC:
- return routine_names_offset;
- case routines_array_SC:
- return routines_array_offset;
- case routine_flags_array_SC:
- return routine_flags_array_offset;
- case highest_global_number_SC:
- return 16 + no_globals-1;
- case global_names_array_SC:
- return global_names_offset;
- case globals_array_SC:
- return variables_offset;
- case global_flags_array_SC:
- return global_flags_array_offset;
- case highest_array_number_SC:
- return no_arrays-1;
- case array_names_array_SC:
- return array_names_offset;
- case array_flags_array_SC:
- return array_flags_array_offset;
- case highest_constant_number_SC:
- return no_named_constants-1;
- case constant_names_array_SC:
- return constant_names_offset;
- case highest_class_number_SC:
- return no_classes-1;
- case class_objects_array_SC:
- return class_numbers_offset;
- case highest_object_number_SC:
- return no_objects-1;
- }
- error_named("System constant not implemented in Z-code",
- system_constants.keywords[t]);
- return(0);
- }
- /* Must match the switch statement below */
- int glulx_system_constant_list[] =
- { classes_table_SC,
- identifiers_table_SC,
- array_names_offset_SC,
- cpv__start_SC,
- cpv__end_SC,
- dictionary_table_SC,
- dynam_string_table_SC,
- grammar_table_SC,
- actions_table_SC,
- globals_array_SC,
- -1 };
- static int32 value_of_system_constant_g(int t)
- {
- switch (t) {
- case classes_table_SC:
- return Write_RAM_At + class_numbers_offset;
- case identifiers_table_SC:
- return Write_RAM_At + identifier_names_offset;
- case array_names_offset_SC:
- return Write_RAM_At + array_names_offset;
- case cpv__start_SC:
- return prop_defaults_offset;
- case cpv__end_SC:
- return Write_RAM_At + class_numbers_offset;
- case dictionary_table_SC:
- return dictionary_offset;
- case dynam_string_table_SC:
- return abbreviations_offset;
- case grammar_table_SC:
- return grammar_table_offset;
- case actions_table_SC:
- return actions_offset;
- case globals_array_SC:
- return variables_offset;
- }
- error_named("System constant not implemented in Glulx",
- system_constants.keywords[t]);
- return 0;
- }
- extern int32 value_of_system_constant(int t)
- {
- if (!glulx_mode)
- return value_of_system_constant_z(t);
- else
- return value_of_system_constant_g(t);
- }
- static int evaluate_term(token_data t, assembly_operand *o)
- {
- /* If the given token is a constant, evaluate it into the operand.
- For now, the identifiers are considered variables.
- Returns FALSE if it fails to understand type. */
- int32 v;
- o->marker = t.marker;
- o->symtype = t.symtype;
- o->symflags = t.symflags;
- switch(t.type)
- { case LARGE_NUMBER_TT:
- v = t.value;
- if (!glulx_mode) {
- if (v < 0) v = v + 0x10000;
- o->type = LONG_CONSTANT_OT;
- o->value = v;
- }
- else {
- o->value = v;
- o->type = CONSTANT_OT;
- }
- return(TRUE);
- case SMALL_NUMBER_TT:
- v = t.value;
- if (!glulx_mode) {
- if (v < 0) v = v + 0x10000;
- o->type = SHORT_CONSTANT_OT;
- o->value = v;
- }
- else {
- o->value = v;
- set_constant_ot(o);
- }
- return(TRUE);
- case DICTWORD_TT:
- /* Find the dictionary address, adding to dictionary if absent */
- if (!glulx_mode)
- o->type = LONG_CONSTANT_OT;
- else
- o->type = CONSTANT_OT;
- o->value = dictionary_add(t.text, 0x80, 0, 0);
- return(TRUE);
- case DQ_TT:
- /* Create as a static string */
- if (!glulx_mode)
- o->type = LONG_CONSTANT_OT;
- else
- o->type = CONSTANT_OT;
- o->value = compile_string(t.text, FALSE, FALSE);
- return(TRUE);
- case VARIABLE_TT:
- if (!glulx_mode) {
- o->type = VARIABLE_OT;
- }
- else {
- if (t.value >= MAX_LOCAL_VARIABLES) {
- o->type = GLOBALVAR_OT;
- }
- else {
- /* This includes "local variable zero", which is really
- the stack-pointer magic variable. */
- o->type = LOCALVAR_OT;
- }
- }
- o->value = t.value;
- return(TRUE);
- case SYSFUN_TT:
- if (!glulx_mode) {
- o->type = VARIABLE_OT;
- o->value = t.value + 256;
- }
- else {
- o->type = SYSFUN_OT;
- o->value = t.value;
- }
- system_function_usage[t.value] = 1;
- return(TRUE);
- case ACTION_TT:
- *o = action_of_name(t.text);
- return(TRUE);
- case SYSTEM_CONSTANT_TT:
- /* Certain system constants depend only on the
- version number and need no backpatching, as they
- are known in advance. We can therefore evaluate
- them immediately. */
- if (!glulx_mode) {
- o->type = LONG_CONSTANT_OT;
- switch(t.value)
- {
- case version_number_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = version_number; break;
- case dict_par1_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?4:6; break;
- case dict_par2_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?5:7; break;
- case dict_par3_SC:
- o->type = SHORT_CONSTANT_OT;
- o->marker = 0;
- v = (version_number==3)?6:8; break;
- case lowest_attribute_number_SC:
- case lowest_action_number_SC:
- case lowest_routine_number_SC:
- case lowest_array_number_SC:
- case lowest_constant_number_SC:
- case lowest_class_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 0; break;
- case lowest_object_number_SC:
- case lowest_property_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 1; break;
- case lowest_global_number_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0; v = 16; break;
- case lowest_fake_action_number_SC:
- o->type = LONG_CONSTANT_OT; o->marker = 0;
- v = ((grammar_version_number==1)?256:4096); break;
- case oddeven_packing_SC:
- o->type = SHORT_CONSTANT_OT; o->marker = 0;
- v = oddeven_packing_switch; break;
- default:
- v = t.value;
- o->marker = INCON_MV;
- break;
- }
- o->value = v;
- }
- else {
- o->type = CONSTANT_OT;
- switch(t.value)
- {
- /* The three dict_par flags point at the lower byte
- of the flag field, because the library is written
- to expect one-byte fields, even though the compiler
- generates a dictionary with room for two. */
- case dict_par1_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+1;
- break;
- case dict_par2_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+3;
- break;
- case dict_par3_SC:
- o->type = BYTECONSTANT_OT;
- o->marker = 0;
- v = DICT_ENTRY_FLAG_POS+5;
- break;
- /* ###fix: need to fill more of these in! */
- default:
- v = t.value;
- o->marker = INCON_MV;
- break;
- }
- o->value = v;
- }
- return(TRUE);
- default:
- return(FALSE);
- }
- }
- /* --- Emitter ------------------------------------------------------------- */
- expression_tree_node *ET;
- static int ET_used;
- extern void clear_expression_space(void)
- { ET_used = 0;
- }
- static assembly_operand *emitter_stack;
- static int *emitter_markers;
- static int *emitter_bracket_counts;
- #define FUNCTION_VALUE_MARKER 1
- #define ARGUMENT_VALUE_MARKER 2
- #define OR_VALUE_MARKER 3
- static int emitter_sp;
- static int is_property_t(int symbol_type)
- { return ((symbol_type == PROPERTY_T) || (symbol_type == INDIVIDUAL_PROPERTY_T));
- }
- static void mark_top_of_emitter_stack(int marker, token_data t)
- { if (emitter_sp < 1)
- { compiler_error("SR error: Attempt to add a marker to the top of an empty emitter stack");
- return;
- }
- if (expr_trace_level >= 2)
- { printf("Marking top of emitter stack (which is ");
- print_operand(emitter_stack[emitter_sp-1]);
- printf(") as ");
- switch(marker)
- {
- case FUNCTION_VALUE_MARKER:
- printf("FUNCTION");
- break;
- case ARGUMENT_VALUE_MARKER:
- printf("ARGUMENT");
- break;
- case OR_VALUE_MARKER:
- printf("OR_VALUE");
- break;
- default:
- printf("UNKNOWN");
- break;
- }
- printf("\n");
- }
- if (emitter_markers[emitter_sp-1])
- { if (marker == ARGUMENT_VALUE_MARKER)
- {
- warning("Ignoring spurious leading comma");
- return;
- }
- error_named("Missing operand for", t.text);
- if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- emitter_stack[emitter_sp] = zero_operand;
- emitter_sp++;
- }
- emitter_markers[emitter_sp-1] = marker;
- }
- static void add_bracket_layer_to_emitter_stack(int depth)
- { /* There's no point in tracking bracket layers that don't fence off any values. */
- if (emitter_sp < depth + 1) return;
- if (expr_trace_level >= 2)
- printf("Adding bracket layer\n");
- ++emitter_bracket_counts[emitter_sp-depth-1];
- }
- static void remove_bracket_layer_from_emitter_stack()
- { /* Bracket layers that don't fence off any values will not have been tracked. */
- if (emitter_sp < 2) return;
- if (expr_trace_level >= 2)
- printf("Removing bracket layer\n");
- if (emitter_bracket_counts[emitter_sp-2] <= 0)
- { compiler_error("SR error: Attempt to remove a nonexistent bracket layer from the emitter stack");
- return;
- }
- --emitter_bracket_counts[emitter_sp-2];
- }
- static void emit_token(token_data t)
- { assembly_operand o1, o2; int arity, stack_size, i;
- int op_node_number, operand_node_number, previous_node_number;
- int32 x;
- if (expr_trace_level >= 2)
- { printf("Output: %-19s%21s ", t.text, "");
- for (i=0; i<emitter_sp; i++)
- { print_operand(emitter_stack[i]); printf(" ");
- if (emitter_markers[i] == FUNCTION_VALUE_MARKER) printf(":FUNCTION ");
- if (emitter_markers[i] == ARGUMENT_VALUE_MARKER) printf(":ARGUMENT ");
- if (emitter_markers[i] == OR_VALUE_MARKER) printf(":OR ");
- if (emitter_bracket_counts[i]) printf(":BRACKETS(%d) ", emitter_bracket_counts[i]);
- }
- printf("\n");
- }
- if (t.type == SUBOPEN_TT) return;
- stack_size = 0;
- while ((stack_size < emitter_sp) &&
- !emitter_markers[emitter_sp-stack_size-1] &&
- !emitter_bracket_counts[emitter_sp-stack_size-1])
- stack_size++;
- if (t.type == SUBCLOSE_TT)
- { if (stack_size < emitter_sp && emitter_bracket_counts[emitter_sp-stack_size-1])
- { if (stack_size == 0)
- { error("No expression between brackets '(' and ')'");
- emitter_stack[emitter_sp] = zero_operand;
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- ++emitter_sp;
- }
- else if (stack_size < 1)
- compiler_error("SR error: emitter stack empty in subexpression");
- else if (stack_size > 1)
- compiler_error("SR error: emitter stack overfull in subexpression");
- remove_bracket_layer_from_emitter_stack();
- }
- return;
- }
- if (t.type != OP_TT)
- { emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- if (!evaluate_term(t, &(emitter_stack[emitter_sp++])))
- compiler_error_named("Emit token error:", t.text);
- return;
- }
- /* A comma is argument-separating if it follows an argument (or a function
- call, since we ignore spurious leading commas in function argument lists)
- with no intervening brackets. Function calls are variadic, so we don't
- apply argument-separating commas. */
- if (t.value == COMMA_OP &&
- stack_size < emitter_sp &&
- (emitter_markers[emitter_sp-stack_size-1] == ARGUMENT_VALUE_MARKER ||
- emitter_markers[emitter_sp-stack_size-1] == FUNCTION_VALUE_MARKER) &&
- !emitter_bracket_counts[emitter_sp-stack_size-1])
- { if (expr_trace_level >= 2)
- printf("Treating comma as argument-separating\n");
- return;
- }
- if (t.value == OR_OP)
- return;
- arity = 1;
- if (t.value == FCALL_OP)
- { if (expr_trace_level >= 3)
- { printf("FCALL_OP finds marker stack: ");
- for (x=0; x<emitter_sp; x++) printf("%d ", emitter_markers[x]);
- printf("\n");
- }
- if (emitter_markers[emitter_sp-1] == ARGUMENT_VALUE_MARKER)
- warning("Ignoring spurious trailing comma");
- while (emitter_markers[emitter_sp-arity] != FUNCTION_VALUE_MARKER)
- {
- if ((glulx_mode &&
- emitter_stack[emitter_sp-arity].type == SYSFUN_OT) ||
- (!glulx_mode &&
- emitter_stack[emitter_sp-arity].type == VARIABLE_OT &&
- emitter_stack[emitter_sp-arity].value >= 256 &&
- emitter_stack[emitter_sp-arity].value < 288))
- { int index = emitter_stack[emitter_sp-arity].value;
- if(!glulx_mode)
- index -= 256;
- if(index > 0 && index < NUMBER_SYSTEM_FUNCTIONS)
- error_named("System function name used as a value:", system_functions.keywords[index]);
- else
- compiler_error("Found unnamed system function used as a value");
- emitter_stack[emitter_sp-arity] = zero_operand;
- }
- ++arity;
- }
- }
- else
- { arity = 1;
- if (operators[t.value].usage == IN_U) arity = 2;
- if (operators[t.value].precedence == 3)
- { arity = 2;
- x = emitter_sp-1;
- if(!emitter_markers[x] && !emitter_bracket_counts[x])
- { for (--x; emitter_markers[x] == OR_VALUE_MARKER && !emitter_bracket_counts[x]; --x)
- { ++arity;
- ++stack_size;
- }
- for (;x >= 0 && !emitter_markers[x] && !emitter_bracket_counts[x]; --x)
- ++stack_size;
- }
- }
- if (arity > stack_size)
- { error_named("Missing operand for", t.text);
- while (arity > stack_size)
- { if (emitter_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- emitter_markers[emitter_sp] = 0;
- emitter_bracket_counts[emitter_sp] = 0;
- emitter_stack[emitter_sp] = zero_operand;
- emitter_sp++;
- stack_size++;
- }
- }
- }
- /* pseudo-typecheck in 6.30 */
- for (i = 1; i <= arity; i++)
- {
- o1 = emitter_stack[emitter_sp - i];
- if (is_property_t(o1.symtype) ) {
- switch(t.value)
- {
- case FCALL_OP:
- case SETEQUALS_OP: case NOTEQUAL_OP:
- case CONDEQUALS_OP:
- case PROVIDES_OP: case NOTPROVIDES_OP:
- case PROP_ADD_OP: case PROP_NUM_OP:
- case SUPERCLASS_OP:
- case MPROP_ADD_OP: case MESSAGE_OP:
- case PROPERTY_OP:
- if (i < arity) break;
- case GE_OP: case LE_OP:
- if ((i < arity) && (o1.symflags & STAR_SFLAG)) break;
- default:
- warning("Property name in expression is not qualified by object");
- }
- } /* if (is_property_t */
- }
- switch(arity)
- { case 1:
- o1 = emitter_stack[emitter_sp - 1];
- if ((o1.marker == 0) && is_constant_ot(o1.type))
- { switch(t.value)
- { case UNARY_MINUS_OP: x = -o1.value; goto FoldConstant;
- case ARTNOT_OP:
- if (!glulx_mode)
- x = (~o1.value) & 0xffff;
- else
- x = (~o1.value) & 0xffffffff;
- goto FoldConstant;
- case LOGNOT_OP:
- if (o1.value != 0) x=0; else x=1;
- goto FoldConstant;
- }
- }
- break;
- case 2:
- o1 = emitter_stack[emitter_sp - 2];
- o2 = emitter_stack[emitter_sp - 1];
- if ((o1.marker == 0) && (o2.marker == 0)
- && is_constant_ot(o1.type) && is_constant_ot(o2.type))
- {
- int32 ov1, ov2;
- if (glulx_mode)
- { ov1 = o1.value;
- ov2 = o2.value;
- }
- else
- { ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
- ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
- }
- switch(t.value)
- {
- case PLUS_OP: x = ov1 + ov2; goto FoldConstantC;
- case MINUS_OP: x = ov1 - ov2; goto FoldConstantC;
- case TIMES_OP: x = ov1 * ov2; goto FoldConstantC;
- case DIVIDE_OP:
- case REMAINDER_OP:
- if (ov2 == 0)
- error("Division of constant by zero");
- else
- if (t.value == DIVIDE_OP) {
- if (ov2 < 0) {
- ov1 = -ov1;
- ov2 = -ov2;
- }
- if (ov1 >= 0)
- x = ov1 / ov2;
- else
- x = -((-ov1) / ov2);
- }
- else {
- if (ov2 < 0) {
- ov2 = -ov2;
- }
- if (ov1 >= 0)
- x = ov1 % ov2;
- else
- x = -((-ov1) % ov2);
- }
- goto FoldConstant;
- case ARTAND_OP: x = o1.value & o2.value; goto FoldConstant;
- case ARTOR_OP: x = o1.value | o2.value; goto FoldConstant;
- case CONDEQUALS_OP:
- if (o1.value == o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case NOTEQUAL_OP:
- if (o1.value != o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case GE_OP:
- if (o1.value >= o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case GREATER_OP:
- if (o1.value > o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LE_OP:
- if (o1.value <= o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LESS_OP:
- if (o1.value < o2.value) x = 1; else x = 0;
- goto FoldConstant;
- case LOGAND_OP:
- if ((o1.value != 0) && (o2.value != 0)) x=1; else x=0;
- goto FoldConstant;
- case LOGOR_OP:
- if ((o1.value != 0) || (o2.value != 0)) x=1; else x=0;
- goto FoldConstant;
- }
- }
- }
- op_node_number = ET_used++;
- if (op_node_number == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[op_node_number].operator_number = t.value;
- ET[op_node_number].up = -1;
- ET[op_node_number].down = -1;
- ET[op_node_number].right = -1;
- /* This statement is redundant, but prevents compilers from wrongly
- issuing a "used before it was assigned a value" error: */
- previous_node_number = 0;
- for (i = emitter_sp-arity; i != emitter_sp; i++)
- {
- if (expr_trace_level >= 3)
- printf("i=%d, emitter_sp=%d, arity=%d, ETU=%d\n",
- i, emitter_sp, arity, ET_used);
- if (emitter_stack[i].type == EXPRESSION_OT)
- operand_node_number = emitter_stack[i].value;
- else
- { operand_node_number = ET_used++;
- if (operand_node_number == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[operand_node_number].down = -1;
- ET[operand_node_number].value = emitter_stack[i];
- }
- ET[operand_node_number].up = op_node_number;
- ET[operand_node_number].right = -1;
- if (i == emitter_sp - arity)
- { ET[op_node_number].down = operand_node_number;
- }
- else
- { ET[previous_node_number].right = operand_node_number;
- }
- previous_node_number = operand_node_number;
- }
- emitter_sp = emitter_sp - arity + 1;
- emitter_stack[emitter_sp - 1].type = EXPRESSION_OT;
- emitter_stack[emitter_sp - 1].value = op_node_number;
- emitter_stack[emitter_sp - 1].marker = 0;
- emitter_markers[emitter_sp - 1] = 0;
- emitter_bracket_counts[emitter_sp - 1] = 0;
- /* Remove the marker for the brackets implied by operator precedence */
- remove_bracket_layer_from_emitter_stack();
- return;
- FoldConstantC:
- /* In Glulx, skip this test; we can't check out-of-range errors
- for 32-bit arithmetic. */
- if (!glulx_mode && ((x<-32768) || (x > 32767)))
- { char folding_error[40];
- int32 ov1 = (o1.value >= 0x8000) ? (o1.value - 0x10000) : o1.value;
- int32 ov2 = (o2.value >= 0x8000) ? (o2.value - 0x10000) : o2.value;
- switch(t.value)
- {
- case PLUS_OP:
- sprintf(folding_error, "%d + %d = %d", ov1, ov2, x);
- break;
- case MINUS_OP:
- sprintf(folding_error, "%d - %d = %d", ov1, ov2, x);
- break;
- case TIMES_OP:
- sprintf(folding_error, "%d * %d = %d", ov1, ov2, x);
- break;
- }
- error_named("Signed arithmetic on compile-time constants overflowed \
- the range -32768 to +32767:", folding_error);
- }
- FoldConstant:
- if (!glulx_mode) {
- while (x < 0) x = x + 0x10000;
- x = x & 0xffff;
- }
- else {
- x = x & 0xffffffff;
- }
- emitter_sp = emitter_sp - arity + 1;
- if (!glulx_mode) {
- if (x<256)
- emitter_stack[emitter_sp - 1].type = SHORT_CONSTANT_OT;
- else emitter_stack[emitter_sp - 1].type = LONG_CONSTANT_OT;
- }
- else {
- if (x == 0)
- emitter_stack[emitter_sp - 1].type = ZEROCONSTANT_OT;
- else if (x >= -128 && x <= 127)
- emitter_stack[emitter_sp - 1].type = BYTECONSTANT_OT;
- else if (x >= -32768 && x <= 32767)
- emitter_stack[emitter_sp - 1].type = HALFCONSTANT_OT;
- else
- emitter_stack[emitter_sp - 1].type = CONSTANT_OT;
- }
- emitter_stack[emitter_sp - 1].value = x;
- emitter_stack[emitter_sp - 1].marker = 0;
- emitter_markers[emitter_sp - 1] = 0;
- emitter_bracket_counts[emitter_sp - 1] = 0;
- if (expr_trace_level >= 2)
- { printf("Folding constant to: ");
- print_operand(emitter_stack[emitter_sp - 1]);
- printf("\n");
- }
- /* Remove the marker for the brackets implied by operator precedence */
- remove_bracket_layer_from_emitter_stack();
- return;
- }
- /* --- Pretty printing ----------------------------------------------------- */
- static void show_node(int n, int depth, int annotate)
- { int j;
- for (j=0; j<2*depth+2; j++) printf(" ");
- if (ET[n].down == -1)
- { print_operand(ET[n].value);
- if (annotate && (ET[n].value.marker != 0))
- printf(" [%s]", describe_mv(ET[n].value.marker));
- printf("\n");
- }
- else
- { printf("%s ", operators[ET[n].operator_number].description);
- j = operators[ET[n].operator_number].precedence;
- if ((annotate) && ((j==2) || (j==3)))
- { printf(" %d|%d ", ET[n].true_label, ET[n].false_label);
- if (ET[n].label_after != -1) printf(" def %d after ",
- ET[n].label_after);
- if (ET[n].to_expression) printf(" con to expr ");
- }
- printf("\n");
- show_node(ET[n].down, depth+1, annotate);
- }
- if (ET[n].right != -1) show_node(ET[n].right, depth, annotate);
- }
- extern void show_tree(assembly_operand AO, int annotate)
- { if (AO.type == EXPRESSION_OT) show_node(AO.value, 0, annotate);
- else
- { printf("Constant: "); print_operand(AO);
- if (annotate && (AO.marker != 0))
- printf(" [%s]", describe_mv(AO.marker));
- printf("\n");
- }
- }
- /* --- Lvalue transformations ---------------------------------------------- */
- /* This only gets called in Z-code, since Glulx doesn't distinguish
- individual property operators from general ones. */
- static void check_property_operator(int from_node)
- { int below = ET[from_node].down;
- int opnum = ET[from_node].operator_number;
- ASSERT_ZCODE();
- if (veneer_mode) return;
- if ((below != -1) && (ET[below].right != -1))
- { int n = ET[below].right, flag = FALSE;
- if ((ET[n].down == -1)
- && ((ET[n].value.type == LONG_CONSTANT_OT)
- || (ET[n].value.type == SHORT_CONSTANT_OT))
- && ((ET[n].value.value > 0) && (ET[n].value.value < 64))
- && ((!module_switch) || (ET[n].value.marker == 0)))
- flag = TRUE;
- if (!flag)
- { switch(opnum)
- { case PROPERTY_OP: opnum = MESSAGE_OP; break;
- case PROP_ADD_OP: opnum = MPROP_ADD_OP; break;
- case PROP_NUM_OP: opnum = MPROP_NUM_OP; break;
- }
- }
- ET[from_node].operator_number = opnum;
- }
- if (below != -1)
- check_property_operator(below);
- if (ET[from_node].right != -1)
- check_property_operator(ET[from_node].right);
- }
- static void check_lvalues(int from_node)
- { int below = ET[from_node].down;
- int opnum = ET[from_node].operator_number, opnum_below;
- int lvalue_form, i, j;
- if (below != -1)
- {
- if ((opnum == FCALL_OP) && (ET[below].down != -1))
- { opnum_below = ET[below].operator_number;
- if ((opnum_below == PROPERTY_OP) || (opnum_below == MESSAGE_OP))
- { i = ET[ET[from_node].down].right;
- ET[from_node].down = ET[below].down;
- ET[ET[below].down].up = from_node;
- ET[ET[ET[below].down].right].up = from_node;
- ET[ET[ET[below].down].right].right = i;
- opnum = PROP_CALL_OP;
- ET[from_node].operator_number = opnum;
- }
- }
- if (operators[opnum].requires_lvalue)
- { opnum_below = ET[below].operator_number;
- if (ET[below].down == -1)
- { if (!is_variable_ot(ET[below].value.type))
- { error("'=' applied to undeclared variable");
- goto LvalueError;
- }
- }
- else
- { lvalue_form=0;
- switch(opnum)
- { case SETEQUALS_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_SETEQUALS_OP; break;
- case DARROW_OP: lvalue_form = DARROW_SETEQUALS_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_SETEQUALS_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_SETEQUALS_OP; break;
- }
- break;
- case INC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_INC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_INC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_INC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_INC_OP; break;
- }
- break;
- case POST_INC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_POST_INC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_POST_INC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_POST_INC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_POST_INC_OP; break;
- }
- break;
- case DEC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_DEC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_DEC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_DEC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_DEC_OP; break;
- }
- break;
- case POST_DEC_OP:
- switch(opnum_below)
- { case ARROW_OP: lvalue_form = ARROW_POST_DEC_OP; break;
- case DARROW_OP: lvalue_form = DARROW_POST_DEC_OP; break;
- case MESSAGE_OP: lvalue_form = MESSAGE_POST_DEC_OP; break;
- case PROPERTY_OP: lvalue_form = PROPERTY_POST_DEC_OP; break;
- }
- break;
- }
- if (lvalue_form == 0)
- { error_named("'=' applied to",
- (char *) operators[opnum_below].description);
- goto LvalueError;
- }
- /* Transform from_node from_node
- | \ | \\\ \
- below value to value
- | \\\
- */
- ET[from_node].operator_number = lvalue_form;
- i = ET[below].down;
- ET[from_node].down = i;
- while (i != -1)
- { ET[i].up = from_node;
- j = i;
- i = ET[i].right;
- }
- ET[j].right = ET[below].right;
- }
- }
- check_lvalues(below);
- }
- if (ET[from_node].right != -1)
- check_lvalues(ET[from_node].right);
- return;
- LvalueError:
- ET[from_node].down = -1;
- ET[from_node].value = zero_operand;
- if (ET[from_node].right != -1)
- check_lvalues(ET[from_node].right);
- }
- /* --- Tree surgery for conditionals --------------------------------------- */
- static void negate_condition(int n)
- { int i;
- if (ET[n].right != -1) negate_condition(ET[n].right);
- if (ET[n].down == -1) return;
- i = operators[ET[n].operator_number].negation;
- if (i!=0) ET[n].operator_number = i;
- if (operators[i].precedence==2) negate_condition(ET[n].down);
- }
- static void delete_negations(int n, int context)
- {
- /* Recursively apply
- ~~(x && y) = ~~x || ~~y
- ~~(x || y) = ~~x && ~~y
- ~~(x == y) = x ~= y
- (etc) to delete the ~~ operator from the tree. Since this is
- depth first, the ~~ being deleted has no ~~s beneath it, which
- is important to make "negate_condition" work. */
- int i;
- if (ET[n].right != -1) delete_negations(ET[n].right, context);
- if (ET[n].down == -1) return;
- delete_negations(ET[n].down, context);
- if (ET[n].operator_number == LOGNOT_OP)
- { negate_condition(ET[n].down);
- ET[n].operator_number
- = ET[ET[n].down].operator_number;
- ET[n].down = ET[ET[n].down].down;
- i = ET[n].down;
- while(i != -1) { ET[i].up = n; i = ET[i].right; }
- }
- }
- static void insert_exp_to_cond(int n, int context)
- {
- /* Insert a ~= test when an expression is used as a condition.
- Check for possible confusion over = and ==, e.g. "if (a = 1) ..." */
- int new, i;
- if (ET[n].right != -1) insert_exp_to_cond(ET[n].right, context);
- if (ET[n].down == -1)
- { if (context==CONDITION_CONTEXT)
- { new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new; ET[n].operator_number = NONZERO_OP;
- ET[new].up = n; ET[new].right = -1;
- }
- return;
- }
- switch(operators[ET[n].operator_number].precedence)
- { case 3: /* Conditionals have level 3 */
- context = QUANTITY_CONTEXT;
- break;
- case 2: /* Logical operators level 2 */
- context = CONDITION_CONTEXT;
- break;
- case 1: /* Forms of '=' have level 1 */
- if (context == CONDITION_CONTEXT)
- warning("'=' used as condition: '==' intended?");
- default:
- if (context != CONDITION_CONTEXT) break;
- new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new; ET[n].operator_number = NONZERO_OP;
- ET[new].up = n; ET[new].right = -1;
- i = ET[new].down;
- while (i!= -1) { ET[i].up = new; i = ET[i].right; }
- context = QUANTITY_CONTEXT; n = new;
- }
- insert_exp_to_cond(ET[n].down, context);
- }
- static unsigned int etoken_num_children(int n)
- {
- int count = 0;
- int i;
- i = ET[n].down;
- if (i == -1) { return 0; }
- do {
- count++;
- i = ET[i].right;
- } while (i!=-1);
- return count;
- }
- static void func_args_on_stack(int n, int context)
- {
- /* Make sure that the arguments of every function-call expression
- are stored to the stack. If any aren't (ie, if any arguments are
- constants or variables), cover them with push operators.
- (The very first argument does not need to be so treated, because
- it's the function address, not a function argument. We also
- skip the treatment for most system functions.) */
- int new, pn, fnaddr, opnum;
- ASSERT_GLULX();
- if (ET[n].right != -1)
- func_args_on_stack(ET[n].right, context);
- if (ET[n].down == -1) {
- pn = ET[n].up;
- if (pn != -1) {
- opnum = ET[pn].operator_number;
- if (opnum == FCALL_OP
- || opnum == MESSAGE_CALL_OP
- || opnum == PROP_CALL_OP) {
- /* If it's an FCALL, get the operand which contains the function
- address (or system-function number) */
- if (opnum == MESSAGE_CALL_OP
- || opnum == PROP_CALL_OP
- || ((fnaddr=ET[pn].down) != n
- && (ET[fnaddr].value.type != SYSFUN_OT
- || ET[fnaddr].value.value == INDIRECT_SYSF
- || ET[fnaddr].value.value == GLK_SYSF))) {
- if (etoken_num_children(pn) > (unsigned int)(opnum == FCALL_OP ? 4:3)) {
- new = ET_used++;
- if (new == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[new] = ET[n];
- ET[n].down = new;
- ET[n].operator_number = PUSH_OP;
- ET[new].up = n;
- ET[new].right = -1;
- }
- }
- }
- }
- return;
- }
- func_args_on_stack(ET[n].down, context);
- }
- static assembly_operand check_conditions(assembly_operand AO, int context)
- { int n;
- if (AO.type != EXPRESSION_OT)
- { if (context != CONDITION_CONTEXT) return AO;
- n = ET_used++;
- if (n == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- ET[n].down = -1;
- ET[n].up = -1;
- ET[n].right = -1;
- ET[n].value = AO;
- AO.type = EXPRESSION_OT;
- AO.value = n;
- AO.marker = 0;
- }
- insert_exp_to_cond(AO.value, context);
- delete_negations(AO.value, context);
- if (glulx_mode)
- func_args_on_stack(AO.value, context);
- return AO;
- }
- /* --- Shift-reduce parser ------------------------------------------------- */
- static int sr_sp;
- static token_data *sr_stack;
- extern assembly_operand parse_expression(int context)
- {
- /* Parses an expression, evaluating it as a constant if possible.
- Possible contexts are:
- VOID_CONTEXT the expression is used as a statement, so that
- its value will be thrown away and it only
- needs to exist for any resulting side-effects
- (function calls and assignments)
- CONDITION_CONTEXT the result must be a condition
- CONSTANT_CONTEXT there is required to be a constant result
- (so that, for instance, comma becomes illegal)
- QUANTITY_CONTEXT the default: a quantity is to be specified
- ACTION_Q_CONTEXT like QUANTITY_CONTEXT, but postfixed brackets
- at the top level do not indicate function call:
- used for e.g.
- <Insert button (random(pocket1, pocket2))>
- RETURN_Q_CONTEXT like QUANTITY_CONTEXT, but a single property
- name does not generate a warning
- ASSEMBLY_CONTEXT a quantity which cannot use the '->' operator
- (needed for assembly language to indicate
- store destinations)
- FORINIT_CONTEXT a quantity which cannot use an (unbracketed)
- '::' operator
- ARRAY_CONTEXT like CONSTANT_CONTEXT, but where an unbracketed
- minus sign is ambiguous, and brackets always
- indicate subexpressions, not function calls
- Return value: an assembly operand.
- If the type is OMITTED_OT, then the expression has no resulting value.
- If the type is EXPRESSION_OT, then the value will need to be
- calculated at run-time by code compiled from the expression tree
- whose root node-number is the operand value.
- Otherwise the assembly operand is the value of the expression, which
- is constant and thus known at compile time.
- If an error has occurred in the expression, which recovery from was
- not possible, then the return is (short constant) 0. This should
- minimise the chance of a cascade of further error messages.
- */
- token_data a, b, pop; int i;
- assembly_operand AO;
- superclass_allowed = (context != FORINIT_CONTEXT);
- if (context == FORINIT_CONTEXT) context = VOID_CONTEXT;
- comma_allowed = (context == VOID_CONTEXT);
- arrow_allowed = (context != ASSEMBLY_CONTEXT);
- bare_prop_allowed = (context == RETURN_Q_CONTEXT);
- array_init_ambiguity = ((context == ARRAY_CONTEXT) ||
- (context == ASSEMBLY_CONTEXT));
- action_ambiguity = (context == ACTION_Q_CONTEXT);
- if (context == ASSEMBLY_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == ACTION_Q_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == RETURN_Q_CONTEXT) context = QUANTITY_CONTEXT;
- if (context == ARRAY_CONTEXT) context = CONSTANT_CONTEXT;
- etoken_count = 0;
- inserting_token = FALSE;
- emitter_sp = 0;
- bracket_level = 0;
- previous_token.text = "$";
- previous_token.type = ENDEXP_TT;
- previous_token.value = 0;
- sr_sp = 1;
- sr_stack[0] = previous_token;
- AO = zero_operand;
- statements.enabled = FALSE;
- directives.enabled = FALSE;
- if (get_next_etoken() == FALSE)
- { ebf_error("expression", token_text);
- return AO;
- }
- do
- { if (expr_trace_level >= 2)
- { printf("Input: %-20s", current_token.text);
- for (i=0; i<sr_sp; i++) printf("%s ", sr_stack[i].text);
- printf("\n");
- }
- if (expr_trace_level >= 3) printf("ET_used = %d\n", ET_used);
- if (sr_sp == 0)
- { compiler_error("SR error: stack empty");
- return(AO);
- }
- a = sr_stack[sr_sp-1]; b = current_token;
- if ((a.type == ENDEXP_TT) && (b.type == ENDEXP_TT))
- { if (emitter_sp == 0)
- { compiler_error("SR error: emitter stack empty");
- return AO;
- }
- if (emitter_sp > 1)
- { compiler_error("SR error: emitter stack overfull");
- return AO;
- }
- AO = emitter_stack[0];
- if (AO.type == EXPRESSION_OT)
- { if (expr_trace_level >= 3)
- { printf("Tree before lvalue checking:\n");
- show_tree(AO, FALSE);
- }
- if (!glulx_mode)
- check_property_operator(AO.value);
- check_lvalues(AO.value);
- ET[AO.value].up = -1;
- }
- else {
- if ((context != CONSTANT_CONTEXT) && is_property_t(AO.symtype)
- && (arrow_allowed) && (!bare_prop_allowed))
- warning("Bare property name found. \"self.prop\" intended?");
- }
- check_conditions(AO, context);
- if (context == CONSTANT_CONTEXT)
- if (!is_constant_ot(AO.type))
- { AO = zero_operand;
- ebf_error("constant", "<expression>");
- }
- put_token_back();
- return(AO);
- }
- switch(find_prec(a,b))
- {
- case e5: /* Associativity error */
- error_named("Brackets mandatory to clarify order of:",
- a.text);
- case LOWER_P:
- case EQUAL_P:
- if (sr_sp == MAX_EXPRESSION_NODES)
- memoryerror("MAX_EXPRESSION_NODES", MAX_EXPRESSION_NODES);
- sr_stack[sr_sp++] = b;
- switch(b.type)
- {
- case SUBOPEN_TT:
- if (sr_sp >= 2 && sr_stack[sr_sp-2].type == OP_TT && sr_stack[sr_sp-2].value == FCALL_OP)
- mark_top_of_emitter_stack(FUNCTION_VALUE_MARKER, b);
- else
- add_bracket_layer_to_emitter_stack(0);
- break;
- case OP_TT:
- switch(b.value){
- case OR_OP:
- if (sr_stack[sr_sp-2].type == OP_TT &&
- operators[sr_stack[sr_sp-2].value].precedence == 3)
- mark_top_of_emitter_stack(OR_VALUE_MARKER, b);
- else
- { error("'or' not between values to the right of a condition");
- /* Convert to + for error recovery purposes */
- sr_stack[sr_sp-1].value = PLUS_OP;
- }
- break;
- case COMMA_OP:
- {
- /* A comma separates arguments only if the shallowest open bracket belongs to a function call. */
- int shallowest_open_bracket_index = sr_sp - 2;
- while (shallowest_open_bracket_index > 0 && sr_stack[shallowest_open_bracket_index].type != SUBOPEN_TT)
- --shallowest_open_bracket_index;
- if (shallowest_open_bracket_index > 0 &&
- sr_stack[shallowest_open_bracket_index-1].type == OP_TT &&
- sr_stack[shallowest_open_bracket_index-1].value == FCALL_OP)
- { mark_top_of_emitter_stack(ARGUMENT_VALUE_MARKER, b);
- break;
- }
- /* Non-argument-separating commas get treated like any other operator; we fall through to the default case. */
- }
- default:
- {
- /* Add a marker for the brackets implied by operator precedence */
- int operands_on_left = (operators[b.value].usage == PRE_U) ? 0 : 1;
- add_bracket_layer_to_emitter_stack(operands_on_left);
- }
- }
- }
- get_next_etoken();
- break;
- case GREATER_P:
- do
- { pop = sr_stack[sr_sp - 1];
- emit_token(pop);
- sr_sp--;
- } while (find_prec(sr_stack[sr_sp-1], pop) != LOWER_P);
- break;
- case e1: /* Missing operand error */
- error_named("Missing operand after", a.text);
- put_token_back();
- current_token.type = NUMBER_TT;
- current_token.value = 0;
- current_token.marker = 0;
- current_token.text = "0";
- break;
- case e2: /* Unexpected close bracket */
- error("Found '(' without matching ')'");
- get_next_etoken();
- break;
- case e3: /* Missing operator error */
- error("Missing operator: inserting '+'");
- put_token_back();
- current_token.type = OP_TT;
- current_token.value = PLUS_OP;
- current_token.marker = 0;
- current_token.text = "+";
- break;
- case e4: /* Expression ends with an open bracket */
- error("Found '(' without matching ')'");
- sr_sp--;
- break;
- }
- }
- while (TRUE);
- }
- /* --- Test for simple ++ or -- usage: used to optimise "for" loop code ---- */
- extern int test_for_incdec(assembly_operand AO)
- { int s = 0;
- if (AO.type != EXPRESSION_OT) return 0;
- if (ET[AO.value].down == -1) return 0;
- switch(ET[AO.value].operator_number)
- { case INC_OP: s = 1; break;
- case POST_INC_OP: s = 1; break;
- case DEC_OP: s = -1; break;
- case POST_DEC_OP: s = -1; break;
- }
- if (s==0) return 0;
- if (ET[ET[AO.value].down].down != -1) return 0;
- if (!is_variable_ot(ET[ET[AO.value].down].value.type)) return 0;
- return s*(ET[ET[AO.value].down].value.value);
- }
- /* ========================================================================= */
- /* Data structure management routines */
- /* ------------------------------------------------------------------------- */
- extern void init_expressp_vars(void)
- { int i;
- /* make_operands(); */
- make_lexical_interface_tables();
- for (i=0;i<32;i++) system_function_usage[i] = 0;
- }
- extern void expressp_begin_pass(void)
- {
- }
- extern void expressp_allocate_arrays(void)
- { ET = my_calloc(sizeof(expression_tree_node), MAX_EXPRESSION_NODES,
- "expression parse trees");
- emitter_markers = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
- "emitter markers");
- emitter_bracket_counts = my_calloc(sizeof(int), MAX_EXPRESSION_NODES,
- "emitter bracket layer counts");
- emitter_stack = my_calloc(sizeof(assembly_operand), MAX_EXPRESSION_NODES,
- "emitter stack");
- sr_stack = my_calloc(sizeof(token_data), MAX_EXPRESSION_NODES,
- "shift-reduce parser stack");
- }
- extern void expressp_free_arrays(void)
- { my_free(&ET, "expression parse trees");
- my_free(&emitter_markers, "emitter markers");
- my_free(&emitter_bracket_counts, "emitter bracket layer counts");
- my_free(&emitter_stack, "emitter stack");
- my_free(&sr_stack, "shift-reduce parser stack");
- }
- /* ========================================================================= */
|