| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444 |
- (*
- BSD 2-Clause License
- Copyright (c) 2018-2023, Anton Krotov
- All rights reserved.
- *)
- MODULE STATEMENTS;
- IMPORT
- PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVMxI,
- ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
- CONST
- eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR;
- eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC;
- eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC;
- eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC;
- eIMP = PARS.eIMP;
- errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4;
- errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8;
- errCHR = 9; errWCHR = 10; errBYTE = 11;
- chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
- chkSTK* = MSP430.chkSTK; (* 6 *)
- chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE, chkSTK};
- TYPE
- isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
- RANGE = RECORD
- a, b: INTEGER
- END;
- CASE_LABEL = POINTER TO rCASE_LABEL;
- rCASE_LABEL = RECORD (AVL.DATA)
- range: RANGE;
- variant, self: INTEGER;
- _type: PROG._TYPE;
- prev: CASE_LABEL
- END;
- CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
- label: INTEGER;
- cmd: IL.COMMAND;
- processed: BOOLEAN
- END;
- VAR
- Options: PROG.OPTIONS;
- begcall, endcall: IL.COMMAND;
- CaseLabels, CaseVar: C.COLLECTION;
- CaseVariants: LISTS.LIST;
- CPU: INTEGER;
- tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE;
- PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
- RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
- END isExpr;
- PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
- RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
- END isVar;
- PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tBOOLEAN)
- END isBoolean;
- PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tINTEGER)
- END isInteger;
- PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tBYTE)
- END isByte;
- PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
- RETURN isByte(e) OR isInteger(e)
- END isInt;
- PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tREAL)
- END isReal;
- PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tSET)
- END isSet;
- PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
- RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR})
- END isString;
- PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
- RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
- END isStringW;
- PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tCHAR)
- END isChar;
- PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type = tWCHAR)
- END isCharW;
- PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER)
- END isPtr;
- PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type.typ = PROG.tRECORD)
- END isRec;
- PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
- RETURN isRec(e) OR isPtr(e)
- END isRecPtr;
- PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type.typ = PROG.tARRAY)
- END isArr;
- PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
- RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
- END isProc;
- PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
- RETURN e._type.typ = PROG.tNIL
- END isNil;
- PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
- RETURN isArr(e) & (e._type.base = tCHAR)
- END isCharArray;
- PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
- RETURN isArr(e) & (e._type.base = tWCHAR)
- END isCharArrayW;
- PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
- RETURN isCharArray(e) OR isCharArrayW(e)
- END isCharArrayX;
- PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
- BEGIN
- pos.line := parser.lex.pos.line;
- pos.col := parser.lex.pos.col;
- pos.parser := parser
- END getpos;
- PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
- BEGIN
- PARS.Next(parser);
- getpos(parser, pos)
- END NextPos;
- PROCEDURE strlen (e: PARS.EXPR): INTEGER;
- VAR
- res: INTEGER;
- BEGIN
- ASSERT(isString(e));
- IF e._type = tCHAR THEN
- res := 1
- ELSE
- res := LENGTH(e.value.string(SCAN.STRING).s)
- END
- RETURN res
- END strlen;
- PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
- VAR
- i, res: INTEGER;
- BEGIN
- i := 0;
- res := 0;
- WHILE (i < LEN(s)) & (s[i] # 0X) DO
- IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
- INC(res)
- END;
- INC(i)
- END
- RETURN res
- END _length;
- PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
- VAR
- res: INTEGER;
- BEGIN
- ASSERT(isStringW(e));
- IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
- res := 1
- ELSE
- res := _length(e.value.string(SCAN.STRING).s)
- END
- RETURN res
- END utf8strlen;
- PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
- VAR
- res: ARRAY 2 OF WCHAR;
- BEGIN
- ASSERT(STRINGS.Utf8To16(s, res) = 1)
- RETURN ORD(res[0])
- END StrToWChar;
- PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
- RETURN isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
- END isStringW1;
- PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN;
- VAR
- res: BOOLEAN;
- BEGIN
- IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
- IF t = e._type THEN
- res := TRUE
- ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
- IF (e.obj = eCONST) & (t = tBYTE) THEN
- res := ARITH.range(e.value, 0, 255)
- ELSE
- res := TRUE
- END
- ELSIF
- (e.obj = eCONST) & isChar(e) & (t = tWCHAR)
- OR isStringW1(e) & (t = tWCHAR)
- OR PROG.isBaseOf(t, e._type)
- OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(t, e._type)
- OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
- OR PROG.arrcomp(e._type, t)
- OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
- OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
- THEN
- res := TRUE
- ELSE
- res := FALSE
- END
- ELSE
- res := FALSE
- END
- RETURN res
- END assigncomp;
- PROCEDURE String (e: PARS.EXPR): INTEGER;
- VAR
- offset: INTEGER;
- string: SCAN.STRING;
- BEGIN
- IF strlen(e) # 1 THEN
- string := e.value.string(SCAN.STRING);
- IF string.offset = -1 THEN
- string.offset := IL.putstr(string.s);
- END;
- offset := string.offset
- ELSE
- offset := IL.putstr1(ARITH.Int(e.value))
- END
- RETURN offset
- END String;
- PROCEDURE StringW (e: PARS.EXPR): INTEGER;
- VAR
- offset: INTEGER;
- string: SCAN.STRING;
- BEGIN
- IF utf8strlen(e) # 1 THEN
- string := e.value.string(SCAN.STRING);
- IF string.offsetW = -1 THEN
- string.offsetW := IL.putstrW(string.s);
- END;
- offset := string.offsetW
- ELSE
- IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
- offset := IL.putstrW1(ARITH.Int(e.value))
- ELSE (* e._type.typ = PROG.tSTRING *)
- string := e.value.string(SCAN.STRING);
- IF string.offsetW = -1 THEN
- string.offsetW := IL.putstrW(string.s);
- END;
- offset := string.offsetW
- END
- END
- RETURN offset
- END StringW;
- PROCEDURE CheckRange (range, line, errno: INTEGER);
- VAR
- label: INTEGER;
- BEGIN
- label := IL.NewLabel();
- IL.AddCmd2(IL.opCHKIDX, label, range);
- IL.OnError(line, errno);
- IL.SetLabel(label)
- END CheckRange;
- PROCEDURE Float (parser: PARS.PARSER; e: PARS.EXPR);
- VAR
- pos: PARS.POSITION;
- BEGIN
- getpos(parser, pos);
- IL.Float(ARITH.Float(e.value), pos.line, pos.col)
- END Float;
- PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN;
- VAR
- res: BOOLEAN;
- label: INTEGER;
- BEGIN
- IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
- res := TRUE;
- IF PROG.arrcomp(e._type, VarType) THEN
- IF ~PROG.isOpenArray(VarType) THEN
- IL.Const(VarType.length)
- END;
- IL.AddCmd(IL.opCOPYA, VarType.base.size);
- label := IL.NewLabel();
- IL.Jmp(IL.opJNZ, label);
- IL.OnError(line, errCOPY);
- IL.SetLabel(label)
- ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
- IF VarType = tINTEGER THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSAVE)
- END
- ELSE
- IF e.obj = eCONST THEN
- res := ARITH.range(e.value, 0, 255);
- IF res THEN
- IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
- END
- ELSE
- IL.AddCmd0(IL.opSAVE8)
- END
- END
- ELSIF isSet(e) & (VarType = tSET) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSAVE)
- END
- ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSBOOL)
- END
- ELSIF isReal(e) & (VarType = tREAL) THEN
- IF e.obj = eCONST THEN
- Float(parser, e)
- END;
- IL.savef(e.obj = eCONST)
- ELSIF isChar(e) & (VarType = tCHAR) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSAVE8)
- END
- ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
- IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
- ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
- IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
- ELSIF isCharW(e) & (VarType = tWCHAR) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSAVE16)
- END
- ELSIF PROG.isBaseOf(VarType, e._type) THEN
- IF VarType.typ = PROG.tPOINTER THEN
- IL.AddCmd0(IL.opSAVE)
- ELSE
- IL.AddCmd(IL.opCOPY, VarType.size)
- END
- ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
- IL.AddCmd0(IL.opSAVE32)
- ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN
- IF e.obj = ePROC THEN
- IL.AssignProc(e.ident.proc.label)
- ELSIF e.obj = eIMP THEN
- IL.AssignImpProc(e.ident._import)
- ELSE
- IF VarType.typ = PROG.tPROCEDURE THEN
- IL.AddCmd0(IL.opSAVE)
- ELSE
- IL.AddCmd(IL.opCOPY, VarType.size)
- END
- END
- ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
- IL.AddCmd(IL.opSAVEC, 0)
- ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
- IL.saves(String(e), strlen(e) + 1)
- ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
- IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
- ELSE
- res := FALSE
- END
- ELSE
- res := FALSE
- END
- RETURN res
- END assign;
- PROCEDURE LoadConst (e: PARS.EXPR);
- BEGIN
- IL.Const(ARITH.Int(e.value))
- END LoadConst;
- PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
- VAR
- stroffs: INTEGER;
- PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
- VAR
- t1, t2: PROG._TYPE;
- BEGIN
- t1 := p._type;
- t2 := e._type;
- WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
- t1 := t1.base;
- t2 := t2.base
- END
- RETURN PROG.isTypeEq(t1, t2)
- END arrcomp;
- PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER;
- VAR
- res: INTEGER;
- BEGIN
- REPEAT
- res := t.length;
- t := t.base;
- DEC(n)
- UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
- ASSERT(n < 0)
- RETURN res
- END ArrLen;
- PROCEDURE OpenArray (t, t2: PROG._TYPE);
- VAR
- n, d1, d2: INTEGER;
- BEGIN
- IF t.length # 0 THEN
- IL.Param1;
- n := PROG.Dim(t2) - 1;
- WHILE n >= 0 DO
- IL.Const(ArrLen(t, n));
- IL.Param1;
- DEC(n)
- END
- ELSE
- d1 := PROG.Dim(t);
- d2 := PROG.Dim(t2);
- IF d1 # d2 THEN
- n := d2 - d1;
- WHILE d2 > d1 DO
- IL.Const(ArrLen(t, d2 - 1));
- DEC(d2)
- END;
- d2 := PROG.Dim(t2);
- WHILE n > 0 DO
- IL.AddCmd(IL.opROT, d2);
- DEC(n)
- END
- END;
- IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
- END
- END OpenArray;
- BEGIN
- IF p.vPar THEN
- PARS.check(isVar(e), pos, 93);
- IF p._type.typ = PROG.tRECORD THEN
- PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66);
- IF e.obj = eVREC THEN
- IF e.ident # NIL THEN
- IL.AddCmd(IL.opVADR, e.ident.offset - 1)
- ELSE
- IL.AddCmd0(IL.opPUSHT)
- END
- ELSE
- IL.Const(e._type.num)
- END;
- IL.AddCmd(IL.opPARAM, 2)
- ELSIF PROG.isOpenArray(p._type) THEN
- PARS.check(arrcomp(e, p), pos, 66);
- OpenArray(e._type, p._type)
- ELSE
- PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66);
- IL.Param1
- END;
- PARS.check(~e.readOnly, pos, 94)
- ELSE
- PARS.check(isExpr(e) OR isProc(e), pos, 66);
- IF PROG.isOpenArray(p._type) THEN
- IF e._type.typ = PROG.tARRAY THEN
- PARS.check(arrcomp(e, p), pos, 66);
- OpenArray(e._type, p._type)
- ELSIF isString(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tCHAR) THEN
- IL.StrAdr(String(e));
- IL.Param1;
- IL.Const(strlen(e) + 1);
- IL.Param1
- ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN
- IL.StrAdr(StringW(e));
- IL.Param1;
- IL.Const(utf8strlen(e) + 1);
- IL.Param1
- ELSE
- PARS.error(pos, 66)
- END
- ELSE
- PARS.check(~PROG.isOpenArray(e._type), pos, 66);
- PARS.check(assigncomp(e, p._type), pos, 66);
- IF e.obj = eCONST THEN
- IF e._type = tREAL THEN
- Float(parser, e);
- IL.AddCmd0(IL.opPUSHF)
- ELSIF e._type.typ = PROG.tNIL THEN
- IL.Const(0);
- IL.Param1
- ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
- IL.Const(StrToWChar(e.value.string(SCAN.STRING).s));
- IL.Param1
- ELSIF (e._type.typ = PROG.tSTRING) OR
- (e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
- IF p._type.base = tCHAR THEN
- stroffs := String(e);
- IL.StrAdr(stroffs);
- IF (CPU = TARGETS.cpuMSP430) & (p._type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
- ERRORS.WarningMsg(pos.line, pos.col, 0)
- END
- ELSE (* WCHAR *)
- stroffs := StringW(e);
- IL.StrAdr(stroffs)
- END;
- IL.set_dmin(stroffs + p._type.size);
- IL.Param1
- ELSE
- LoadConst(e);
- IL.Param1
- END
- ELSIF e.obj = ePROC THEN
- PARS.check(e.ident.global, pos, 85);
- IL.PushProc(e.ident.proc.label);
- IL.Param1
- ELSIF e.obj = eIMP THEN
- IL.PushImpProc(e.ident._import);
- IL.Param1
- ELSIF isExpr(e) & (e._type = tREAL) THEN
- IL.AddCmd0(IL.opPUSHF)
- ELSE
- IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN
- CheckRange(256, pos.line, errBYTE)
- END;
- IL.Param1
- END
- END
- END
- END paramcomp;
- PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
- BEGIN
- parser.expression(parser, e)
- END PExpression;
- PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- e1, e2: PARS.EXPR;
- pos: PARS.POSITION;
- proc,
- label,
- size,
- n, i: INTEGER;
- code: ARITH.VALUE;
- wchar,
- comma: BOOLEAN;
- cmd1,
- cmd2: IL.COMMAND;
- PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
- BEGIN
- parser.designator(parser, e);
- PARS.check(isVar(e), pos, 93);
- PARS.check(isfunc(e), pos, 66);
- IF readOnly THEN
- PARS.check(~e.readOnly, pos, 94)
- END
- END varparam;
- PROCEDURE shift_minmax (proc: INTEGER): CHAR;
- VAR
- res: CHAR;
- BEGIN
- CASE proc OF
- |PROG.stASR: res := "A"
- |PROG.stLSL: res := "L"
- |PROG.stROR: res := "O"
- |PROG.stLSR: res := "R"
- |PROG.stMIN: res := "m"
- |PROG.stMAX: res := "x"
- END
- RETURN res
- END shift_minmax;
- BEGIN
- ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
- proc := e.stproc;
- (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
- PARS.checklex(parser, SCAN.lxLROUND);
- PARS.Next(parser);
- (* END; *)
- getpos(parser, pos);
- IF e.obj IN {eSTPROC, eSYSPROC} THEN
- CASE proc OF
- |PROG.stASSERT:
- PExpression(parser, e);
- PARS.check(isBoolean(e), pos, 66);
- IF e.obj = eCONST THEN
- IF ~ARITH.getBool(e.value) THEN
- IL.OnError(pos.line, errASSERT)
- END
- ELSE
- label := IL.NewLabel();
- IL.not;
- IL.AndOrOpt(label);
- IL.OnError(pos.line, errASSERT);
- IL.SetLabel(label)
- END
- |PROG.stINC, PROG.stDEC:
- IL.pushBegEnd(begcall, endcall);
- varparam(parser, pos, isInt, TRUE, e);
- IF e._type = tINTEGER THEN
- IF parser.sym = SCAN.lxCOMMA THEN
- NextPos(parser, pos);
- IL.setlast(begcall);
- PExpression(parser, e2);
- IL.setlast(endcall.prev(IL.COMMAND));
- PARS.check(isInt(e2), pos, 66);
- IF e2.obj = eCONST THEN
- IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
- ELSE
- IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
- END
- ELSE
- IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
- END
- ELSE (* e._type = tBYTE *)
- IF parser.sym = SCAN.lxCOMMA THEN
- NextPos(parser, pos);
- IL.setlast(begcall);
- PExpression(parser, e2);
- IL.setlast(endcall.prev(IL.COMMAND));
- PARS.check(isInt(e2), pos, 66);
- IF e2.obj = eCONST THEN
- IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
- ELSE
- IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
- END
- ELSE
- IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
- END
- END;
- IL.popBegEnd(begcall, endcall)
- |PROG.stINCL, PROG.stEXCL:
- IL.pushBegEnd(begcall, endcall);
- varparam(parser, pos, isSet, TRUE, e);
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- IL.setlast(begcall);
- PExpression(parser, e2);
- IL.setlast(endcall.prev(IL.COMMAND));
- PARS.check(isInt(e2), pos, 66);
- IF e2.obj = eCONST THEN
- PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
- IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
- ELSE
- IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
- END;
- IL.popBegEnd(begcall, endcall)
- |PROG.stNEW:
- varparam(parser, pos, isPtr, TRUE, e);
- IF CPU = TARGETS.cpuMSP430 THEN
- PARS.check(e._type.base.size + 16 < Options.ram, pos, 63)
- END;
- IL.New(e._type.base.size, e._type.base.num)
- |PROG.stDISPOSE:
- varparam(parser, pos, isPtr, TRUE, e);
- IL.AddCmd0(IL.opDISP)
- |PROG.stPACK:
- varparam(parser, pos, isReal, TRUE, e);
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- PExpression(parser, e2);
- PARS.check(isInt(e2), pos, 66);
- IF e2.obj = eCONST THEN
- IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
- ELSE
- IL.AddCmd0(IL.opPACK)
- END
- |PROG.stUNPK:
- varparam(parser, pos, isReal, TRUE, e);
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- varparam(parser, pos, isInteger, TRUE, e2);
- IL.AddCmd0(IL.opUNPK)
- |PROG.stCOPY:
- IL.pushBegEnd(begcall, endcall);
- PExpression(parser, e);
- IF isString(e) OR isCharArray(e) THEN
- wchar := FALSE
- ELSIF isStringW(e) OR isCharArrayW(e) THEN
- wchar := TRUE
- ELSE
- PARS.error(pos, 66)
- END;
- IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN
- IL.Const(e._type.length)
- END;
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- IL.setlast(begcall);
- IF wchar THEN
- varparam(parser, pos, isCharArrayW, TRUE, e1)
- ELSE
- IF e.obj = eCONST THEN
- varparam(parser, pos, isCharArrayX, TRUE, e1)
- ELSE
- varparam(parser, pos, isCharArray, TRUE, e1)
- END;
- wchar := e1._type.base = tWCHAR
- END;
- IF ~PROG.isOpenArray(e1._type) THEN
- IL.Const(e1._type.length)
- END;
- IL.setlast(endcall.prev(IL.COMMAND));
- IF e.obj = eCONST THEN
- IF wchar THEN
- IL.StrAdr(StringW(e));
- IL.Const(utf8strlen(e) + 1)
- ELSE
- IL.StrAdr(String(e));
- IL.Const(strlen(e) + 1)
- END
- END;
- IL.AddCmd(IL.opCOPYS, e1._type.base.size);
- IL.popBegEnd(begcall, endcall)
- |PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- parser.designator(parser, e2);
- PARS.check(isVar(e2), pos, 93);
- IF proc = PROG.sysGET THEN
- PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66)
- ELSE
- PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66)
- END;
- CASE proc OF
- |PROG.sysGET: size := e2._type.size
- |PROG.sysGET8: size := 1
- |PROG.sysGET16: size := 2
- |PROG.sysGET32: size := 4
- END;
- PARS.check(size <= e2._type.size, pos, 66);
- IF e.obj = eCONST THEN
- IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size)
- ELSE
- IL.AddCmd(IL.opGET, size)
- END
- |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
- IL.pushBegEnd(begcall, endcall);
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- IF e.obj = eCONST THEN
- LoadConst(e)
- END;
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- IL.setlast(begcall);
- PExpression(parser, e2);
- PARS.check(isExpr(e2), pos, 66);
- IF proc = PROG.sysPUT THEN
- PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
- IF e2.obj = eCONST THEN
- IF e2._type = tREAL THEN
- Float(parser, e2);
- IL.setlast(endcall.prev(IL.COMMAND));
- IL.savef(FALSE)
- ELSE
- LoadConst(e2);
- IL.setlast(endcall.prev(IL.COMMAND));
- IL.SysPut(e2._type.size)
- END
- ELSE
- IL.setlast(endcall.prev(IL.COMMAND));
- IF e2._type = tREAL THEN
- IL.savef(FALSE)
- ELSIF e2._type = tBYTE THEN
- IL.SysPut(tINTEGER.size)
- ELSE
- IL.SysPut(e2._type.size)
- END
- END
- ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
- PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
- IF e2.obj = eCONST THEN
- LoadConst(e2)
- END;
- IL.setlast(endcall.prev(IL.COMMAND));
- CASE proc OF
- |PROG.sysPUT8: size := 1
- |PROG.sysPUT16: size := 2
- |PROG.sysPUT32: size := 4
- END;
- IL.SysPut(size)
- END;
- IL.popBegEnd(begcall, endcall)
- |PROG.sysMOVE:
- FOR i := 1 TO 2 DO
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- IF e.obj = eCONST THEN
- LoadConst(e)
- END;
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos)
- END;
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opMOVE)
- END
- |PROG.sysCOPY:
- FOR i := 1 TO 2 DO
- parser.designator(parser, e);
- PARS.check(isVar(e), pos, 93);
- n := PROG.Dim(e._type);
- WHILE n > 0 DO
- IL.drop;
- DEC(n)
- END;
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos)
- END;
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opMOVE)
- END
- |PROG.sysCODE:
- REPEAT
- getpos(parser, pos);
- PARS.ConstExpression(parser, code);
- PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
- IF TARGETS.WordSize > TARGETS.InstrSize THEN
- CASE TARGETS.InstrSize OF
- |1: PARS.check(ARITH.range(code, 0, 255), pos, 42)
- |2: PARS.check(ARITH.range(code, 0, 65535), pos, 110)
- END
- END;
- IL.AddCmd(IL.opCODE, ARITH.getInt(code));
- comma := parser.sym = SCAN.lxCOMMA;
- IF comma THEN
- PARS.Next(parser)
- ELSE
- PARS.checklex(parser, SCAN.lxRROUND)
- END
- UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
- (*
- |PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
- IF parser.sym = SCAN.lxLROUND THEN
- PARS.Next(parser);
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser)
- END;
- ASSERT(CPU = cpuMSP430);
- CASE proc OF
- |PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H)
- |PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
- |PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
- END
- *)
- END;
- e.obj := eEXPR;
- e._type := NIL
- ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
- CASE e.stproc OF
- |PROG.stABS:
- PExpression(parser, e);
- PARS.check(isInt(e) OR isReal(e), pos, 66);
- IF e.obj = eCONST THEN
- PARS.check(ARITH.abs(e.value), pos, 39)
- ELSE
- IL.abs(isReal(e))
- END
- |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- PARS.checklex(parser, SCAN.lxCOMMA);
- NextPos(parser, pos);
- PExpression(parser, e2);
- PARS.check(isInt(e2), pos, 66);
- e._type := tINTEGER;
- IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
- ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
- ELSE
- IF e.obj = eCONST THEN
- IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
- ELSIF e2.obj = eCONST THEN
- IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
- ELSE
- IL.shift_minmax(shift_minmax(proc))
- END;
- e.obj := eEXPR
- END
- |PROG.stCHR:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- e._type := tCHAR;
- IF e.obj = eCONST THEN
- ARITH.setChar(e.value, ARITH.getInt(e.value));
- PARS.check(ARITH.check(e.value), pos, 107)
- ELSE
- IF chkCHR IN Options.checking THEN
- CheckRange(256, pos.line, errCHR)
- ELSE
- IL.AddCmd(IL.opMODR, 256)
- END
- END
- |PROG.stWCHR:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- e._type := tWCHAR;
- IF e.obj = eCONST THEN
- ARITH.setWChar(e.value, ARITH.getInt(e.value));
- PARS.check(ARITH.check(e.value), pos, 101)
- ELSE
- IF chkWCHR IN Options.checking THEN
- CheckRange(65536, pos.line, errWCHR)
- ELSE
- IL.AddCmd(IL.opMODR, 65536)
- END
- END
- |PROG.stFLOOR:
- PExpression(parser, e);
- PARS.check(isReal(e), pos, 66);
- e._type := tINTEGER;
- IF e.obj = eCONST THEN
- PARS.check(ARITH.floor(e.value), pos, 39)
- ELSE
- IL.AddCmd0(IL.opFLOOR)
- END
- |PROG.stFLT:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- e._type := tREAL;
- IF e.obj = eCONST THEN
- ARITH.flt(e.value)
- ELSE
- IL.AddCmd2(IL.opFLT, pos.line, pos.col)
- END
- |PROG.stLEN:
- cmd1 := IL.getlast();
- varparam(parser, pos, isArr, FALSE, e);
- IF e._type.length > 0 THEN
- cmd2 := IL.getlast();
- IL.delete2(cmd1.next, cmd2);
- IL.setlast(cmd1);
- ASSERT(ARITH.setInt(e.value, e._type.length));
- e.obj := eCONST
- ELSE
- IL.len(PROG.Dim(e._type))
- END;
- e._type := tINTEGER
- |PROG.stLENGTH:
- PExpression(parser, e);
- IF isCharArray(e) THEN
- IF e._type.length > 0 THEN
- IL.Const(e._type.length)
- END;
- IL.AddCmd0(IL.opLENGTH)
- ELSIF isCharArrayW(e) THEN
- IF e._type.length > 0 THEN
- IL.Const(e._type.length)
- END;
- IL.AddCmd0(IL.opLENGTHW)
- ELSE
- PARS.error(pos, 66);
- END;
- e._type := tINTEGER
- |PROG.stODD:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- e._type := tBOOLEAN;
- IF e.obj = eCONST THEN
- ARITH.odd(e.value)
- ELSE
- IL.AddCmd(IL.opMODR, 2)
- END
- |PROG.stORD:
- cmd1 := IL.getlast();
- PExpression(parser, e);
- PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
- IF e.obj = eCONST THEN
- IF isStringW1(e) THEN
- ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
- ELSE
- ARITH.ord(e.value)
- END
- ELSE
- IF isBoolean(e) THEN
- cmd2 := IL.getlast();
- IL.setlast(cmd1);
- IL.AddCmd(IL.opPRECALL, 0);
- IL.AddCmd0(IL.opRES);
- IL.drop;
- IL.setlast(cmd2);
- IL._ord
- END
- END;
- e._type := tINTEGER
- |PROG.stBITS:
- PExpression(parser, e);
- PARS.check(isInt(e), pos, 66);
- IF e.obj = eCONST THEN
- ARITH.bits(e.value)
- END;
- e._type := tSET
- |PROG.sysADR:
- parser.designator(parser, e);
- IF isVar(e) THEN
- n := PROG.Dim(e._type);
- WHILE n > 0 DO
- IL.drop;
- DEC(n)
- END
- ELSIF e.obj = ePROC THEN
- IL.PushProc(e.ident.proc.label)
- ELSIF e.obj = eIMP THEN
- IL.PushImpProc(e.ident._import)
- ELSE
- PARS.error(pos, 108)
- END;
- e._type := tINTEGER
- |PROG.sysSADR:
- PExpression(parser, e);
- PARS.check(isString(e), pos, 66);
- IL.StrAdr(String(e));
- e._type := tINTEGER;
- e.obj := eEXPR
- |PROG.sysWSADR:
- PExpression(parser, e);
- PARS.check(isStringW(e), pos, 66);
- IL.StrAdr(StringW(e));
- e._type := tINTEGER;
- e.obj := eEXPR
- |PROG.sysTYPEID:
- PExpression(parser, e);
- PARS.check(e.obj = eTYPE, pos, 68);
- IF e._type.typ = PROG.tRECORD THEN
- ASSERT(ARITH.setInt(e.value, e._type.num))
- ELSIF e._type.typ = PROG.tPOINTER THEN
- ASSERT(ARITH.setInt(e.value, e._type.base.num))
- ELSE
- PARS.error(pos, 52)
- END;
- e.obj := eCONST;
- e._type := tINTEGER
- |PROG.sysINF:
- IL.AddCmd2(IL.opINF, pos.line, pos.col);
- e.obj := eEXPR;
- e._type := tREAL
- |PROG.sysSIZE:
- PExpression(parser, e);
- PARS.check(e.obj = eTYPE, pos, 68);
- ASSERT(ARITH.setInt(e.value, e._type.size));
- e.obj := eCONST;
- e._type := tINTEGER
- END
- END;
- (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser);
- (* END; *)
- IF e.obj # eCONST THEN
- e.obj := eEXPR
- END
- END stProc;
- PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- proc: PROG._TYPE;
- param: LISTS.ITEM;
- e1: PARS.EXPR;
- pos: PARS.POSITION;
- BEGIN
- ASSERT(parser.sym = SCAN.lxLROUND);
- IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
- proc := e._type;
- PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
- PARS.Next(parser);
- param := proc.params.first;
- WHILE param # NIL DO
- getpos(parser, pos);
- IL.setlast(begcall);
- IF param(PROG.PARAM).vPar THEN
- parser.designator(parser, e1)
- ELSE
- PExpression(parser, e1)
- END;
- paramcomp(parser, pos, e1, param(PROG.PARAM));
- param := param.next;
- IF param # NIL THEN
- PARS.checklex(parser, SCAN.lxCOMMA);
- PARS.Next(parser)
- END
- END;
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser);
- e.obj := eEXPR;
- e._type := proc.base
- ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
- stProc(parser, e)
- ELSE
- PARS.check1(FALSE, parser, 86)
- END
- END ActualParameters;
- PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- ident: PROG.IDENT;
- imp: BOOLEAN;
- pos: PARS.POSITION;
- BEGIN
- PARS.checklex(parser, SCAN.lxIDENT);
- getpos(parser, pos);
- imp := FALSE;
- ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
- PARS.check1(ident # NIL, parser, 48);
- IF ident.typ = PROG.idMODULE THEN
- PARS.ExpectSym(parser, SCAN.lxPOINT);
- PARS.ExpectSym(parser, SCAN.lxIDENT);
- ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
- PARS.check1((ident # NIL) & ident.export, parser, 48);
- imp := TRUE
- END;
- PARS.Next(parser);
- e.readOnly := FALSE;
- e.ident := ident;
- CASE ident.typ OF
- |PROG.idCONST:
- e.obj := eCONST;
- e._type := ident._type;
- e.value := ident.value
- |PROG.idTYPE:
- e.obj := eTYPE;
- e._type := ident._type
- |PROG.idVAR:
- e.obj := eVAR;
- e._type := ident._type;
- e.readOnly := imp
- |PROG.idPROC:
- e.obj := ePROC;
- e._type := ident._type
- |PROG.idIMP:
- e.obj := eIMP;
- e._type := ident._type
- |PROG.idVPAR:
- e._type := ident._type;
- IF e._type.typ = PROG.tRECORD THEN
- e.obj := eVREC
- ELSE
- e.obj := eVPAR
- END
- |PROG.idPARAM:
- e.obj := ePARAM;
- e._type := ident._type;
- e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY})
- |PROG.idSTPROC:
- e.obj := eSTPROC;
- e._type := ident._type;
- e.stproc := ident.stproc
- |PROG.idSTFUNC:
- e.obj := eSTFUNC;
- e._type := ident._type;
- e.stproc := ident.stproc
- |PROG.idSYSPROC:
- e.obj := eSYSPROC;
- e._type := ident._type;
- e.stproc := ident.stproc
- |PROG.idSYSFUNC:
- PARS.check(~parser.constexp, pos, 109);
- e.obj := eSYSFUNC;
- e._type := ident._type;
- e.stproc := ident.stproc
- |PROG.idNONE:
- PARS.error(pos, 115)
- END;
- IF isVar(e) THEN
- PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
- END
- END qualident;
- PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
- VAR
- label: INTEGER;
- BEGIN
- IF load THEN
- IL.load(e._type.size)
- END;
- IF chkPTR IN Options.checking THEN
- label := IL.NewLabel();
- IL.Jmp(IL.opJNZ1, label);
- IL.OnError(pos.line, error);
- IL.SetLabel(label)
- END
- END deref;
- PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- field: PROG.FIELD;
- pos: PARS.POSITION;
- t, idx: PARS.EXPR;
- sysVal: BOOLEAN;
- n: INTEGER;
- PROCEDURE LoadAdr (e: PARS.EXPR);
- VAR
- offset: INTEGER;
- PROCEDURE OpenArray (e: PARS.EXPR);
- VAR
- offset, n: INTEGER;
- BEGIN
- offset := e.ident.offset;
- n := PROG.Dim(e._type);
- WHILE n >= 0 DO
- IL.AddCmd(IL.opVADR, offset);
- DEC(offset);
- DEC(n)
- END
- END OpenArray;
- BEGIN
- IF e.obj = eVAR THEN
- offset := PROG.getOffset(e.ident);
- IF e.ident.global THEN
- IL.AddCmd(IL.opGADR, offset)
- ELSE
- IL.AddCmd(IL.opLADR, -offset)
- END
- ELSIF e.obj = ePARAM THEN
- IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN
- IL.AddCmd(IL.opVADR, e.ident.offset)
- ELSIF PROG.isOpenArray(e._type) THEN
- OpenArray(e)
- ELSE
- IL.AddCmd(IL.opLADR, e.ident.offset)
- END
- ELSIF e.obj IN {eVPAR, eVREC} THEN
- IF PROG.isOpenArray(e._type) THEN
- OpenArray(e)
- ELSE
- IL.AddCmd(IL.opVADR, e.ident.offset)
- END
- END
- END LoadAdr;
- PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
- VAR
- label, offset, n, k: INTEGER;
- _type: PROG._TYPE;
- BEGIN
- IF chkIDX IN Options.checking THEN
- label := IL.NewLabel();
- IL.AddCmd2(IL.opCHKIDX2, label, 0);
- IL.OnError(pos.line, errIDX);
- IL.SetLabel(label)
- ELSE
- IL.AddCmd(IL.opCHKIDX2, -1)
- END;
- _type := PROG.OpenBase(e._type);
- IF _type.size # 1 THEN
- IL.AddCmd(IL.opMULC, _type.size)
- END;
- n := PROG.Dim(e._type) - 1;
- k := n;
- WHILE n > 0 DO
- IL.AddCmd0(IL.opMUL);
- DEC(n)
- END;
- IL.AddCmd0(IL.opADD);
- offset := e.ident.offset - 1;
- n := k;
- WHILE n > 0 DO
- IL.AddCmd(IL.opVADR, offset);
- DEC(offset);
- DEC(n)
- END
- END OpenIdx;
- BEGIN
- qualident(parser, e);
- sysVal := (e.obj = eSYSPROC) & (e.stproc = PROG.sysVAL);
- IF sysVal THEN
- PARS.checklex(parser, SCAN.lxLROUND);
- PARS.Next(parser);
- getpos(parser, pos);
- designator(parser, e);
- PARS.check(isVar(e), pos, 93);
- IF PROG.isOpenArray(e._type) THEN
- n := PROG.Dim(e._type);
- WHILE n > 0 DO
- IL.drop;
- DEC(n)
- END
- END;
- PARS.checklex(parser, SCAN.lxCOMMA);
- PARS.Next(parser);
- getpos(parser, pos);
- qualident(parser, t);
- PARS.check(t.obj = eTYPE, pos, 79);
- e._type := t._type;
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser)
- END;
- IF e.obj IN {ePROC, eIMP} THEN
- PROG.UseProc(parser.unit, e.ident.proc)
- END;
- IF isVar(e) & ~sysVal THEN
- LoadAdr(e)
- END;
- WHILE parser.sym = SCAN.lxPOINT DO
- getpos(parser, pos);
- PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
- IF e._type.typ = PROG.tPOINTER THEN
- deref(pos, e, TRUE, errPTR)
- END;
- PARS.ExpectSym(parser, SCAN.lxIDENT);
- IF e._type.typ = PROG.tPOINTER THEN
- e._type := e._type.base;
- e.readOnly := FALSE
- END;
- field := PROG.getField(e._type, parser.lex.ident, parser.unit);
- PARS.check1(field # NIL, parser, 74);
- e._type := field._type;
- IF e.obj = eVREC THEN
- e.obj := eVPAR
- END;
- IF field.offset # 0 THEN
- IL.AddCmd(IL.opADDC, field.offset)
- END;
- PARS.Next(parser);
- e.ident := NIL
- ELSIF parser.sym = SCAN.lxLSQUARE DO
- REPEAT
- PARS.check1(isArr(e), parser, 75);
- NextPos(parser, pos);
- PExpression(parser, idx);
- PARS.check(isInt(idx), pos, 76);
- IF idx.obj = eCONST THEN
- IF e._type.length > 0 THEN
- PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83);
- IF ARITH.Int(idx.value) > 0 THEN
- IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size)
- END
- ELSE
- PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
- LoadConst(idx);
- OpenIdx(parser, pos, e)
- END
- ELSE
- IF e._type.length > 0 THEN
- IF chkIDX IN Options.checking THEN
- CheckRange(e._type.length, pos.line, errIDX)
- END;
- IF e._type.base.size # 1 THEN
- IL.AddCmd(IL.opMULC, e._type.base.size)
- END;
- IL.AddCmd0(IL.opADD)
- ELSE
- OpenIdx(parser, pos, e)
- END
- END;
- e._type := e._type.base
- UNTIL parser.sym # SCAN.lxCOMMA;
- PARS.checklex(parser, SCAN.lxRSQUARE);
- PARS.Next(parser);
- IF ~(isArr(e) & (e._type.length = 0) & (parser.sym = SCAN.lxLSQUARE)) THEN
- e.ident := NIL
- END
- ELSIF parser.sym = SCAN.lxCARET DO
- getpos(parser, pos);
- PARS.check1(isPtr(e), parser, 77);
- deref(pos, e, TRUE, errPTR);
- e._type := e._type.base;
- e.readOnly := FALSE;
- PARS.Next(parser);
- e.ident := NIL;
- e.obj := eVREC
- ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
- IF e._type.typ = PROG.tRECORD THEN
- PARS.check1(e.obj = eVREC, parser, 78)
- END;
- NextPos(parser, pos);
- qualident(parser, t);
- PARS.check(t.obj = eTYPE, pos, 79);
- IF e._type.typ = PROG.tRECORD THEN
- PARS.check(t._type.typ = PROG.tRECORD, pos, 80);
- IF chkGUARD IN Options.checking THEN
- IF e.ident = NIL THEN
- IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD)
- ELSE
- IL.AddCmd(IL.opVADR, e.ident.offset - 1);
- IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD)
- END
- END;
- ELSE
- PARS.check(t._type.typ = PROG.tPOINTER, pos, 81);
- IF chkGUARD IN Options.checking THEN
- IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD)
- END
- END;
- PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82);
- e._type := t._type;
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser)
- END
- END designator;
- PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
- VAR
- cconv,
- parSize,
- callconv,
- fparSize,
- int, flt,
- stk_par: INTEGER;
- BEGIN
- cconv := procType.call;
- parSize := procType.parSize;
- IF cconv IN {PROG._win64, PROG.win64} THEN
- callconv := IL.call_win64;
- fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
- ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
- callconv := IL.call_sysv;
- fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
- stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
- ELSIF cconv IN {PROG.fastcall, PROG._fastcall} THEN
- IF parSize = 0 THEN
- callconv := IL.call_stack
- ELSIF parSize = 1 THEN
- callconv := IL.call_fast1
- ELSIF parSize >= 2 THEN
- callconv := IL.call_fast2
- END;
- fparSize := 0
- ELSE
- callconv := IL.call_stack;
- fparSize := 0
- END;
- IL.setlast(begcall);
- IL.AddCmd(IL.opPRECALL, ORD(isfloat));
- IF cconv IN {PROG._ccall, PROG.ccall} THEN
- IL.AddCmd(IL.opALIGN16, parSize)
- ELSIF cconv IN {PROG._win64, PROG.win64} THEN
- IL.AddCmd(IL.opWIN64ALIGN16, parSize)
- ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
- IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
- END;
- IL.setlast(endcall.prev(IL.COMMAND));
- IF e.obj = eIMP THEN
- IL.CallImp(e.ident._import, callconv, fparSize)
- ELSIF e.obj = ePROC THEN
- IL.Call(e.ident.proc.label, callconv, fparSize)
- ELSIF isExpr(e) THEN
- deref(pos, e, CallStat, errPROC);
- IL.CallP(callconv, fparSize)
- END;
- IF cconv IN {PROG._ccall, PROG.ccall} THEN
- IL.AddCmd(IL.opCLEANUP, parSize);
- IL.AddCmd0(IL.opPOPSP)
- ELSIF cconv IN {PROG._win64, PROG.win64} THEN
- IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
- IL.AddCmd0(IL.opPOPSP)
- ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
- IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
- IL.AddCmd0(IL.opPOPSP)
- ELSIF cconv IN {PROG._cdecl, PROG.cdecl, PROG.default16, PROG.code, PROG._code} THEN
- IL.AddCmd(IL.opCLEANUP, parSize)
- END;
- IF CallStat THEN
- IL.AddCmd0(IL.opRES);
- IL.drop
- ELSE
- IF isfloat THEN
- IL.AddCmd2(IL.opRESF, pos.line, pos.col)
- ELSE
- IL.AddCmd0(IL.opRES)
- END
- END
- END ProcCall;
- PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- pos, pos0, pos1: PARS.POSITION;
- e1: PARS.EXPR;
- op, cmp, error: INTEGER;
- constant, eq: BOOLEAN;
- PROCEDURE relation (sym: INTEGER): BOOLEAN;
- RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
- (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
- (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
- (sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
- END relation;
- PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
- RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
- (sym = SCAN.lxOR)
- END AddOperator;
- PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
- RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
- (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
- (sym = SCAN.lxAND)
- END MulOperator;
- PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- e1, e2: PARS.EXPR;
- pos: PARS.POSITION;
- range: BOOLEAN;
- BEGIN
- range := FALSE;
- getpos(parser, pos);
- expression(parser, e1);
- PARS.check(isInt(e1), pos, 76);
- IF e1.obj = eCONST THEN
- PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
- END;
- range := parser.sym = SCAN.lxRANGE;
- IF range THEN
- NextPos(parser, pos);
- expression(parser, e2);
- PARS.check(isInt(e2), pos, 76);
- IF e2.obj = eCONST THEN
- PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
- END
- ELSE
- IF e1.obj = eCONST THEN
- e2 := e1
- END
- END;
- e._type := tSET;
- IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
- ARITH.constrSet(e.value, e1.value, e2.value);
- e.obj := eCONST
- ELSE
- IF range THEN
- IF e1.obj = eCONST THEN
- IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
- ELSIF e2.obj = eCONST THEN
- IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
- ELSE
- IL.AddCmd0(IL.opRSET)
- END
- ELSE
- IL.AddCmd0(IL.opRSET1)
- END;
- e.obj := eEXPR
- END
- END element;
- PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- e1: PARS.EXPR;
- BEGIN
- ASSERT(parser.sym = SCAN.lxLCURLY);
- e.obj := eCONST;
- e._type := tSET;
- ARITH.emptySet(e.value);
- PARS.Next(parser);
- IF parser.sym # SCAN.lxRCURLY THEN
- element(parser, e1);
- IF e1.obj = eCONST THEN
- ARITH.opSet(e.value, e1.value, "+")
- ELSE
- e.obj := eEXPR
- END;
- WHILE parser.sym = SCAN.lxCOMMA DO
- PARS.Next(parser);
- element(parser, e1);
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
- ARITH.opSet(e.value, e1.value, "+")
- ELSE
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opADDSC, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opADDSC, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opADDS)
- END;
- e.obj := eEXPR
- END
- END;
- PARS.checklex(parser, SCAN.lxRCURLY)
- END;
- PARS.Next(parser);
- END set;
- PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- sym: INTEGER;
- pos: PARS.POSITION;
- e1: PARS.EXPR;
- isfloat: BOOLEAN;
- PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
- BEGIN
- IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
- IF e._type = tREAL THEN
- IL.AddCmd2(IL.opLOADF, pos.line, pos.col)
- ELSE
- IL.load(e._type.size)
- END
- END
- END LoadVar;
- BEGIN
- sym := parser.sym;
- IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
- e.obj := eCONST;
- e.value := parser.lex.value;
- e._type := PROG.getType(e.value.typ);
- PARS.Next(parser)
- ELSIF sym = SCAN.lxNIL THEN
- e.obj := eCONST;
- e._type := PROG.program.stTypes.tNIL;
- PARS.Next(parser)
- ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
- e.obj := eCONST;
- ARITH.setbool(e.value, sym = SCAN.lxTRUE);
- e._type := tBOOLEAN;
- PARS.Next(parser)
- ELSIF sym = SCAN.lxLCURLY THEN
- set(parser, e)
- ELSIF sym = SCAN.lxIDENT THEN
- getpos(parser, pos);
- IL.pushBegEnd(begcall, endcall);
- designator(parser, e);
- IF isVar(e) THEN
- LoadVar(e, parser, pos)
- END;
- IF parser.sym = SCAN.lxLROUND THEN
- e1 := e;
- ActualParameters(parser, e);
- PARS.check(e._type # NIL, pos, 59);
- isfloat := e._type = tREAL;
- IF e1.obj IN {ePROC, eIMP} THEN
- ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE)
- ELSIF isExpr(e1) THEN
- ProcCall(e1, e1._type, isfloat, parser, pos, FALSE)
- END
- END;
- IL.popBegEnd(begcall, endcall)
- ELSIF sym = SCAN.lxLROUND THEN
- PARS.Next(parser);
- expression(parser, e);
- PARS.checklex(parser, SCAN.lxRROUND);
- PARS.Next(parser);
- IF isExpr(e) & (e.obj # eCONST) THEN
- e.obj := eEXPR
- END
- ELSIF sym = SCAN.lxNOT THEN
- NextPos(parser, pos);
- factor(parser, e);
- PARS.check(isBoolean(e), pos, 72);
- IF e.obj # eCONST THEN
- IL.not;
- e.obj := eEXPR
- ELSE
- ASSERT(ARITH.neg(e.value))
- END
- ELSE
- PARS.check1(FALSE, parser, 34)
- END
- END factor;
- PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- pos: PARS.POSITION;
- e1: PARS.EXPR;
- op, label, label1: INTEGER;
- BEGIN
- factor(parser, e);
- label := -1;
- WHILE MulOperator(parser.sym) DO
- op := parser.sym;
- getpos(parser, pos);
- PARS.Next(parser);
- IF op = SCAN.lxAND THEN
- IF ~parser.constexp THEN
- IF label = -1 THEN
- label := IL.NewLabel()
- END;
- IF (e.obj = eCONST) & isBoolean(e) THEN
- IL.Const(ORD(ARITH.getBool(e.value)))
- END;
- IL.Jmp(IL.opJZ, label)
- END
- END;
- factor(parser, e1);
- CASE op OF
- |SCAN.lxMUL:
- PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
- CASE e.value.typ OF
- |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39)
- |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
- |ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
- END
- ELSE
- IF isInt(e) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opMUL)
- END
- ELSIF isReal(e) THEN
- IF e.obj = eCONST THEN
- Float(parser, e)
- ELSIF e1.obj = eCONST THEN
- Float(parser, e1)
- END;
- IL.AddCmd0(IL.opMULF)
- ELSIF isSet(e) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opMULS)
- END
- END;
- e.obj := eEXPR
- END
- |SCAN.lxSLASH:
- PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
- IF (e1.obj = eCONST) & isReal(e1) THEN
- PARS.check(~ARITH.isZero(e1.value), pos, 45)
- END;
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
- CASE e.value.typ OF
- |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
- |ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
- END
- ELSE
- IF isReal(e) THEN
- IF e.obj = eCONST THEN
- Float(parser, e);
- IL.AddCmd0(IL.opDIVFI)
- ELSIF e1.obj = eCONST THEN
- Float(parser, e1);
- IL.AddCmd0(IL.opDIVF)
- ELSE
- IL.AddCmd0(IL.opDIVF)
- END
- ELSIF isSet(e) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opDIVS)
- END
- END;
- e.obj := eEXPR
- END
- |SCAN.lxDIV, SCAN.lxMOD:
- PARS.check(isInt(e) & isInt(e1), pos, 37);
- IF e1.obj = eCONST THEN
- PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
- END;
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
- IF op = SCAN.lxDIV THEN
- PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
- ELSE
- ASSERT(ARITH.opInt(e.value, e1.value, "M"))
- END
- ELSE
- IF e1.obj # eCONST THEN
- label1 := IL.NewLabel();
- IL.Jmp(IL.opJG, label1)
- END;
- IF e.obj = eCONST THEN
- IL.OnError(pos.line, errDIV);
- IL.SetLabel(label1);
- IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
- ELSE
- IL.OnError(pos.line, errDIV);
- IL.SetLabel(label1);
- IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD))
- END;
- e.obj := eEXPR
- END
- |SCAN.lxAND:
- PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
- ARITH.opBoolean(e.value, e1.value, "&")
- ELSE
- e.obj := eEXPR;
- IF e1.obj = eCONST THEN
- IL.Const(ORD(ARITH.getBool(e1.value)))
- END
- END
- END
- END;
- IF label # -1 THEN
- label1 := IL.NewLabel();
- IL.Jmp(IL.opJNZ, label1);
- IL.SetLabel(label);
- IL.Const(0);
- IL.drop;
- label := IL.NewLabel();
- IL.Jmp(IL.opJMP, label);
- IL.SetLabel(label1);
- IL.Const(1);
- IL.SetLabel(label);
- IL.AddCmd0(IL.opAND)
- END
- END term;
- PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
- VAR
- pos: PARS.POSITION;
- op: INTEGER;
- e1: PARS.EXPR;
- s, s1: SCAN.TEXTSTR;
- plus, minus: BOOLEAN;
- label, label1: INTEGER;
- BEGIN
- plus := parser.sym = SCAN.lxPLUS;
- minus := parser.sym = SCAN.lxMINUS;
- IF plus OR minus THEN
- getpos(parser, pos);
- PARS.Next(parser)
- END;
- term(parser, e);
- IF plus OR minus THEN
- PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);
- IF minus & (e.obj = eCONST) THEN
- PARS.check(ARITH.neg(e.value), pos, 39)
- END;
- IF e.obj # eCONST THEN
- IF minus THEN
- IF isInt(e) THEN
- IL.AddCmd0(IL.opUMINUS)
- ELSIF isReal(e) THEN
- IL.AddCmd0(IL.opUMINF)
- ELSIF isSet(e) THEN
- IL.AddCmd0(IL.opUMINS)
- END
- END;
- e.obj := eEXPR
- END
- END;
- label := -1;
- WHILE AddOperator(parser.sym) DO
- op := parser.sym;
- getpos(parser, pos);
- PARS.Next(parser);
- IF op = SCAN.lxOR THEN
- IF ~parser.constexp THEN
- IF label = -1 THEN
- label := IL.NewLabel()
- END;
- IF (e.obj = eCONST) & isBoolean(e) THEN
- IL.Const(ORD(ARITH.getBool(e.value)))
- END;
- IL.Jmp(IL.opJNZ, label)
- END
- END;
- term(parser, e1);
- CASE op OF
- |SCAN.lxPLUS, SCAN.lxMINUS:
- minus := op = SCAN.lxMINUS;
- IF minus THEN
- op := ORD("-")
- ELSE
- op := ORD("+")
- END;
- PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
- CASE e.value.typ OF
- |ARITH.tINTEGER:
- PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
- |ARITH.tREAL:
- PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
- |ARITH.tSET:
- ARITH.opSet(e.value, e1.value, CHR(op))
- |ARITH.tCHAR, ARITH.tSTRING:
- IF e.value.typ = ARITH.tCHAR THEN
- ARITH.charToStr(e.value, s)
- ELSE
- s := e.value.string(SCAN.STRING).s
- END;
- IF e1.value.typ = ARITH.tCHAR THEN
- ARITH.charToStr(e1.value, s1)
- ELSE
- s1 := e1.value.string(SCAN.STRING).s
- END;
- PARS.check(ARITH.concat(s, s1), pos, 5);
- e.value.string := SCAN.enterStr(s);
- e.value.typ := ARITH.tSTRING;
- e._type := PROG.program.stTypes.tSTRING
- END
- ELSE
- IF isInt(e) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opADD + ORD(minus))
- END
- ELSIF isReal(e) THEN
- IF e.obj = eCONST THEN
- Float(parser, e);
- IL.AddCmd0(IL.opADDF - ORD(minus))
- ELSIF e1.obj = eCONST THEN
- Float(parser, e1);
- IL.AddCmd0(IL.opADDF + ORD(minus))
- ELSE
- IL.AddCmd0(IL.opADDF + ORD(minus))
- END
- ELSIF isSet(e) THEN
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opADDS + ORD(minus))
- END
- END;
- e.obj := eEXPR
- END
- |SCAN.lxOR:
- PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
- IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
- ARITH.opBoolean(e.value, e1.value, "|")
- ELSE
- e.obj := eEXPR;
- IF e1.obj = eCONST THEN
- IL.Const(ORD(ARITH.getBool(e1.value)))
- END
- END
- END
- END;
- IF label # -1 THEN
- label1 := IL.NewLabel();
- IL.Jmp(IL.opJZ, label1);
- IL.SetLabel(label);
- IL.Const(1);
- IL.drop;
- label := IL.NewLabel();
- IL.Jmp(IL.opJMP, label);
- IL.SetLabel(label1);
- IL.Const(0);
- IL.SetLabel(label);
- IL.AddCmd0(IL.opOR)
- END
- END SimpleExpression;
- PROCEDURE cmpcode (op: INTEGER): INTEGER;
- VAR
- res: INTEGER;
- BEGIN
- CASE op OF
- |SCAN.lxEQ: res := ARITH.opEQ
- |SCAN.lxNE: res := ARITH.opNE
- |SCAN.lxLT: res := ARITH.opLT
- |SCAN.lxLE: res := ARITH.opLE
- |SCAN.lxGT: res := ARITH.opGT
- |SCAN.lxGE: res := ARITH.opGE
- |SCAN.lxIN: res := ARITH.opIN
- |SCAN.lxIS: res := ARITH.opIS
- END
- RETURN res
- END cmpcode;
- PROCEDURE invcmpcode (op: INTEGER): INTEGER;
- VAR
- res: INTEGER;
- BEGIN
- CASE op OF
- |SCAN.lxEQ: res := ARITH.opEQ
- |SCAN.lxNE: res := ARITH.opNE
- |SCAN.lxLT: res := ARITH.opGT
- |SCAN.lxLE: res := ARITH.opGE
- |SCAN.lxGT: res := ARITH.opLT
- |SCAN.lxGE: res := ARITH.opLE
- |SCAN.lxIN: res := ARITH.opIN
- |SCAN.lxIS: res := ARITH.opIS
- END
- RETURN res
- END invcmpcode;
- PROCEDURE BoolCmp (eq, val: BOOLEAN);
- BEGIN
- IF eq = val THEN
- IL.AddCmd0(IL.opNEC)
- ELSE
- IL.AddCmd0(IL.opEQC)
- END
- END BoolCmp;
- PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
- VAR
- res: BOOLEAN;
- cmp: INTEGER;
- BEGIN
- res := TRUE;
- cmp := cmpcode(op);
- IF isString(e) & isCharArray(e1) THEN
- IL.StrAdr(String(e));
- IL.Const(strlen(e) + 1);
- IL.AddCmd0(IL.opEQS + invcmpcode(op))
- ELSIF (isString(e) OR isStringW(e)) & isCharArrayW(e1) THEN
- IL.StrAdr(StringW(e));
- IL.Const(utf8strlen(e) + 1);
- IL.AddCmd0(IL.opEQSW + invcmpcode(op))
- ELSIF isCharArray(e) & isString(e1) THEN
- IL.StrAdr(String(e1));
- IL.Const(strlen(e1) + 1);
- IL.AddCmd0(IL.opEQS + cmp)
- ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN
- IL.StrAdr(StringW(e1));
- IL.Const(utf8strlen(e1) + 1);
- IL.AddCmd0(IL.opEQSW + cmp)
- ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
- IL.AddCmd0(IL.opEQSW + cmp)
- ELSIF isCharArray(e) & isCharArray(e1) THEN
- IL.AddCmd0(IL.opEQS + cmp)
- ELSIF isString(e) & isString(e1) THEN
- PARS.strcmp(e.value, e1.value, op)
- ELSE
- res := FALSE
- END
- RETURN res
- END strcmp;
- BEGIN
- getpos(parser, pos0);
- SimpleExpression(parser, e);
- IF relation(parser.sym) THEN
- IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN
- IL.Const(e._type.length)
- END;
- op := parser.sym;
- getpos(parser, pos);
- PARS.Next(parser);
- getpos(parser, pos1);
- SimpleExpression(parser, e1);
- IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN
- IL.Const(e1._type.length)
- END;
- constant := (e.obj = eCONST) & (e1.obj = eCONST);
- error := 0;
- cmp := cmpcode(op);
- CASE op OF
- |SCAN.lxEQ, SCAN.lxNE:
- eq := op = SCAN.lxEQ;
- IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
- isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
- isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
- isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
- isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN
- IF constant THEN
- ARITH.relation(e.value, e1.value, cmp, error)
- ELSE
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opEQ + cmp)
- END
- END
- ELSIF isStringW1(e) & isCharW(e1) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))
- ELSIF isStringW1(e1) & isCharW(e) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
- ELSIF isBoolean(e) & isBoolean(e1) THEN
- IF constant THEN
- ARITH.relation(e.value, e1.value, cmp, error)
- ELSE
- IF e.obj = eCONST THEN
- BoolCmp(eq, ARITH.Int(e.value) # 0)
- ELSIF e1.obj = eCONST THEN
- BoolCmp(eq, ARITH.Int(e1.value) # 0)
- ELSE
- IF eq THEN
- IL.AddCmd0(IL.opEQB)
- ELSE
- IL.AddCmd0(IL.opNEB)
- END
- END
- END
- ELSIF isReal(e) & isReal(e1) THEN
- IF constant THEN
- ARITH.relation(e.value, e1.value, cmp, error)
- ELSE
- IF e.obj = eCONST THEN
- Float(parser, e)
- ELSIF e1.obj = eCONST THEN
- Float(parser, e1)
- END;
- IL.AddCmd0(IL.opEQF + cmp)
- END
- ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
- IF ~strcmp(e, e1, op) THEN
- PARS.error(pos, 37)
- END
- ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
- IL.AddCmd0(IL.opEQC + cmp)
- ELSIF isProc(e) & isNil(e1) THEN
- IF e.obj IN {ePROC, eIMP} THEN
- PARS.check(e.ident.global, pos0, 85);
- constant := TRUE;
- e.obj := eCONST;
- ARITH.setbool(e.value, ~eq)
- ELSE
- IL.AddCmd0(IL.opEQC + cmp)
- END
- ELSIF isNil(e) & isProc(e1) THEN
- IF e1.obj IN {ePROC, eIMP} THEN
- PARS.check(e1.ident.global, pos1, 85);
- constant := TRUE;
- e.obj := eCONST;
- ARITH.setbool(e.value, ~eq)
- ELSE
- IL.AddCmd0(IL.opEQC + cmp)
- END
- ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN
- IF e.obj = ePROC THEN
- PARS.check(e.ident.global, pos0, 85)
- END;
- IF e1.obj = ePROC THEN
- PARS.check(e1.ident.global, pos1, 85)
- END;
- IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
- constant := TRUE;
- e.obj := eCONST;
- IF eq THEN
- ARITH.setbool(e.value, e.ident = e1.ident)
- ELSE
- ARITH.setbool(e.value, e.ident # e1.ident)
- END
- ELSIF e.obj = ePROC THEN
- IL.ProcCmp(e.ident.proc.label, eq)
- ELSIF e1.obj = ePROC THEN
- IL.ProcCmp(e1.ident.proc.label, eq)
- ELSIF e.obj = eIMP THEN
- IL.ProcImpCmp(e.ident._import, eq)
- ELSIF e1.obj = eIMP THEN
- IL.ProcImpCmp(e1.ident._import, eq)
- ELSE
- IL.AddCmd0(IL.opEQ + cmp)
- END
- ELSIF isNil(e) & isNil(e1) THEN
- constant := TRUE;
- e.obj := eCONST;
- ARITH.setbool(e.value, eq)
- ELSE
- PARS.error(pos, 37)
- END
- |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
- IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
- isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
- isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
- isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
- IF constant THEN
- ARITH.relation(e.value, e1.value, cmp, error)
- ELSE
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opEQ + cmp)
- END
- END
- ELSIF isStringW1(e) & isCharW(e1) THEN
- IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))
- ELSIF isStringW1(e1) & isCharW(e) THEN
- IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
- ELSIF isReal(e) & isReal(e1) THEN
- IF constant THEN
- ARITH.relation(e.value, e1.value, cmp, error)
- ELSE
- IF e.obj = eCONST THEN
- Float(parser, e);
- IL.AddCmd0(IL.opEQF + invcmpcode(op))
- ELSIF e1.obj = eCONST THEN
- Float(parser, e1);
- IL.AddCmd0(IL.opEQF + cmp)
- ELSE
- IL.AddCmd0(IL.opEQF + cmp)
- END
- END
- ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
- IF ~strcmp(e, e1, op) THEN
- PARS.error(pos, 37)
- END
- ELSE
- PARS.error(pos, 37)
- END
- |SCAN.lxIN:
- PARS.check(isInt(e) & isSet(e1), pos, 37);
- IF e.obj = eCONST THEN
- PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
- END;
- IF constant THEN
- ARITH.relation(e.value, e1.value, ARITH.opIN, error)
- ELSE
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opINL, ARITH.Int(e.value))
- ELSIF e1.obj = eCONST THEN
- IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
- ELSE
- IL.AddCmd0(IL.opIN)
- END
- END
- |SCAN.lxIS:
- PARS.check(isRecPtr(e), pos, 73);
- PARS.check(e1.obj = eTYPE, pos1, 79);
- IF isRec(e) THEN
- PARS.check(e.obj = eVREC, pos0, 78);
- PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80);
- IF e.ident = NIL THEN
- IL.TypeCheck(e1._type.num)
- ELSE
- IL.AddCmd(IL.opVADR, e.ident.offset - 1);
- IL.TypeCheckRec(e1._type.num)
- END
- ELSE
- PARS.check(e1._type.typ = PROG.tPOINTER, pos1, 81);
- IL.TypeCheck(e1._type.base.num)
- END;
- PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82)
- END;
- ASSERT(error = 0);
- e._type := tBOOLEAN;
- IF ~constant THEN
- e.obj := eEXPR
- END
- END
- END expression;
- PROCEDURE ElementaryStatement (parser: PARS.PARSER);
- VAR
- e, e1: PARS.EXPR;
- pos: PARS.POSITION;
- line: INTEGER;
- call: BOOLEAN;
- BEGIN
- getpos(parser, pos);
- IL.pushBegEnd(begcall, endcall);
- designator(parser, e);
- IF parser.sym = SCAN.lxASSIGN THEN
- line := parser.lex.pos.line;
- PARS.check(isVar(e), pos, 93);
- PARS.check(~e.readOnly, pos, 94);
- IL.setlast(begcall);
- NextPos(parser, pos);
- expression(parser, e1);
- IF (e._type.typ = PROG.tBYTE) & (e1.obj # eCONST) & (e1._type.typ = PROG.tINTEGER) & (chkBYTE IN Options.checking) THEN
- CheckRange(256, pos.line, errBYTE)
- END;
- IL.setlast(endcall.prev(IL.COMMAND));
- PARS.check(assign(parser, e1, e._type, line), pos, 91);
- IF e1.obj = ePROC THEN
- PARS.check(e1.ident.global, pos, 85)
- END;
- call := FALSE
- ELSIF parser.sym = SCAN.lxEQ THEN
- PARS.check1(FALSE, parser, 96)
- ELSIF parser.sym = SCAN.lxLROUND THEN
- e1 := e;
- ActualParameters(parser, e1);
- PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92);
- call := TRUE
- ELSE
- IF e.obj IN {eSYSPROC, eSTPROC} THEN
- stProc(parser, e);
- call := FALSE
- ELSE
- PARS.check(isProc(e), pos, 86);
- PARS.check((e._type.base = NIL) OR ODD(e._type.call), pos, 92);
- PARS.check1(e._type.params.first = NIL, parser, 64);
- call := TRUE
- END
- END;
- IF call THEN
- IF e.obj IN {ePROC, eIMP} THEN
- ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE)
- ELSIF isExpr(e) THEN
- ProcCall(e, e._type, FALSE, parser, pos, TRUE)
- END
- END;
- IL.popBegEnd(begcall, endcall)
- END ElementaryStatement;
- PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN);
- VAR
- e: PARS.EXPR;
- pos: PARS.POSITION;
- label, L: INTEGER;
- BEGIN
- L := IL.NewLabel();
- IF ~_if THEN
- IL.AddCmd(IL.opNOP, IL.begin_loop);
- IL.SetLabel(L)
- END;
- REPEAT
- NextPos(parser, pos);
- label := IL.NewLabel();
- expression(parser, e);
- PARS.check(isBoolean(e), pos, 72);
- IF e.obj = eCONST THEN
- IF ~ARITH.getBool(e.value) THEN
- IL.Jmp(IL.opJMP, label)
- END
- ELSE
- IL.AndOrOpt(label)
- END;
- IF _if THEN
- PARS.checklex(parser, SCAN.lxTHEN)
- ELSE
- PARS.checklex(parser, SCAN.lxDO)
- END;
- PARS.Next(parser);
- parser.StatSeq(parser);
- IF ~_if OR (parser.sym # SCAN.lxEND) THEN
- IL.Jmp(IL.opJMP, L)
- END;
- IL.SetLabel(label)
- UNTIL parser.sym # SCAN.lxELSIF;
- IF _if THEN
- IF parser.sym = SCAN.lxELSE THEN
- PARS.Next(parser);
- parser.StatSeq(parser)
- END;
- IL.SetLabel(L)
- ELSE
- IL.AddCmd(IL.opNOP, IL.end_loop)
- END;
- PARS.checklex(parser, SCAN.lxEND);
- PARS.Next(parser)
- END IfStatement;
- PROCEDURE RepeatStatement (parser: PARS.PARSER);
- VAR
- e: PARS.EXPR;
- pos: PARS.POSITION;
- label: INTEGER;
- L: IL.COMMAND;
- BEGIN
- IL.AddCmd(IL.opNOP, IL.begin_loop);
- label := IL.NewLabel();
- IL.SetLabel(label);
- L := IL.getlast();
- PARS.Next(parser);
- parser.StatSeq(parser);
- PARS.checklex(parser, SCAN.lxUNTIL);
- NextPos(parser, pos);
- expression(parser, e);
- PARS.check(isBoolean(e), pos, 72);
- IF e.obj = eCONST THEN
- IF ~ARITH.getBool(e.value) THEN
- IL.Jmp(IL.opJMP, label)
- END
- ELSE
- IL.AndOrOpt(label);
- L.param1 := label
- END;
- IL.AddCmd(IL.opNOP, IL.end_loop)
- END RepeatStatement;
- PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
- VAR
- La, Ra, Lb, Rb, res: INTEGER;
- BEGIN
- La := a(CASE_LABEL).range.a;
- Ra := a(CASE_LABEL).range.b;
- Lb := b(CASE_LABEL).range.a;
- Rb := b(CASE_LABEL).range.b;
- IF (Ra < Lb) OR (La > Rb) THEN
- res := ORD(La > Lb) - ORD(La < Lb)
- ELSE
- res := 0
- END
- RETURN res
- END LabelCmp;
- PROCEDURE DestroyLabel (VAR label: AVL.DATA);
- BEGIN
- C.push(CaseLabels, label);
- label := NIL
- END DestroyLabel;
- PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
- VAR
- res: CASE_VARIANT;
- citem: C.ITEM;
- BEGIN
- citem := C.pop(CaseVar);
- IF citem = NIL THEN
- NEW(res)
- ELSE
- res := citem(CASE_VARIANT)
- END;
- res.label := label;
- res.cmd := cmd;
- res.processed := FALSE
- RETURN res
- END NewVariant;
- PROCEDURE CaseStatement (parser: PARS.PARSER);
- VAR
- e: PARS.EXPR;
- pos: PARS.POSITION;
- PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER;
- VAR
- a: INTEGER;
- label: PARS.EXPR;
- pos: PARS.POSITION;
- value: ARITH.VALUE;
- BEGIN
- getpos(parser, pos);
- _type := NIL;
- IF isChar(caseExpr) THEN
- PARS.ConstExpression(parser, value);
- PARS.check(value.typ = ARITH.tCHAR, pos, 99);
- a := ARITH.getInt(value)
- ELSIF isCharW(caseExpr) THEN
- PARS.ConstExpression(parser, value);
- IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
- ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
- ELSE
- PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
- END;
- a := ARITH.getInt(value)
- ELSIF isInt(caseExpr) THEN
- PARS.ConstExpression(parser, value);
- PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
- a := ARITH.getInt(value)
- ELSIF isRecPtr(caseExpr) THEN
- qualident(parser, label);
- PARS.check(label.obj = eTYPE, pos, 79);
- PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99);
- IF isRec(caseExpr) THEN
- a := label._type.num
- ELSE
- a := label._type.base.num
- END;
- _type := label._type
- END
- RETURN a
- END Label;
- PROCEDURE CheckType (node: AVL.NODE; _type: PROG._TYPE; parser: PARS.PARSER; pos: PARS.POSITION);
- BEGIN
- IF node # NIL THEN
- PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL)._type, _type) OR PROG.isBaseOf(_type, node.data(CASE_LABEL)._type)), pos, 100);
- CheckType(node.left, _type, parser, pos);
- CheckType(node.right, _type, parser, pos)
- END
- END CheckType;
- PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
- VAR
- label: CASE_LABEL;
- citem: C.ITEM;
- pos, pos1: PARS.POSITION;
- node: AVL.NODE;
- newnode: BOOLEAN;
- range: RANGE;
- BEGIN
- citem := C.pop(CaseLabels);
- IF citem = NIL THEN
- NEW(label)
- ELSE
- label := citem(CASE_LABEL)
- END;
- label.variant := variant;
- label.self := IL.NewLabel();
- getpos(parser, pos1);
- range.a := Label(parser, caseExpr, label._type);
- IF parser.sym = SCAN.lxRANGE THEN
- PARS.check1(~isRecPtr(caseExpr), parser, 53);
- NextPos(parser, pos);
- range.b := Label(parser, caseExpr, label._type);
- PARS.check(range.a <= range.b, pos, 103)
- ELSE
- range.b := range.a
- END;
- label.range := range;
- IF isRecPtr(caseExpr) THEN
- CheckType(tree, label._type, parser, pos1)
- END;
- tree := AVL.insert(tree, label, LabelCmp, newnode, node);
- PARS.check(newnode, pos1, 100)
- RETURN node
- END LabelRange;
- PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
- VAR
- exit: BOOLEAN;
- res: AVL.NODE;
- BEGIN
- exit := FALSE;
- REPEAT
- res := LabelRange(parser, caseExpr, tree, variant);
- IF parser.sym = SCAN.lxCOMMA THEN
- PARS.check1(~isRecPtr(caseExpr), parser, 53);
- PARS.Next(parser)
- ELSE
- exit := TRUE
- END
- UNTIL exit
- RETURN res
- END CaseLabelList;
- PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER);
- VAR
- sym: INTEGER;
- t: PROG._TYPE;
- variant: INTEGER;
- node: AVL.NODE;
- last: IL.COMMAND;
- BEGIN
- sym := parser.sym;
- IF sym # SCAN.lxBAR THEN
- variant := IL.NewLabel();
- node := CaseLabelList(parser, caseExpr, tree, variant);
- PARS.checklex(parser, SCAN.lxCOLON);
- PARS.Next(parser);
- IF isRecPtr(caseExpr) THEN
- t := caseExpr._type;
- caseExpr.ident._type := node.data(CASE_LABEL)._type
- END;
- last := IL.getlast();
- IL.SetLabel(variant);
- IF ~isRecPtr(caseExpr) THEN
- LISTS.push(CaseVariants, NewVariant(variant, last))
- END;
- parser.StatSeq(parser);
- IL.Jmp(IL.opJMP, _end);
- IF isRecPtr(caseExpr) THEN
- caseExpr.ident._type := t
- END
- END
- END _case;
- PROCEDURE Table (node: AVL.NODE; _else: INTEGER);
- VAR
- L, R: INTEGER;
- range: RANGE;
- left, right: AVL.NODE;
- last: IL.COMMAND;
- v: CASE_VARIANT;
- BEGIN
- IF node # NIL THEN
- range := node.data(CASE_LABEL).range;
- left := node.left;
- IF left # NIL THEN
- L := left.data(CASE_LABEL).self
- ELSE
- L := _else
- END;
- right := node.right;
- IF right # NIL THEN
- R := right.data(CASE_LABEL).self
- ELSE
- R := _else
- END;
- last := IL.getlast();
- v := CaseVariants.last(CASE_VARIANT);
- WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
- v := v.prev(CASE_VARIANT)
- END;
- ASSERT((v # NIL) & (v.label # 0));
- IL.setlast(v.cmd);
- IL.SetLabel(node.data(CASE_LABEL).self);
- IL._case(range.a, range.b, L, R);
- IF v.processed THEN
- IL.Jmp(IL.opJMP, node.data(CASE_LABEL).variant)
- END;
- v.processed := TRUE;
- IL.setlast(last);
- Table(left, _else);
- Table(right, _else)
- END
- END Table;
- PROCEDURE TableT (node: AVL.NODE);
- BEGIN
- IF node # NIL THEN
- IL.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a);
- TableT(node.left);
- TableT(node.right)
- END
- END TableT;
- PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
- VAR
- table, _end, _else: INTEGER;
- tree: AVL.NODE;
- item: LISTS.ITEM;
- BEGIN
- LISTS.push(CaseVariants, NewVariant(0, NIL));
- _end := IL.NewLabel();
- _else := IL.NewLabel();
- table := IL.NewLabel();
- IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
- IL.Jmp(IL.opJMP, table);
- tree := NIL;
- _case(parser, e, tree, _end);
- WHILE parser.sym = SCAN.lxBAR DO
- PARS.Next(parser);
- _case(parser, e, tree, _end)
- END;
- IL.SetLabel(_else);
- IF parser.sym = SCAN.lxELSE THEN
- PARS.Next(parser);
- parser.StatSeq(parser);
- IL.Jmp(IL.opJMP, _end)
- ELSE
- IL.OnError(pos.line, errCASE)
- END;
- PARS.checklex(parser, SCAN.lxEND);
- PARS.Next(parser);
- IF isRecPtr(e) THEN
- IL.SetLabel(table);
- TableT(tree);
- IL.Jmp(IL.opJMP, _else)
- ELSE
- tree.data(CASE_LABEL).self := table;
- Table(tree, _else)
- END;
- AVL.destroy(tree, DestroyLabel);
- IL.SetLabel(_end);
- IL.AddCmd0(IL.opENDSW);
- REPEAT
- item := LISTS.pop(CaseVariants);
- C.push(CaseVar, item)
- UNTIL item(CASE_VARIANT).cmd = NIL
- END ParseCase;
- BEGIN
- NextPos(parser, pos);
- expression(parser, e);
- PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
- IF isRecPtr(e) THEN
- PARS.check(isVar(e), pos, 93);
- PARS.check(e.ident # NIL, pos, 106)
- END;
- IF isRec(e) THEN
- PARS.check(e.obj = eVREC, pos, 78)
- END;
- IF e.obj = eCONST THEN
- LoadConst(e)
- ELSIF isRec(e) THEN
- IL.drop;
- IL.AddCmd(IL.opLADR, e.ident.offset - 1);
- IL.load(TARGETS.WordSize)
- ELSIF isPtr(e) THEN
- deref(pos, e, FALSE, errPTR);
- IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
- IL.load(TARGETS.WordSize)
- END;
- PARS.checklex(parser, SCAN.lxOF);
- PARS.Next(parser);
- ParseCase(parser, e, pos)
- END CaseStatement;
- PROCEDURE ForStatement (parser: PARS.PARSER);
- VAR
- e: PARS.EXPR;
- pos, pos2: PARS.POSITION;
- step: ARITH.VALUE;
- st: INTEGER;
- ident: PROG.IDENT;
- offset: INTEGER;
- L1, L2: INTEGER;
- BEGIN
- IL.AddCmd(IL.opNOP, IL.begin_loop);
- L1 := IL.NewLabel();
- L2 := IL.NewLabel();
- PARS.ExpectSym(parser, SCAN.lxIDENT);
- ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
- PARS.check1(ident # NIL, parser, 48);
- PARS.check1(ident.typ = PROG.idVAR, parser, 93);
- PARS.check1(ident._type = tINTEGER, parser, 97);
- PARS.ExpectSym(parser, SCAN.lxASSIGN);
- NextPos(parser, pos);
- expression(parser, e);
- PARS.check(isInt(e), pos, 76);
- offset := PROG.getOffset(ident);
- IF ident.global THEN
- IL.AddCmd(IL.opGADR, offset)
- ELSE
- IL.AddCmd(IL.opLADR, -offset)
- END;
- IF e.obj = eCONST THEN
- IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
- ELSE
- IL.AddCmd0(IL.opSAVE)
- END;
- IL.SetLabel(L1);
- IF ident.global THEN
- IL.AddCmd(IL.opGADR, offset)
- ELSE
- IL.AddCmd(IL.opLADR, -offset)
- END;
- IL.load(ident._type.size);
- PARS.checklex(parser, SCAN.lxTO);
- NextPos(parser, pos2);
- expression(parser, e);
- PARS.check(isInt(e), pos2, 76);
- IF parser.sym = SCAN.lxBY THEN
- NextPos(parser, pos);
- PARS.ConstExpression(parser, step);
- PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
- st := ARITH.getInt(step);
- PARS.check(st # 0, pos, 98)
- ELSE
- st := 1
- END;
- IF e.obj = eCONST THEN
- IF st > 0 THEN
- IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
- IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
- ERRORS.WarningMsg(pos2.line, pos2.col, 1)
- END
- ELSE
- IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
- IF ARITH.Int(e.value) = UTILS.target.minInt THEN
- ERRORS.WarningMsg(pos2.line, pos2.col, 1)
- END
- END
- ELSE
- IF st > 0 THEN
- IL.AddCmd0(IL.opLE)
- ELSE
- IL.AddCmd0(IL.opGE)
- END
- END;
- IL.Jmp(IL.opJZ, L2);
- PARS.checklex(parser, SCAN.lxDO);
- PARS.Next(parser);
- parser.StatSeq(parser);
- IF ident.global THEN
- IL.AddCmd(IL.opGADR, offset)
- ELSE
- IL.AddCmd(IL.opLADR, -offset)
- END;
- IL.AddCmd(IL.opINCC, st);
- IL.Jmp(IL.opJMP, L1);
- PARS.checklex(parser, SCAN.lxEND);
- PARS.Next(parser);
- IL.SetLabel(L2);
- IL.AddCmd(IL.opNOP, IL.end_loop)
- END ForStatement;
- PROCEDURE statement (parser: PARS.PARSER);
- VAR
- sym: INTEGER;
- BEGIN
- sym := parser.sym;
- IF sym = SCAN.lxIDENT THEN
- ElementaryStatement(parser)
- ELSIF sym = SCAN.lxIF THEN
- IfStatement(parser, TRUE)
- ELSIF sym = SCAN.lxWHILE THEN
- IfStatement(parser, FALSE)
- ELSIF sym = SCAN.lxREPEAT THEN
- RepeatStatement(parser)
- ELSIF sym = SCAN.lxCASE THEN
- CaseStatement(parser)
- ELSIF sym = SCAN.lxFOR THEN
- ForStatement(parser)
- END
- END statement;
- PROCEDURE StatSeq (parser: PARS.PARSER);
- BEGIN
- statement(parser);
- WHILE parser.sym = SCAN.lxSEMI DO
- PARS.Next(parser);
- statement(parser)
- END
- END StatSeq;
- PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN;
- VAR
- res: BOOLEAN;
- BEGIN
- res := assigncomp(e, t);
- IF res THEN
- IF e.obj = eCONST THEN
- IF e._type = tREAL THEN
- Float(parser, e)
- ELSIF e._type.typ = PROG.tNIL THEN
- IL.Const(0)
- ELSE
- LoadConst(e)
- END
- ELSIF (e._type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
- CheckRange(256, pos.line, errBYTE)
- ELSIF e.obj = ePROC THEN
- PARS.check(e.ident.global, pos, 85);
- IL.PushProc(e.ident.proc.label)
- ELSIF e.obj = eIMP THEN
- IL.PushImpProc(e.ident._import)
- END
- END
- RETURN res
- END chkreturn;
- PROCEDURE setrtl;
- VAR
- rtl: PROG.UNIT;
- PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.IDSTR; idx: INTEGER);
- VAR
- id: PROG.IDENT;
- ident: SCAN.IDENT;
- BEGIN
- SCAN.setIdent(ident, name);
- id := PROG.getIdent(rtl, ident, FALSE);
- IF (id # NIL) & (id._import # NIL) THEN
- IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
- id.proc.used := TRUE
- ELSIF (id # NIL) & (id.proc # NIL) THEN
- IL.set_rtl(idx, id.proc.label);
- id.proc.used := TRUE
- ELSE
- ERRORS.WrongRTL(name)
- END
- END getproc;
- BEGIN
- rtl := PROG.program.rtl;
- ASSERT(rtl # NIL);
- getproc(rtl, "_strcmp", IL._strcmp);
- getproc(rtl, "_length", IL._length);
- getproc(rtl, "_arrcpy", IL._arrcpy);
- getproc(rtl, "_is", IL._is);
- getproc(rtl, "_guard", IL._guard);
- getproc(rtl, "_guardrec", IL._guardrec);
- getproc(rtl, "_new", IL._new);
- getproc(rtl, "_rot", IL._rot);
- getproc(rtl, "_strcpy", IL._strcpy);
- getproc(rtl, "_move", IL._move);
- getproc(rtl, "_set", IL._set);
- getproc(rtl, "_set1", IL._set1);
- getproc(rtl, "_lengthw", IL._lengthw);
- getproc(rtl, "_strcmpw", IL._strcmpw);
- getproc(rtl, "_init", IL._init);
- IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
- getproc(rtl, "_error", IL._error);
- getproc(rtl, "_divmod", IL._divmod);
- getproc(rtl, "_exit", IL._exit);
- getproc(rtl, "_dispose", IL._dispose);
- getproc(rtl, "_isrec", IL._isrec);
- getproc(rtl, "_dllentry", IL._dllentry);
- getproc(rtl, "_sofinit", IL._sofinit)
- ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
- getproc(rtl, "_fmul", IL._fmul);
- getproc(rtl, "_fdiv", IL._fdiv);
- getproc(rtl, "_fdivi", IL._fdivi);
- getproc(rtl, "_fadd", IL._fadd);
- getproc(rtl, "_fsub", IL._fsub);
- getproc(rtl, "_fsubi", IL._fsubi);
- getproc(rtl, "_fcmp", IL._fcmp);
- getproc(rtl, "_floor", IL._floor);
- getproc(rtl, "_flt", IL._flt);
- getproc(rtl, "_pack", IL._pack);
- getproc(rtl, "_unpk", IL._unpk);
- IF CPU IN {TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
- getproc(rtl, "_error", IL._error)
- END
- END
- END setrtl;
- PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
- VAR
- parser: PARS.PARSER;
- ext: PARS.PATH;
- BEGIN
- tINTEGER := PROG.program.stTypes.tINTEGER;
- tBYTE := PROG.program.stTypes.tBYTE;
- tCHAR := PROG.program.stTypes.tCHAR;
- tSET := PROG.program.stTypes.tSET;
- tBOOLEAN := PROG.program.stTypes.tBOOLEAN;
- tWCHAR := PROG.program.stTypes.tWCHAR;
- tREAL := PROG.program.stTypes.tREAL;
- Options := options;
- CPU := TARGETS.CPU;
- ext := UTILS.FILE_EXT;
- CaseLabels := C.create();
- CaseVar := C.create();
- CaseVariants := LISTS.create(NIL);
- LISTS.push(CaseVariants, NewVariant(0, NIL));
- IL.init(CPU);
- IF TARGETS.RTL THEN
- parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
- IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
- parser.parse(parser);
- PARS.destroy(parser)
- ELSE
- PARS.destroy(parser);
- parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
- IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
- parser.parse(parser);
- PARS.destroy(parser)
- ELSE
- ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
- END
- END
- END;
- parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
- parser.main := TRUE;
- IF parser.open(parser, modname, UTILS.FILE_EXT) THEN
- parser.parse(parser)
- ELSE
- ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
- END;
- PARS.destroy(parser);
- IF PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
- ERRORS.Error(204)
- END;
- IF TARGETS.RTL THEN
- setrtl
- END;
- PROG.DelUnused(IL.DelImport);
- IL.set_bss(PROG.program.bss);
- CASE CPU OF
- |TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
- |TARGETS.cpuX86: X86.CodeGen(outname, target, options)
- |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
- |TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
- |TARGETS.cpuRVM32I,
- TARGETS.cpuRVM64I: RVMxI.CodeGen(outname, target, options)
- END
- END compile;
- END STATEMENTS.
|