STATEMENTS.ob07 103 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444
  1. (*
  2. BSD 2-Clause License
  3. Copyright (c) 2018-2023, Anton Krotov
  4. All rights reserved.
  5. *)
  6. MODULE STATEMENTS;
  7. IMPORT
  8. PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430, THUMB, RVMxI,
  9. ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, TARGETS;
  10. CONST
  11. eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR;
  12. eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC;
  13. eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC;
  14. eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC;
  15. eIMP = PARS.eIMP;
  16. errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4;
  17. errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8;
  18. errCHR = 9; errWCHR = 10; errBYTE = 11;
  19. chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;
  20. chkSTK* = MSP430.chkSTK; (* 6 *)
  21. chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE, chkSTK};
  22. TYPE
  23. isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;
  24. RANGE = RECORD
  25. a, b: INTEGER
  26. END;
  27. CASE_LABEL = POINTER TO rCASE_LABEL;
  28. rCASE_LABEL = RECORD (AVL.DATA)
  29. range: RANGE;
  30. variant, self: INTEGER;
  31. _type: PROG._TYPE;
  32. prev: CASE_LABEL
  33. END;
  34. CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)
  35. label: INTEGER;
  36. cmd: IL.COMMAND;
  37. processed: BOOLEAN
  38. END;
  39. VAR
  40. Options: PROG.OPTIONS;
  41. begcall, endcall: IL.COMMAND;
  42. CaseLabels, CaseVar: C.COLLECTION;
  43. CaseVariants: LISTS.LIST;
  44. CPU: INTEGER;
  45. tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG._TYPE;
  46. PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;
  47. RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}
  48. END isExpr;
  49. PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;
  50. RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}
  51. END isVar;
  52. PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;
  53. RETURN isExpr(e) & (e._type = tBOOLEAN)
  54. END isBoolean;
  55. PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;
  56. RETURN isExpr(e) & (e._type = tINTEGER)
  57. END isInteger;
  58. PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;
  59. RETURN isExpr(e) & (e._type = tBYTE)
  60. END isByte;
  61. PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;
  62. RETURN isByte(e) OR isInteger(e)
  63. END isInt;
  64. PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;
  65. RETURN isExpr(e) & (e._type = tREAL)
  66. END isReal;
  67. PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;
  68. RETURN isExpr(e) & (e._type = tSET)
  69. END isSet;
  70. PROCEDURE isString (e: PARS.EXPR): BOOLEAN;
  71. RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR})
  72. END isString;
  73. PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;
  74. RETURN (e.obj = eCONST) & (e._type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})
  75. END isStringW;
  76. PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;
  77. RETURN isExpr(e) & (e._type = tCHAR)
  78. END isChar;
  79. PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;
  80. RETURN isExpr(e) & (e._type = tWCHAR)
  81. END isCharW;
  82. PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;
  83. RETURN isExpr(e) & (e._type.typ = PROG.tPOINTER)
  84. END isPtr;
  85. PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;
  86. RETURN isExpr(e) & (e._type.typ = PROG.tRECORD)
  87. END isRec;
  88. PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;
  89. RETURN isRec(e) OR isPtr(e)
  90. END isRecPtr;
  91. PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;
  92. RETURN isExpr(e) & (e._type.typ = PROG.tARRAY)
  93. END isArr;
  94. PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;
  95. RETURN isExpr(e) & (e._type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})
  96. END isProc;
  97. PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;
  98. RETURN e._type.typ = PROG.tNIL
  99. END isNil;
  100. PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;
  101. RETURN isArr(e) & (e._type.base = tCHAR)
  102. END isCharArray;
  103. PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;
  104. RETURN isArr(e) & (e._type.base = tWCHAR)
  105. END isCharArrayW;
  106. PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;
  107. RETURN isCharArray(e) OR isCharArrayW(e)
  108. END isCharArrayX;
  109. PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
  110. BEGIN
  111. pos.line := parser.lex.pos.line;
  112. pos.col := parser.lex.pos.col;
  113. pos.parser := parser
  114. END getpos;
  115. PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);
  116. BEGIN
  117. PARS.Next(parser);
  118. getpos(parser, pos)
  119. END NextPos;
  120. PROCEDURE strlen (e: PARS.EXPR): INTEGER;
  121. VAR
  122. res: INTEGER;
  123. BEGIN
  124. ASSERT(isString(e));
  125. IF e._type = tCHAR THEN
  126. res := 1
  127. ELSE
  128. res := LENGTH(e.value.string(SCAN.STRING).s)
  129. END
  130. RETURN res
  131. END strlen;
  132. PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;
  133. VAR
  134. i, res: INTEGER;
  135. BEGIN
  136. i := 0;
  137. res := 0;
  138. WHILE (i < LEN(s)) & (s[i] # 0X) DO
  139. IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN
  140. INC(res)
  141. END;
  142. INC(i)
  143. END
  144. RETURN res
  145. END _length;
  146. PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER;
  147. VAR
  148. res: INTEGER;
  149. BEGIN
  150. ASSERT(isStringW(e));
  151. IF e._type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN
  152. res := 1
  153. ELSE
  154. res := _length(e.value.string(SCAN.STRING).s)
  155. END
  156. RETURN res
  157. END utf8strlen;
  158. PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER;
  159. VAR
  160. res: ARRAY 2 OF WCHAR;
  161. BEGIN
  162. ASSERT(STRINGS.Utf8To16(s, res) = 1)
  163. RETURN ORD(res[0])
  164. END StrToWChar;
  165. PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN;
  166. RETURN isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1)
  167. END isStringW1;
  168. PROCEDURE assigncomp (e: PARS.EXPR; t: PROG._TYPE): BOOLEAN;
  169. VAR
  170. res: BOOLEAN;
  171. BEGIN
  172. IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
  173. IF t = e._type THEN
  174. res := TRUE
  175. ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
  176. IF (e.obj = eCONST) & (t = tBYTE) THEN
  177. res := ARITH.range(e.value, 0, 255)
  178. ELSE
  179. res := TRUE
  180. END
  181. ELSIF
  182. (e.obj = eCONST) & isChar(e) & (t = tWCHAR)
  183. OR isStringW1(e) & (t = tWCHAR)
  184. OR PROG.isBaseOf(t, e._type)
  185. OR ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(t, e._type)
  186. OR isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE})
  187. OR PROG.arrcomp(e._type, t)
  188. OR isString(e) & (t.typ = PROG.tARRAY) & (t.base = tCHAR) & (t.length > strlen(e))
  189. OR isStringW(e) & (t.typ = PROG.tARRAY) & (t.base = tWCHAR) & (t.length > utf8strlen(e))
  190. THEN
  191. res := TRUE
  192. ELSE
  193. res := FALSE
  194. END
  195. ELSE
  196. res := FALSE
  197. END
  198. RETURN res
  199. END assigncomp;
  200. PROCEDURE String (e: PARS.EXPR): INTEGER;
  201. VAR
  202. offset: INTEGER;
  203. string: SCAN.STRING;
  204. BEGIN
  205. IF strlen(e) # 1 THEN
  206. string := e.value.string(SCAN.STRING);
  207. IF string.offset = -1 THEN
  208. string.offset := IL.putstr(string.s);
  209. END;
  210. offset := string.offset
  211. ELSE
  212. offset := IL.putstr1(ARITH.Int(e.value))
  213. END
  214. RETURN offset
  215. END String;
  216. PROCEDURE StringW (e: PARS.EXPR): INTEGER;
  217. VAR
  218. offset: INTEGER;
  219. string: SCAN.STRING;
  220. BEGIN
  221. IF utf8strlen(e) # 1 THEN
  222. string := e.value.string(SCAN.STRING);
  223. IF string.offsetW = -1 THEN
  224. string.offsetW := IL.putstrW(string.s);
  225. END;
  226. offset := string.offsetW
  227. ELSE
  228. IF e._type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN
  229. offset := IL.putstrW1(ARITH.Int(e.value))
  230. ELSE (* e._type.typ = PROG.tSTRING *)
  231. string := e.value.string(SCAN.STRING);
  232. IF string.offsetW = -1 THEN
  233. string.offsetW := IL.putstrW(string.s);
  234. END;
  235. offset := string.offsetW
  236. END
  237. END
  238. RETURN offset
  239. END StringW;
  240. PROCEDURE CheckRange (range, line, errno: INTEGER);
  241. VAR
  242. label: INTEGER;
  243. BEGIN
  244. label := IL.NewLabel();
  245. IL.AddCmd2(IL.opCHKIDX, label, range);
  246. IL.OnError(line, errno);
  247. IL.SetLabel(label)
  248. END CheckRange;
  249. PROCEDURE Float (parser: PARS.PARSER; e: PARS.EXPR);
  250. VAR
  251. pos: PARS.POSITION;
  252. BEGIN
  253. getpos(parser, pos);
  254. IL.Float(ARITH.Float(e.value), pos.line, pos.col)
  255. END Float;
  256. PROCEDURE assign (parser: PARS.PARSER; e: PARS.EXPR; VarType: PROG._TYPE; line: INTEGER): BOOLEAN;
  257. VAR
  258. res: BOOLEAN;
  259. label: INTEGER;
  260. BEGIN
  261. IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN
  262. res := TRUE;
  263. IF PROG.arrcomp(e._type, VarType) THEN
  264. IF ~PROG.isOpenArray(VarType) THEN
  265. IL.Const(VarType.length)
  266. END;
  267. IL.AddCmd(IL.opCOPYA, VarType.base.size);
  268. label := IL.NewLabel();
  269. IL.Jmp(IL.opJNZ, label);
  270. IL.OnError(line, errCOPY);
  271. IL.SetLabel(label)
  272. ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN
  273. IF VarType = tINTEGER THEN
  274. IF e.obj = eCONST THEN
  275. IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
  276. ELSE
  277. IL.AddCmd0(IL.opSAVE)
  278. END
  279. ELSE
  280. IF e.obj = eCONST THEN
  281. res := ARITH.range(e.value, 0, 255);
  282. IF res THEN
  283. IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
  284. END
  285. ELSE
  286. IL.AddCmd0(IL.opSAVE8)
  287. END
  288. END
  289. ELSIF isSet(e) & (VarType = tSET) THEN
  290. IF e.obj = eCONST THEN
  291. IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
  292. ELSE
  293. IL.AddCmd0(IL.opSAVE)
  294. END
  295. ELSIF isBoolean(e) & (VarType = tBOOLEAN) THEN
  296. IF e.obj = eCONST THEN
  297. IL.AddCmd(IL.opSBOOLC, ARITH.Int(e.value))
  298. ELSE
  299. IL.AddCmd0(IL.opSBOOL)
  300. END
  301. ELSIF isReal(e) & (VarType = tREAL) THEN
  302. IF e.obj = eCONST THEN
  303. Float(parser, e)
  304. END;
  305. IL.savef(e.obj = eCONST)
  306. ELSIF isChar(e) & (VarType = tCHAR) THEN
  307. IF e.obj = eCONST THEN
  308. IL.AddCmd(IL.opSAVE8C, ARITH.Int(e.value))
  309. ELSE
  310. IL.AddCmd0(IL.opSAVE8)
  311. END
  312. ELSIF (e.obj = eCONST) & isChar(e) & (VarType = tWCHAR) THEN
  313. IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
  314. ELSIF isStringW1(e) & (VarType = tWCHAR) THEN
  315. IL.AddCmd(IL.opSAVE16C, StrToWChar(e.value.string(SCAN.STRING).s))
  316. ELSIF isCharW(e) & (VarType = tWCHAR) THEN
  317. IF e.obj = eCONST THEN
  318. IL.AddCmd(IL.opSAVE16C, ARITH.Int(e.value))
  319. ELSE
  320. IL.AddCmd0(IL.opSAVE16)
  321. END
  322. ELSIF PROG.isBaseOf(VarType, e._type) THEN
  323. IF VarType.typ = PROG.tPOINTER THEN
  324. IL.AddCmd0(IL.opSAVE)
  325. ELSE
  326. IL.AddCmd(IL.opCOPY, VarType.size)
  327. END
  328. ELSIF (e._type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN
  329. IL.AddCmd0(IL.opSAVE32)
  330. ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e._type) & PROG.isTypeEq(VarType, e._type) THEN
  331. IF e.obj = ePROC THEN
  332. IL.AssignProc(e.ident.proc.label)
  333. ELSIF e.obj = eIMP THEN
  334. IL.AssignImpProc(e.ident._import)
  335. ELSE
  336. IF VarType.typ = PROG.tPROCEDURE THEN
  337. IL.AddCmd0(IL.opSAVE)
  338. ELSE
  339. IL.AddCmd(IL.opCOPY, VarType.size)
  340. END
  341. END
  342. ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN
  343. IL.AddCmd(IL.opSAVEC, 0)
  344. ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tCHAR) & (VarType.length > strlen(e))) THEN
  345. IL.saves(String(e), strlen(e) + 1)
  346. ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base = tWCHAR) & (VarType.length > utf8strlen(e))) THEN
  347. IL.saves(StringW(e), (utf8strlen(e) + 1) * 2)
  348. ELSE
  349. res := FALSE
  350. END
  351. ELSE
  352. res := FALSE
  353. END
  354. RETURN res
  355. END assign;
  356. PROCEDURE LoadConst (e: PARS.EXPR);
  357. BEGIN
  358. IL.Const(ARITH.Int(e.value))
  359. END LoadConst;
  360. PROCEDURE paramcomp (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR; p: PROG.PARAM);
  361. VAR
  362. stroffs: INTEGER;
  363. PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN;
  364. VAR
  365. t1, t2: PROG._TYPE;
  366. BEGIN
  367. t1 := p._type;
  368. t2 := e._type;
  369. WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO
  370. t1 := t1.base;
  371. t2 := t2.base
  372. END
  373. RETURN PROG.isTypeEq(t1, t2)
  374. END arrcomp;
  375. PROCEDURE ArrLen (t: PROG._TYPE; n: INTEGER): INTEGER;
  376. VAR
  377. res: INTEGER;
  378. BEGIN
  379. REPEAT
  380. res := t.length;
  381. t := t.base;
  382. DEC(n)
  383. UNTIL (n < 0) OR (t.typ # PROG.tARRAY);
  384. ASSERT(n < 0)
  385. RETURN res
  386. END ArrLen;
  387. PROCEDURE OpenArray (t, t2: PROG._TYPE);
  388. VAR
  389. n, d1, d2: INTEGER;
  390. BEGIN
  391. IF t.length # 0 THEN
  392. IL.Param1;
  393. n := PROG.Dim(t2) - 1;
  394. WHILE n >= 0 DO
  395. IL.Const(ArrLen(t, n));
  396. IL.Param1;
  397. DEC(n)
  398. END
  399. ELSE
  400. d1 := PROG.Dim(t);
  401. d2 := PROG.Dim(t2);
  402. IF d1 # d2 THEN
  403. n := d2 - d1;
  404. WHILE d2 > d1 DO
  405. IL.Const(ArrLen(t, d2 - 1));
  406. DEC(d2)
  407. END;
  408. d2 := PROG.Dim(t2);
  409. WHILE n > 0 DO
  410. IL.AddCmd(IL.opROT, d2);
  411. DEC(n)
  412. END
  413. END;
  414. IL.AddCmd(IL.opPARAM, PROG.Dim(t2) + 1)
  415. END
  416. END OpenArray;
  417. BEGIN
  418. IF p.vPar THEN
  419. PARS.check(isVar(e), pos, 93);
  420. IF p._type.typ = PROG.tRECORD THEN
  421. PARS.check(PROG.isBaseOf(p._type, e._type), pos, 66);
  422. IF e.obj = eVREC THEN
  423. IF e.ident # NIL THEN
  424. IL.AddCmd(IL.opVADR, e.ident.offset - 1)
  425. ELSE
  426. IL.AddCmd0(IL.opPUSHT)
  427. END
  428. ELSE
  429. IL.Const(e._type.num)
  430. END;
  431. IL.AddCmd(IL.opPARAM, 2)
  432. ELSIF PROG.isOpenArray(p._type) THEN
  433. PARS.check(arrcomp(e, p), pos, 66);
  434. OpenArray(e._type, p._type)
  435. ELSE
  436. PARS.check(PROG.isTypeEq(e._type, p._type), pos, 66);
  437. IL.Param1
  438. END;
  439. PARS.check(~e.readOnly, pos, 94)
  440. ELSE
  441. PARS.check(isExpr(e) OR isProc(e), pos, 66);
  442. IF PROG.isOpenArray(p._type) THEN
  443. IF e._type.typ = PROG.tARRAY THEN
  444. PARS.check(arrcomp(e, p), pos, 66);
  445. OpenArray(e._type, p._type)
  446. ELSIF isString(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tCHAR) THEN
  447. IL.StrAdr(String(e));
  448. IL.Param1;
  449. IL.Const(strlen(e) + 1);
  450. IL.Param1
  451. ELSIF isStringW(e) & (p._type.typ = PROG.tARRAY) & (p._type.base = tWCHAR) THEN
  452. IL.StrAdr(StringW(e));
  453. IL.Param1;
  454. IL.Const(utf8strlen(e) + 1);
  455. IL.Param1
  456. ELSE
  457. PARS.error(pos, 66)
  458. END
  459. ELSE
  460. PARS.check(~PROG.isOpenArray(e._type), pos, 66);
  461. PARS.check(assigncomp(e, p._type), pos, 66);
  462. IF e.obj = eCONST THEN
  463. IF e._type = tREAL THEN
  464. Float(parser, e);
  465. IL.AddCmd0(IL.opPUSHF)
  466. ELSIF e._type.typ = PROG.tNIL THEN
  467. IL.Const(0);
  468. IL.Param1
  469. ELSIF isStringW1(e) & (p._type = tWCHAR) THEN
  470. IL.Const(StrToWChar(e.value.string(SCAN.STRING).s));
  471. IL.Param1
  472. ELSIF (e._type.typ = PROG.tSTRING) OR
  473. (e._type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p._type.typ = PROG.tARRAY) & (p._type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN
  474. IF p._type.base = tCHAR THEN
  475. stroffs := String(e);
  476. IL.StrAdr(stroffs);
  477. IF (CPU = TARGETS.cpuMSP430) & (p._type.size - strlen(e) - 1 > MSP430.IntVectorSize) THEN
  478. ERRORS.WarningMsg(pos.line, pos.col, 0)
  479. END
  480. ELSE (* WCHAR *)
  481. stroffs := StringW(e);
  482. IL.StrAdr(stroffs)
  483. END;
  484. IL.set_dmin(stroffs + p._type.size);
  485. IL.Param1
  486. ELSE
  487. LoadConst(e);
  488. IL.Param1
  489. END
  490. ELSIF e.obj = ePROC THEN
  491. PARS.check(e.ident.global, pos, 85);
  492. IL.PushProc(e.ident.proc.label);
  493. IL.Param1
  494. ELSIF e.obj = eIMP THEN
  495. IL.PushImpProc(e.ident._import);
  496. IL.Param1
  497. ELSIF isExpr(e) & (e._type = tREAL) THEN
  498. IL.AddCmd0(IL.opPUSHF)
  499. ELSE
  500. IF (p._type = tBYTE) & (e._type = tINTEGER) & (chkBYTE IN Options.checking) THEN
  501. CheckRange(256, pos.line, errBYTE)
  502. END;
  503. IL.Param1
  504. END
  505. END
  506. END
  507. END paramcomp;
  508. PROCEDURE PExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  509. BEGIN
  510. parser.expression(parser, e)
  511. END PExpression;
  512. PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR);
  513. VAR
  514. e1, e2: PARS.EXPR;
  515. pos: PARS.POSITION;
  516. proc,
  517. label,
  518. size,
  519. n, i: INTEGER;
  520. code: ARITH.VALUE;
  521. wchar,
  522. comma: BOOLEAN;
  523. cmd1,
  524. cmd2: IL.COMMAND;
  525. PROCEDURE varparam (parser: PARS.PARSER; pos: PARS.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR);
  526. BEGIN
  527. parser.designator(parser, e);
  528. PARS.check(isVar(e), pos, 93);
  529. PARS.check(isfunc(e), pos, 66);
  530. IF readOnly THEN
  531. PARS.check(~e.readOnly, pos, 94)
  532. END
  533. END varparam;
  534. PROCEDURE shift_minmax (proc: INTEGER): CHAR;
  535. VAR
  536. res: CHAR;
  537. BEGIN
  538. CASE proc OF
  539. |PROG.stASR: res := "A"
  540. |PROG.stLSL: res := "L"
  541. |PROG.stROR: res := "O"
  542. |PROG.stLSR: res := "R"
  543. |PROG.stMIN: res := "m"
  544. |PROG.stMAX: res := "x"
  545. END
  546. RETURN res
  547. END shift_minmax;
  548. BEGIN
  549. ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC});
  550. proc := e.stproc;
  551. (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
  552. PARS.checklex(parser, SCAN.lxLROUND);
  553. PARS.Next(parser);
  554. (* END; *)
  555. getpos(parser, pos);
  556. IF e.obj IN {eSTPROC, eSYSPROC} THEN
  557. CASE proc OF
  558. |PROG.stASSERT:
  559. PExpression(parser, e);
  560. PARS.check(isBoolean(e), pos, 66);
  561. IF e.obj = eCONST THEN
  562. IF ~ARITH.getBool(e.value) THEN
  563. IL.OnError(pos.line, errASSERT)
  564. END
  565. ELSE
  566. label := IL.NewLabel();
  567. IL.not;
  568. IL.AndOrOpt(label);
  569. IL.OnError(pos.line, errASSERT);
  570. IL.SetLabel(label)
  571. END
  572. |PROG.stINC, PROG.stDEC:
  573. IL.pushBegEnd(begcall, endcall);
  574. varparam(parser, pos, isInt, TRUE, e);
  575. IF e._type = tINTEGER THEN
  576. IF parser.sym = SCAN.lxCOMMA THEN
  577. NextPos(parser, pos);
  578. IL.setlast(begcall);
  579. PExpression(parser, e2);
  580. IL.setlast(endcall.prev(IL.COMMAND));
  581. PARS.check(isInt(e2), pos, 66);
  582. IF e2.obj = eCONST THEN
  583. IL.AddCmd(IL.opINCC, ARITH.Int(e2.value) * (ORD(proc = PROG.stINC) * 2 - 1))
  584. ELSE
  585. IL.AddCmd0(IL.opINC + ORD(proc = PROG.stDEC))
  586. END
  587. ELSE
  588. IL.AddCmd(IL.opINCC, ORD(proc = PROG.stINC) * 2 - 1)
  589. END
  590. ELSE (* e._type = tBYTE *)
  591. IF parser.sym = SCAN.lxCOMMA THEN
  592. NextPos(parser, pos);
  593. IL.setlast(begcall);
  594. PExpression(parser, e2);
  595. IL.setlast(endcall.prev(IL.COMMAND));
  596. PARS.check(isInt(e2), pos, 66);
  597. IF e2.obj = eCONST THEN
  598. IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value))
  599. ELSE
  600. IL.AddCmd0(IL.opINCB + ORD(proc = PROG.stDEC))
  601. END
  602. ELSE
  603. IL.AddCmd(IL.opINCCB + ORD(proc = PROG.stDEC), 1)
  604. END
  605. END;
  606. IL.popBegEnd(begcall, endcall)
  607. |PROG.stINCL, PROG.stEXCL:
  608. IL.pushBegEnd(begcall, endcall);
  609. varparam(parser, pos, isSet, TRUE, e);
  610. PARS.checklex(parser, SCAN.lxCOMMA);
  611. NextPos(parser, pos);
  612. IL.setlast(begcall);
  613. PExpression(parser, e2);
  614. IL.setlast(endcall.prev(IL.COMMAND));
  615. PARS.check(isInt(e2), pos, 66);
  616. IF e2.obj = eCONST THEN
  617. PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 56);
  618. IL.AddCmd(IL.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value))
  619. ELSE
  620. IL.AddCmd0(IL.opINCL + ORD(proc = PROG.stEXCL))
  621. END;
  622. IL.popBegEnd(begcall, endcall)
  623. |PROG.stNEW:
  624. varparam(parser, pos, isPtr, TRUE, e);
  625. IF CPU = TARGETS.cpuMSP430 THEN
  626. PARS.check(e._type.base.size + 16 < Options.ram, pos, 63)
  627. END;
  628. IL.New(e._type.base.size, e._type.base.num)
  629. |PROG.stDISPOSE:
  630. varparam(parser, pos, isPtr, TRUE, e);
  631. IL.AddCmd0(IL.opDISP)
  632. |PROG.stPACK:
  633. varparam(parser, pos, isReal, TRUE, e);
  634. PARS.checklex(parser, SCAN.lxCOMMA);
  635. NextPos(parser, pos);
  636. PExpression(parser, e2);
  637. PARS.check(isInt(e2), pos, 66);
  638. IF e2.obj = eCONST THEN
  639. IL.AddCmd(IL.opPACKC, ARITH.Int(e2.value))
  640. ELSE
  641. IL.AddCmd0(IL.opPACK)
  642. END
  643. |PROG.stUNPK:
  644. varparam(parser, pos, isReal, TRUE, e);
  645. PARS.checklex(parser, SCAN.lxCOMMA);
  646. NextPos(parser, pos);
  647. varparam(parser, pos, isInteger, TRUE, e2);
  648. IL.AddCmd0(IL.opUNPK)
  649. |PROG.stCOPY:
  650. IL.pushBegEnd(begcall, endcall);
  651. PExpression(parser, e);
  652. IF isString(e) OR isCharArray(e) THEN
  653. wchar := FALSE
  654. ELSIF isStringW(e) OR isCharArrayW(e) THEN
  655. wchar := TRUE
  656. ELSE
  657. PARS.error(pos, 66)
  658. END;
  659. IF isCharArrayX(e) & ~PROG.isOpenArray(e._type) THEN
  660. IL.Const(e._type.length)
  661. END;
  662. PARS.checklex(parser, SCAN.lxCOMMA);
  663. NextPos(parser, pos);
  664. IL.setlast(begcall);
  665. IF wchar THEN
  666. varparam(parser, pos, isCharArrayW, TRUE, e1)
  667. ELSE
  668. IF e.obj = eCONST THEN
  669. varparam(parser, pos, isCharArrayX, TRUE, e1)
  670. ELSE
  671. varparam(parser, pos, isCharArray, TRUE, e1)
  672. END;
  673. wchar := e1._type.base = tWCHAR
  674. END;
  675. IF ~PROG.isOpenArray(e1._type) THEN
  676. IL.Const(e1._type.length)
  677. END;
  678. IL.setlast(endcall.prev(IL.COMMAND));
  679. IF e.obj = eCONST THEN
  680. IF wchar THEN
  681. IL.StrAdr(StringW(e));
  682. IL.Const(utf8strlen(e) + 1)
  683. ELSE
  684. IL.StrAdr(String(e));
  685. IL.Const(strlen(e) + 1)
  686. END
  687. END;
  688. IL.AddCmd(IL.opCOPYS, e1._type.base.size);
  689. IL.popBegEnd(begcall, endcall)
  690. |PROG.sysGET, PROG.sysGET8, PROG.sysGET16, PROG.sysGET32:
  691. PExpression(parser, e);
  692. PARS.check(isInt(e), pos, 66);
  693. PARS.checklex(parser, SCAN.lxCOMMA);
  694. NextPos(parser, pos);
  695. parser.designator(parser, e2);
  696. PARS.check(isVar(e2), pos, 93);
  697. IF proc = PROG.sysGET THEN
  698. PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66)
  699. ELSE
  700. PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66)
  701. END;
  702. CASE proc OF
  703. |PROG.sysGET: size := e2._type.size
  704. |PROG.sysGET8: size := 1
  705. |PROG.sysGET16: size := 2
  706. |PROG.sysGET32: size := 4
  707. END;
  708. PARS.check(size <= e2._type.size, pos, 66);
  709. IF e.obj = eCONST THEN
  710. IL.AddCmd2(IL.opGETC, ARITH.Int(e.value), size)
  711. ELSE
  712. IL.AddCmd(IL.opGET, size)
  713. END
  714. |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32:
  715. IL.pushBegEnd(begcall, endcall);
  716. PExpression(parser, e);
  717. PARS.check(isInt(e), pos, 66);
  718. IF e.obj = eCONST THEN
  719. LoadConst(e)
  720. END;
  721. PARS.checklex(parser, SCAN.lxCOMMA);
  722. NextPos(parser, pos);
  723. IL.setlast(begcall);
  724. PExpression(parser, e2);
  725. PARS.check(isExpr(e2), pos, 66);
  726. IF proc = PROG.sysPUT THEN
  727. PARS.check(e2._type.typ IN PROG.BASICTYPES + {PROG.tPOINTER, PROG.tPROCEDURE}, pos, 66);
  728. IF e2.obj = eCONST THEN
  729. IF e2._type = tREAL THEN
  730. Float(parser, e2);
  731. IL.setlast(endcall.prev(IL.COMMAND));
  732. IL.savef(FALSE)
  733. ELSE
  734. LoadConst(e2);
  735. IL.setlast(endcall.prev(IL.COMMAND));
  736. IL.SysPut(e2._type.size)
  737. END
  738. ELSE
  739. IL.setlast(endcall.prev(IL.COMMAND));
  740. IF e2._type = tREAL THEN
  741. IL.savef(FALSE)
  742. ELSIF e2._type = tBYTE THEN
  743. IL.SysPut(tINTEGER.size)
  744. ELSE
  745. IL.SysPut(e2._type.size)
  746. END
  747. END
  748. ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN
  749. PARS.check(e2._type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tSET, PROG.tWCHAR, PROG.tCARD32}, pos, 66);
  750. IF e2.obj = eCONST THEN
  751. LoadConst(e2)
  752. END;
  753. IL.setlast(endcall.prev(IL.COMMAND));
  754. CASE proc OF
  755. |PROG.sysPUT8: size := 1
  756. |PROG.sysPUT16: size := 2
  757. |PROG.sysPUT32: size := 4
  758. END;
  759. IL.SysPut(size)
  760. END;
  761. IL.popBegEnd(begcall, endcall)
  762. |PROG.sysMOVE:
  763. FOR i := 1 TO 2 DO
  764. PExpression(parser, e);
  765. PARS.check(isInt(e), pos, 66);
  766. IF e.obj = eCONST THEN
  767. LoadConst(e)
  768. END;
  769. PARS.checklex(parser, SCAN.lxCOMMA);
  770. NextPos(parser, pos)
  771. END;
  772. PExpression(parser, e);
  773. PARS.check(isInt(e), pos, 66);
  774. IF e.obj = eCONST THEN
  775. IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
  776. ELSE
  777. IL.AddCmd0(IL.opMOVE)
  778. END
  779. |PROG.sysCOPY:
  780. FOR i := 1 TO 2 DO
  781. parser.designator(parser, e);
  782. PARS.check(isVar(e), pos, 93);
  783. n := PROG.Dim(e._type);
  784. WHILE n > 0 DO
  785. IL.drop;
  786. DEC(n)
  787. END;
  788. PARS.checklex(parser, SCAN.lxCOMMA);
  789. NextPos(parser, pos)
  790. END;
  791. PExpression(parser, e);
  792. PARS.check(isInt(e), pos, 66);
  793. IF e.obj = eCONST THEN
  794. IL.AddCmd(IL.opCOPY, ARITH.Int(e.value))
  795. ELSE
  796. IL.AddCmd0(IL.opMOVE)
  797. END
  798. |PROG.sysCODE:
  799. REPEAT
  800. getpos(parser, pos);
  801. PARS.ConstExpression(parser, code);
  802. PARS.check(code.typ = ARITH.tINTEGER, pos, 43);
  803. IF TARGETS.WordSize > TARGETS.InstrSize THEN
  804. CASE TARGETS.InstrSize OF
  805. |1: PARS.check(ARITH.range(code, 0, 255), pos, 42)
  806. |2: PARS.check(ARITH.range(code, 0, 65535), pos, 110)
  807. END
  808. END;
  809. IL.AddCmd(IL.opCODE, ARITH.getInt(code));
  810. comma := parser.sym = SCAN.lxCOMMA;
  811. IF comma THEN
  812. PARS.Next(parser)
  813. ELSE
  814. PARS.checklex(parser, SCAN.lxRROUND)
  815. END
  816. UNTIL (parser.sym = SCAN.lxRROUND) & ~comma
  817. (*
  818. |PROG.sysNOP, PROG.sysDINT, PROG.sysEINT:
  819. IF parser.sym = SCAN.lxLROUND THEN
  820. PARS.Next(parser);
  821. PARS.checklex(parser, SCAN.lxRROUND);
  822. PARS.Next(parser)
  823. END;
  824. ASSERT(CPU = cpuMSP430);
  825. CASE proc OF
  826. |PROG.sysNOP: IL.AddCmd(IL.opCODE, 4303H)
  827. |PROG.sysDINT: IL.AddCmd(IL.opCODE, 0C232H); IL.AddCmd(IL.opCODE, 4303H)
  828. |PROG.sysEINT: IL.AddCmd(IL.opCODE, 0D232H)
  829. END
  830. *)
  831. END;
  832. e.obj := eEXPR;
  833. e._type := NIL
  834. ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN
  835. CASE e.stproc OF
  836. |PROG.stABS:
  837. PExpression(parser, e);
  838. PARS.check(isInt(e) OR isReal(e), pos, 66);
  839. IF e.obj = eCONST THEN
  840. PARS.check(ARITH.abs(e.value), pos, 39)
  841. ELSE
  842. IL.abs(isReal(e))
  843. END
  844. |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX:
  845. PExpression(parser, e);
  846. PARS.check(isInt(e), pos, 66);
  847. PARS.checklex(parser, SCAN.lxCOMMA);
  848. NextPos(parser, pos);
  849. PExpression(parser, e2);
  850. PARS.check(isInt(e2), pos, 66);
  851. e._type := tINTEGER;
  852. IF (e.obj = eCONST) & (e2.obj = eCONST) THEN
  853. ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc)))
  854. ELSE
  855. IF e.obj = eCONST THEN
  856. IL.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value))
  857. ELSIF e2.obj = eCONST THEN
  858. IL.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value))
  859. ELSE
  860. IL.shift_minmax(shift_minmax(proc))
  861. END;
  862. e.obj := eEXPR
  863. END
  864. |PROG.stCHR:
  865. PExpression(parser, e);
  866. PARS.check(isInt(e), pos, 66);
  867. e._type := tCHAR;
  868. IF e.obj = eCONST THEN
  869. ARITH.setChar(e.value, ARITH.getInt(e.value));
  870. PARS.check(ARITH.check(e.value), pos, 107)
  871. ELSE
  872. IF chkCHR IN Options.checking THEN
  873. CheckRange(256, pos.line, errCHR)
  874. ELSE
  875. IL.AddCmd(IL.opMODR, 256)
  876. END
  877. END
  878. |PROG.stWCHR:
  879. PExpression(parser, e);
  880. PARS.check(isInt(e), pos, 66);
  881. e._type := tWCHAR;
  882. IF e.obj = eCONST THEN
  883. ARITH.setWChar(e.value, ARITH.getInt(e.value));
  884. PARS.check(ARITH.check(e.value), pos, 101)
  885. ELSE
  886. IF chkWCHR IN Options.checking THEN
  887. CheckRange(65536, pos.line, errWCHR)
  888. ELSE
  889. IL.AddCmd(IL.opMODR, 65536)
  890. END
  891. END
  892. |PROG.stFLOOR:
  893. PExpression(parser, e);
  894. PARS.check(isReal(e), pos, 66);
  895. e._type := tINTEGER;
  896. IF e.obj = eCONST THEN
  897. PARS.check(ARITH.floor(e.value), pos, 39)
  898. ELSE
  899. IL.AddCmd0(IL.opFLOOR)
  900. END
  901. |PROG.stFLT:
  902. PExpression(parser, e);
  903. PARS.check(isInt(e), pos, 66);
  904. e._type := tREAL;
  905. IF e.obj = eCONST THEN
  906. ARITH.flt(e.value)
  907. ELSE
  908. IL.AddCmd2(IL.opFLT, pos.line, pos.col)
  909. END
  910. |PROG.stLEN:
  911. cmd1 := IL.getlast();
  912. varparam(parser, pos, isArr, FALSE, e);
  913. IF e._type.length > 0 THEN
  914. cmd2 := IL.getlast();
  915. IL.delete2(cmd1.next, cmd2);
  916. IL.setlast(cmd1);
  917. ASSERT(ARITH.setInt(e.value, e._type.length));
  918. e.obj := eCONST
  919. ELSE
  920. IL.len(PROG.Dim(e._type))
  921. END;
  922. e._type := tINTEGER
  923. |PROG.stLENGTH:
  924. PExpression(parser, e);
  925. IF isCharArray(e) THEN
  926. IF e._type.length > 0 THEN
  927. IL.Const(e._type.length)
  928. END;
  929. IL.AddCmd0(IL.opLENGTH)
  930. ELSIF isCharArrayW(e) THEN
  931. IF e._type.length > 0 THEN
  932. IL.Const(e._type.length)
  933. END;
  934. IL.AddCmd0(IL.opLENGTHW)
  935. ELSE
  936. PARS.error(pos, 66);
  937. END;
  938. e._type := tINTEGER
  939. |PROG.stODD:
  940. PExpression(parser, e);
  941. PARS.check(isInt(e), pos, 66);
  942. e._type := tBOOLEAN;
  943. IF e.obj = eCONST THEN
  944. ARITH.odd(e.value)
  945. ELSE
  946. IL.AddCmd(IL.opMODR, 2)
  947. END
  948. |PROG.stORD:
  949. cmd1 := IL.getlast();
  950. PExpression(parser, e);
  951. PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), pos, 66);
  952. IF e.obj = eCONST THEN
  953. IF isStringW1(e) THEN
  954. ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.STRING).s)))
  955. ELSE
  956. ARITH.ord(e.value)
  957. END
  958. ELSE
  959. IF isBoolean(e) THEN
  960. cmd2 := IL.getlast();
  961. IL.setlast(cmd1);
  962. IL.AddCmd(IL.opPRECALL, 0);
  963. IL.AddCmd0(IL.opRES);
  964. IL.drop;
  965. IL.setlast(cmd2);
  966. IL._ord
  967. END
  968. END;
  969. e._type := tINTEGER
  970. |PROG.stBITS:
  971. PExpression(parser, e);
  972. PARS.check(isInt(e), pos, 66);
  973. IF e.obj = eCONST THEN
  974. ARITH.bits(e.value)
  975. END;
  976. e._type := tSET
  977. |PROG.sysADR:
  978. parser.designator(parser, e);
  979. IF isVar(e) THEN
  980. n := PROG.Dim(e._type);
  981. WHILE n > 0 DO
  982. IL.drop;
  983. DEC(n)
  984. END
  985. ELSIF e.obj = ePROC THEN
  986. IL.PushProc(e.ident.proc.label)
  987. ELSIF e.obj = eIMP THEN
  988. IL.PushImpProc(e.ident._import)
  989. ELSE
  990. PARS.error(pos, 108)
  991. END;
  992. e._type := tINTEGER
  993. |PROG.sysSADR:
  994. PExpression(parser, e);
  995. PARS.check(isString(e), pos, 66);
  996. IL.StrAdr(String(e));
  997. e._type := tINTEGER;
  998. e.obj := eEXPR
  999. |PROG.sysWSADR:
  1000. PExpression(parser, e);
  1001. PARS.check(isStringW(e), pos, 66);
  1002. IL.StrAdr(StringW(e));
  1003. e._type := tINTEGER;
  1004. e.obj := eEXPR
  1005. |PROG.sysTYPEID:
  1006. PExpression(parser, e);
  1007. PARS.check(e.obj = eTYPE, pos, 68);
  1008. IF e._type.typ = PROG.tRECORD THEN
  1009. ASSERT(ARITH.setInt(e.value, e._type.num))
  1010. ELSIF e._type.typ = PROG.tPOINTER THEN
  1011. ASSERT(ARITH.setInt(e.value, e._type.base.num))
  1012. ELSE
  1013. PARS.error(pos, 52)
  1014. END;
  1015. e.obj := eCONST;
  1016. e._type := tINTEGER
  1017. |PROG.sysINF:
  1018. IL.AddCmd2(IL.opINF, pos.line, pos.col);
  1019. e.obj := eEXPR;
  1020. e._type := tREAL
  1021. |PROG.sysSIZE:
  1022. PExpression(parser, e);
  1023. PARS.check(e.obj = eTYPE, pos, 68);
  1024. ASSERT(ARITH.setInt(e.value, e._type.size));
  1025. e.obj := eCONST;
  1026. e._type := tINTEGER
  1027. END
  1028. END;
  1029. (* IF (proc # PROG.sysNOP) & (proc # PROG.sysEINT) & (proc # PROG.sysDINT) THEN *)
  1030. PARS.checklex(parser, SCAN.lxRROUND);
  1031. PARS.Next(parser);
  1032. (* END; *)
  1033. IF e.obj # eCONST THEN
  1034. e.obj := eEXPR
  1035. END
  1036. END stProc;
  1037. PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1038. VAR
  1039. proc: PROG._TYPE;
  1040. param: LISTS.ITEM;
  1041. e1: PARS.EXPR;
  1042. pos: PARS.POSITION;
  1043. BEGIN
  1044. ASSERT(parser.sym = SCAN.lxLROUND);
  1045. IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN
  1046. proc := e._type;
  1047. PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86);
  1048. PARS.Next(parser);
  1049. param := proc.params.first;
  1050. WHILE param # NIL DO
  1051. getpos(parser, pos);
  1052. IL.setlast(begcall);
  1053. IF param(PROG.PARAM).vPar THEN
  1054. parser.designator(parser, e1)
  1055. ELSE
  1056. PExpression(parser, e1)
  1057. END;
  1058. paramcomp(parser, pos, e1, param(PROG.PARAM));
  1059. param := param.next;
  1060. IF param # NIL THEN
  1061. PARS.checklex(parser, SCAN.lxCOMMA);
  1062. PARS.Next(parser)
  1063. END
  1064. END;
  1065. PARS.checklex(parser, SCAN.lxRROUND);
  1066. PARS.Next(parser);
  1067. e.obj := eEXPR;
  1068. e._type := proc.base
  1069. ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN
  1070. stProc(parser, e)
  1071. ELSE
  1072. PARS.check1(FALSE, parser, 86)
  1073. END
  1074. END ActualParameters;
  1075. PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1076. VAR
  1077. ident: PROG.IDENT;
  1078. imp: BOOLEAN;
  1079. pos: PARS.POSITION;
  1080. BEGIN
  1081. PARS.checklex(parser, SCAN.lxIDENT);
  1082. getpos(parser, pos);
  1083. imp := FALSE;
  1084. ident := PROG.getIdent(parser.unit, parser.lex.ident, FALSE);
  1085. PARS.check1(ident # NIL, parser, 48);
  1086. IF ident.typ = PROG.idMODULE THEN
  1087. PARS.ExpectSym(parser, SCAN.lxPOINT);
  1088. PARS.ExpectSym(parser, SCAN.lxIDENT);
  1089. ident := PROG.getIdent(ident.unit, parser.lex.ident, FALSE);
  1090. PARS.check1((ident # NIL) & ident.export, parser, 48);
  1091. imp := TRUE
  1092. END;
  1093. PARS.Next(parser);
  1094. e.readOnly := FALSE;
  1095. e.ident := ident;
  1096. CASE ident.typ OF
  1097. |PROG.idCONST:
  1098. e.obj := eCONST;
  1099. e._type := ident._type;
  1100. e.value := ident.value
  1101. |PROG.idTYPE:
  1102. e.obj := eTYPE;
  1103. e._type := ident._type
  1104. |PROG.idVAR:
  1105. e.obj := eVAR;
  1106. e._type := ident._type;
  1107. e.readOnly := imp
  1108. |PROG.idPROC:
  1109. e.obj := ePROC;
  1110. e._type := ident._type
  1111. |PROG.idIMP:
  1112. e.obj := eIMP;
  1113. e._type := ident._type
  1114. |PROG.idVPAR:
  1115. e._type := ident._type;
  1116. IF e._type.typ = PROG.tRECORD THEN
  1117. e.obj := eVREC
  1118. ELSE
  1119. e.obj := eVPAR
  1120. END
  1121. |PROG.idPARAM:
  1122. e.obj := ePARAM;
  1123. e._type := ident._type;
  1124. e.readOnly := (e._type.typ IN {PROG.tRECORD, PROG.tARRAY})
  1125. |PROG.idSTPROC:
  1126. e.obj := eSTPROC;
  1127. e._type := ident._type;
  1128. e.stproc := ident.stproc
  1129. |PROG.idSTFUNC:
  1130. e.obj := eSTFUNC;
  1131. e._type := ident._type;
  1132. e.stproc := ident.stproc
  1133. |PROG.idSYSPROC:
  1134. e.obj := eSYSPROC;
  1135. e._type := ident._type;
  1136. e.stproc := ident.stproc
  1137. |PROG.idSYSFUNC:
  1138. PARS.check(~parser.constexp, pos, 109);
  1139. e.obj := eSYSFUNC;
  1140. e._type := ident._type;
  1141. e.stproc := ident.stproc
  1142. |PROG.idNONE:
  1143. PARS.error(pos, 115)
  1144. END;
  1145. IF isVar(e) THEN
  1146. PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), pos, 105)
  1147. END
  1148. END qualident;
  1149. PROCEDURE deref (pos: PARS.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER);
  1150. VAR
  1151. label: INTEGER;
  1152. BEGIN
  1153. IF load THEN
  1154. IL.load(e._type.size)
  1155. END;
  1156. IF chkPTR IN Options.checking THEN
  1157. label := IL.NewLabel();
  1158. IL.Jmp(IL.opJNZ1, label);
  1159. IL.OnError(pos.line, error);
  1160. IL.SetLabel(label)
  1161. END
  1162. END deref;
  1163. PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1164. VAR
  1165. field: PROG.FIELD;
  1166. pos: PARS.POSITION;
  1167. t, idx: PARS.EXPR;
  1168. sysVal: BOOLEAN;
  1169. n: INTEGER;
  1170. PROCEDURE LoadAdr (e: PARS.EXPR);
  1171. VAR
  1172. offset: INTEGER;
  1173. PROCEDURE OpenArray (e: PARS.EXPR);
  1174. VAR
  1175. offset, n: INTEGER;
  1176. BEGIN
  1177. offset := e.ident.offset;
  1178. n := PROG.Dim(e._type);
  1179. WHILE n >= 0 DO
  1180. IL.AddCmd(IL.opVADR, offset);
  1181. DEC(offset);
  1182. DEC(n)
  1183. END
  1184. END OpenArray;
  1185. BEGIN
  1186. IF e.obj = eVAR THEN
  1187. offset := PROG.getOffset(e.ident);
  1188. IF e.ident.global THEN
  1189. IL.AddCmd(IL.opGADR, offset)
  1190. ELSE
  1191. IL.AddCmd(IL.opLADR, -offset)
  1192. END
  1193. ELSIF e.obj = ePARAM THEN
  1194. IF (e._type.typ = PROG.tRECORD) OR ((e._type.typ = PROG.tARRAY) & (e._type.length > 0)) THEN
  1195. IL.AddCmd(IL.opVADR, e.ident.offset)
  1196. ELSIF PROG.isOpenArray(e._type) THEN
  1197. OpenArray(e)
  1198. ELSE
  1199. IL.AddCmd(IL.opLADR, e.ident.offset)
  1200. END
  1201. ELSIF e.obj IN {eVPAR, eVREC} THEN
  1202. IF PROG.isOpenArray(e._type) THEN
  1203. OpenArray(e)
  1204. ELSE
  1205. IL.AddCmd(IL.opVADR, e.ident.offset)
  1206. END
  1207. END
  1208. END LoadAdr;
  1209. PROCEDURE OpenIdx (parser: PARS.PARSER; pos: PARS.POSITION; e: PARS.EXPR);
  1210. VAR
  1211. label, offset, n, k: INTEGER;
  1212. _type: PROG._TYPE;
  1213. BEGIN
  1214. IF chkIDX IN Options.checking THEN
  1215. label := IL.NewLabel();
  1216. IL.AddCmd2(IL.opCHKIDX2, label, 0);
  1217. IL.OnError(pos.line, errIDX);
  1218. IL.SetLabel(label)
  1219. ELSE
  1220. IL.AddCmd(IL.opCHKIDX2, -1)
  1221. END;
  1222. _type := PROG.OpenBase(e._type);
  1223. IF _type.size # 1 THEN
  1224. IL.AddCmd(IL.opMULC, _type.size)
  1225. END;
  1226. n := PROG.Dim(e._type) - 1;
  1227. k := n;
  1228. WHILE n > 0 DO
  1229. IL.AddCmd0(IL.opMUL);
  1230. DEC(n)
  1231. END;
  1232. IL.AddCmd0(IL.opADD);
  1233. offset := e.ident.offset - 1;
  1234. n := k;
  1235. WHILE n > 0 DO
  1236. IL.AddCmd(IL.opVADR, offset);
  1237. DEC(offset);
  1238. DEC(n)
  1239. END
  1240. END OpenIdx;
  1241. BEGIN
  1242. qualident(parser, e);
  1243. sysVal := (e.obj = eSYSPROC) & (e.stproc = PROG.sysVAL);
  1244. IF sysVal THEN
  1245. PARS.checklex(parser, SCAN.lxLROUND);
  1246. PARS.Next(parser);
  1247. getpos(parser, pos);
  1248. designator(parser, e);
  1249. PARS.check(isVar(e), pos, 93);
  1250. IF PROG.isOpenArray(e._type) THEN
  1251. n := PROG.Dim(e._type);
  1252. WHILE n > 0 DO
  1253. IL.drop;
  1254. DEC(n)
  1255. END
  1256. END;
  1257. PARS.checklex(parser, SCAN.lxCOMMA);
  1258. PARS.Next(parser);
  1259. getpos(parser, pos);
  1260. qualident(parser, t);
  1261. PARS.check(t.obj = eTYPE, pos, 79);
  1262. e._type := t._type;
  1263. PARS.checklex(parser, SCAN.lxRROUND);
  1264. PARS.Next(parser)
  1265. END;
  1266. IF e.obj IN {ePROC, eIMP} THEN
  1267. PROG.UseProc(parser.unit, e.ident.proc)
  1268. END;
  1269. IF isVar(e) & ~sysVal THEN
  1270. LoadAdr(e)
  1271. END;
  1272. WHILE parser.sym = SCAN.lxPOINT DO
  1273. getpos(parser, pos);
  1274. PARS.check1(isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73);
  1275. IF e._type.typ = PROG.tPOINTER THEN
  1276. deref(pos, e, TRUE, errPTR)
  1277. END;
  1278. PARS.ExpectSym(parser, SCAN.lxIDENT);
  1279. IF e._type.typ = PROG.tPOINTER THEN
  1280. e._type := e._type.base;
  1281. e.readOnly := FALSE
  1282. END;
  1283. field := PROG.getField(e._type, parser.lex.ident, parser.unit);
  1284. PARS.check1(field # NIL, parser, 74);
  1285. e._type := field._type;
  1286. IF e.obj = eVREC THEN
  1287. e.obj := eVPAR
  1288. END;
  1289. IF field.offset # 0 THEN
  1290. IL.AddCmd(IL.opADDC, field.offset)
  1291. END;
  1292. PARS.Next(parser);
  1293. e.ident := NIL
  1294. ELSIF parser.sym = SCAN.lxLSQUARE DO
  1295. REPEAT
  1296. PARS.check1(isArr(e), parser, 75);
  1297. NextPos(parser, pos);
  1298. PExpression(parser, idx);
  1299. PARS.check(isInt(idx), pos, 76);
  1300. IF idx.obj = eCONST THEN
  1301. IF e._type.length > 0 THEN
  1302. PARS.check(ARITH.range(idx.value, 0, e._type.length - 1), pos, 83);
  1303. IF ARITH.Int(idx.value) > 0 THEN
  1304. IL.AddCmd(IL.opADDC, ARITH.Int(idx.value) * e._type.base.size)
  1305. END
  1306. ELSE
  1307. PARS.check(ARITH.range(idx.value, 0, UTILS.target.maxInt), pos, 83);
  1308. LoadConst(idx);
  1309. OpenIdx(parser, pos, e)
  1310. END
  1311. ELSE
  1312. IF e._type.length > 0 THEN
  1313. IF chkIDX IN Options.checking THEN
  1314. CheckRange(e._type.length, pos.line, errIDX)
  1315. END;
  1316. IF e._type.base.size # 1 THEN
  1317. IL.AddCmd(IL.opMULC, e._type.base.size)
  1318. END;
  1319. IL.AddCmd0(IL.opADD)
  1320. ELSE
  1321. OpenIdx(parser, pos, e)
  1322. END
  1323. END;
  1324. e._type := e._type.base
  1325. UNTIL parser.sym # SCAN.lxCOMMA;
  1326. PARS.checklex(parser, SCAN.lxRSQUARE);
  1327. PARS.Next(parser);
  1328. IF ~(isArr(e) & (e._type.length = 0) & (parser.sym = SCAN.lxLSQUARE)) THEN
  1329. e.ident := NIL
  1330. END
  1331. ELSIF parser.sym = SCAN.lxCARET DO
  1332. getpos(parser, pos);
  1333. PARS.check1(isPtr(e), parser, 77);
  1334. deref(pos, e, TRUE, errPTR);
  1335. e._type := e._type.base;
  1336. e.readOnly := FALSE;
  1337. PARS.Next(parser);
  1338. e.ident := NIL;
  1339. e.obj := eVREC
  1340. ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e._type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO
  1341. IF e._type.typ = PROG.tRECORD THEN
  1342. PARS.check1(e.obj = eVREC, parser, 78)
  1343. END;
  1344. NextPos(parser, pos);
  1345. qualident(parser, t);
  1346. PARS.check(t.obj = eTYPE, pos, 79);
  1347. IF e._type.typ = PROG.tRECORD THEN
  1348. PARS.check(t._type.typ = PROG.tRECORD, pos, 80);
  1349. IF chkGUARD IN Options.checking THEN
  1350. IF e.ident = NIL THEN
  1351. IL.TypeGuard(IL.opTYPEGD, t._type.num, pos.line, errGUARD)
  1352. ELSE
  1353. IL.AddCmd(IL.opVADR, e.ident.offset - 1);
  1354. IL.TypeGuard(IL.opTYPEGR, t._type.num, pos.line, errGUARD)
  1355. END
  1356. END;
  1357. ELSE
  1358. PARS.check(t._type.typ = PROG.tPOINTER, pos, 81);
  1359. IF chkGUARD IN Options.checking THEN
  1360. IL.TypeGuard(IL.opTYPEGP, t._type.base.num, pos.line, errGUARD)
  1361. END
  1362. END;
  1363. PARS.check(PROG.isBaseOf(e._type, t._type), pos, 82);
  1364. e._type := t._type;
  1365. PARS.checklex(parser, SCAN.lxRROUND);
  1366. PARS.Next(parser)
  1367. END
  1368. END designator;
  1369. PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG._TYPE; isfloat: BOOLEAN; parser: PARS.PARSER; pos: PARS.POSITION; CallStat: BOOLEAN);
  1370. VAR
  1371. cconv,
  1372. parSize,
  1373. callconv,
  1374. fparSize,
  1375. int, flt,
  1376. stk_par: INTEGER;
  1377. BEGIN
  1378. cconv := procType.call;
  1379. parSize := procType.parSize;
  1380. IF cconv IN {PROG._win64, PROG.win64} THEN
  1381. callconv := IL.call_win64;
  1382. fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, 3, int, flt)), 5) + MIN(parSize, 4)
  1383. ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1384. callconv := IL.call_sysv;
  1385. fparSize := LSL(ORD(PROG.getFloatParamsPos(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + parSize;
  1386. stk_par := MAX(0, int - 6) + MAX(0, flt - 8)
  1387. ELSIF cconv IN {PROG.fastcall, PROG._fastcall} THEN
  1388. IF parSize = 0 THEN
  1389. callconv := IL.call_stack
  1390. ELSIF parSize = 1 THEN
  1391. callconv := IL.call_fast1
  1392. ELSIF parSize >= 2 THEN
  1393. callconv := IL.call_fast2
  1394. END;
  1395. fparSize := 0
  1396. ELSE
  1397. callconv := IL.call_stack;
  1398. fparSize := 0
  1399. END;
  1400. IL.setlast(begcall);
  1401. IL.AddCmd(IL.opPRECALL, ORD(isfloat));
  1402. IF cconv IN {PROG._ccall, PROG.ccall} THEN
  1403. IL.AddCmd(IL.opALIGN16, parSize)
  1404. ELSIF cconv IN {PROG._win64, PROG.win64} THEN
  1405. IL.AddCmd(IL.opWIN64ALIGN16, parSize)
  1406. ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1407. IL.AddCmd(IL.opSYSVALIGN16, parSize + stk_par)
  1408. END;
  1409. IL.setlast(endcall.prev(IL.COMMAND));
  1410. IF e.obj = eIMP THEN
  1411. IL.CallImp(e.ident._import, callconv, fparSize)
  1412. ELSIF e.obj = ePROC THEN
  1413. IL.Call(e.ident.proc.label, callconv, fparSize)
  1414. ELSIF isExpr(e) THEN
  1415. deref(pos, e, CallStat, errPROC);
  1416. IL.CallP(callconv, fparSize)
  1417. END;
  1418. IF cconv IN {PROG._ccall, PROG.ccall} THEN
  1419. IL.AddCmd(IL.opCLEANUP, parSize);
  1420. IL.AddCmd0(IL.opPOPSP)
  1421. ELSIF cconv IN {PROG._win64, PROG.win64} THEN
  1422. IL.AddCmd(IL.opCLEANUP, MAX(parSize + parSize MOD 2, 4) + 1);
  1423. IL.AddCmd0(IL.opPOPSP)
  1424. ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN
  1425. IL.AddCmd(IL.opCLEANUP, parSize + stk_par);
  1426. IL.AddCmd0(IL.opPOPSP)
  1427. ELSIF cconv IN {PROG._cdecl, PROG.cdecl, PROG.default16, PROG.code, PROG._code} THEN
  1428. IL.AddCmd(IL.opCLEANUP, parSize)
  1429. END;
  1430. IF CallStat THEN
  1431. IL.AddCmd0(IL.opRES);
  1432. IL.drop
  1433. ELSE
  1434. IF isfloat THEN
  1435. IL.AddCmd2(IL.opRESF, pos.line, pos.col)
  1436. ELSE
  1437. IL.AddCmd0(IL.opRES)
  1438. END
  1439. END
  1440. END ProcCall;
  1441. PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1442. VAR
  1443. pos, pos0, pos1: PARS.POSITION;
  1444. e1: PARS.EXPR;
  1445. op, cmp, error: INTEGER;
  1446. constant, eq: BOOLEAN;
  1447. PROCEDURE relation (sym: INTEGER): BOOLEAN;
  1448. RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR
  1449. (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR
  1450. (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR
  1451. (sym = SCAN.lxIN) OR (sym = SCAN.lxIS)
  1452. END relation;
  1453. PROCEDURE AddOperator (sym: INTEGER): BOOLEAN;
  1454. RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR
  1455. (sym = SCAN.lxOR)
  1456. END AddOperator;
  1457. PROCEDURE MulOperator (sym: INTEGER): BOOLEAN;
  1458. RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR
  1459. (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR
  1460. (sym = SCAN.lxAND)
  1461. END MulOperator;
  1462. PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1463. VAR
  1464. e1, e2: PARS.EXPR;
  1465. pos: PARS.POSITION;
  1466. range: BOOLEAN;
  1467. BEGIN
  1468. range := FALSE;
  1469. getpos(parser, pos);
  1470. expression(parser, e1);
  1471. PARS.check(isInt(e1), pos, 76);
  1472. IF e1.obj = eCONST THEN
  1473. PARS.check(ARITH.range(e1.value, 0, UTILS.target.maxSet), pos, 44)
  1474. END;
  1475. range := parser.sym = SCAN.lxRANGE;
  1476. IF range THEN
  1477. NextPos(parser, pos);
  1478. expression(parser, e2);
  1479. PARS.check(isInt(e2), pos, 76);
  1480. IF e2.obj = eCONST THEN
  1481. PARS.check(ARITH.range(e2.value, 0, UTILS.target.maxSet), pos, 44)
  1482. END
  1483. ELSE
  1484. IF e1.obj = eCONST THEN
  1485. e2 := e1
  1486. END
  1487. END;
  1488. e._type := tSET;
  1489. IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN
  1490. ARITH.constrSet(e.value, e1.value, e2.value);
  1491. e.obj := eCONST
  1492. ELSE
  1493. IF range THEN
  1494. IF e1.obj = eCONST THEN
  1495. IL.AddCmd(IL.opRSETL, ARITH.Int(e1.value))
  1496. ELSIF e2.obj = eCONST THEN
  1497. IL.AddCmd(IL.opRSETR, ARITH.Int(e2.value))
  1498. ELSE
  1499. IL.AddCmd0(IL.opRSET)
  1500. END
  1501. ELSE
  1502. IL.AddCmd0(IL.opRSET1)
  1503. END;
  1504. e.obj := eEXPR
  1505. END
  1506. END element;
  1507. PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1508. VAR
  1509. e1: PARS.EXPR;
  1510. BEGIN
  1511. ASSERT(parser.sym = SCAN.lxLCURLY);
  1512. e.obj := eCONST;
  1513. e._type := tSET;
  1514. ARITH.emptySet(e.value);
  1515. PARS.Next(parser);
  1516. IF parser.sym # SCAN.lxRCURLY THEN
  1517. element(parser, e1);
  1518. IF e1.obj = eCONST THEN
  1519. ARITH.opSet(e.value, e1.value, "+")
  1520. ELSE
  1521. e.obj := eEXPR
  1522. END;
  1523. WHILE parser.sym = SCAN.lxCOMMA DO
  1524. PARS.Next(parser);
  1525. element(parser, e1);
  1526. IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1527. ARITH.opSet(e.value, e1.value, "+")
  1528. ELSE
  1529. IF e.obj = eCONST THEN
  1530. IL.AddCmd(IL.opADDSC, ARITH.Int(e.value))
  1531. ELSIF e1.obj = eCONST THEN
  1532. IL.AddCmd(IL.opADDSC, ARITH.Int(e1.value))
  1533. ELSE
  1534. IL.AddCmd0(IL.opADDS)
  1535. END;
  1536. e.obj := eEXPR
  1537. END
  1538. END;
  1539. PARS.checklex(parser, SCAN.lxRCURLY)
  1540. END;
  1541. PARS.Next(parser);
  1542. END set;
  1543. PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1544. VAR
  1545. sym: INTEGER;
  1546. pos: PARS.POSITION;
  1547. e1: PARS.EXPR;
  1548. isfloat: BOOLEAN;
  1549. PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: PARS.POSITION);
  1550. BEGIN
  1551. IF ~(e._type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN
  1552. IF e._type = tREAL THEN
  1553. IL.AddCmd2(IL.opLOADF, pos.line, pos.col)
  1554. ELSE
  1555. IL.load(e._type.size)
  1556. END
  1557. END
  1558. END LoadVar;
  1559. BEGIN
  1560. sym := parser.sym;
  1561. IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN
  1562. e.obj := eCONST;
  1563. e.value := parser.lex.value;
  1564. e._type := PROG.getType(e.value.typ);
  1565. PARS.Next(parser)
  1566. ELSIF sym = SCAN.lxNIL THEN
  1567. e.obj := eCONST;
  1568. e._type := PROG.program.stTypes.tNIL;
  1569. PARS.Next(parser)
  1570. ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN
  1571. e.obj := eCONST;
  1572. ARITH.setbool(e.value, sym = SCAN.lxTRUE);
  1573. e._type := tBOOLEAN;
  1574. PARS.Next(parser)
  1575. ELSIF sym = SCAN.lxLCURLY THEN
  1576. set(parser, e)
  1577. ELSIF sym = SCAN.lxIDENT THEN
  1578. getpos(parser, pos);
  1579. IL.pushBegEnd(begcall, endcall);
  1580. designator(parser, e);
  1581. IF isVar(e) THEN
  1582. LoadVar(e, parser, pos)
  1583. END;
  1584. IF parser.sym = SCAN.lxLROUND THEN
  1585. e1 := e;
  1586. ActualParameters(parser, e);
  1587. PARS.check(e._type # NIL, pos, 59);
  1588. isfloat := e._type = tREAL;
  1589. IF e1.obj IN {ePROC, eIMP} THEN
  1590. ProcCall(e1, e1.ident._type, isfloat, parser, pos, FALSE)
  1591. ELSIF isExpr(e1) THEN
  1592. ProcCall(e1, e1._type, isfloat, parser, pos, FALSE)
  1593. END
  1594. END;
  1595. IL.popBegEnd(begcall, endcall)
  1596. ELSIF sym = SCAN.lxLROUND THEN
  1597. PARS.Next(parser);
  1598. expression(parser, e);
  1599. PARS.checklex(parser, SCAN.lxRROUND);
  1600. PARS.Next(parser);
  1601. IF isExpr(e) & (e.obj # eCONST) THEN
  1602. e.obj := eEXPR
  1603. END
  1604. ELSIF sym = SCAN.lxNOT THEN
  1605. NextPos(parser, pos);
  1606. factor(parser, e);
  1607. PARS.check(isBoolean(e), pos, 72);
  1608. IF e.obj # eCONST THEN
  1609. IL.not;
  1610. e.obj := eEXPR
  1611. ELSE
  1612. ASSERT(ARITH.neg(e.value))
  1613. END
  1614. ELSE
  1615. PARS.check1(FALSE, parser, 34)
  1616. END
  1617. END factor;
  1618. PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1619. VAR
  1620. pos: PARS.POSITION;
  1621. e1: PARS.EXPR;
  1622. op, label, label1: INTEGER;
  1623. BEGIN
  1624. factor(parser, e);
  1625. label := -1;
  1626. WHILE MulOperator(parser.sym) DO
  1627. op := parser.sym;
  1628. getpos(parser, pos);
  1629. PARS.Next(parser);
  1630. IF op = SCAN.lxAND THEN
  1631. IF ~parser.constexp THEN
  1632. IF label = -1 THEN
  1633. label := IL.NewLabel()
  1634. END;
  1635. IF (e.obj = eCONST) & isBoolean(e) THEN
  1636. IL.Const(ORD(ARITH.getBool(e.value)))
  1637. END;
  1638. IL.Jmp(IL.opJZ, label)
  1639. END
  1640. END;
  1641. factor(parser, e1);
  1642. CASE op OF
  1643. |SCAN.lxMUL:
  1644. PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
  1645. IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1646. CASE e.value.typ OF
  1647. |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), pos, 39)
  1648. |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), pos, 40)
  1649. |ARITH.tSET: ARITH.opSet(e.value, e1.value, "*")
  1650. END
  1651. ELSE
  1652. IF isInt(e) THEN
  1653. IF e.obj = eCONST THEN
  1654. IL.AddCmd(IL.opMULC, ARITH.Int(e.value))
  1655. ELSIF e1.obj = eCONST THEN
  1656. IL.AddCmd(IL.opMULC, ARITH.Int(e1.value))
  1657. ELSE
  1658. IL.AddCmd0(IL.opMUL)
  1659. END
  1660. ELSIF isReal(e) THEN
  1661. IF e.obj = eCONST THEN
  1662. Float(parser, e)
  1663. ELSIF e1.obj = eCONST THEN
  1664. Float(parser, e1)
  1665. END;
  1666. IL.AddCmd0(IL.opMULF)
  1667. ELSIF isSet(e) THEN
  1668. IF e.obj = eCONST THEN
  1669. IL.AddCmd(IL.opMULSC, ARITH.Int(e.value))
  1670. ELSIF e1.obj = eCONST THEN
  1671. IL.AddCmd(IL.opMULSC, ARITH.Int(e1.value))
  1672. ELSE
  1673. IL.AddCmd0(IL.opMULS)
  1674. END
  1675. END;
  1676. e.obj := eEXPR
  1677. END
  1678. |SCAN.lxSLASH:
  1679. PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), pos, 37);
  1680. IF (e1.obj = eCONST) & isReal(e1) THEN
  1681. PARS.check(~ARITH.isZero(e1.value), pos, 45)
  1682. END;
  1683. IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1684. CASE e.value.typ OF
  1685. |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), pos, 40)
  1686. |ARITH.tSET: ARITH.opSet(e.value, e1.value, "/")
  1687. END
  1688. ELSE
  1689. IF isReal(e) THEN
  1690. IF e.obj = eCONST THEN
  1691. Float(parser, e);
  1692. IL.AddCmd0(IL.opDIVFI)
  1693. ELSIF e1.obj = eCONST THEN
  1694. Float(parser, e1);
  1695. IL.AddCmd0(IL.opDIVF)
  1696. ELSE
  1697. IL.AddCmd0(IL.opDIVF)
  1698. END
  1699. ELSIF isSet(e) THEN
  1700. IF e.obj = eCONST THEN
  1701. IL.AddCmd(IL.opDIVSC, ARITH.Int(e.value))
  1702. ELSIF e1.obj = eCONST THEN
  1703. IL.AddCmd(IL.opDIVSC, ARITH.Int(e1.value))
  1704. ELSE
  1705. IL.AddCmd0(IL.opDIVS)
  1706. END
  1707. END;
  1708. e.obj := eEXPR
  1709. END
  1710. |SCAN.lxDIV, SCAN.lxMOD:
  1711. PARS.check(isInt(e) & isInt(e1), pos, 37);
  1712. IF e1.obj = eCONST THEN
  1713. PARS.check(ARITH.Int(e1.value) > 0, pos, 122)
  1714. END;
  1715. IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1716. IF op = SCAN.lxDIV THEN
  1717. PARS.check(ARITH.opInt(e.value, e1.value, "D"), pos, 39)
  1718. ELSE
  1719. ASSERT(ARITH.opInt(e.value, e1.value, "M"))
  1720. END
  1721. ELSE
  1722. IF e1.obj # eCONST THEN
  1723. label1 := IL.NewLabel();
  1724. IL.Jmp(IL.opJG, label1)
  1725. END;
  1726. IF e.obj = eCONST THEN
  1727. IL.OnError(pos.line, errDIV);
  1728. IL.SetLabel(label1);
  1729. IL.AddCmd(IL.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value))
  1730. ELSIF e1.obj = eCONST THEN
  1731. IL.AddCmd(IL.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value))
  1732. ELSE
  1733. IL.OnError(pos.line, errDIV);
  1734. IL.SetLabel(label1);
  1735. IL.AddCmd0(IL.opDIV + ORD(op = SCAN.lxMOD))
  1736. END;
  1737. e.obj := eEXPR
  1738. END
  1739. |SCAN.lxAND:
  1740. PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
  1741. IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
  1742. ARITH.opBoolean(e.value, e1.value, "&")
  1743. ELSE
  1744. e.obj := eEXPR;
  1745. IF e1.obj = eCONST THEN
  1746. IL.Const(ORD(ARITH.getBool(e1.value)))
  1747. END
  1748. END
  1749. END
  1750. END;
  1751. IF label # -1 THEN
  1752. label1 := IL.NewLabel();
  1753. IL.Jmp(IL.opJNZ, label1);
  1754. IL.SetLabel(label);
  1755. IL.Const(0);
  1756. IL.drop;
  1757. label := IL.NewLabel();
  1758. IL.Jmp(IL.opJMP, label);
  1759. IL.SetLabel(label1);
  1760. IL.Const(1);
  1761. IL.SetLabel(label);
  1762. IL.AddCmd0(IL.opAND)
  1763. END
  1764. END term;
  1765. PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR);
  1766. VAR
  1767. pos: PARS.POSITION;
  1768. op: INTEGER;
  1769. e1: PARS.EXPR;
  1770. s, s1: SCAN.TEXTSTR;
  1771. plus, minus: BOOLEAN;
  1772. label, label1: INTEGER;
  1773. BEGIN
  1774. plus := parser.sym = SCAN.lxPLUS;
  1775. minus := parser.sym = SCAN.lxMINUS;
  1776. IF plus OR minus THEN
  1777. getpos(parser, pos);
  1778. PARS.Next(parser)
  1779. END;
  1780. term(parser, e);
  1781. IF plus OR minus THEN
  1782. PARS.check(isInt(e) OR isReal(e) OR isSet(e), pos, 36);
  1783. IF minus & (e.obj = eCONST) THEN
  1784. PARS.check(ARITH.neg(e.value), pos, 39)
  1785. END;
  1786. IF e.obj # eCONST THEN
  1787. IF minus THEN
  1788. IF isInt(e) THEN
  1789. IL.AddCmd0(IL.opUMINUS)
  1790. ELSIF isReal(e) THEN
  1791. IL.AddCmd0(IL.opUMINF)
  1792. ELSIF isSet(e) THEN
  1793. IL.AddCmd0(IL.opUMINS)
  1794. END
  1795. END;
  1796. e.obj := eEXPR
  1797. END
  1798. END;
  1799. label := -1;
  1800. WHILE AddOperator(parser.sym) DO
  1801. op := parser.sym;
  1802. getpos(parser, pos);
  1803. PARS.Next(parser);
  1804. IF op = SCAN.lxOR THEN
  1805. IF ~parser.constexp THEN
  1806. IF label = -1 THEN
  1807. label := IL.NewLabel()
  1808. END;
  1809. IF (e.obj = eCONST) & isBoolean(e) THEN
  1810. IL.Const(ORD(ARITH.getBool(e.value)))
  1811. END;
  1812. IL.Jmp(IL.opJNZ, label)
  1813. END
  1814. END;
  1815. term(parser, e1);
  1816. CASE op OF
  1817. |SCAN.lxPLUS, SCAN.lxMINUS:
  1818. minus := op = SCAN.lxMINUS;
  1819. IF minus THEN
  1820. op := ORD("-")
  1821. ELSE
  1822. op := ORD("+")
  1823. END;
  1824. PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1) OR isString(e) & isString(e1) & ~minus, pos, 37);
  1825. IF (e.obj = eCONST) & (e1.obj = eCONST) THEN
  1826. CASE e.value.typ OF
  1827. |ARITH.tINTEGER:
  1828. PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), pos, 39)
  1829. |ARITH.tREAL:
  1830. PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), pos, 40)
  1831. |ARITH.tSET:
  1832. ARITH.opSet(e.value, e1.value, CHR(op))
  1833. |ARITH.tCHAR, ARITH.tSTRING:
  1834. IF e.value.typ = ARITH.tCHAR THEN
  1835. ARITH.charToStr(e.value, s)
  1836. ELSE
  1837. s := e.value.string(SCAN.STRING).s
  1838. END;
  1839. IF e1.value.typ = ARITH.tCHAR THEN
  1840. ARITH.charToStr(e1.value, s1)
  1841. ELSE
  1842. s1 := e1.value.string(SCAN.STRING).s
  1843. END;
  1844. PARS.check(ARITH.concat(s, s1), pos, 5);
  1845. e.value.string := SCAN.enterStr(s);
  1846. e.value.typ := ARITH.tSTRING;
  1847. e._type := PROG.program.stTypes.tSTRING
  1848. END
  1849. ELSE
  1850. IF isInt(e) THEN
  1851. IF e.obj = eCONST THEN
  1852. IL.AddCmd(IL.opADDC - ORD(minus), ARITH.Int(e.value))
  1853. ELSIF e1.obj = eCONST THEN
  1854. IL.AddCmd(IL.opADDC + ORD(minus), ARITH.Int(e1.value))
  1855. ELSE
  1856. IL.AddCmd0(IL.opADD + ORD(minus))
  1857. END
  1858. ELSIF isReal(e) THEN
  1859. IF e.obj = eCONST THEN
  1860. Float(parser, e);
  1861. IL.AddCmd0(IL.opADDF - ORD(minus))
  1862. ELSIF e1.obj = eCONST THEN
  1863. Float(parser, e1);
  1864. IL.AddCmd0(IL.opADDF + ORD(minus))
  1865. ELSE
  1866. IL.AddCmd0(IL.opADDF + ORD(minus))
  1867. END
  1868. ELSIF isSet(e) THEN
  1869. IF e.obj = eCONST THEN
  1870. IL.AddCmd(IL.opADDSC - ORD(minus), ARITH.Int(e.value))
  1871. ELSIF e1.obj = eCONST THEN
  1872. IL.AddCmd(IL.opADDSC + ORD(minus), ARITH.Int(e1.value))
  1873. ELSE
  1874. IL.AddCmd0(IL.opADDS + ORD(minus))
  1875. END
  1876. END;
  1877. e.obj := eEXPR
  1878. END
  1879. |SCAN.lxOR:
  1880. PARS.check(isBoolean(e) & isBoolean(e1), pos, 37);
  1881. IF (e.obj = eCONST) & (e1.obj = eCONST) & parser.constexp THEN
  1882. ARITH.opBoolean(e.value, e1.value, "|")
  1883. ELSE
  1884. e.obj := eEXPR;
  1885. IF e1.obj = eCONST THEN
  1886. IL.Const(ORD(ARITH.getBool(e1.value)))
  1887. END
  1888. END
  1889. END
  1890. END;
  1891. IF label # -1 THEN
  1892. label1 := IL.NewLabel();
  1893. IL.Jmp(IL.opJZ, label1);
  1894. IL.SetLabel(label);
  1895. IL.Const(1);
  1896. IL.drop;
  1897. label := IL.NewLabel();
  1898. IL.Jmp(IL.opJMP, label);
  1899. IL.SetLabel(label1);
  1900. IL.Const(0);
  1901. IL.SetLabel(label);
  1902. IL.AddCmd0(IL.opOR)
  1903. END
  1904. END SimpleExpression;
  1905. PROCEDURE cmpcode (op: INTEGER): INTEGER;
  1906. VAR
  1907. res: INTEGER;
  1908. BEGIN
  1909. CASE op OF
  1910. |SCAN.lxEQ: res := ARITH.opEQ
  1911. |SCAN.lxNE: res := ARITH.opNE
  1912. |SCAN.lxLT: res := ARITH.opLT
  1913. |SCAN.lxLE: res := ARITH.opLE
  1914. |SCAN.lxGT: res := ARITH.opGT
  1915. |SCAN.lxGE: res := ARITH.opGE
  1916. |SCAN.lxIN: res := ARITH.opIN
  1917. |SCAN.lxIS: res := ARITH.opIS
  1918. END
  1919. RETURN res
  1920. END cmpcode;
  1921. PROCEDURE invcmpcode (op: INTEGER): INTEGER;
  1922. VAR
  1923. res: INTEGER;
  1924. BEGIN
  1925. CASE op OF
  1926. |SCAN.lxEQ: res := ARITH.opEQ
  1927. |SCAN.lxNE: res := ARITH.opNE
  1928. |SCAN.lxLT: res := ARITH.opGT
  1929. |SCAN.lxLE: res := ARITH.opGE
  1930. |SCAN.lxGT: res := ARITH.opLT
  1931. |SCAN.lxGE: res := ARITH.opLE
  1932. |SCAN.lxIN: res := ARITH.opIN
  1933. |SCAN.lxIS: res := ARITH.opIS
  1934. END
  1935. RETURN res
  1936. END invcmpcode;
  1937. PROCEDURE BoolCmp (eq, val: BOOLEAN);
  1938. BEGIN
  1939. IF eq = val THEN
  1940. IL.AddCmd0(IL.opNEC)
  1941. ELSE
  1942. IL.AddCmd0(IL.opEQC)
  1943. END
  1944. END BoolCmp;
  1945. PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN;
  1946. VAR
  1947. res: BOOLEAN;
  1948. cmp: INTEGER;
  1949. BEGIN
  1950. res := TRUE;
  1951. cmp := cmpcode(op);
  1952. IF isString(e) & isCharArray(e1) THEN
  1953. IL.StrAdr(String(e));
  1954. IL.Const(strlen(e) + 1);
  1955. IL.AddCmd0(IL.opEQS + invcmpcode(op))
  1956. ELSIF (isString(e) OR isStringW(e)) & isCharArrayW(e1) THEN
  1957. IL.StrAdr(StringW(e));
  1958. IL.Const(utf8strlen(e) + 1);
  1959. IL.AddCmd0(IL.opEQSW + invcmpcode(op))
  1960. ELSIF isCharArray(e) & isString(e1) THEN
  1961. IL.StrAdr(String(e1));
  1962. IL.Const(strlen(e1) + 1);
  1963. IL.AddCmd0(IL.opEQS + cmp)
  1964. ELSIF isCharArrayW(e) & (isString(e1) OR isStringW(e1)) THEN
  1965. IL.StrAdr(StringW(e1));
  1966. IL.Const(utf8strlen(e1) + 1);
  1967. IL.AddCmd0(IL.opEQSW + cmp)
  1968. ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN
  1969. IL.AddCmd0(IL.opEQSW + cmp)
  1970. ELSIF isCharArray(e) & isCharArray(e1) THEN
  1971. IL.AddCmd0(IL.opEQS + cmp)
  1972. ELSIF isString(e) & isString(e1) THEN
  1973. PARS.strcmp(e.value, e1.value, op)
  1974. ELSE
  1975. res := FALSE
  1976. END
  1977. RETURN res
  1978. END strcmp;
  1979. BEGIN
  1980. getpos(parser, pos0);
  1981. SimpleExpression(parser, e);
  1982. IF relation(parser.sym) THEN
  1983. IF (isCharArray(e) OR isCharArrayW(e)) & (e._type.length # 0) THEN
  1984. IL.Const(e._type.length)
  1985. END;
  1986. op := parser.sym;
  1987. getpos(parser, pos);
  1988. PARS.Next(parser);
  1989. getpos(parser, pos1);
  1990. SimpleExpression(parser, e1);
  1991. IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1._type.length # 0) THEN
  1992. IL.Const(e1._type.length)
  1993. END;
  1994. constant := (e.obj = eCONST) & (e1.obj = eCONST);
  1995. error := 0;
  1996. cmp := cmpcode(op);
  1997. CASE op OF
  1998. |SCAN.lxEQ, SCAN.lxNE:
  1999. eq := op = SCAN.lxEQ;
  2000. IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2001. isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2002. isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2003. isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR
  2004. isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e._type, e1._type) OR PROG.isBaseOf(e1._type, e._type)) THEN
  2005. IF constant THEN
  2006. ARITH.relation(e.value, e1.value, cmp, error)
  2007. ELSE
  2008. IF e.obj = eCONST THEN
  2009. IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e.value))
  2010. ELSIF e1.obj = eCONST THEN
  2011. IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
  2012. ELSE
  2013. IL.AddCmd0(IL.opEQ + cmp)
  2014. END
  2015. END
  2016. ELSIF isStringW1(e) & isCharW(e1) THEN
  2017. IL.AddCmd(IL.opEQC + cmp, StrToWChar(e.value.string(SCAN.STRING).s))
  2018. ELSIF isStringW1(e1) & isCharW(e) THEN
  2019. IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
  2020. ELSIF isBoolean(e) & isBoolean(e1) THEN
  2021. IF constant THEN
  2022. ARITH.relation(e.value, e1.value, cmp, error)
  2023. ELSE
  2024. IF e.obj = eCONST THEN
  2025. BoolCmp(eq, ARITH.Int(e.value) # 0)
  2026. ELSIF e1.obj = eCONST THEN
  2027. BoolCmp(eq, ARITH.Int(e1.value) # 0)
  2028. ELSE
  2029. IF eq THEN
  2030. IL.AddCmd0(IL.opEQB)
  2031. ELSE
  2032. IL.AddCmd0(IL.opNEB)
  2033. END
  2034. END
  2035. END
  2036. ELSIF isReal(e) & isReal(e1) THEN
  2037. IF constant THEN
  2038. ARITH.relation(e.value, e1.value, cmp, error)
  2039. ELSE
  2040. IF e.obj = eCONST THEN
  2041. Float(parser, e)
  2042. ELSIF e1.obj = eCONST THEN
  2043. Float(parser, e1)
  2044. END;
  2045. IL.AddCmd0(IL.opEQF + cmp)
  2046. END
  2047. ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2048. IF ~strcmp(e, e1, op) THEN
  2049. PARS.error(pos, 37)
  2050. END
  2051. ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN
  2052. IL.AddCmd0(IL.opEQC + cmp)
  2053. ELSIF isProc(e) & isNil(e1) THEN
  2054. IF e.obj IN {ePROC, eIMP} THEN
  2055. PARS.check(e.ident.global, pos0, 85);
  2056. constant := TRUE;
  2057. e.obj := eCONST;
  2058. ARITH.setbool(e.value, ~eq)
  2059. ELSE
  2060. IL.AddCmd0(IL.opEQC + cmp)
  2061. END
  2062. ELSIF isNil(e) & isProc(e1) THEN
  2063. IF e1.obj IN {ePROC, eIMP} THEN
  2064. PARS.check(e1.ident.global, pos1, 85);
  2065. constant := TRUE;
  2066. e.obj := eCONST;
  2067. ARITH.setbool(e.value, ~eq)
  2068. ELSE
  2069. IL.AddCmd0(IL.opEQC + cmp)
  2070. END
  2071. ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e._type, e1._type) THEN
  2072. IF e.obj = ePROC THEN
  2073. PARS.check(e.ident.global, pos0, 85)
  2074. END;
  2075. IF e1.obj = ePROC THEN
  2076. PARS.check(e1.ident.global, pos1, 85)
  2077. END;
  2078. IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN
  2079. constant := TRUE;
  2080. e.obj := eCONST;
  2081. IF eq THEN
  2082. ARITH.setbool(e.value, e.ident = e1.ident)
  2083. ELSE
  2084. ARITH.setbool(e.value, e.ident # e1.ident)
  2085. END
  2086. ELSIF e.obj = ePROC THEN
  2087. IL.ProcCmp(e.ident.proc.label, eq)
  2088. ELSIF e1.obj = ePROC THEN
  2089. IL.ProcCmp(e1.ident.proc.label, eq)
  2090. ELSIF e.obj = eIMP THEN
  2091. IL.ProcImpCmp(e.ident._import, eq)
  2092. ELSIF e1.obj = eIMP THEN
  2093. IL.ProcImpCmp(e1.ident._import, eq)
  2094. ELSE
  2095. IL.AddCmd0(IL.opEQ + cmp)
  2096. END
  2097. ELSIF isNil(e) & isNil(e1) THEN
  2098. constant := TRUE;
  2099. e.obj := eCONST;
  2100. ARITH.setbool(e.value, eq)
  2101. ELSE
  2102. PARS.error(pos, 37)
  2103. END
  2104. |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE:
  2105. IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR
  2106. isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR
  2107. isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR
  2108. isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN
  2109. IF constant THEN
  2110. ARITH.relation(e.value, e1.value, cmp, error)
  2111. ELSE
  2112. IF e.obj = eCONST THEN
  2113. IL.AddCmd(IL.opEQC + invcmpcode(op), ARITH.Int(e.value))
  2114. ELSIF e1.obj = eCONST THEN
  2115. IL.AddCmd(IL.opEQC + cmp, ARITH.Int(e1.value))
  2116. ELSE
  2117. IL.AddCmd0(IL.opEQ + cmp)
  2118. END
  2119. END
  2120. ELSIF isStringW1(e) & isCharW(e1) THEN
  2121. IL.AddCmd(IL.opEQC + invcmpcode(op), StrToWChar(e.value.string(SCAN.STRING).s))
  2122. ELSIF isStringW1(e1) & isCharW(e) THEN
  2123. IL.AddCmd(IL.opEQC + cmp, StrToWChar(e1.value.string(SCAN.STRING).s))
  2124. ELSIF isReal(e) & isReal(e1) THEN
  2125. IF constant THEN
  2126. ARITH.relation(e.value, e1.value, cmp, error)
  2127. ELSE
  2128. IF e.obj = eCONST THEN
  2129. Float(parser, e);
  2130. IL.AddCmd0(IL.opEQF + invcmpcode(op))
  2131. ELSIF e1.obj = eCONST THEN
  2132. Float(parser, e1);
  2133. IL.AddCmd0(IL.opEQF + cmp)
  2134. ELSE
  2135. IL.AddCmd0(IL.opEQF + cmp)
  2136. END
  2137. END
  2138. ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN
  2139. IF ~strcmp(e, e1, op) THEN
  2140. PARS.error(pos, 37)
  2141. END
  2142. ELSE
  2143. PARS.error(pos, 37)
  2144. END
  2145. |SCAN.lxIN:
  2146. PARS.check(isInt(e) & isSet(e1), pos, 37);
  2147. IF e.obj = eCONST THEN
  2148. PARS.check(ARITH.range(e.value, 0, UTILS.target.maxSet), pos0, 56)
  2149. END;
  2150. IF constant THEN
  2151. ARITH.relation(e.value, e1.value, ARITH.opIN, error)
  2152. ELSE
  2153. IF e.obj = eCONST THEN
  2154. IL.AddCmd(IL.opINL, ARITH.Int(e.value))
  2155. ELSIF e1.obj = eCONST THEN
  2156. IL.AddCmd(IL.opINR, ARITH.Int(e1.value))
  2157. ELSE
  2158. IL.AddCmd0(IL.opIN)
  2159. END
  2160. END
  2161. |SCAN.lxIS:
  2162. PARS.check(isRecPtr(e), pos, 73);
  2163. PARS.check(e1.obj = eTYPE, pos1, 79);
  2164. IF isRec(e) THEN
  2165. PARS.check(e.obj = eVREC, pos0, 78);
  2166. PARS.check(e1._type.typ = PROG.tRECORD, pos1, 80);
  2167. IF e.ident = NIL THEN
  2168. IL.TypeCheck(e1._type.num)
  2169. ELSE
  2170. IL.AddCmd(IL.opVADR, e.ident.offset - 1);
  2171. IL.TypeCheckRec(e1._type.num)
  2172. END
  2173. ELSE
  2174. PARS.check(e1._type.typ = PROG.tPOINTER, pos1, 81);
  2175. IL.TypeCheck(e1._type.base.num)
  2176. END;
  2177. PARS.check(PROG.isBaseOf(e._type, e1._type), pos1, 82)
  2178. END;
  2179. ASSERT(error = 0);
  2180. e._type := tBOOLEAN;
  2181. IF ~constant THEN
  2182. e.obj := eEXPR
  2183. END
  2184. END
  2185. END expression;
  2186. PROCEDURE ElementaryStatement (parser: PARS.PARSER);
  2187. VAR
  2188. e, e1: PARS.EXPR;
  2189. pos: PARS.POSITION;
  2190. line: INTEGER;
  2191. call: BOOLEAN;
  2192. BEGIN
  2193. getpos(parser, pos);
  2194. IL.pushBegEnd(begcall, endcall);
  2195. designator(parser, e);
  2196. IF parser.sym = SCAN.lxASSIGN THEN
  2197. line := parser.lex.pos.line;
  2198. PARS.check(isVar(e), pos, 93);
  2199. PARS.check(~e.readOnly, pos, 94);
  2200. IL.setlast(begcall);
  2201. NextPos(parser, pos);
  2202. expression(parser, e1);
  2203. IF (e._type.typ = PROG.tBYTE) & (e1.obj # eCONST) & (e1._type.typ = PROG.tINTEGER) & (chkBYTE IN Options.checking) THEN
  2204. CheckRange(256, pos.line, errBYTE)
  2205. END;
  2206. IL.setlast(endcall.prev(IL.COMMAND));
  2207. PARS.check(assign(parser, e1, e._type, line), pos, 91);
  2208. IF e1.obj = ePROC THEN
  2209. PARS.check(e1.ident.global, pos, 85)
  2210. END;
  2211. call := FALSE
  2212. ELSIF parser.sym = SCAN.lxEQ THEN
  2213. PARS.check1(FALSE, parser, 96)
  2214. ELSIF parser.sym = SCAN.lxLROUND THEN
  2215. e1 := e;
  2216. ActualParameters(parser, e1);
  2217. PARS.check((e1._type = NIL) OR ODD(e._type.call), pos, 92);
  2218. call := TRUE
  2219. ELSE
  2220. IF e.obj IN {eSYSPROC, eSTPROC} THEN
  2221. stProc(parser, e);
  2222. call := FALSE
  2223. ELSE
  2224. PARS.check(isProc(e), pos, 86);
  2225. PARS.check((e._type.base = NIL) OR ODD(e._type.call), pos, 92);
  2226. PARS.check1(e._type.params.first = NIL, parser, 64);
  2227. call := TRUE
  2228. END
  2229. END;
  2230. IF call THEN
  2231. IF e.obj IN {ePROC, eIMP} THEN
  2232. ProcCall(e, e.ident._type, FALSE, parser, pos, TRUE)
  2233. ELSIF isExpr(e) THEN
  2234. ProcCall(e, e._type, FALSE, parser, pos, TRUE)
  2235. END
  2236. END;
  2237. IL.popBegEnd(begcall, endcall)
  2238. END ElementaryStatement;
  2239. PROCEDURE IfStatement (parser: PARS.PARSER; _if: BOOLEAN);
  2240. VAR
  2241. e: PARS.EXPR;
  2242. pos: PARS.POSITION;
  2243. label, L: INTEGER;
  2244. BEGIN
  2245. L := IL.NewLabel();
  2246. IF ~_if THEN
  2247. IL.AddCmd(IL.opNOP, IL.begin_loop);
  2248. IL.SetLabel(L)
  2249. END;
  2250. REPEAT
  2251. NextPos(parser, pos);
  2252. label := IL.NewLabel();
  2253. expression(parser, e);
  2254. PARS.check(isBoolean(e), pos, 72);
  2255. IF e.obj = eCONST THEN
  2256. IF ~ARITH.getBool(e.value) THEN
  2257. IL.Jmp(IL.opJMP, label)
  2258. END
  2259. ELSE
  2260. IL.AndOrOpt(label)
  2261. END;
  2262. IF _if THEN
  2263. PARS.checklex(parser, SCAN.lxTHEN)
  2264. ELSE
  2265. PARS.checklex(parser, SCAN.lxDO)
  2266. END;
  2267. PARS.Next(parser);
  2268. parser.StatSeq(parser);
  2269. IF ~_if OR (parser.sym # SCAN.lxEND) THEN
  2270. IL.Jmp(IL.opJMP, L)
  2271. END;
  2272. IL.SetLabel(label)
  2273. UNTIL parser.sym # SCAN.lxELSIF;
  2274. IF _if THEN
  2275. IF parser.sym = SCAN.lxELSE THEN
  2276. PARS.Next(parser);
  2277. parser.StatSeq(parser)
  2278. END;
  2279. IL.SetLabel(L)
  2280. ELSE
  2281. IL.AddCmd(IL.opNOP, IL.end_loop)
  2282. END;
  2283. PARS.checklex(parser, SCAN.lxEND);
  2284. PARS.Next(parser)
  2285. END IfStatement;
  2286. PROCEDURE RepeatStatement (parser: PARS.PARSER);
  2287. VAR
  2288. e: PARS.EXPR;
  2289. pos: PARS.POSITION;
  2290. label: INTEGER;
  2291. L: IL.COMMAND;
  2292. BEGIN
  2293. IL.AddCmd(IL.opNOP, IL.begin_loop);
  2294. label := IL.NewLabel();
  2295. IL.SetLabel(label);
  2296. L := IL.getlast();
  2297. PARS.Next(parser);
  2298. parser.StatSeq(parser);
  2299. PARS.checklex(parser, SCAN.lxUNTIL);
  2300. NextPos(parser, pos);
  2301. expression(parser, e);
  2302. PARS.check(isBoolean(e), pos, 72);
  2303. IF e.obj = eCONST THEN
  2304. IF ~ARITH.getBool(e.value) THEN
  2305. IL.Jmp(IL.opJMP, label)
  2306. END
  2307. ELSE
  2308. IL.AndOrOpt(label);
  2309. L.param1 := label
  2310. END;
  2311. IL.AddCmd(IL.opNOP, IL.end_loop)
  2312. END RepeatStatement;
  2313. PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER;
  2314. VAR
  2315. La, Ra, Lb, Rb, res: INTEGER;
  2316. BEGIN
  2317. La := a(CASE_LABEL).range.a;
  2318. Ra := a(CASE_LABEL).range.b;
  2319. Lb := b(CASE_LABEL).range.a;
  2320. Rb := b(CASE_LABEL).range.b;
  2321. IF (Ra < Lb) OR (La > Rb) THEN
  2322. res := ORD(La > Lb) - ORD(La < Lb)
  2323. ELSE
  2324. res := 0
  2325. END
  2326. RETURN res
  2327. END LabelCmp;
  2328. PROCEDURE DestroyLabel (VAR label: AVL.DATA);
  2329. BEGIN
  2330. C.push(CaseLabels, label);
  2331. label := NIL
  2332. END DestroyLabel;
  2333. PROCEDURE NewVariant (label: INTEGER; cmd: IL.COMMAND): CASE_VARIANT;
  2334. VAR
  2335. res: CASE_VARIANT;
  2336. citem: C.ITEM;
  2337. BEGIN
  2338. citem := C.pop(CaseVar);
  2339. IF citem = NIL THEN
  2340. NEW(res)
  2341. ELSE
  2342. res := citem(CASE_VARIANT)
  2343. END;
  2344. res.label := label;
  2345. res.cmd := cmd;
  2346. res.processed := FALSE
  2347. RETURN res
  2348. END NewVariant;
  2349. PROCEDURE CaseStatement (parser: PARS.PARSER);
  2350. VAR
  2351. e: PARS.EXPR;
  2352. pos: PARS.POSITION;
  2353. PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR _type: PROG._TYPE): INTEGER;
  2354. VAR
  2355. a: INTEGER;
  2356. label: PARS.EXPR;
  2357. pos: PARS.POSITION;
  2358. value: ARITH.VALUE;
  2359. BEGIN
  2360. getpos(parser, pos);
  2361. _type := NIL;
  2362. IF isChar(caseExpr) THEN
  2363. PARS.ConstExpression(parser, value);
  2364. PARS.check(value.typ = ARITH.tCHAR, pos, 99);
  2365. a := ARITH.getInt(value)
  2366. ELSIF isCharW(caseExpr) THEN
  2367. PARS.ConstExpression(parser, value);
  2368. IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.STRING).s) = 1) & (LENGTH(value.string(SCAN.STRING).s) > 1) THEN
  2369. ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.STRING).s)))
  2370. ELSE
  2371. PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, pos, 99)
  2372. END;
  2373. a := ARITH.getInt(value)
  2374. ELSIF isInt(caseExpr) THEN
  2375. PARS.ConstExpression(parser, value);
  2376. PARS.check(value.typ = ARITH.tINTEGER, pos, 99);
  2377. a := ARITH.getInt(value)
  2378. ELSIF isRecPtr(caseExpr) THEN
  2379. qualident(parser, label);
  2380. PARS.check(label.obj = eTYPE, pos, 79);
  2381. PARS.check(PROG.isBaseOf(caseExpr._type, label._type), pos, 99);
  2382. IF isRec(caseExpr) THEN
  2383. a := label._type.num
  2384. ELSE
  2385. a := label._type.base.num
  2386. END;
  2387. _type := label._type
  2388. END
  2389. RETURN a
  2390. END Label;
  2391. PROCEDURE CheckType (node: AVL.NODE; _type: PROG._TYPE; parser: PARS.PARSER; pos: PARS.POSITION);
  2392. BEGIN
  2393. IF node # NIL THEN
  2394. PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL)._type, _type) OR PROG.isBaseOf(_type, node.data(CASE_LABEL)._type)), pos, 100);
  2395. CheckType(node.left, _type, parser, pos);
  2396. CheckType(node.right, _type, parser, pos)
  2397. END
  2398. END CheckType;
  2399. PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2400. VAR
  2401. label: CASE_LABEL;
  2402. citem: C.ITEM;
  2403. pos, pos1: PARS.POSITION;
  2404. node: AVL.NODE;
  2405. newnode: BOOLEAN;
  2406. range: RANGE;
  2407. BEGIN
  2408. citem := C.pop(CaseLabels);
  2409. IF citem = NIL THEN
  2410. NEW(label)
  2411. ELSE
  2412. label := citem(CASE_LABEL)
  2413. END;
  2414. label.variant := variant;
  2415. label.self := IL.NewLabel();
  2416. getpos(parser, pos1);
  2417. range.a := Label(parser, caseExpr, label._type);
  2418. IF parser.sym = SCAN.lxRANGE THEN
  2419. PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2420. NextPos(parser, pos);
  2421. range.b := Label(parser, caseExpr, label._type);
  2422. PARS.check(range.a <= range.b, pos, 103)
  2423. ELSE
  2424. range.b := range.a
  2425. END;
  2426. label.range := range;
  2427. IF isRecPtr(caseExpr) THEN
  2428. CheckType(tree, label._type, parser, pos1)
  2429. END;
  2430. tree := AVL.insert(tree, label, LabelCmp, newnode, node);
  2431. PARS.check(newnode, pos1, 100)
  2432. RETURN node
  2433. END LabelRange;
  2434. PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE;
  2435. VAR
  2436. exit: BOOLEAN;
  2437. res: AVL.NODE;
  2438. BEGIN
  2439. exit := FALSE;
  2440. REPEAT
  2441. res := LabelRange(parser, caseExpr, tree, variant);
  2442. IF parser.sym = SCAN.lxCOMMA THEN
  2443. PARS.check1(~isRecPtr(caseExpr), parser, 53);
  2444. PARS.Next(parser)
  2445. ELSE
  2446. exit := TRUE
  2447. END
  2448. UNTIL exit
  2449. RETURN res
  2450. END CaseLabelList;
  2451. PROCEDURE _case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; _end: INTEGER);
  2452. VAR
  2453. sym: INTEGER;
  2454. t: PROG._TYPE;
  2455. variant: INTEGER;
  2456. node: AVL.NODE;
  2457. last: IL.COMMAND;
  2458. BEGIN
  2459. sym := parser.sym;
  2460. IF sym # SCAN.lxBAR THEN
  2461. variant := IL.NewLabel();
  2462. node := CaseLabelList(parser, caseExpr, tree, variant);
  2463. PARS.checklex(parser, SCAN.lxCOLON);
  2464. PARS.Next(parser);
  2465. IF isRecPtr(caseExpr) THEN
  2466. t := caseExpr._type;
  2467. caseExpr.ident._type := node.data(CASE_LABEL)._type
  2468. END;
  2469. last := IL.getlast();
  2470. IL.SetLabel(variant);
  2471. IF ~isRecPtr(caseExpr) THEN
  2472. LISTS.push(CaseVariants, NewVariant(variant, last))
  2473. END;
  2474. parser.StatSeq(parser);
  2475. IL.Jmp(IL.opJMP, _end);
  2476. IF isRecPtr(caseExpr) THEN
  2477. caseExpr.ident._type := t
  2478. END
  2479. END
  2480. END _case;
  2481. PROCEDURE Table (node: AVL.NODE; _else: INTEGER);
  2482. VAR
  2483. L, R: INTEGER;
  2484. range: RANGE;
  2485. left, right: AVL.NODE;
  2486. last: IL.COMMAND;
  2487. v: CASE_VARIANT;
  2488. BEGIN
  2489. IF node # NIL THEN
  2490. range := node.data(CASE_LABEL).range;
  2491. left := node.left;
  2492. IF left # NIL THEN
  2493. L := left.data(CASE_LABEL).self
  2494. ELSE
  2495. L := _else
  2496. END;
  2497. right := node.right;
  2498. IF right # NIL THEN
  2499. R := right.data(CASE_LABEL).self
  2500. ELSE
  2501. R := _else
  2502. END;
  2503. last := IL.getlast();
  2504. v := CaseVariants.last(CASE_VARIANT);
  2505. WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO
  2506. v := v.prev(CASE_VARIANT)
  2507. END;
  2508. ASSERT((v # NIL) & (v.label # 0));
  2509. IL.setlast(v.cmd);
  2510. IL.SetLabel(node.data(CASE_LABEL).self);
  2511. IL._case(range.a, range.b, L, R);
  2512. IF v.processed THEN
  2513. IL.Jmp(IL.opJMP, node.data(CASE_LABEL).variant)
  2514. END;
  2515. v.processed := TRUE;
  2516. IL.setlast(last);
  2517. Table(left, _else);
  2518. Table(right, _else)
  2519. END
  2520. END Table;
  2521. PROCEDURE TableT (node: AVL.NODE);
  2522. BEGIN
  2523. IF node # NIL THEN
  2524. IL.AddCmd2(IL.opCASET, node.data(CASE_LABEL).variant, node.data(CASE_LABEL).range.a);
  2525. TableT(node.left);
  2526. TableT(node.right)
  2527. END
  2528. END TableT;
  2529. PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: PARS.POSITION);
  2530. VAR
  2531. table, _end, _else: INTEGER;
  2532. tree: AVL.NODE;
  2533. item: LISTS.ITEM;
  2534. BEGIN
  2535. LISTS.push(CaseVariants, NewVariant(0, NIL));
  2536. _end := IL.NewLabel();
  2537. _else := IL.NewLabel();
  2538. table := IL.NewLabel();
  2539. IL.AddCmd(IL.opSWITCH, ORD(isRecPtr(e)));
  2540. IL.Jmp(IL.opJMP, table);
  2541. tree := NIL;
  2542. _case(parser, e, tree, _end);
  2543. WHILE parser.sym = SCAN.lxBAR DO
  2544. PARS.Next(parser);
  2545. _case(parser, e, tree, _end)
  2546. END;
  2547. IL.SetLabel(_else);
  2548. IF parser.sym = SCAN.lxELSE THEN
  2549. PARS.Next(parser);
  2550. parser.StatSeq(parser);
  2551. IL.Jmp(IL.opJMP, _end)
  2552. ELSE
  2553. IL.OnError(pos.line, errCASE)
  2554. END;
  2555. PARS.checklex(parser, SCAN.lxEND);
  2556. PARS.Next(parser);
  2557. IF isRecPtr(e) THEN
  2558. IL.SetLabel(table);
  2559. TableT(tree);
  2560. IL.Jmp(IL.opJMP, _else)
  2561. ELSE
  2562. tree.data(CASE_LABEL).self := table;
  2563. Table(tree, _else)
  2564. END;
  2565. AVL.destroy(tree, DestroyLabel);
  2566. IL.SetLabel(_end);
  2567. IL.AddCmd0(IL.opENDSW);
  2568. REPEAT
  2569. item := LISTS.pop(CaseVariants);
  2570. C.push(CaseVar, item)
  2571. UNTIL item(CASE_VARIANT).cmd = NIL
  2572. END ParseCase;
  2573. BEGIN
  2574. NextPos(parser, pos);
  2575. expression(parser, e);
  2576. PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), pos, 95);
  2577. IF isRecPtr(e) THEN
  2578. PARS.check(isVar(e), pos, 93);
  2579. PARS.check(e.ident # NIL, pos, 106)
  2580. END;
  2581. IF isRec(e) THEN
  2582. PARS.check(e.obj = eVREC, pos, 78)
  2583. END;
  2584. IF e.obj = eCONST THEN
  2585. LoadConst(e)
  2586. ELSIF isRec(e) THEN
  2587. IL.drop;
  2588. IL.AddCmd(IL.opLADR, e.ident.offset - 1);
  2589. IL.load(TARGETS.WordSize)
  2590. ELSIF isPtr(e) THEN
  2591. deref(pos, e, FALSE, errPTR);
  2592. IL.AddCmd(IL.opSUBR, TARGETS.WordSize);
  2593. IL.load(TARGETS.WordSize)
  2594. END;
  2595. PARS.checklex(parser, SCAN.lxOF);
  2596. PARS.Next(parser);
  2597. ParseCase(parser, e, pos)
  2598. END CaseStatement;
  2599. PROCEDURE ForStatement (parser: PARS.PARSER);
  2600. VAR
  2601. e: PARS.EXPR;
  2602. pos, pos2: PARS.POSITION;
  2603. step: ARITH.VALUE;
  2604. st: INTEGER;
  2605. ident: PROG.IDENT;
  2606. offset: INTEGER;
  2607. L1, L2: INTEGER;
  2608. BEGIN
  2609. IL.AddCmd(IL.opNOP, IL.begin_loop);
  2610. L1 := IL.NewLabel();
  2611. L2 := IL.NewLabel();
  2612. PARS.ExpectSym(parser, SCAN.lxIDENT);
  2613. ident := PROG.getIdent(parser.unit, parser.lex.ident, TRUE);
  2614. PARS.check1(ident # NIL, parser, 48);
  2615. PARS.check1(ident.typ = PROG.idVAR, parser, 93);
  2616. PARS.check1(ident._type = tINTEGER, parser, 97);
  2617. PARS.ExpectSym(parser, SCAN.lxASSIGN);
  2618. NextPos(parser, pos);
  2619. expression(parser, e);
  2620. PARS.check(isInt(e), pos, 76);
  2621. offset := PROG.getOffset(ident);
  2622. IF ident.global THEN
  2623. IL.AddCmd(IL.opGADR, offset)
  2624. ELSE
  2625. IL.AddCmd(IL.opLADR, -offset)
  2626. END;
  2627. IF e.obj = eCONST THEN
  2628. IL.AddCmd(IL.opSAVEC, ARITH.Int(e.value))
  2629. ELSE
  2630. IL.AddCmd0(IL.opSAVE)
  2631. END;
  2632. IL.SetLabel(L1);
  2633. IF ident.global THEN
  2634. IL.AddCmd(IL.opGADR, offset)
  2635. ELSE
  2636. IL.AddCmd(IL.opLADR, -offset)
  2637. END;
  2638. IL.load(ident._type.size);
  2639. PARS.checklex(parser, SCAN.lxTO);
  2640. NextPos(parser, pos2);
  2641. expression(parser, e);
  2642. PARS.check(isInt(e), pos2, 76);
  2643. IF parser.sym = SCAN.lxBY THEN
  2644. NextPos(parser, pos);
  2645. PARS.ConstExpression(parser, step);
  2646. PARS.check(step.typ = ARITH.tINTEGER, pos, 76);
  2647. st := ARITH.getInt(step);
  2648. PARS.check(st # 0, pos, 98)
  2649. ELSE
  2650. st := 1
  2651. END;
  2652. IF e.obj = eCONST THEN
  2653. IF st > 0 THEN
  2654. IL.AddCmd(IL.opLEC, ARITH.Int(e.value));
  2655. IF ARITH.Int(e.value) = UTILS.target.maxInt THEN
  2656. ERRORS.WarningMsg(pos2.line, pos2.col, 1)
  2657. END
  2658. ELSE
  2659. IL.AddCmd(IL.opGEC, ARITH.Int(e.value));
  2660. IF ARITH.Int(e.value) = UTILS.target.minInt THEN
  2661. ERRORS.WarningMsg(pos2.line, pos2.col, 1)
  2662. END
  2663. END
  2664. ELSE
  2665. IF st > 0 THEN
  2666. IL.AddCmd0(IL.opLE)
  2667. ELSE
  2668. IL.AddCmd0(IL.opGE)
  2669. END
  2670. END;
  2671. IL.Jmp(IL.opJZ, L2);
  2672. PARS.checklex(parser, SCAN.lxDO);
  2673. PARS.Next(parser);
  2674. parser.StatSeq(parser);
  2675. IF ident.global THEN
  2676. IL.AddCmd(IL.opGADR, offset)
  2677. ELSE
  2678. IL.AddCmd(IL.opLADR, -offset)
  2679. END;
  2680. IL.AddCmd(IL.opINCC, st);
  2681. IL.Jmp(IL.opJMP, L1);
  2682. PARS.checklex(parser, SCAN.lxEND);
  2683. PARS.Next(parser);
  2684. IL.SetLabel(L2);
  2685. IL.AddCmd(IL.opNOP, IL.end_loop)
  2686. END ForStatement;
  2687. PROCEDURE statement (parser: PARS.PARSER);
  2688. VAR
  2689. sym: INTEGER;
  2690. BEGIN
  2691. sym := parser.sym;
  2692. IF sym = SCAN.lxIDENT THEN
  2693. ElementaryStatement(parser)
  2694. ELSIF sym = SCAN.lxIF THEN
  2695. IfStatement(parser, TRUE)
  2696. ELSIF sym = SCAN.lxWHILE THEN
  2697. IfStatement(parser, FALSE)
  2698. ELSIF sym = SCAN.lxREPEAT THEN
  2699. RepeatStatement(parser)
  2700. ELSIF sym = SCAN.lxCASE THEN
  2701. CaseStatement(parser)
  2702. ELSIF sym = SCAN.lxFOR THEN
  2703. ForStatement(parser)
  2704. END
  2705. END statement;
  2706. PROCEDURE StatSeq (parser: PARS.PARSER);
  2707. BEGIN
  2708. statement(parser);
  2709. WHILE parser.sym = SCAN.lxSEMI DO
  2710. PARS.Next(parser);
  2711. statement(parser)
  2712. END
  2713. END StatSeq;
  2714. PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG._TYPE; pos: PARS.POSITION): BOOLEAN;
  2715. VAR
  2716. res: BOOLEAN;
  2717. BEGIN
  2718. res := assigncomp(e, t);
  2719. IF res THEN
  2720. IF e.obj = eCONST THEN
  2721. IF e._type = tREAL THEN
  2722. Float(parser, e)
  2723. ELSIF e._type.typ = PROG.tNIL THEN
  2724. IL.Const(0)
  2725. ELSE
  2726. LoadConst(e)
  2727. END
  2728. ELSIF (e._type = tINTEGER) & (t = tBYTE) & (chkBYTE IN Options.checking) THEN
  2729. CheckRange(256, pos.line, errBYTE)
  2730. ELSIF e.obj = ePROC THEN
  2731. PARS.check(e.ident.global, pos, 85);
  2732. IL.PushProc(e.ident.proc.label)
  2733. ELSIF e.obj = eIMP THEN
  2734. IL.PushImpProc(e.ident._import)
  2735. END
  2736. END
  2737. RETURN res
  2738. END chkreturn;
  2739. PROCEDURE setrtl;
  2740. VAR
  2741. rtl: PROG.UNIT;
  2742. PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.IDSTR; idx: INTEGER);
  2743. VAR
  2744. id: PROG.IDENT;
  2745. ident: SCAN.IDENT;
  2746. BEGIN
  2747. SCAN.setIdent(ident, name);
  2748. id := PROG.getIdent(rtl, ident, FALSE);
  2749. IF (id # NIL) & (id._import # NIL) THEN
  2750. IL.set_rtl(idx, -id._import(IL.IMPORT_PROC).label);
  2751. id.proc.used := TRUE
  2752. ELSIF (id # NIL) & (id.proc # NIL) THEN
  2753. IL.set_rtl(idx, id.proc.label);
  2754. id.proc.used := TRUE
  2755. ELSE
  2756. ERRORS.WrongRTL(name)
  2757. END
  2758. END getproc;
  2759. BEGIN
  2760. rtl := PROG.program.rtl;
  2761. ASSERT(rtl # NIL);
  2762. getproc(rtl, "_strcmp", IL._strcmp);
  2763. getproc(rtl, "_length", IL._length);
  2764. getproc(rtl, "_arrcpy", IL._arrcpy);
  2765. getproc(rtl, "_is", IL._is);
  2766. getproc(rtl, "_guard", IL._guard);
  2767. getproc(rtl, "_guardrec", IL._guardrec);
  2768. getproc(rtl, "_new", IL._new);
  2769. getproc(rtl, "_rot", IL._rot);
  2770. getproc(rtl, "_strcpy", IL._strcpy);
  2771. getproc(rtl, "_move", IL._move);
  2772. getproc(rtl, "_set", IL._set);
  2773. getproc(rtl, "_set1", IL._set1);
  2774. getproc(rtl, "_lengthw", IL._lengthw);
  2775. getproc(rtl, "_strcmpw", IL._strcmpw);
  2776. getproc(rtl, "_init", IL._init);
  2777. IF CPU IN {TARGETS.cpuX86, TARGETS.cpuAMD64} THEN
  2778. getproc(rtl, "_error", IL._error);
  2779. getproc(rtl, "_divmod", IL._divmod);
  2780. getproc(rtl, "_exit", IL._exit);
  2781. getproc(rtl, "_dispose", IL._dispose);
  2782. getproc(rtl, "_isrec", IL._isrec);
  2783. getproc(rtl, "_dllentry", IL._dllentry);
  2784. getproc(rtl, "_sofinit", IL._sofinit)
  2785. ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
  2786. getproc(rtl, "_fmul", IL._fmul);
  2787. getproc(rtl, "_fdiv", IL._fdiv);
  2788. getproc(rtl, "_fdivi", IL._fdivi);
  2789. getproc(rtl, "_fadd", IL._fadd);
  2790. getproc(rtl, "_fsub", IL._fsub);
  2791. getproc(rtl, "_fsubi", IL._fsubi);
  2792. getproc(rtl, "_fcmp", IL._fcmp);
  2793. getproc(rtl, "_floor", IL._floor);
  2794. getproc(rtl, "_flt", IL._flt);
  2795. getproc(rtl, "_pack", IL._pack);
  2796. getproc(rtl, "_unpk", IL._unpk);
  2797. IF CPU IN {TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN
  2798. getproc(rtl, "_error", IL._error)
  2799. END
  2800. END
  2801. END setrtl;
  2802. PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target: INTEGER; options: PROG.OPTIONS);
  2803. VAR
  2804. parser: PARS.PARSER;
  2805. ext: PARS.PATH;
  2806. BEGIN
  2807. tINTEGER := PROG.program.stTypes.tINTEGER;
  2808. tBYTE := PROG.program.stTypes.tBYTE;
  2809. tCHAR := PROG.program.stTypes.tCHAR;
  2810. tSET := PROG.program.stTypes.tSET;
  2811. tBOOLEAN := PROG.program.stTypes.tBOOLEAN;
  2812. tWCHAR := PROG.program.stTypes.tWCHAR;
  2813. tREAL := PROG.program.stTypes.tREAL;
  2814. Options := options;
  2815. CPU := TARGETS.CPU;
  2816. ext := UTILS.FILE_EXT;
  2817. CaseLabels := C.create();
  2818. CaseVar := C.create();
  2819. CaseVariants := LISTS.create(NIL);
  2820. LISTS.push(CaseVariants, NewVariant(0, NIL));
  2821. IL.init(CPU);
  2822. IF TARGETS.RTL THEN
  2823. parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  2824. IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
  2825. parser.parse(parser);
  2826. PARS.destroy(parser)
  2827. ELSE
  2828. PARS.destroy(parser);
  2829. parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn);
  2830. IF parser.open(parser, UTILS.RTL_NAME, UTILS.FILE_EXT) THEN
  2831. parser.parse(parser);
  2832. PARS.destroy(parser)
  2833. ELSE
  2834. ERRORS.FileNotFound(lib_path, UTILS.RTL_NAME, UTILS.FILE_EXT)
  2835. END
  2836. END
  2837. END;
  2838. parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn);
  2839. parser.main := TRUE;
  2840. IF parser.open(parser, modname, UTILS.FILE_EXT) THEN
  2841. parser.parse(parser)
  2842. ELSE
  2843. ERRORS.FileNotFound(path, modname, UTILS.FILE_EXT)
  2844. END;
  2845. PARS.destroy(parser);
  2846. IF PROG.program.bss > UTILS.MAX_GLOBAL_SIZE THEN
  2847. ERRORS.Error(204)
  2848. END;
  2849. IF TARGETS.RTL THEN
  2850. setrtl
  2851. END;
  2852. PROG.DelUnused(IL.DelImport);
  2853. IL.set_bss(PROG.program.bss);
  2854. CASE CPU OF
  2855. |TARGETS.cpuAMD64: AMD64.CodeGen(outname, target, options)
  2856. |TARGETS.cpuX86: X86.CodeGen(outname, target, options)
  2857. |TARGETS.cpuMSP430: MSP430.CodeGen(outname, target, options)
  2858. |TARGETS.cpuTHUMB: THUMB.CodeGen(outname, target, options)
  2859. |TARGETS.cpuRVM32I,
  2860. TARGETS.cpuRVM64I: RVMxI.CodeGen(outname, target, options)
  2861. END
  2862. END compile;
  2863. END STATEMENTS.