STATEMENTS.ob07 114 KB

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