12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948 |
- /* ------------------------------------------------------------------------- */
- /* "expressc" : The expression code generator */
- /* */
- /* Part of Inform 6.33 */
- /* copyright (c) Graham Nelson 1993 - 2014 */
- /* */
- /* ------------------------------------------------------------------------- */
- #include "header.h"
- int vivc_flag; /* TRUE if the last code-generated
- expression produced a "value in void
- context" error: used to help the syntax
- analyser recover from unknown-keyword
- errors, since unknown keywords are
- treated as yet-to-be-defined constants
- and thus as values in void context */
- /* These data structures are global, because they're too useful to be
- static. */
- assembly_operand stack_pointer, temp_var1, temp_var2, temp_var3,
- temp_var4, zero_operand, one_operand, two_operand, three_operand,
- four_operand, valueless_operand;
- static void make_operands(void)
- {
- if (!glulx_mode) {
- stack_pointer.type = VARIABLE_OT;
- stack_pointer.value = 0;
- stack_pointer.marker = 0;
- temp_var1.type = VARIABLE_OT;
- temp_var1.value = 255;
- temp_var1.marker = 0;
- temp_var2.type = VARIABLE_OT;
- temp_var2.value = 254;
- temp_var2.marker = 0;
- temp_var3.type = VARIABLE_OT;
- temp_var3.value = 253;
- temp_var3.marker = 0;
- temp_var4.type = VARIABLE_OT;
- temp_var4.value = 252;
- temp_var4.marker = 0;
- zero_operand.type = SHORT_CONSTANT_OT;
- zero_operand.value = 0;
- zero_operand.marker = 0;
- one_operand.type = SHORT_CONSTANT_OT;
- one_operand.value = 1;
- one_operand.marker = 0;
- two_operand.type = SHORT_CONSTANT_OT;
- two_operand.value = 2;
- two_operand.marker = 0;
- three_operand.type = SHORT_CONSTANT_OT;
- three_operand.value = 3;
- three_operand.marker = 0;
- four_operand.type = SHORT_CONSTANT_OT;
- four_operand.value = 4;
- four_operand.marker = 0;
- valueless_operand.type = OMITTED_OT;
- valueless_operand.value = 0;
- valueless_operand.marker = 0;
- }
- else {
- stack_pointer.type = LOCALVAR_OT;
- stack_pointer.value = 0;
- stack_pointer.marker = 0;
- temp_var1.type = GLOBALVAR_OT;
- temp_var1.value = MAX_LOCAL_VARIABLES+0;
- temp_var1.marker = 0;
- temp_var2.type = GLOBALVAR_OT;
- temp_var2.value = MAX_LOCAL_VARIABLES+1;
- temp_var2.marker = 0;
- temp_var3.type = GLOBALVAR_OT;
- temp_var3.value = MAX_LOCAL_VARIABLES+2;
- temp_var3.marker = 0;
- temp_var4.type = GLOBALVAR_OT;
- temp_var4.value = MAX_LOCAL_VARIABLES+3;
- temp_var4.marker = 0;
- zero_operand.type = ZEROCONSTANT_OT;
- zero_operand.value = 0;
- zero_operand.marker = 0;
- one_operand.type = BYTECONSTANT_OT;
- one_operand.value = 1;
- one_operand.marker = 0;
- two_operand.type = BYTECONSTANT_OT;
- two_operand.value = 2;
- two_operand.marker = 0;
- three_operand.type = BYTECONSTANT_OT;
- three_operand.value = 3;
- three_operand.marker = 0;
- four_operand.type = BYTECONSTANT_OT;
- four_operand.value = 4;
- four_operand.marker = 0;
- valueless_operand.type = OMITTED_OT;
- valueless_operand.value = 0;
- valueless_operand.marker = 0;
- }
- }
- /* ------------------------------------------------------------------------- */
- /* The table of conditionals. (Only used in Glulx) */
- #define ZERO_CC (500)
- #define EQUAL_CC (502)
- #define LT_CC (504)
- #define GT_CC (506)
- #define HAS_CC (508)
- #define IN_CC (510)
- #define OFCLASS_CC (512)
- #define PROVIDES_CC (514)
- #define FIRST_CC (500)
- #define LAST_CC (515)
- typedef struct condclass_s {
- int32 posform; /* Opcode for the conditional in its positive form. */
- int32 negform; /* Opcode for the conditional in its negated form. */
- } condclass;
- condclass condclasses[] = {
- { jz_gc, jnz_gc },
- { jeq_gc, jne_gc },
- { jlt_gc, jge_gc },
- { jgt_gc, jle_gc },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 },
- { -1, -1 }
- };
- /* ------------------------------------------------------------------------- */
- /* The table of operators.
- The ordering in this table is not significant except that it must match
- the #define's in "header.h" */
- operator operators[NUM_OPERATORS] =
- {
- /* ------------------------ */
- /* Level 0: , */
- /* ------------------------ */
- { 0, SEP_TT, COMMA_SEP, IN_U, L_A, 0, -1, -1, 0, 0, "comma" },
- /* ------------------------ */
- /* Level 1: = */
- /* ------------------------ */
- { 1, SEP_TT, SETEQUALS_SEP, IN_U, R_A, 1, -1, -1, 1, 0,
- "assignment operator '='" },
- /* ------------------------ */
- /* Level 2: ~~ && || */
- /* ------------------------ */
- { 2, SEP_TT, LOGAND_SEP, IN_U, L_A, 0, -1, -1, 0, LOGOR_OP,
- "logical conjunction '&&'" },
- { 2, SEP_TT, LOGOR_SEP, IN_U, L_A, 0, -1, -1, 0, LOGAND_OP,
- "logical disjunction '||'" },
- { 2, SEP_TT, LOGNOT_SEP, PRE_U, R_A, 0, -1, -1, 0, LOGNOT_OP,
- "logical negation '~~'" },
- /* ------------------------ */
- /* Level 3: == ~= */
- /* > >= < <= */
- /* has hasnt */
- /* in notin */
- /* provides */
- /* ofclass */
- /* ------------------------ */
- { 3, -1, -1, -1, 0, 0, 400 + jz_zc, ZERO_CC+0, 0, NONZERO_OP,
- "expression used as condition then negated" },
- { 3, -1, -1, -1, 0, 0, 800 + jz_zc, ZERO_CC+1, 0, ZERO_OP,
- "expression used as condition" },
- { 3, SEP_TT, CONDEQUALS_SEP, IN_U, 0, 0, 400 + je_zc, EQUAL_CC+0, 0, NOTEQUAL_OP,
- "'==' condition" },
- { 3, SEP_TT, NOTEQUAL_SEP, IN_U, 0, 0, 800 + je_zc, EQUAL_CC+1, 0, CONDEQUALS_OP,
- "'~=' condition" },
- { 3, SEP_TT, GE_SEP, IN_U, 0, 0, 800 + jl_zc, LT_CC+1, 0, LESS_OP,
- "'>=' condition" },
- { 3, SEP_TT, GREATER_SEP, IN_U, 0, 0, 400 + jg_zc, GT_CC+0, 0, LE_OP,
- "'>' condition" },
- { 3, SEP_TT, LE_SEP, IN_U, 0, 0, 800 + jg_zc, GT_CC+1, 0, GREATER_OP,
- "'<=' condition" },
- { 3, SEP_TT, LESS_SEP, IN_U, 0, 0, 400 + jl_zc, LT_CC+0, 0, GE_OP,
- "'<' condition" },
- { 3, CND_TT, HAS_COND, IN_U, 0, 0, 400 + test_attr_zc, HAS_CC+0, 0, HASNT_OP,
- "'has' condition" },
- { 3, CND_TT, HASNT_COND, IN_U, 0, 0, 800 + test_attr_zc, HAS_CC+1, 0, HAS_OP,
- "'hasnt' condition" },
- { 3, CND_TT, IN_COND, IN_U, 0, 0, 400 + jin_zc, IN_CC+0, 0, NOTIN_OP,
- "'in' condition" },
- { 3, CND_TT, NOTIN_COND, IN_U, 0, 0, 800 + jin_zc, IN_CC+1, 0, IN_OP,
- "'notin' condition" },
- { 3, CND_TT, OFCLASS_COND, IN_U, 0, 0, 600, OFCLASS_CC+0, 0, NOTOFCLASS_OP,
- "'ofclass' condition" },
- { 3, CND_TT, PROVIDES_COND, IN_U, 0, 0, 601, PROVIDES_CC+0, 0, NOTPROVIDES_OP,
- "'provides' condition" },
- { 3, -1, -1, -1, 0, 0, 1000, OFCLASS_CC+1, 0, OFCLASS_OP,
- "negated 'ofclass' condition" },
- { 3, -1, -1, -1, 0, 0, 1001, PROVIDES_CC+1, 0, PROVIDES_OP,
- "negated 'provides' condition" },
- /* ------------------------ */
- /* Level 4: or */
- /* ------------------------ */
- { 4, CND_TT, OR_COND, IN_U, L_A, 0, -1, -1, 0, 0, "'or'" },
- /* ------------------------ */
- /* Level 5: + binary - */
- /* ------------------------ */
- { 5, SEP_TT, PLUS_SEP, IN_U, L_A, 0, add_zc, add_gc, 0, 0, "'+'" },
- { 5, SEP_TT, MINUS_SEP, IN_U, L_A, 0, sub_zc, sub_gc, 0, 0, "'-'" },
- /* ------------------------ */
- /* Level 6: * / % */
- /* & | ~ */
- /* ------------------------ */
- { 6, SEP_TT, TIMES_SEP, IN_U, L_A, 0, mul_zc, mul_gc, 0, 0, "'*'" },
- { 6, SEP_TT, DIVIDE_SEP, IN_U, L_A, 0, div_zc, div_gc, 0, 0, "'/'" },
- { 6, SEP_TT, REMAINDER_SEP, IN_U, L_A, 0, mod_zc, mod_gc, 0, 0,
- "remainder after division '%'" },
- { 6, SEP_TT, ARTAND_SEP, IN_U, L_A, 0, and_zc, bitand_gc, 0, 0,
- "bitwise AND '&'" },
- { 6, SEP_TT, ARTOR_SEP, IN_U, L_A, 0, or_zc, bitor_gc, 0, 0,
- "bitwise OR '|'" },
- { 6, SEP_TT, ARTNOT_SEP, PRE_U, R_A, 0, -1, bitnot_gc, 0, 0,
- "bitwise NOT '~'" },
- /* ------------------------ */
- /* Level 7: -> --> */
- /* ------------------------ */
- { 7, SEP_TT, ARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "byte array operator '->'" },
- { 7, SEP_TT, DARROW_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "word array operator '-->'" },
- /* ------------------------ */
- /* Level 8: unary - */
- /* ------------------------ */
- { 8, SEP_TT, UNARY_MINUS_SEP, PRE_U, R_A, 0, -1, neg_gc, 0, 0,
- "unary minus" },
- /* ------------------------ */
- /* Level 9: ++ -- */
- /* (prefix or postfix) */
- /* ------------------------ */
- { 9, SEP_TT, INC_SEP, PRE_U, R_A, 2, -1, -1, 1, 0,
- "pre-increment operator '++'" },
- { 9, SEP_TT, POST_INC_SEP, POST_U, R_A, 3, -1, -1, 1, 0,
- "post-increment operator '++'" },
- { 9, SEP_TT, DEC_SEP, PRE_U, R_A, 4, -1, -1, 1, 0,
- "pre-decrement operator '--'" },
- { 9, SEP_TT, POST_DEC_SEP, POST_U, R_A, 5, -1, -1, 1, 0,
- "post-decrement operator '--'" },
- /* ------------------------ */
- /* Level 10: .& .# */
- /* ..& ..# */
- /* ------------------------ */
- {10, SEP_TT, PROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property address operator '.&'" },
- {10, SEP_TT, PROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property length operator '.#'" },
- {10, SEP_TT, MPROPADD_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property address operator '..&'" },
- {10, SEP_TT, MPROPNUM_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property length operator '..#'" },
- /* ------------------------ */
- /* Level 11: function ( */
- /* ------------------------ */
- {11, SEP_TT, OPENB_SEP, IN_U, L_A, 0, -1, -1, 1, 0,
- "function call" },
- /* ------------------------ */
- /* Level 12: . .. */
- /* ------------------------ */
- {12, SEP_TT, MESSAGE_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "individual property selector '..'" },
- {12, SEP_TT, PROPERTY_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "property selector '.'" },
- /* ------------------------ */
- /* Level 13: :: */
- /* ------------------------ */
- {13, SEP_TT, SUPERCLASS_SEP, IN_U, L_A, 0, -1, -1, 0, 0,
- "superclass operator '::'" },
- /* ------------------------ */
- /* Miscellaneous operators */
- /* generated at lvalue */
- /* checking time */
- /* ------------------------ */
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> = */
- "byte array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> = */
- "word array entry assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. = */
- "individual property assignment" },
- { 1, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . = */
- "common property assignment" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ -> */
- "byte array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ --> */
- "word array entry preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ .. */
- "individual property preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* ++ . */
- "common property preincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- -> */
- "byte array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- --> */
- "word array entry predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- .. */
- "individual property predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -- . */
- "common property predecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> ++ */
- "byte array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> ++ */
- "word array entry postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. ++ */
- "individual property postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . ++ */
- "common property postincrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* -> -- */
- "byte array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* --> -- */
- "word array entry postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* .. -- */
- "individual property postdecrement" },
- { 9, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* . -- */
- "common property postdecrement" },
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x.y(args) */
- "call to common property" },
- {11, -1, -1, -1, -1, 0, -1, -1, 1, 0, /* x..y(args) */
- "call to individual property" },
- /* ------------------------ */
- /* And one Glulx-only op */
- /* which just pushes its */
- /* argument on the stack, */
- /* unchanged. */
- /* ------------------------ */
- {14, -1, -1, -1, -1, 0, -1, -1, 1, 0,
- "push on stack" }
- };
- /* --- Condition annotater ------------------------------------------------- */
- static void annotate_for_conditions(int n, int a, int b)
- { int i, opnum = ET[n].operator_number;
- ET[n].label_after = -1;
- ET[n].to_expression = FALSE;
- ET[n].true_label = a;
- ET[n].false_label = b;
- if (ET[n].down == -1) return;
- if ((operators[opnum].precedence == 2)
- || (operators[opnum].precedence == 3))
- { if ((a == -1) && (b == -1))
- { if (opnum == LOGAND_OP)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].to_expression = TRUE;
- }
- else
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].to_expression = TRUE;
- }
- }
- }
- switch(opnum)
- { case LOGAND_OP:
- if (b == -1)
- { b = next_label++;
- ET[n].false_label = b;
- ET[n].label_after = b;
- }
- annotate_for_conditions(ET[n].down, -1, b);
- if (b == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, a, -1);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- case LOGOR_OP:
- if (a == -1)
- { a = next_label++;
- ET[n].true_label = a;
- ET[n].label_after = a;
- }
- annotate_for_conditions(ET[n].down, a, -1);
- if (a == ET[n].label_after)
- annotate_for_conditions(ET[ET[n].down].right, -1, b);
- else annotate_for_conditions(ET[ET[n].down].right, a, b);
- return;
- }
- i = ET[n].down;
- while (i != -1)
- { annotate_for_conditions(i, -1, -1); i = ET[i].right; }
- }
- /* --- Code generator ------------------------------------------------------ */
- static void value_in_void_context_z(assembly_operand AO)
- { char *t;
- ASSERT_ZCODE();
-
- switch(AO.type)
- { case LONG_CONSTANT_OT:
- case SHORT_CONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case VARIABLE_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
- if (strcmp(t, "print_paddr") == 0)
- obsolete_warning("ignoring 'print_paddr': use 'print (string)' instead");
- else
- if (strcmp(t, "print_addr") == 0)
- obsolete_warning("ignoring 'print_addr': use 'print (address)' instead");
- else
- if (strcmp(t, "print_char") == 0)
- obsolete_warning("ignoring 'print_char': use 'print (char)' instead");
- else
- ebf_error("expression with side-effects", t);
- }
- static void write_result_z(assembly_operand to, assembly_operand from)
- { if (to.value == from.value) return;
- if (to.value == 0) assemblez_1(push_zc, from);
- else assemblez_store(to, from);
- }
- static void pop_zm_stack(void)
- { assembly_operand st;
- if (version_number < 5) assemblez_0(pop_zc);
- else
- { st.marker = 0; st.type = VARIABLE_OT; st.value = 0;
- assemblez_1_branch(jz_zc, st, -2, TRUE);
- }
- }
- static void access_memory_z(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
- { int vr;
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao;
- int x, y, byte_flag, read_flag, from_module;
- if (AO1.marker == ARRAY_MV)
- {
- if ((oc == loadb_zc) || (oc == storeb_zc)) byte_flag=TRUE;
- else byte_flag = FALSE;
- if ((oc == loadb_zc) || (oc == loadw_zc)) read_flag=TRUE;
- else read_flag = FALSE;
- zero_ao.type = SHORT_CONSTANT_OT;
- zero_ao.value = 0; zero_ao.marker = 0;
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1)
- from_module=TRUE;
- else {
- from_module=FALSE;
- type_ao = zero_ao; type_ao.value = array_types[y];
- if ((!is_systemfile()))
- { if (byte_flag)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
- }
- if ((!runtime_error_checking_switch) || (veneer_mode))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- return;
- }
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
- if ((AO1.marker == ARRAY_MV) && (!from_module))
- {
- int passed_label = next_label++, failed_label = next_label++,
- final_label = next_label++;
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
- if (byte_flag
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*2 + 1;
- type_ao.value += 8;
- }
- if ((!byte_flag)
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { if ((size_ao.value % 2) == 0)
- max_ao.value = size_ao.value/2 - 1;
- else max_ao.value = (size_ao.value-1)/2;
- type_ao.value += 16;
- }
- max_ao.value++;
- if (size_ao.value >= 256) size_ao.type = LONG_CONSTANT_OT;
- if (max_ao.value >= 256) max_ao.type = LONG_CONSTANT_OT;
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && byte_flag)
- zero_ao.value = 2;
- else zero_ao.value = 1;
- }
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
- switch(oc) { case loadb_zc: en_ao.value = ABOUNDS_RTE; break;
- case loadw_zc: en_ao.value = ABOUNDS_RTE+1; break;
- case storeb_zc: en_ao.value = ABOUNDS_RTE+2; break;
- case storew_zc: en_ao.value = ABOUNDS_RTE+3; break; }
- index_ao = AO2;
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- { assemblez_store(temp_var2, AO2);
- assemblez_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assemblez_2_branch(jl_zc, index_ao, zero_ao, failed_label, TRUE);
- assemblez_2_branch(jl_zc, index_ao, max_ao, passed_label, TRUE);
- assemble_label_no(failed_label);
- an_ao = zero_ao; an_ao.value = y;
- assemblez_6(call_vn2_zc, veneer_routine(RT__Err_VR), en_ao,
- index_ao, size_ao, type_ao, an_ao);
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0)) pop_zm_stack();
- if ((AO2.type == VARIABLE_OT) && (AO2.value == 0)) pop_zm_stack();
- if ((AO3.type == VARIABLE_OT) && (AO3.value == 0))
- { if ((oc == loadb_zc) || (oc == loadw_zc))
- { assemblez_store(AO3, zero_ao);
- }
- else pop_zm_stack();
- }
- assemblez_jump(final_label);
- assemble_label_no(passed_label);
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_2_to(oc, AO1, AO2, AO3);
- else
- assemblez_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
- switch(oc) { case loadb_zc: vr = RT__ChLDB_VR; break;
- case loadw_zc: vr = RT__ChLDW_VR; break;
- case storeb_zc: vr = RT__ChSTB_VR; break;
- case storew_zc: vr = RT__ChSTW_VR; break; }
- if ((oc == loadb_zc) || (oc == loadw_zc))
- assemblez_3_to(call_vs_zc, veneer_routine(vr), AO1, AO2, AO3);
- else
- assemblez_4(call_vn_zc, veneer_routine(vr), AO1, AO2, AO3);
- }
- static assembly_operand check_nonzero_at_runtime_z(assembly_operand AO1,
- int error_label, int rte_number)
- { assembly_operand AO2, AO3;
- int check_sp = FALSE, passed_label, failed_label, last_label;
- if (veneer_mode) return AO1;
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant 2, or return the operand (short constant) 2.
- The point of 2 is that object 2 is the class-object Object
- and therefore has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
- /* Sometimes we can already see that the object number is valid. */
- if (((AO1.type == LONG_CONSTANT_OT) || (AO1.type == SHORT_CONSTANT_OT))
- && (AO1.marker == 0) && (AO1.value >= 1) && (AO1.value < no_objects))
- return AO1;
- passed_label = next_label++;
- failed_label = next_label++;
- AO2.type = LONG_CONSTANT_OT;
- AO2.value = actual_largest_object_SC;
- AO2.marker = INCON_MV;
- AO3.value = 5; AO3.type = SHORT_CONSTANT_OT; AO3.marker = 0;
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE))
- { /* Allow classes */
- AO3.value = 1;
- if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, passed_label, FALSE);
- }
- }
- else
- { if ((AO1.type == VARIABLE_OT) && (AO1.value == 0))
- { /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assemblez_store(temp_var2, AO1);
- assemblez_store(AO1, temp_var2);
- assemblez_2_branch(jg_zc, AO3, temp_var2, failed_label, TRUE);
- assemblez_2_branch(jg_zc, temp_var2, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, temp_var2, AO3, passed_label, FALSE);
- }
- else
- { assemblez_2_branch(jg_zc, AO3, AO1, failed_label, TRUE);
- assemblez_2_branch(jg_zc, AO1, AO2, failed_label, TRUE);
- AO3.value = 1;
- assemblez_2_branch(jin_zc, AO1, AO3, passed_label, FALSE);
- }
- }
- assemble_label_no(failed_label);
- AO2.type = SHORT_CONSTANT_OT; AO2.value = rte_number; AO2.marker = 0;
- if (version_number >= 5)
- assemblez_3(call_vn_zc, veneer_routine(RT__Err_VR), AO2, AO1);
- else
- assemblez_3_to(call_zc, veneer_routine(RT__Err_VR), AO2, AO1, temp_var2);
- if (error_label != -1)
- { /* Jump to the error label */
- if (error_label == -3) assemblez_0(rfalse_zc);
- else if (error_label == -4) assemblez_0(rtrue_zc);
- else assemblez_jump(error_label);
- }
- else
- { if (check_sp)
- { /* Push the short constant 2 */
- AO2.type = SHORT_CONSTANT_OT; AO2.value = 2; AO2.marker = 0;
- assemblez_store(AO1, AO2);
- }
- else
- { /* Store either short constant 2 or the operand's value in
- the temporary variable */
- AO2.type = SHORT_CONSTANT_OT; AO2.value = 2; AO2.marker = 0;
- AO3 = temp_var2; assemblez_store(AO3, AO2);
- last_label = next_label++;
- assemblez_jump(last_label);
- assemble_label_no(passed_label);
- assemblez_store(AO3, AO1);
- assemble_label_no(last_label);
- return AO3;
- }
- }
- assemble_label_no(passed_label);
- return AO1;
- }
- static void compile_conditional_z(int oc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
- { assembly_operand AO3; int the_zc, error_label = label,
- va_flag = FALSE, va_label;
- ASSERT_ZCODE();
- if (oc<200)
- { if ((runtime_error_checking_switch) && (oc == jin_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- if ((runtime_error_checking_switch) && (oc == test_attr_zc))
- { if (flag) error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- switch(AO2.type)
- { case SHORT_CONSTANT_OT:
- case LONG_CONSTANT_OT:
- if (AO2.marker == 0)
- { if ((AO2.value < 0) || (AO2.value > 47))
- error("'has'/'hasnt' applied to illegal attribute number");
- break;
- }
- case VARIABLE_OT:
- { int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, zero_ao, max_ao;
- assemblez_store(temp_var1, AO1);
- if ((AO1.type == VARIABLE_OT)&&(AO1.value == 0))
- assemblez_store(AO1, temp_var1);
- assemblez_store(temp_var2, AO2);
- if ((AO2.type == VARIABLE_OT)&&(AO2.value == 0))
- assemblez_store(AO2, temp_var2);
- zero_ao.type = SHORT_CONSTANT_OT; zero_ao.marker = 0;
- zero_ao.value = 0; max_ao = zero_ao; max_ao.value = 48;
- assemblez_2_branch(jl_zc,temp_var2,zero_ao,fa_label,TRUE);
- assemblez_2_branch(jl_zc,temp_var2,max_ao,pa_label,TRUE);
- assemble_label_no(fa_label);
- en_ao = zero_ao; en_ao.value = 19;
- assemblez_4(call_vn_zc, veneer_routine(RT__Err_VR),
- en_ao, temp_var1, temp_var2);
- va_flag = TRUE; va_label = next_label++;
- assemblez_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- }
- assemblez_2_branch(oc, AO1, AO2, label, flag);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
- return;
- }
- AO3.type = VARIABLE_OT; AO3.value = 0; AO3.marker = 0;
- the_zc = (version_number == 3)?call_zc:call_vs_zc;
- if (oc == 201)
- assemblez_3_to(the_zc, veneer_routine(OP__Pr_VR), AO1, AO2, AO3);
- else
- assemblez_3_to(the_zc, veneer_routine(OC__Cl_VR), AO1, AO2, AO3);
- assemblez_1_branch(jz_zc, AO3, label, !flag);
- }
- static void value_in_void_context_g(assembly_operand AO)
- { char *t;
- ASSERT_GLULX();
- switch(AO.type)
- { case CONSTANT_OT:
- case HALFCONSTANT_OT:
- case BYTECONSTANT_OT:
- case ZEROCONSTANT_OT:
- t = "<constant>";
- if (AO.marker == SYMBOL_MV)
- t = (char *) (symbs[AO.value]);
- break;
- case GLOBALVAR_OT:
- case LOCALVAR_OT:
- t = variable_name(AO.value);
- break;
- default:
- compiler_error("Unable to print value in void context");
- t = "<expression>";
- break;
- }
- vivc_flag = TRUE;
- ebf_error("expression with side-effects", t);
- }
- static void write_result_g(assembly_operand to, assembly_operand from)
- { if (to.value == from.value && to.type == from.type) return;
- assembleg_store(to, from);
- }
- static void access_memory_g(int oc, assembly_operand AO1, assembly_operand AO2,
- assembly_operand AO3)
- { int vr;
- int data_len, read_flag;
- assembly_operand zero_ao, max_ao, size_ao, en_ao, type_ao, an_ao,
- index_ao, five_ao;
- int passed_label, failed_label, final_label, x, y;
- if ((oc == aloadb_gc) || (oc == astoreb_gc)) data_len = 1;
- else if ((oc == aloads_gc) || (oc == astores_gc)) data_len = 2;
- else data_len = 4;
- if ((oc == aloadb_gc) || (oc == aloads_gc) || (oc == aload_gc))
- read_flag = TRUE;
- else
- read_flag = FALSE;
- if (AO1.marker == ARRAY_MV)
- {
- zero_ao.value = 0; zero_ao.marker = 0;
- size_ao = zero_ao; size_ao.value = -1;
- for (x=0; x<no_arrays; x++)
- { if (AO1.value == svals[array_symbols[x]])
- { size_ao.value = array_sizes[x]; y=x;
- }
- }
- if (size_ao.value==-1) compiler_error("Array size can't be found");
- type_ao = zero_ao; type_ao.value = array_types[y];
- if ((!is_systemfile()))
- { if (data_len == 1)
- {
- if ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- warning("Using '->' to access a --> or table array");
- }
- else
- {
- if ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY))
- warning("Using '-->' to access a -> or string array");
- }
- }
- }
- if ((!runtime_error_checking_switch) || (veneer_mode))
- {
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
- /* If we recognise AO1 as arising textually from a declared
- array, we can check bounds explicitly. */
- if (AO1.marker == ARRAY_MV)
- {
- /* Calculate the largest permitted array entry + 1
- Here "size_ao.value" = largest permitted entry of its own kind */
- max_ao = size_ao;
- if (data_len == 1
- && ((array_types[y] == WORD_ARRAY)
- || (array_types[y] == TABLE_ARRAY)))
- { max_ao.value = size_ao.value*4 + 3;
- type_ao.value += 8;
- }
- if (data_len == 4
- && ((array_types[y] == BYTE_ARRAY)
- || (array_types[y] == STRING_ARRAY)
- || (array_types[y] == BUFFER_ARRAY)))
- { max_ao.value = (size_ao.value-3)/4;
- type_ao.value += 16;
- }
- max_ao.value++;
- /* Can't write to the size entry in a string or table */
- if (((array_types[y] == STRING_ARRAY)
- || (array_types[y] == TABLE_ARRAY))
- && (!read_flag))
- { if ((array_types[y] == TABLE_ARRAY) && data_len == 1)
- zero_ao.value = 4;
- else zero_ao.value = 1;
- }
- en_ao = zero_ao; en_ao.value = ABOUNDS_RTE;
- switch(oc) { case aloadb_gc: en_ao.value = ABOUNDS_RTE; break;
- case aload_gc: en_ao.value = ABOUNDS_RTE+1; break;
- case astoreb_gc: en_ao.value = ABOUNDS_RTE+2; break;
- case astore_gc: en_ao.value = ABOUNDS_RTE+3; break; }
- set_constant_ot(&zero_ao);
- set_constant_ot(&size_ao);
- set_constant_ot(&max_ao);
- set_constant_ot(&type_ao);
- set_constant_ot(&en_ao);
- /* If we recognize A02 as a constant, we can do the test right
- now. */
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if (AO2.value < zero_ao.value || AO2.value >= max_ao.value) {
- error("Array reference is out-of-bounds");
- }
- assembleg_3(oc, AO1, AO2, AO3);
- return;
- }
- passed_label = next_label++;
- failed_label = next_label++;
- final_label = next_label++;
- index_ao = AO2;
- if ((AO2.type == LOCALVAR_OT)&&(AO2.value == 0))
- { assembleg_store(temp_var2, AO2); /* ### could peek */
- assembleg_store(AO2, temp_var2);
- index_ao = temp_var2;
- }
- assembleg_2_branch(jlt_gc, index_ao, zero_ao, failed_label);
- assembleg_2_branch(jlt_gc, index_ao, max_ao, passed_label);
- assemble_label_no(failed_label);
- an_ao = zero_ao; an_ao.value = y;
- set_constant_ot(&an_ao);
- five_ao = zero_ao; five_ao.value = 5;
- set_constant_ot(&five_ao);
- /* Call the error veneer routine. */
- assembleg_store(stack_pointer, an_ao);
- assembleg_store(stack_pointer, type_ao);
- assembleg_store(stack_pointer, size_ao);
- assembleg_store(stack_pointer, index_ao);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- five_ao, zero_operand);
- /* We have to clear any of AO1, AO2, AO3 off the stack if
- present, so that we can achieve the same effect on the stack
- that executing the opcode would have had */
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_2(copy_gc, stack_pointer, zero_operand);
- if ((AO3.type == LOCALVAR_OT) && (AO3.value == 0))
- { if ((oc == aloadb_gc) || (oc == aload_gc))
- { assembleg_store(AO3, zero_ao);
- }
- else assembleg_2(copy_gc, stack_pointer, zero_operand);
- }
- assembleg_jump(final_label);
- assemble_label_no(passed_label);
- assembleg_3(oc, AO1, AO2, AO3);
- assemble_label_no(final_label);
- return;
- }
- /* Otherwise, compile a call to the veneer which verifies that
- the proposed read/write is within dynamic Z-machine memory. */
- switch(oc) {
- case aloadb_gc: vr = RT__ChLDB_VR; break;
- case aload_gc: vr = RT__ChLDW_VR; break;
- case astoreb_gc: vr = RT__ChSTB_VR; break;
- case astore_gc: vr = RT__ChSTW_VR; break;
- }
- if ((oc == aloadb_gc) || (oc == aload_gc))
- assembleg_call_2(veneer_routine(vr), AO1, AO2, AO3);
- else
- assembleg_call_3(veneer_routine(vr), AO1, AO2, AO3, zero_operand);
- }
- static assembly_operand check_nonzero_at_runtime_g(assembly_operand AO1,
- int error_label, int rte_number)
- {
- assembly_operand AO, AO2, AO3;
- int ln;
- int check_sp = FALSE, passed_label, failed_label, last_label;
- if (veneer_mode)
- return AO1;
- /* Assemble to code to check that the operand AO1 is ofclass Object:
- if it is, execution should continue and the stack should be
- unchanged. Otherwise, call the veneer's run-time-error routine
- with the given error number, and then: if the label isn't -1,
- switch execution to this label, with the value popped from
- the stack if it was on the stack in the first place;
- if the label is -1, either replace the top of the stack with
- the constant symbol (class-object) Object.
- The Object has no parent, child or sibling, so that the
- built-in tree functions will safely return 0 on this object. */
- /* Sometimes we can already see that the object number is valid. */
- if (AO1.marker == OBJECT_MV &&
- ((AO1.value >= 1) && (AO1.value <= no_objects))) {
- return AO1;
- }
- passed_label = next_label++;
- failed_label = next_label++;
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0) && (AO1.marker == 0)) {
- /* That is, if AO1 is the stack pointer */
- check_sp = TRUE;
- assembleg_store(temp_var2, stack_pointer);
- assembleg_store(stack_pointer, temp_var2);
- AO = temp_var2;
- }
- else {
- AO = AO1;
- }
-
- if ((rte_number == IN_RTE) || (rte_number == HAS_RTE)
- || (rte_number == PROPERTY_RTE) || (rte_number == PROP_NUM_RTE)
- || (rte_number == PROP_ADD_RTE)) {
- /* Allow classes */
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- AO3.marker = 0;
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jeq_gc, stack_pointer, AO3, passed_label);
- }
- else {
- /* Test if zero... */
- assembleg_1_branch(jz_gc, AO, failed_label);
- /* Test if first byte is 0x70... */
- assembleg_3(aloadb_gc, AO, zero_operand, stack_pointer);
- AO3.marker = 0;
- AO3.value = 0x70; /* type byte -- object */
- set_constant_ot(&AO3);
- assembleg_2_branch(jne_gc, stack_pointer, AO3, failed_label);
- /* Test if inside the "Class" object... */
- AO3.type = BYTECONSTANT_OT;
- AO3.value = GOBJFIELD_PARENT();
- AO3.marker = 0;
- assembleg_3(aload_gc, AO, AO3, stack_pointer);
- ln = symbol_index("Class", -1);
- AO3.value = svals[ln];
- AO3.marker = OBJECT_MV;
- AO3.type = CONSTANT_OT;
- assembleg_2_branch(jne_gc, stack_pointer, AO3, passed_label);
- }
-
- assemble_label_no(failed_label);
- AO2.marker = 0;
- AO2.value = rte_number;
- set_constant_ot(&AO2);
- assembleg_call_2(veneer_routine(RT__Err_VR), AO2, AO1, zero_operand);
-
- if (error_label != -1) {
- /* Jump to the error label */
- if (error_label == -3) assembleg_1(return_gc, zero_operand);
- else if (error_label == -4) assembleg_1(return_gc, one_operand);
- else assembleg_jump(error_label);
- }
- else {
- /* Build the symbol for "Object" */
- ln = symbol_index("Object", -1);
- AO2.value = svals[ln];
- AO2.marker = OBJECT_MV;
- AO2.type = CONSTANT_OT;
- if (check_sp) {
- /* Push "Object" */
- assembleg_store(AO1, AO2);
- }
- else {
- /* Store either "Object" or the operand's value in the temporary
- variable. */
- assembleg_store(temp_var2, AO2);
- last_label = next_label++;
- assembleg_jump(last_label);
- assemble_label_no(passed_label);
- assembleg_store(temp_var2, AO1);
- assemble_label_no(last_label);
- return temp_var2;
- }
- }
-
- assemble_label_no(passed_label);
- return AO1;
- }
- static void compile_conditional_g(condclass *cc,
- assembly_operand AO1, assembly_operand AO2, int label, int flag)
- { assembly_operand AO4;
- int the_zc, error_label = label,
- va_flag = FALSE, va_label;
- ASSERT_GLULX();
- the_zc = (flag ? cc->posform : cc->negform);
- if (the_zc == -1) {
- switch ((cc-condclasses)*2 + 500) {
- case HAS_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, HAS_RTE);
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- if ((AO2.value < 0) || (AO2.value >= NUM_ATTR_BYTES*8)) {
- error("'has'/'hasnt' applied to illegal attribute number");
- }
- }
- else {
- int pa_label = next_label++, fa_label = next_label++;
- assembly_operand en_ao, max_ao;
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_2(stkpeek_gc, one_operand, temp_var2);
- }
- else {
- assembleg_2(stkpeek_gc, zero_operand, temp_var1);
- assembleg_store(temp_var2, AO2);
- }
- }
- else {
- assembleg_store(temp_var1, AO1);
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0)) {
- assembleg_2(stkpeek_gc, zero_operand, temp_var2);
- }
- else {
- assembleg_store(temp_var2, AO2);
- }
- }
- max_ao.marker = 0;
- max_ao.value = NUM_ATTR_BYTES*8;
- set_constant_ot(&max_ao);
- assembleg_2_branch(jlt_gc, temp_var2, zero_operand, fa_label);
- assembleg_2_branch(jlt_gc, temp_var2, max_ao, pa_label);
- assemble_label_no(fa_label);
- en_ao.marker = 0;
- en_ao.value = 19; /* INVALIDATTR_RTE */
- set_constant_ot(&en_ao);
- assembleg_store(stack_pointer, temp_var2);
- assembleg_store(stack_pointer, temp_var1);
- assembleg_store(stack_pointer, en_ao);
- assembleg_3(call_gc, veneer_routine(RT__Err_VR),
- three_operand, zero_operand);
- va_flag = TRUE;
- va_label = next_label++;
- assembleg_jump(va_label);
- assemble_label_no(pa_label);
- }
- }
- if (is_constant_ot(AO2.type) && AO2.marker == 0) {
- AO2.value += 8;
- set_constant_ot(&AO2);
- }
- else {
- AO4.value = 8;
- AO4.marker = 0;
- AO4.type = BYTECONSTANT_OT;
- if ((AO1.type == LOCALVAR_OT) && (AO1.value == 0)) {
- if ((AO2.type == LOCALVAR_OT) && (AO2.value == 0))
- assembleg_0(stkswap_gc);
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- assembleg_0(stkswap_gc);
- }
- else {
- assembleg_3(add_gc, AO2, AO4, stack_pointer);
- }
- AO2 = stack_pointer;
- }
- assembleg_3(aloadbit_gc, AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
- case IN_CC:
- if (runtime_error_checking_switch) {
- if (flag)
- error_label = next_label++;
- AO1 = check_nonzero_at_runtime(AO1, error_label, IN_RTE);
- }
- AO4.value = GOBJFIELD_PARENT();
- AO4.marker = 0;
- AO4.type = BYTECONSTANT_OT;
- assembleg_3(aload_gc, AO1, AO4, stack_pointer);
- AO1 = stack_pointer;
- the_zc = (flag ? jeq_gc : jne_gc);
- break;
- case OFCLASS_CC:
- assembleg_call_2(veneer_routine(OC__Cl_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
- case PROVIDES_CC:
- assembleg_call_2(veneer_routine(OP__Pr_VR), AO1, AO2, stack_pointer);
- the_zc = (flag ? jnz_gc : jz_gc);
- AO1 = stack_pointer;
- break;
- default:
- error("condition not yet supported in Glulx");
- return;
- }
- }
- if (the_zc == jnz_gc || the_zc == jz_gc)
- assembleg_1_branch(the_zc, AO1, label);
- else
- assembleg_2_branch(the_zc, AO1, AO2, label);
- if (error_label != label) assemble_label_no(error_label);
- if (va_flag) assemble_label_no(va_label);
- }
- static void value_in_void_context(assembly_operand AO)
- {
- if (!glulx_mode)
- value_in_void_context_z(AO);
- else
- value_in_void_context_g(AO);
- }
- extern assembly_operand check_nonzero_at_runtime(assembly_operand AO1,
- int error_label, int rte_number)
- {
- if (!glulx_mode)
- return check_nonzero_at_runtime_z(AO1, error_label, rte_number);
- else
- return check_nonzero_at_runtime_g(AO1, error_label, rte_number);
- }
- static void generate_code_from(int n, int void_flag)
- {
- /* When void, this must not leave anything on the stack. */
- int i, j, below, above, opnum, arity; assembly_operand Result;
- below = ET[n].down; above = ET[n].up;
- if (below == -1)
- { if ((void_flag) && (ET[n].value.type != OMITTED_OT))
- value_in_void_context(ET[n].value);
- return;
- }
- opnum = ET[n].operator_number;
- if (opnum == COMMA_OP)
- { generate_code_from(below, TRUE);
- generate_code_from(ET[below].right, void_flag);
- ET[n].value = ET[ET[below].right].value;
- goto OperatorGenerated;
- }
- if ((opnum == LOGAND_OP) || (opnum == LOGOR_OP))
- { generate_code_from(below, FALSE);
- generate_code_from(ET[below].right, FALSE);
- goto OperatorGenerated;
- }
- if (opnum == -1)
- {
- /* Signifies a SETEQUALS_OP which has already been done */
- ET[n].down = -1; return;
- }
- /* Note that (except in the cases of comma and logical and/or) it
- is essential to code generate the operands right to left, because
- of the peculiar way the Z-machine's stack works:
- @sub sp sp -> a;
- (for instance) pulls to the first operand, then the second. So
- @mul a 2 -> sp;
- @add b 7 -> sp;
- @sub sp sp -> a;
- calculates (b+7)-(a*2), not the other way around (as would be more
- usual in stack machines evaluating expressions written in reverse
- Polish notation). (Basically this is because the Z-machine was
- designed to implement a LISP-like language naturally expressed
- in forward Polish notation: (PLUS 3 4), for instance.) */
- /* And the Glulx machine follows the Z-machine in this respect. */
- i=below; arity = 0;
- while (i != -1)
- { i = ET[i].right; arity++;
- }
- for (j=arity;j>0;j--)
- { int k = 1;
- i = below;
- while (k<j)
- { k++; i = ET[i].right;
- }
- generate_code_from(i, FALSE);
- }
- /* Check this again, because code generation lower down may have
- stubbed it into -1 */
- if (ET[n].operator_number == -1)
- { ET[n].down = -1; return;
- }
- if (!glulx_mode) {
- if (operators[opnum].opcode_number_z >= 400)
- {
- /* Conditional terms such as '==': */
- int a = ET[n].true_label, b = ET[n].false_label,
- branch_away, branch_other,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int oc = operators[opnum].opcode_number_z-400, flag = TRUE;
- if (oc >= 400) { oc = oc - 400; flag = FALSE; }
- if ((oc == je_zc) && (arity == 2))
- { i = ET[ET[n].down].right;
- if ((ET[i].value.value == zero_operand.value)
- && (ET[i].value.type == zero_operand.type))
- oc = jz_zc;
- }
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
- /* Reduce to the case where the branch_away label does exist: */
- if (a == -1) { a = b; b = -1; flag = !flag; }
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
- if ((((oc != je_zc)&&(arity > 2)) || (arity > 4)) && (flag == FALSE))
- {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
- if not (A cond B or C or D) then branch_away
- which we transform into
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
- if (branch_other == -1)
- { branch_other = next_label++; make_branch_label = TRUE;
- }
- }
- if (oc == jz_zc)
- assemblez_1_branch(jz_zc, ET[below].value, branch_away, flag);
- else
- { assembly_operand left_operand;
- if (arity == 2)
- compile_conditional_z(oc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- else
- { /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
- if (((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value == 0))
- && ((oc != je_zc) || (arity>4)) )
- { left_operand.type = VARIABLE_OT;
- left_operand.value = 255;
- left_operand.marker = 0;
- assemblez_store(left_operand, ET[below].value);
- }
- else left_operand = ET[below].value;
- i = ET[below].right; arity--;
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
- while (i != -1)
- { if ((oc == je_zc) && (arity>1))
- {
- /* je_zc is an especially good case since the
- Z-machine implements "or" for up to three
- right operands automatically, though it's an
- especially bad case to generate code for! */
- if (arity == 2)
- { assemblez_3_branch(je_zc,
- left_operand, ET[i].value,
- ET[ET[i].right].value, branch_away, flag);
- i = ET[i].right; arity--;
- }
- else
- { if ((arity == 3) || flag)
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_away, flag);
- else
- assemblez_4_branch(je_zc, left_operand,
- ET[i].value,
- ET[ET[i].right].value,
- ET[ET[ET[i].right].right].value,
- branch_other, !flag);
- i = ET[ET[i].right].right; arity -= 2;
- }
- }
- else
- { /* Otherwise we can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
- if ((arity == 1) || flag)
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_z(oc, left_operand,
- ET[i].value, branch_other, !flag);
- }
- i = ET[i].right; arity--;
- }
- }
- }
- /* NB: These two conditions cannot both occur, fortunately! */
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assemblez_jump(branch_other);
- goto OperatorGenerated;
- }
- }
- else {
- if (operators[opnum].opcode_number_g >= FIRST_CC
- && operators[opnum].opcode_number_g <= LAST_CC) {
- /* Conditional terms such as '==': */
- int a = ET[n].true_label, b = ET[n].false_label;
- int branch_away, branch_other, flag,
- make_jump_away = FALSE, make_branch_label = FALSE;
- int ccode = operators[opnum].opcode_number_g;
- condclass *cc = &condclasses[(ccode-FIRST_CC) / 2];
- flag = (ccode & 1) ? 0 : 1;
- /* If the comparison is "equal to (constant) 0", change it
- to the simple "zero" test. Unfortunately, this doesn't
- work for the commutative form "(constant) 0 is equal to".
- At least I don't think it does. */
- if ((cc == &condclasses[1]) && (arity == 2)) {
- i = ET[ET[n].down].right;
- if ((ET[i].value.value == 0)
- && (ET[i].value.marker == 0)
- && is_constant_ot(ET[i].value.type)) {
- cc = &condclasses[0];
- }
- }
- /* If the condition has truth state flag, branch to
- label a, and if not, to label b. Possibly one of a, b
- equals -1, meaning "continue from this instruction".
-
- branch_away is the label which is a branch away (the one
- which isn't immediately after) and flag is the truth
- state to branch there.
- Note that when multiple instructions are needed (because
- of the use of the 'or' operator) the branch_other label
- is created if need be.
- */
-
- /* Reduce to the case where the branch_away label does exist: */
- if (a == -1) { a = b; b = -1; flag = !flag; }
- branch_away = a; branch_other = b;
- if (branch_other != -1) make_jump_away = TRUE;
-
- if ((arity > 2) && (flag == FALSE)) {
- /* In this case, we have an 'or' situation where multiple
- instructions are needed and where the overall condition
- is negated. That is, we have, e.g.
-
- if not (A cond B or C or D) then branch_away
-
- which we transform into
-
- if (A cond B) then branch_other
- if (A cond C) then branch_other
- if not (A cond D) then branch_away
- .branch_other */
-
- if (branch_other == -1) {
- branch_other = next_label++; make_branch_label = TRUE;
- }
- }
- if (cc == &condclasses[0]) {
- assembleg_1_branch((flag ? cc->posform : cc->negform),
- ET[below].value, branch_away);
- }
- else {
- if (arity == 2) {
- compile_conditional_g(cc, ET[below].value,
- ET[ET[below].right].value, branch_away, flag);
- }
- else {
- /* The case of a condition using "or".
- First: if the condition tests the stack pointer,
- and it can't always be done in a single test, move
- the value off the stack and into temporary variable
- storage. */
- assembly_operand left_operand;
- if (((ET[below].value.type == LOCALVAR_OT)
- && (ET[below].value.value == 0))) {
- assembleg_store(temp_var1, ET[below].value);
- left_operand = temp_var1;
- }
- else {
- left_operand = ET[below].value;
- }
- i = ET[below].right;
- arity--;
- /* "left_operand" now holds the quantity to be tested;
- "i" holds the right operand reached so far;
- "arity" the number of right operands. */
- while (i != -1) {
- /* We can compare the left_operand with
- only one right operand at the time. There are
- two cases: it's the last right operand, or it
- isn't. */
- if ((arity == 1) || flag)
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_away, flag);
- else
- compile_conditional_g(cc, left_operand,
- ET[i].value, branch_other, !flag);
- i = ET[i].right;
- arity--;
- }
- }
- }
-
- /* NB: These two conditions cannot both occur, fortunately! */
-
- if (make_branch_label) assemble_label_no(branch_other);
- if (make_jump_away) assembleg_jump(branch_other);
-
- goto OperatorGenerated;
- }
- }
- /* The operator is now definitely one which produces a value */
- if (void_flag && (!(operators[opnum].side_effect)))
- error_named("Evaluating this has no effect:",
- operators[opnum].description);
- /* Where shall we put the resulting value? (In Glulx, this could
- be smarter, and peg the result into ZEROCONSTANT.) */
- if (void_flag) Result = temp_var1; /* Throw it away */
- else
- { if ((above != -1) && (ET[above].operator_number == SETEQUALS_OP))
- {
- /* If the node above is "set variable equal to", then
- make that variable the place to put the result, and
- delete the SETEQUALS_OP node since its effect has already
- been accomplished. */
- ET[above].operator_number = -1;
- Result = ET[ET[above].down].value;
- ET[above].value = Result;
- }
- else Result = stack_pointer; /* Otherwise, put it on the stack */
- }
- if (!glulx_mode) {
- if (operators[opnum].opcode_number_z != -1)
- {
- /* Operators directly translatable into Z-code opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_z;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_zc) || (o_n == mod_zc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && ((by_ao.type == SHORT_CONSTANT_OT)
- || (by_ao.type == LONG_CONSTANT_OT)))
- assemblez_2_to(o_n, ET[below].value,
- by_ao, Result);
- else
- {
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, by_ao);
- ln = next_label++;
- assemblez_1_branch(jz_zc, temp_var2, ln, FALSE);
- error_ao.type = SHORT_CONSTANT_OT; error_ao.marker = 0;
- error_ao.value = DBYZERO_RTE;
- assemblez_2(call_vn_zc, veneer_routine(RT__Err_VR),
- error_ao);
- assemblez_inc(temp_var2);
- assemble_label_no(ln);
- assemblez_2_to(o_n, temp_var1, temp_var2, Result);
- }
- }
- else {
- assemblez_2_to(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- }
- else
- assemblez_1_to(operators[opnum].opcode_number_z, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- { case ARROW_OP:
- access_memory_z(loadb_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_z(loadw_zc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case UNARY_MINUS_OP:
- assemblez_2_to(sub_zc, zero_operand, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assemblez_1_to(not_zc, ET[below].value, Result);
- break;
- case PROP_ADD_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_ADD_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
- case PROP_NUM_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = check_nonzero_at_runtime(AO, -1, PROP_NUM_RTE);
- assemblez_2_to(get_prop_addr_zc, AO,
- ET[ET[below].right].value, temp_var1);
- assemblez_1_branch(jz_zc, temp_var1, next_label++, TRUE);
- assemblez_1_to(get_prop_len_zc, temp_var1, temp_var1);
- assemble_label_no(next_label-1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
- case PROPERTY_OP:
- { assembly_operand AO = ET[below].value;
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_3_to(call_vs_zc, veneer_routine(RT__ChPR_VR),
- AO, ET[ET[below].right].value, temp_var1);
- else
- assemblez_2_to(get_prop_zc, AO,
- ET[ET[below].right].value, temp_var1);
- if (!void_flag) write_result_z(Result, temp_var1);
- }
- break;
- case MESSAGE_OP:
- j=1; AI.operand[0] = veneer_routine(RV__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_ADD_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Pr_VR);
- goto GenFunctionCallZ;
- case MPROP_NUM_OP:
- j=1; AI.operand[0] = veneer_routine(RL__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_SETEQUALS_OP:
- j=1; AI.operand[0] = veneer_routine(WV__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DB__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_INC_OP:
- j=1; AI.operand[0] = veneer_routine(IA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_POST_DEC_OP:
- j=1; AI.operand[0] = veneer_routine(DA__Pr_VR);
- goto GenFunctionCallZ;
- case SUPERCLASS_OP:
- j=1; AI.operand[0] = veneer_routine(RA__Sc_VR);
- goto GenFunctionCallZ;
- case PROP_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
- case MESSAGE_CALL_OP:
- j=1; AI.operand[0] = veneer_routine(CA__Pr_VR);
- goto GenFunctionCallZ;
- case FCALL_OP:
- j = 0;
- if ((ET[below].value.type == VARIABLE_OT)
- && (ET[below].value.value >= 256))
- { int sf_number = ET[below].value.value - 256;
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1))
- || ((sf_number == INDIRECT_SYSF) && (j>7)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
- AI.store_variable_number = Result.value;
- AI.branch_label_number = -1;
- switch(sf_number)
- { case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2; int arg_c, arg_et;
- AO.value = j; AO.marker = 0;
- AO.type = SHORT_CONSTANT_OT;
- AO2.type = LONG_CONSTANT_OT;
- AO2.value = begin_word_array();
- AO2.marker = ARRAY_MV;
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == VARIABLE_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
- assemblez_1_to(random_zc, AO, temp_var1);
- assemblez_dec(temp_var1);
- assemblez_2_to(loadw_zc, AO2, temp_var1, Result);
- }
- else
- assemblez_1_to(random_zc,
- ET[ET[below].right].value, Result);
- break;
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- assemblez_1_to(get_parent_zc, AO, Result);
- }
- break;
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, Result, -2, TRUE);
- }
- break;
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- assemblez_objcode(get_sibling_zc,
- AO, Result, -2, TRUE);
- }
- break;
- case INDIRECT_SYSF:
- j=0; i = ET[below].right;
- goto IndirectFunctionCallZ;
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- assemblez_store(temp_var1, zero_operand);
- assemblez_objcode(get_child_zc,
- AO, stack_pointer, next_label+1, FALSE);
- assemble_label_no(next_label);
- assemblez_inc(temp_var1);
- assemblez_objcode(get_sibling_zc,
- stack_pointer, stack_pointer,
- next_label, TRUE);
- assemble_label_no(next_label+1);
- assemblez_store(temp_var2, stack_pointer);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
- case YOUNGEST_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assemblez_objcode(get_child_zc,
- AO, temp_var1, next_label+1, FALSE);
- assemblez_1(push_zc, temp_var1);
- assemble_label_no(next_label);
- assemblez_store(temp_var1, stack_pointer);
- assemblez_objcode(get_sibling_zc,
- temp_var1, stack_pointer, next_label, TRUE);
- assemble_label_no(next_label+1);
- if (!void_flag) write_result_z(Result, temp_var1);
- next_label += 2;
- }
- break;
- case ELDER_SYSF:
- assemblez_store(temp_var1, ET[ET[below].right].value);
- if (runtime_error_checking_switch)
- check_nonzero_at_runtime(temp_var1, -1,
- ELDER_RTE);
- assemblez_1_to(get_parent_zc, temp_var1, temp_var3);
- assemblez_1_branch(jz_zc, temp_var3,next_label+1,TRUE);
- assemblez_store(temp_var2, temp_var3);
- assemblez_store(temp_var3, zero_operand);
- assemblez_objcode(get_child_zc,
- temp_var2, temp_var2, next_label, TRUE);
- assemble_label_no(next_label++);
- assemblez_2_branch(je_zc, temp_var1, temp_var2,
- next_label, TRUE);
- assemblez_store(temp_var3, temp_var2);
- assemblez_objcode(get_sibling_zc,
- temp_var2, temp_var2, next_label - 1, TRUE);
- assemble_label_no(next_label++);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case METACLASS_SYSF:
- assemblez_2_to((version_number==3)?call_zc:call_vs_zc,
- veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
- case GLK_SYSF:
- error("The glk() system function does not exist in Z-code");
- break;
- }
- break;
- }
- GenFunctionCallZ:
- i = below;
- IndirectFunctionCallZ:
- while ((i != -1) && (j<8))
- { AI.operand[j++] = ET[i].value;
- i = ET[i].right;
- }
- if ((j > 4) && (version_number == 3))
- { error("A function may be called with at most 3 arguments");
- j = 4;
- }
- if ((j==8) && (i != -1))
- { error("A function may be called with at most 7 arguments");
- }
- AI.operand_count = j;
- if ((void_flag) && (version_number >= 5))
- { AI.store_variable_number = -1;
- switch(j)
- { case 1: AI.internal_number = call_1n_zc; break;
- case 2: AI.internal_number = call_2n_zc; break;
- case 3: case 4: AI.internal_number = call_vn_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vn2_zc; break;
- }
- }
- else
- { AI.store_variable_number = Result.value;
- if (version_number == 3)
- AI.internal_number = call_zc;
- else
- switch(j)
- { case 1: AI.internal_number = call_1s_zc; break;
- case 2: AI.internal_number = call_2s_zc; break;
- case 3: case 4: AI.internal_number = call_vs_zc; break;
- case 5: case 6: case 7: case 8:
- AI.internal_number = call_vs2_zc; break;
- }
- }
- AI.branch_label_number = -1;
- assemblez_instruction(&AI);
- break;
- case SETEQUALS_OP:
- assemblez_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case PROPERTY_SETEQUALS_OP:
- if (!void_flag)
- { if (runtime_error_checking_switch)
- assemblez_4_to(call_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value, Result);
- else
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- }
- else
- { if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- ET[below].value, ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- else assemblez_3(put_prop_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- }
- break;
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else access_memory_z(storeb_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assemblez_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_z(Result, temp_var1);
- }
- else
- access_memory_z(storew_zc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
- case INC_OP:
- assemblez_inc(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case DEC_OP:
- assemblez_dec(ET[below].value);
- if (!void_flag) write_result_z(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_z(Result, ET[below].value);
- assemblez_dec(ET[below].value);
- break;
- case ARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case ARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case ARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
- case ARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadb_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storeb_zc, temp_var1, temp_var2, temp_var3);
- break;
- case DARROW_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case DARROW_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case DARROW_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
- case DARROW_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- access_memory_z(loadw_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- access_memory_z(storew_zc, temp_var1, temp_var2, temp_var3);
- break;
- case PROPERTY_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case PROPERTY_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- break;
- case PROPERTY_POST_INC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_inc(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
- case PROPERTY_POST_DEC_OP:
- assemblez_store(temp_var1, ET[below].value);
- assemblez_store(temp_var2, ET[ET[below].right].value);
- assemblez_2_to(get_prop_zc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_z(Result, temp_var3);
- assemblez_dec(temp_var3);
- if (runtime_error_checking_switch && (!veneer_mode))
- assemblez_4(call_vn_zc, veneer_routine(RT__ChPS_VR),
- temp_var1, temp_var2, temp_var3);
- else assemblez_3(put_prop_zc, temp_var1, temp_var2, temp_var3);
- break;
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
- else {
- assembly_operand AO, AO2;
- if (operators[opnum].opcode_number_g != -1)
- {
- /* Operators directly translatable into opcodes: infix ops
- take two operands whereas pre/postfix operators take only one */
- if (operators[opnum].usage == IN_U)
- { int o_n = operators[opnum].opcode_number_g;
- if (runtime_error_checking_switch && (!veneer_mode)
- && ((o_n == div_gc) || (o_n == mod_gc)))
- { assembly_operand by_ao, error_ao; int ln;
- by_ao = ET[ET[below].right].value;
- if ((by_ao.value != 0) && (by_ao.marker == 0)
- && is_constant_ot(by_ao.type))
- assembleg_3(o_n, ET[below].value,
- by_ao, Result);
- else
- { assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, by_ao);
- ln = next_label++;
- assembleg_1_branch(jnz_gc, temp_var2, ln);
- error_ao.marker = 0;
- error_ao.value = DBYZERO_RTE;
- set_constant_ot(&error_ao);
- assembleg_call_1(veneer_routine(RT__Err_VR),
- error_ao, zero_operand);
- assembleg_store(temp_var2, one_operand);
- assemble_label_no(ln);
- assembleg_3(o_n, temp_var1, temp_var2, Result);
- }
- }
- else
- assembleg_3(o_n, ET[below].value,
- ET[ET[below].right].value, Result);
- }
- else
- assembleg_2(operators[opnum].opcode_number_g, ET[below].value,
- Result);
- }
- else
- switch(opnum)
- {
- case PUSH_OP:
- if (ET[below].value.type == Result.type
- && ET[below].value.value == Result.value
- && ET[below].value.marker == Result.marker)
- break;
- assembleg_2(copy_gc, ET[below].value, Result);
- break;
- case UNARY_MINUS_OP:
- assembleg_2(neg_gc, ET[below].value, Result);
- break;
- case ARTNOT_OP:
- assembleg_2(bitnot_gc, ET[below].value, Result);
- break;
- case ARROW_OP:
- access_memory_g(aloadb_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case DARROW_OP:
- access_memory_g(aload_gc, ET[below].value,
- ET[ET[below].right].value, Result);
- break;
- case SETEQUALS_OP:
- assembleg_store(ET[below].value,
- ET[ET[below].right].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case ARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else access_memory_g(astoreb_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
- case DARROW_SETEQUALS_OP:
- if (!void_flag)
- { assembleg_store(temp_var1,
- ET[ET[ET[below].right].right].value);
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- temp_var1);
- write_result_g(Result, temp_var1);
- }
- else
- access_memory_g(astore_gc, ET[below].value,
- ET[ET[below].right].value,
- ET[ET[ET[below].right].right].value);
- break;
- case INC_OP:
- assembleg_inc(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case DEC_OP:
- assembleg_dec(ET[below].value);
- if (!void_flag) write_result_g(Result, ET[below].value);
- break;
- case POST_INC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_inc(ET[below].value);
- break;
- case POST_DEC_OP:
- if (!void_flag) write_result_g(Result, ET[below].value);
- assembleg_dec(ET[below].value);
- break;
- case ARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
- case ARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
- case ARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
- case ARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aloadb_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astoreb_gc, temp_var1, temp_var2, temp_var3);
- break;
- case DARROW_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
- case DARROW_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- break;
- case DARROW_POST_INC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_inc(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
- case DARROW_POST_DEC_OP:
- assembleg_store(temp_var1, ET[below].value);
- assembleg_store(temp_var2, ET[ET[below].right].value);
- access_memory_g(aload_gc, temp_var1, temp_var2, temp_var3);
- if (!void_flag) write_result_g(Result, temp_var3);
- assembleg_dec(temp_var3);
- access_memory_g(astore_gc, temp_var1, temp_var2, temp_var3);
- break;
- case PROPERTY_OP:
- case MESSAGE_OP:
- AO = veneer_routine(RV__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_ADD_OP:
- case PROP_ADD_OP:
- AO = veneer_routine(RA__Pr_VR);
- goto TwoArgFunctionCall;
- case MPROP_NUM_OP:
- case PROP_NUM_OP:
- AO = veneer_routine(RL__Pr_VR);
- goto TwoArgFunctionCall;
- case PROP_CALL_OP:
- case MESSAGE_CALL_OP:
- AO2 = veneer_routine(CA__Pr_VR);
- i = below;
- goto DoFunctionCall;
- case MESSAGE_INC_OP:
- case PROPERTY_INC_OP:
- AO = veneer_routine(IB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_DEC_OP:
- case PROPERTY_DEC_OP:
- AO = veneer_routine(DB__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_INC_OP:
- case PROPERTY_POST_INC_OP:
- AO = veneer_routine(IA__Pr_VR);
- goto TwoArgFunctionCall;
- case MESSAGE_POST_DEC_OP:
- case PROPERTY_POST_DEC_OP:
- AO = veneer_routine(DA__Pr_VR);
- goto TwoArgFunctionCall;
- case SUPERCLASS_OP:
- AO = veneer_routine(RA__Sc_VR);
- goto TwoArgFunctionCall;
- TwoArgFunctionCall:
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- if (void_flag)
- assembleg_call_2(AO, AO2, AO3, zero_operand);
- else
- assembleg_call_2(AO, AO2, AO3, Result);
- }
- break;
- case PROPERTY_SETEQUALS_OP:
- case MESSAGE_SETEQUALS_OP:
- if (runtime_error_checking_switch && (!veneer_mode))
- AO = veneer_routine(RT__ChPS_VR);
- else
- AO = veneer_routine(WV__Pr_VR);
- {
- assembly_operand AO2 = ET[below].value;
- assembly_operand AO3 = ET[ET[below].right].value;
- assembly_operand AO4 = ET[ET[ET[below].right].right].value;
- if (AO4.type == LOCALVAR_OT && AO4.value == 0) {
- /* Rightmost is on the stack; reduce to previous case. */
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- /* both already on stack. */
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_0(stkswap_gc);
- }
- }
- else {
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- assembleg_store(stack_pointer, AO2);
- }
- else {
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- else {
- /* We have to get the rightmost on the stack, below the
- others. */
- if (AO3.type == LOCALVAR_OT && AO3.value == 0) {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_2(stkroll_gc, three_operand, one_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_0(stkswap_gc);
- assembleg_store(stack_pointer, AO2);
- }
- }
- else {
- if (AO2.type == LOCALVAR_OT && AO2.value == 0) {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_2(stkroll_gc, three_operand, two_operand);
- }
- else {
- assembleg_store(stack_pointer, AO4);
- assembleg_store(stack_pointer, AO3);
- assembleg_store(stack_pointer, AO2);
- }
- }
- }
- if (void_flag)
- assembleg_3(call_gc, AO, three_operand, zero_operand);
- else
- assembleg_3(call_gc, AO, three_operand, Result);
- }
- break;
- case FCALL_OP:
- j = 0;
- if (ET[below].value.type == SYSFUN_OT)
- { int sf_number = ET[below].value.value;
- i = ET[below].right;
- if (i == -1)
- { error("Argument to system function missing");
- AI.operand[0] = one_operand;
- AI.operand_count = 1;
- }
- else
- { j=0;
- while (i != -1) { j++; i = ET[i].right; }
- if (((sf_number != INDIRECT_SYSF) &&
- (sf_number != GLK_SYSF) &&
- (sf_number != RANDOM_SYSF) && (j > 1)))
- { j=1;
- error("System function given with too many arguments");
- }
- if (sf_number != RANDOM_SYSF)
- { int jcount;
- i = ET[below].right;
- for (jcount = 0; jcount < j; jcount++)
- { AI.operand[jcount] = ET[i].value;
- i = ET[i].right;
- }
- AI.operand_count = j;
- }
- }
- switch(sf_number)
- {
- case RANDOM_SYSF:
- if (j>1)
- { assembly_operand AO, AO2;
- int arg_c, arg_et;
- AO.value = j;
- AO.marker = 0;
- set_constant_ot(&AO);
- AO2.type = CONSTANT_OT;
- AO2.value = begin_word_array();
- AO2.marker = ARRAY_MV;
- for (arg_c=0, arg_et = ET[below].right;arg_c<j;
- arg_c++, arg_et = ET[arg_et].right)
- { if (ET[arg_et].value.type == LOCALVAR_OT
- || ET[arg_et].value.type == GLOBALVAR_OT)
- error("Only constants can be used as possible 'random' results");
- array_entry(arg_c, ET[arg_et].value);
- }
- finish_array(arg_c);
- assembleg_2(random_gc, AO, stack_pointer);
- assembleg_3(aload_gc, AO2, stack_pointer, Result);
- }
- else {
- assembleg_2(random_gc,
- ET[ET[below].right].value, stack_pointer);
- assembleg_3(add_gc, stack_pointer, one_operand,
- Result);
- }
- break;
- case PARENT_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- PARENT_RTE);
- AO2.type = BYTECONSTANT_OT;
- AO2.value = GOBJFIELD_PARENT();
- AO2.marker = 0;
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
- case ELDEST_SYSF:
- case CHILD_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==CHILD_SYSF)?CHILD_RTE:ELDEST_RTE);
- AO2.type = BYTECONSTANT_OT;
- AO2.value = GOBJFIELD_CHILD();
- AO2.marker = 0;
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
- case YOUNGER_SYSF:
- case SIBLING_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- (sf_number==SIBLING_SYSF)
- ?SIBLING_RTE:YOUNGER_RTE);
- AO2.type = BYTECONSTANT_OT;
- AO2.value = GOBJFIELD_SIBLING();
- AO2.marker = 0;
- assembleg_3(aload_gc, AO, AO2, Result);
- }
- break;
- case CHILDREN_SYSF:
- { assembly_operand AO;
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- CHILDREN_RTE);
- AO2.type = BYTECONSTANT_OT;
- AO2.value = GOBJFIELD_CHILD();
- AO2.marker = 0;
- assembleg_store(temp_var1, zero_operand);
- assembleg_3(aload_gc, AO, AO2, temp_var2);
- AO2.value = GOBJFIELD_SIBLING();
- assemble_label_no(next_label);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_3(add_gc, temp_var1, one_operand,
- temp_var1);
- assembleg_3(aload_gc, temp_var2, AO2, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- next_label += 2;
- if (!void_flag)
- write_result_g(Result, temp_var1);
- }
- break;
- case INDIRECT_SYSF:
- i = ET[below].right;
- goto IndirectFunctionCallG;
- case GLK_SYSF:
- AO2 = veneer_routine(Glk__Wrap_VR);
- i = ET[below].right;
- goto DoFunctionCall;
- case METACLASS_SYSF:
- assembleg_call_1(veneer_routine(Metaclass_VR),
- ET[ET[below].right].value, Result);
- break;
- case YOUNGEST_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- AO2.marker = 0;
- AO2.value = GOBJFIELD_CHILD();
- AO2.type = BYTECONSTANT_OT;
- assembleg_3(aload_gc, AO, AO2, temp_var1);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_1_branch(jz_gc, temp_var1, next_label+1);
- assemble_label_no(next_label);
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_1_branch(jz_gc, temp_var2, next_label+1);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 2;
- break;
- case ELDER_SYSF:
- AO = ET[ET[below].right].value;
- if (runtime_error_checking_switch)
- AO = check_nonzero_at_runtime(AO, -1,
- YOUNGEST_RTE);
- assembleg_store(temp_var3, AO);
- AO2.marker = 0;
- AO2.value = GOBJFIELD_PARENT();
- AO2.type = BYTECONSTANT_OT;
- assembleg_3(aload_gc, temp_var3, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- AO2.value = GOBJFIELD_CHILD();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var1);
- assembleg_1_branch(jz_gc, temp_var1, next_label+2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var1,
- next_label+1);
- assemble_label_no(next_label);
- AO2.value = GOBJFIELD_SIBLING();
- assembleg_3(aload_gc, temp_var1, AO2, temp_var2);
- assembleg_2_branch(jeq_gc, temp_var3, temp_var2,
- next_label+2);
- assembleg_store(temp_var1, temp_var2);
- assembleg_0_branch(jump_gc, next_label);
- assemble_label_no(next_label+1);
- assembleg_store(temp_var1, zero_operand);
- assemble_label_no(next_label+2);
- if (!void_flag)
- write_result_g(Result, temp_var1);
- next_label += 3;
- break;
- default:
- error("*** system function not implemented ***");
- break;
- }
- break;
- }
- i = below;
- IndirectFunctionCallG:
- /* Get the function address. */
- AO2 = ET[i].value;
- i = ET[i].right;
- DoFunctionCall:
- {
- /* If all the function arguments are in local/global
- variables, we have to push them all on the stack.
- If all of them are on the stack, we have to do nothing.
- If some are and some aren't, we have a hopeless mess,
- and we should throw a compiler error.
- */
- int onstack = 0;
- int offstack = 0;
- /* begin part of patch G03701 */
- int nargs = 0;
- j = i;
- while (j != -1) {
- nargs++;
- j = ET[j].right;
- }
- if (nargs==0) {
- assembleg_2(callf_gc, AO2, void_flag ? zero_operand : Result);
- } else if (nargs==1) {
- assembleg_call_1(AO2, ET[i].value, void_flag ? zero_operand : Result);
- } else if (nargs==2) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembleg_call_2(AO2, o1, o2, void_flag ? zero_operand : Result);
- } else if (nargs==3) {
- assembly_operand o1 = ET[i].value;
- assembly_operand o2 = ET[ET[i].right].value;
- assembly_operand o3 = ET[ET[ET[i].right].right].value;
- assembleg_call_3(AO2, o1, o2, o3, void_flag ? zero_operand : Result);
- } else {
- j = 0;
- while (i != -1) {
- if (ET[i].value.type == LOCALVAR_OT
- && ET[i].value.value == 0) {
- onstack++;
- }
- else {
- assembleg_store(stack_pointer, ET[i].value);
- offstack++;
- }
- i = ET[i].right;
- j++;
- }
- if (onstack && offstack)
- error("*** Function call cannot be generated with mixed arguments ***");
- if (offstack > 1)
- error("*** Function call cannot be generated with more than one nonstack argument ***");
- AO.value = j;
- AO.marker = 0;
- set_constant_ot(&AO);
- if (void_flag)
- assembleg_3(call_gc, AO2, AO, zero_operand);
- else
- assembleg_3(call_gc, AO2, AO, Result);
- } /* else nargs>=4 */
- } /* DoFunctionCall: */
- break;
- default:
- printf("** Trouble op = %d i.e. '%s' **\n",
- opnum, operators[opnum].description);
- compiler_error("Expr code gen: Can't generate yet");
- }
- }
- ET[n].value = Result;
- OperatorGenerated:
- if (!glulx_mode) {
- if (ET[n].to_expression)
- { if (ET[n].true_label != -1)
- { assemblez_1(push_zc, zero_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assemblez_1(push_zc, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assemblez_1(push_zc, one_operand);
- assemblez_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assemblez_1(push_zc, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
- }
- else {
- if (ET[n].to_expression)
- { if (ET[n].true_label != -1)
- { assembleg_store(stack_pointer, zero_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].true_label);
- assembleg_store(stack_pointer, one_operand);
- assemble_label_no(next_label-1);
- }
- else
- { assembleg_store(stack_pointer, one_operand);
- assembleg_jump(next_label++);
- assemble_label_no(ET[n].false_label);
- assembleg_store(stack_pointer, zero_operand);
- assemble_label_no(next_label-1);
- }
- ET[n].value = stack_pointer;
- }
- else
- if (ET[n].label_after != -1)
- assemble_label_no(ET[n].label_after);
- }
- ET[n].down = -1;
- }
- assembly_operand code_generate(assembly_operand AO, int context, int label)
- {
- /* Used in three contexts: VOID_CONTEXT, CONDITION_CONTEXT and
- QUANTITY_CONTEXT.
- If CONDITION_CONTEXT, then compile code branching to label number
- "label" if the condition is false: there's no return value.
- (Except that if label is -3 or -4 (internal codes for rfalse and
- rtrue rather than branch) then this is for branching when the
- condition is true. This is used for optimising code generation
- for "if" statements.)
- Otherwise return the assembly operand containing the result
- (probably the stack pointer variable but not necessarily:
- e.g. is would be short constant 2 from the expression "j++, 2") */
- vivc_flag = FALSE;
- if (AO.type != EXPRESSION_OT)
- { switch(context)
- { case VOID_CONTEXT:
- value_in_void_context(AO);
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- case CONDITION_CONTEXT:
- if (!glulx_mode) {
- if (label < -2) assemblez_1_branch(jz_zc, AO, label, FALSE);
- else assemblez_1_branch(jz_zc, AO, label, TRUE);
- }
- else {
- if (label < -2)
- assembleg_1_branch(jnz_gc, AO, label);
- else
- assembleg_1_branch(jz_gc, AO, label);
- }
- AO.type = OMITTED_OT;
- AO.value = 0;
- break;
- }
- return AO;
- }
- if (expr_trace_level >= 2)
- { printf("Raw parse tree:\n"); show_tree(AO, FALSE);
- }
- if (context == CONDITION_CONTEXT)
- { if (label < -2) annotate_for_conditions(AO.value, label, -1);
- else annotate_for_conditions(AO.value, -1, label);
- }
- else annotate_for_conditions(AO.value, -1, -1);
- if (expr_trace_level >= 1)
- { printf("Code generation for expression in ");
- switch(context)
- { case VOID_CONTEXT: printf("void"); break;
- case CONDITION_CONTEXT: printf("condition"); break;
- case QUANTITY_CONTEXT: printf("quantity"); break;
- case ASSEMBLY_CONTEXT: printf("assembly"); break;
- case ARRAY_CONTEXT: printf("array initialisation"); break;
- default: printf("* ILLEGAL *"); break;
- }
- printf(" context with annotated tree:\n");
- show_tree(AO, TRUE);
- }
- generate_code_from(AO.value, (context==VOID_CONTEXT));
- return ET[AO.value].value;
- }
- /* ========================================================================= */
- /* Data structure management routines */
- /* ------------------------------------------------------------------------- */
- extern void init_expressc_vars(void)
- { make_operands();
- }
- extern void expressc_begin_pass(void)
- {
- }
- extern void expressc_allocate_arrays(void)
- {
- }
- extern void expressc_free_arrays(void)
- {
- }
- /* ========================================================================= */
|