From 82d72daa768575ba64e91a9a9521131a24450843 Mon Sep 17 00:00:00 2001 From: Anton Krotov Date: Mon, 11 Mar 2019 08:59:55 +0000 Subject: [PATCH] Oberon07: upload new compiler git-svn-id: svn://kolibrios.org@7597 a494cfbc-eb01-0410-851d-a64ba20cac60 --- programs/develop/oberon07/Compiler.kex | Bin 34834 -> 237149 bytes programs/develop/oberon07/Docs/About1251.txt | 1054 ++--- programs/develop/oberon07/Docs/About866.txt | 872 ---- programs/develop/oberon07/Docs/KOSLib1251.txt | 563 +++ .../Docs/Oberon07.Report_2016_05_03.pdf | Bin 0 -> 70214 bytes .../develop/oberon07/Docs/Oberon07.report.fb2 | 693 --- .../develop/oberon07/Lib/KolibriOS/API.ob07 | 289 +- .../develop/oberon07/Lib/KolibriOS/Args.ob07 | 20 +- .../oberon07/Lib/KolibriOS/ColorDlg.ob07 | 12 +- .../oberon07/Lib/KolibriOS/Console.ob07 | 78 +- .../oberon07/Lib/KolibriOS/ConsoleLib.ob07 | 76 +- .../oberon07/Lib/KolibriOS/DateTime.ob07 | 67 +- .../develop/oberon07/Lib/KolibriOS/Debug.ob07 | 106 +- .../develop/oberon07/Lib/KolibriOS/File.ob07 | 455 +- .../develop/oberon07/Lib/KolibriOS/HOST.ob07 | 617 ++- .../develop/oberon07/Lib/KolibriOS/In.ob07 | 114 +- .../oberon07/Lib/KolibriOS/KOSAPI.ob07 | 610 +-- .../develop/oberon07/Lib/KolibriOS/Math.ob07 | 437 +- .../oberon07/Lib/KolibriOS/OpenDlg.ob07 | 12 +- .../develop/oberon07/Lib/KolibriOS/Out.ob07 | 104 +- .../develop/oberon07/Lib/KolibriOS/RTL.ob07 | 838 +++- .../oberon07/Lib/KolibriOS/RasterWorks.ob07 | 60 +- .../develop/oberon07/Lib/KolibriOS/Read.ob07 | 8 +- .../develop/oberon07/Lib/KolibriOS/Write.ob07 | 8 +- .../oberon07/Lib/KolibriOS/kfonts.ob07 | 187 +- .../oberon07/Lib/KolibriOS/libimg.ob07 | 122 +- .../develop/oberon07/Lib/Linux32/API.ob07 | 227 +- .../develop/oberon07/Lib/Linux32/HOST.ob07 | 251 +- .../develop/oberon07/Lib/Linux32/LINAPI.ob07 | 141 + .../develop/oberon07/Lib/Linux32/RTL.ob07 | 836 +++- .../develop/oberon07/Lib/Windows32/API.ob07 | 94 +- .../develop/oberon07/Lib/Windows32/HOST.ob07 | 396 +- .../develop/oberon07/Lib/Windows32/RTL.ob07 | 844 +++- .../develop/oberon07/Samples/Dialogs.ob07 | 12 +- programs/develop/oberon07/Samples/HW.ob07 | 12 +- programs/develop/oberon07/Samples/HW_con.ob07 | 94 +- .../develop/oberon07/Samples/RasterW.ob07 | 159 - programs/develop/oberon07/Samples/kfont.ob07 | 175 - .../develop/oberon07/Samples/lib_img.ob07 | 97 - .../develop/oberon07/Samples/vector_ex.ob07 | 57 - programs/develop/oberon07/Source/AMD64.ob07 | 2782 +++++++++++ programs/develop/oberon07/Source/ARITH.ob07 | 861 ++++ .../develop/oberon07/Source/AVLTREES.ob07 | 197 + programs/develop/oberon07/Source/BIN.ob07 | 396 ++ .../develop/oberon07/Source/CHUNKLISTS.ob07 | 251 + programs/develop/oberon07/Source/CODE.ob07 | 1179 +++++ .../develop/oberon07/Source/COLLECTIONS.ob07 | 59 + programs/develop/oberon07/Source/CONSOLE.ob07 | 72 + .../develop/oberon07/Source/CONSTANTS.ob07 | 43 + .../develop/oberon07/Source/Compiler.ob07 | 2142 +-------- programs/develop/oberon07/Source/DECL.ob07 | 1630 ------- programs/develop/oberon07/Source/ELF.ob07 | 655 +-- programs/develop/oberon07/Source/ERRORS.ob07 | 430 +- programs/develop/oberon07/Source/FILES.ob07 | 219 + programs/develop/oberon07/Source/KOS.ob07 | 218 + programs/develop/oberon07/Source/LISTS.ob07 | 184 + programs/develop/oberon07/Source/MACHINE.ob07 | 110 + programs/develop/oberon07/Source/MSCOFF.ob07 | 316 ++ programs/develop/oberon07/Source/PARS.ob07 | 1166 +++++ programs/develop/oberon07/Source/PATHS.ob07 | 109 + programs/develop/oberon07/Source/PE32.ob07 | 733 +++ programs/develop/oberon07/Source/PROG.ob07 | 1311 ++++++ programs/develop/oberon07/Source/REG.ob07 | 434 ++ programs/develop/oberon07/Source/SCAN.ob07 | 1320 +++--- .../develop/oberon07/Source/STATEMENTS.ob07 | 3297 +++++++++++++ programs/develop/oberon07/Source/STRINGS.ob07 | 291 ++ programs/develop/oberon07/Source/TEXTDRV.ob07 | 209 + .../develop/oberon07/Source/UNIXTIME.ob07 | 69 + programs/develop/oberon07/Source/UTILS.ob07 | 488 +- programs/develop/oberon07/Source/WRITER.ob07 | 111 + programs/develop/oberon07/Source/X86.ob07 | 4194 +++++++++-------- 71 files changed, 23804 insertions(+), 12469 deletions(-) delete mode 100644 programs/develop/oberon07/Docs/About866.txt create mode 100644 programs/develop/oberon07/Docs/KOSLib1251.txt create mode 100644 programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf delete mode 100644 programs/develop/oberon07/Docs/Oberon07.report.fb2 create mode 100644 programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 delete mode 100644 programs/develop/oberon07/Samples/RasterW.ob07 delete mode 100644 programs/develop/oberon07/Samples/kfont.ob07 delete mode 100644 programs/develop/oberon07/Samples/lib_img.ob07 delete mode 100644 programs/develop/oberon07/Samples/vector_ex.ob07 create mode 100644 programs/develop/oberon07/Source/AMD64.ob07 create mode 100644 programs/develop/oberon07/Source/ARITH.ob07 create mode 100644 programs/develop/oberon07/Source/AVLTREES.ob07 create mode 100644 programs/develop/oberon07/Source/BIN.ob07 create mode 100644 programs/develop/oberon07/Source/CHUNKLISTS.ob07 create mode 100644 programs/develop/oberon07/Source/CODE.ob07 create mode 100644 programs/develop/oberon07/Source/COLLECTIONS.ob07 create mode 100644 programs/develop/oberon07/Source/CONSOLE.ob07 create mode 100644 programs/develop/oberon07/Source/CONSTANTS.ob07 delete mode 100644 programs/develop/oberon07/Source/DECL.ob07 create mode 100644 programs/develop/oberon07/Source/FILES.ob07 create mode 100644 programs/develop/oberon07/Source/KOS.ob07 create mode 100644 programs/develop/oberon07/Source/LISTS.ob07 create mode 100644 programs/develop/oberon07/Source/MACHINE.ob07 create mode 100644 programs/develop/oberon07/Source/MSCOFF.ob07 create mode 100644 programs/develop/oberon07/Source/PARS.ob07 create mode 100644 programs/develop/oberon07/Source/PATHS.ob07 create mode 100644 programs/develop/oberon07/Source/PE32.ob07 create mode 100644 programs/develop/oberon07/Source/PROG.ob07 create mode 100644 programs/develop/oberon07/Source/REG.ob07 create mode 100644 programs/develop/oberon07/Source/STATEMENTS.ob07 create mode 100644 programs/develop/oberon07/Source/STRINGS.ob07 create mode 100644 programs/develop/oberon07/Source/TEXTDRV.ob07 create mode 100644 programs/develop/oberon07/Source/UNIXTIME.ob07 create mode 100644 programs/develop/oberon07/Source/WRITER.ob07 diff --git a/programs/develop/oberon07/Compiler.kex b/programs/develop/oberon07/Compiler.kex index 926b99964d495f27a64c593498943a66f937cd69..a378875ae2914371c481cbcf131cc1cce9317b05 100644 GIT binary patch literal 237149 zcmdqKd3;qxwl;hc0tq3oLkJKM5h9>CVpJ5z5Dnsh#wdt0pyDykm^gJHh68F$(os~j zuQQIVwgXNCrv!)K3^)%U&<=GxsE84cN}KO_Rt6NWYxcP1b4GSlWmV)<9IA!_ss+w(sq77CN7Yuf0Kh~fk=X`e_}_FC z=kzoUH2`T}3g`_1tN);YtVCpbSfA5GR!&7eXg<+2kdx)AMLE#7(@4ih)2R^RMHdwj zX>8-9t=C1aO{*`>X`Gbgua45Jj?x_O+0w1vvy+nJmU}n1#MY+GZ>bX4{1)#f{am>$ zKqD|$G(}fLOylZHbHQYURBnTUproalFqpC>w7p}?%PP{;ZC)gTR-Xmxy3%BQX|i!r zdwrxXEmoS$sxNK#i>(@EBv5hV-mF_WD?7S54|aI@zdAb7mX~!@wTsRntXUWbp5Tp63cZq7`PK*j5~ zPHQaP`g$bNSenG&w$gTLrEz}y?;Raw(SfXBFEzAh1TD^LY}^PaRZu^lzo4Mw0gkm~ zG&XK97{ghS-SG@T>KN4A!ur9^jzyK~<||UmU)wFvt@QD=X^9?El{7XAB}~*$OU{HA z%cAUb^mSvFtz$FcwXJM**|Aanqy7e@kk__E@UtyK8$p+uIy*y3u|{v+N1)SGjg4QK z_SDbkFH~*b-$XB8ZGm3Uo2Tj(qX79Qn|FAq;!T(r!@gk{3Z+w&Z5{JAr@I=V&!tinGZjwDY#e$KCx3vQuoA zeFi5V?!@I5V*3d#p>ug9eity&LUgsd5sng`f9oDCC)Cg8u>bjy(^;Z%o2cgh*43uL z2%q>B{eyxanLaX7F-bLRke+Bds&YH3a)?R?>Pv%?VPoLk0KebBr7r4js6Cpy1I83Q zVOBj9^b{a^cxV%JnzBH)*HM!{g`!NIOc9f^FyLgEwUNW054Dp7sx}!ZjzqksL(wsK zY)y8DR+dB`=oZ0*Q~PTgYy>W0EKDbUKP;eiU3%Jb3}f+<=;nRk-kODa^48kl4D}RJ zUq1iuv(4$$ClHyP^;vb_T##z*NKkqS?lm(%^FT&4p%d5|p`D|jcqXTt=8O-Sy zjbPG~`Rr&w>q^@>cZsvnK6V!&pzke2p@210Dq1emYg@?POzCjI}KfJV@nw|Jh+)H-5L%V zD&R`GSE3hSHocczjvr;}4{)>6S+QhV72=Z|aXes6^cP^d2JTJ+2e1nX%1DqoRfZEQ zk*4a&g3&HMiJ)|Kc@R|5q2B!^K!WF&g3oYuSqKd(4pyH9!4ek?Z!k*yiz}TtBF=d^+l(B{u`qe?^$$(v-Z(CvhgX$ zlJZGQS*E_l*y=zh+)A}d$ID3Q8nR!O(Ap50EV)Yl?JfTn zzaGh!AF-Bn;Lz%r8qqut6m@A8yTVIu z*FunJ^;$$B-Stydrg~Q@r!^P91>t7&ShPj`i0B9vh26|=nKNkX2~+B;a_VR2*0r|A z(|^9dt~Iu<+t2r%b~^cF3JDVCVpjW8LYibgtO1LGEFGjJ5K&@kDiC;<_jqfWnu~@B zQUWFxBC)xp!zDA!+A!l0)tdA?y(A@)3>bJ z@++5=eY;vwRxmopx`ZK#dW9mmz6?$*`$`R+$1n}LOE;)$u*RClN`tlTrF+LDc;#Sa z+1-H>#bW+%mWcIOPFiWw&2&Kx^$KdpGMTab|sFCIhmp zbX}-@&Pivv&!ODsOu6QFO1XfB%e^O9E@Z;WCl+6|Z=|x@`egCWr8%7wFNSDhaq-L; z=rY!CE+*kh)tQv-2)Y_rG@Y4xkljoB!g{Z2J3uMnZQWNB;i}3rz(XDViG87Zh zSTf=@G(&e@(^L2>oZ6|Q8;s|U-wO;TvFcSduz$U}M2r|9m@5S7)tA&hDu7H&gXD9h_EwlkxliZ~8mC0Q&n2mJfj!DPlvyjV@!SWjWDljYqSt`Vu+3F-Li(@Tg5Tau-hAC{&HW2l` ztR;|G%n24kOfxW22nICSe@3)|)i`1_05BZ>ZWbk|+e9pyWa@(_@f!ascAqN~VbaW} z3n}qzN@QHvIB6rZa+;*wkUT(=LoJDGc+yOxf*xt>geGrvBz8`ImJ-q}Nk?h2V^Vwk zOpH)ll#Nn1lkiilBGQ&4M(dT&$jWnkTO*gOMNRd}cd6$v4Z;19b(iRDAM)f0J z6SG#)Yf0BHM0W}4vW2d@*RTatUeiycy{)s%!$`XZ$XK$6)bY{I^0p_r5@vw!q$(hLmIyw8>J`LSfr>eFgYiT<;5r52Oms8}+) z`m>tB(RLDqHG2aIc8(=`RSy9{k83&+aMhm3j%E%;{}v&iAPb7Jif*BL90{Um0hxP- z;CliN09=G#+t6A64Tc+pg&5Mo&}9j6SWk2~OUMi{tOPtL4Mx?7M=9J8>8g~irWD~yESLBh&FF9(t~e7m|KF;;h+|BG zDoYdptR3NsBYt+_1Y%03t<-k(fD702vgQvrL&{BTqkV*omlgPn`3ZwE5`RaAM|$27KL4i#JOwHnoR~U0R!zfaXL@gEQLrV4t$|la8a}x97m|?1&+y zj>B|{H6T{;ck4Q5BX{4w0GaAU1lgkN{~4%+Pt>O(tr634NB*k6(l=j= z@;L*v&HoC68+mUGI{re2QCG)4n%ddN9F4_ng?$Fnx5^5I!FJ=#0$7$`wj>Mli{9DV z6*_60zZR5bT0~jJ1a%Rrf54+rb>0G3rftkW8fB}DYG>_n;0CtMA428rL3C8HqVv2|<5R6l&mR3T{AJPrEwj8z} zNwN8>P+B?hYlshPxeW#x*il76&R^<<3&JsP-u==XMrM$N#83PtNV3Hs)XJLw1~4;- zxsqkH=Fo~+z9421F5Gta_v>d>3vm(9mr+8Y9slK90caH|>%+pzlHpKxEP7_gWT(J-uqb&McuUo#Q=rAyN+_2 zV*XT4&x*n7oz=q2403ZCW>os=3V6}2qT`_VYJJ8Gth|N?7p>k-O(s?^9q>|0|$t23XsuO^OXYY=MTjEEc zCJHXrit%PvRc)mk8G_Vzzwcdat;_bEODyW`wH|iE!JGFZNNHaYh;5v-feX&|_)q{P zMe{O#cumdt+gRFOhE{Cgc1#B1(KswYw(8P&9Am3g0&6aJeqj{TBm2TiTi17!eW^&i zTBN2`-(PcPP+B)g9qXfk zq$>SZX{0!~?gy{UPwx(G82iX__OXzR1%aB^_XLYg@K4}A^7)uYBnJY!+Zan0 zR_@3jE}vm@J+D&|w-HSi069kNGQ{-;ovymSpEinFr+Y}8lGCs*4#xPMScdUb&wSU> zfy526IRyBEKBAzhA_%F8SaNraNTfGEaddW%q{ko-?j9`BE`lI0=<%nJutz|m9;Bg3 zqheci$0y<(V8J)aFXma0tbj0Cv9%_#JC52Cc5X{H>)ew$n9f+N4!h>a(HxzzP<_`N z$j7scFg7W*$|pxsYDGt8Yn87#I%CBrcEwSkIp8rO~JpDzm;^#{_(@opGV(NZpYPWxUKJ#Ip<>o#<1vX|F% z6RPU6ipf}VXwB>;kD`3+(#3wwnUxv66y7iK^f_VP-Mg`o_t z_+Q{AQWyWx9_9taHM%e$mjK-IQ{s0Wbxf4Zdp1iDY59z|-|kmPBb zP)%B3J}J~=NzLe}bG@HH)Sp57HYCZdBk=znDS&GF2x9}e||y54K* zVfAUcKRfy?r8B+OsUrn*D=@}eV--}4bZWC$&*ZJK-*V6euao@}vab>YT3J6i8T)NJ zi#d_(dQO+QHf%(j$;?=_Q`v$UV#}7L1BySSzH~#l_#Rlp#M|NeI~6aO&wvR|b{pvJ zlkp#*Iojd-_}2_$9dKsVs>SH8b6U=ao=izON9dM*#G>j#Mdbp;rV8o;TNaLUwEmVp zf0cLBve^1G{ChM1jr~T870N?}lIN_nv#pIki9%a{h2>~(d``<%$ELx|^UrxB7cn?T zWx=^`9Ke5vkcPfdJ0q12S@CmF+vw4B2FJ$58MsA4*|E&NJcsiU+84oLrQm)F;_SSp z_CSV|95VY*#1RG{;jJSp50dHGQ|R z|2E>kcKnwtQ?G)xqw1@UD%DZ7p`&Ue;tB@Qt6_(_V^G>FYJU(lAN3hSB5~=>Tt_c0 z1E6dPf9f>O%r)?FQvr<5ocYJW_%n0n>WmSwSF=_ZXmAH;KhGGkI`ZkiRu_CeWW?0? zD`1Wu&u+Z#Tj@rf3doEuL;oheW)dI=c?I+QA?GoM83I~Gl4W|1GV3eLJp-c*Tg*5C z$eA9ifsyhL|sg-O^6=>`Zm;@ zksmo;i9duTe{>q#vFsaZhYlD6nWRRW@i3b}v*nq=iOF;5Gf~x<(eZ58;;wgqO2Rup znbCzLo-f;Bowk37i_b(|gWEq(YYqC_Ki`n5m{d06bBpCr%xmJk*Pslzxg?m2HPdJHRwt~ z_jl+=h>pb9ON*HJyh-vOcW#F^EX4nvmCoo*^H9XJZ>^mwMQ%I0H!{p4Kq+Yqz)C}+2C@V>lLRbJmv{7c=7v8iP9uF#CMl zqt>p+GQrv?Svpu=nd*(6f;H?VJta$<6bCVZ45yG`rT1*lscFk&YK$z$63q9&n@Nor zC?)F9UYP}4Mmb=n%Q61-oT7b@J;UlBd;vF7+Lc|rfwQm|>hK8`GGZfTYAXB{6gH2^ zJLewY+XA*;Il{KwZumb-AvgL$`iT%GyV?`2XiAuUhg9}&$bP(Kk0p20MuQ4ZfdtDx z8{RQRQm2XxU_Lk7N-9&=!4E);u84WVC1U?IO2H1P5i6TIzS4qpG!-+O2NciuP>^*D zxmj=C7cd`ZMfui>LgwUqx*kmJPDQw5^#2L`0cwnQ12DY1GMWKo*ntcwMnf~XN4&3| z^sHGl=eHmcdE$kHjB_q}t><{Ph}cm)}3~chmL!D`l<4uhz9W z|3z5~S=LUWvho9E{imvaMD_%8RqWYLRZXNz4i2qkJd(yl;dMO7-V6?AQ)D8wr+BU= z<}P4XuE$i0yChC04UYRhCC}0{~d8p^hWBSFMPUCGRQGo$>;zH9WtXmxL){3T7eZQUYvCi zj=?QOpP&=bSY(iTk@_JXs2kFOr~=W>Lu`eMb`Y&qo}q)b?C5&N$d{u^wJllT?-&z8 zoDKvIL*VcYa3M^oU@|(!sNp!kV3#;NylqY*q@K?<>lqvj*n1jQXKE!juPs|u9+!d9 zVJM^`Q$6rLG&_t7pE5kPtfq&=qNkKmC|?ek$|V(|PAFXW6{fj1;pz&+3I zz66blz>2ZEmcyeHTtQ?7+4wR8>4A9NUknE!D;kKYc zhGKJ3kgq)(qk8kWEoBKyNO)p^uvT#>a9xE+gcuy2rPw=+E$LWa!jRx$y9t+ignc&v&-#0BUsmf1WF9y{Kjwh1Q5 ze3@0bj-5q7XXVOn{YWQItk=Bs;mu>TZ3~ud`>hCwZ7=AGR-M7>A435$FIC#tat_D* z$yq?g@gl~4FM~PO%Jno|Uv~5n0v`sDD}CL%#RT2r3Nh~~&kBlKPm)S43d?>uzap?{ zWJ4eb-(b&=Vf)d)aW3foVJHcej=VzRYm5l+>PBTo^9Wm6+me9|J~t%M@tM&=VxD7}shA>S z?x=0a>4YgECRW>$3ydqoWSP!E@7K2U4P$12A%2Wt@kwt+7>^t+)#ta1ZD%o18jQXC~^u)jHCsIEQjLe&^tKtOT z2yiFyC7fWcpeU&u7Ihfj^It>Lq7-Qjs+?ryAVV!UF{WVl6#-N-9O*CUe_K=G8%!+5 zY6iO83YDtA#APDF_yI@fFlks}3ZYL?Ki zi9!2wiR&4_x%Mm~=11|MX5_`62vl?#(JKUPhKjA^Dq@}$31w9&Xu3@h;Vve!RglJ~`h~40j#ntuwsiK?n~1ztkiMtx z)jTR>Hx}WrSJ2-o1B^4UJ4Hb3Jrtown)`P_OwPWCUSxxM+mZ`#78b8 zaq{ zMV760TOr!ajQ+xf=F?V{S;+3lmRKRiLgJ3V@+vbbvB!0>7I&^wuewS&7heRu$68#z zOk>K4nIaghEVQ*t0BV+zdc3&Rrt?lkocD%mzIwCs*2$t5ljv8>K`0iJ^dlg515j|h z$_bSPt_e82(|1EB8F`$Ko^fOsGC#@5)|GIb3u~rC9d!s0hn`3jc=7CiV`& zW~pOY-DG;z>9#^V8xWtUD}+wj19-g6?ZTjCM2~jprzzYnkcjGI>!$NHxu^q-JTZ%9 zeob8R55KHDIzSsxgWKNd?#alm4E*VLq0s;kflL$11XVVf`#u{Dt zEu}}LW&&^Eic|FF-JvyLJfy5u50V1yu&~avgzk2GT^Cv{R?fUG1RG_RViqaVgdzij z6<9=Jl>~0!T!c4igchz;oZ-)3(nw8W16rj2Q>TJZe&g5zPyQw(uEtvKXlzM0lMgO- z3LInfVY=9Hn1>{2#99*|sQm4z^lwOA`7zt7B45B7vvcwM_fEwOE2)-W=AWLRTjPO??C2%* z)Qe$=NS>bkGDo5}uhtqwtzw-Z^?9yKW8|s^7fytzF<^rSpNh>^^LluA1E;bG z^^y{K%m?Q%@%pf20Pdxfu~K%q`tBu>0@6BM^u?_rZXWtedGv9DVPxxCT#JWOL{TMjClv(0idhbYFHw_xqM zhi`z;*K&8r2=49#?`Q?X^sG2KFcDXqq&d3GI*MSr#|f}#}+TkWGgAq z2c}l`Edb2&!M6Y~Y*%vPpMsgwP^MK4kxIymkGdFtA2l(?P^I%EJ`{`AefmSNirv5x zpqFX|s>AJkd1V9jz)q~}Ke+U7cym;4y5a0?c7#s+l0Kyp1E)Y%8dd{ymRt|-ryUF2 ziaiK3g_HjrvU5WXnI>2aGED+L8(9}>1WQq^9IV}Wo{pOzhqD0<>hS^KMsX`zZm{f_I zKebZW`rzsH0bKvQh#Anfe~rk=j`k(uJ|MbKBr4<|57zp$JGNJo?R+aQmYnFa!5ENT zke2wQQypol_Pu#Dwsi$%Km>#r5OMsE{qP z3i%9J6_yBMRkxuwuqxzX0OY8qsa>ss+SGJ;dIAWT^0PY+-u@)F2;W9!0+VDDhnG+bN(~cK_ZJq!8;1ant0Hmr20HuBqXMBZCboR zRM@E|sT^<`+jmiwF331D>1LztsC&33DJ}FX!VsffhZv|^C47cRp@3HYF2K&r1JGS8 zxvST3qbPC9f2+j*vgQZ)Wr`}pHBW7-U-fwXf33s+t~;#?(Rf{v)?jD;pQtcyRd@z; z7EA8rHI(6p*K~wa;kr*%u#nW&qDw~V{{PQ}T92Qule!zGHNOU>|DQDB4cmmfp>4d` zcVoz-2q&T9zwo*l^w$iWoPwHIlPKAAC&-C)#$tTE7nn|wm zW4bkO9`#ePQ>X-e%pJv-DWJ_>pc5UoZNzsy;xTkC7V;S5?3* z0EemyrNgKE8mRH%y2eBQL{}Tj)DB&@NoSPwoMSs4ZRiX*>Vwi3U z>9+UjcD2)Cl{-IZMG9#W$489Foh@nQ*i@-ADfJzn)JVl)G2`#qEC1P|9-x@3t(Y=Z zh#gwkN=lSyE#+BKPbGE8QUp96V5|PR(zSBJY;7n?oce@|5|u=WYt7*@Yd)NK%wZ*yKx$F(`W`>iBtj8UO7_PVmJlYh>aK!NOwb5681kbT2q+jkFzDzDHFe^1@hy5;2Q7LhLc(Jr z%{g%(8N76bl#H81`c^&A7VX}?fLS--KPzA~b1?s<0_L~WWJfO^jM0$5 zISO}pFiXyiN_t~uQr=M5n&5no6>cRr47g2C13|8TxRvg}`Hp25~hh@>og9J>mCfl7Z?s1a0%swz6Z( zRWWWmK5<;Du1_G?;*Mvh%7*))3U88xdpe~tfx~6t>LG&{tgv4!Cv*%@9Ex|<$0Zs} zmVrZVTKxo5DxObFYmNOntQxNjIl@luyoBxC0k6}tol~(L(?vVEz%?;3M-2OLY0P2f$4{0pc<1U9YWVt&>@QF-4!9`puKVLQ zzK>mVjF2_QQ2b5hI2n;tfTO!`AjIAzA@&9dvBPCtj&w$V<9(?OB3d3ks?k|Bq%8z` zsMqj0EZ%Fn&&lEW0CyEVZ)su0@dCMaJa%D^`wcW4XOuBx)c2GGbGJg6-lMoZ014(b z4PJCmXhAOq1jYI0Z!CF~*T4h8HOGaO zh0Uy0Op}>XDZR84v0QUu+cYPZEU&(> z27@-Je$;_i8d;Hvsj=kw)gRUjOVyXX-`Xf>k67~Z>cXzbu+a%GZpgBu&kcuW4o4yk z0(AyU&uNu%!SD`H8SPqD2Cz@tbXCGqx^LWvJ(?~;3{KBNX&NpvN0-C`5S^z_sf$CgQ=3M=dCnKhW=!X#T( z4)=-5uy(8-UvqFOQGjGutj(&2b}niUUka|NWnD+2uA-xEXhc9K&>Dsiy&lhfqwA0f z(4m+Vi??`h!5o1&O%(bOqy(AkBZ;28W~8Dfn#kl0CK)vw6KC^M-EC{|F(x!Fn7nuW zR?16xaT}fAGTouRE5m)g90xF;4jjX9j1jE+o*RMYO!+p@<*bpoRxq{UFa+(I+!(uS z(}Xu4?wW5ehAF8EODSaN8b{&p24F9ceVUF-C~=q=f|@OUY=SNlYse~z)q_=c=u!7q@tsarVKRssFo;f0;9JRlr!*tdrO*BTpm|v>$okb3P~aNdjO}4rvum}qm43mI)>!%l z`cSXo!D2gMFW$#&I$^C96`uAgpXrv{ipbi)(*&M!j}Hy+S1$XUG+@ zOjQUW?VUSJ1j@L9%d%isS${wv*g~}=b!|gUW_vhQ+HIR@P;l__COX4^gZJjW3I>r8 zzZJi@x7BbzWi;J|zlkC6EnWlD5;b2XJVwe5OhtK3wfO5-nnvjF&G|h`14yr4UV}H` z^cIll8pAj^8d6eN0q)VXtid$}iC(mbr@f{NFdw3a^!S7UoV^Pa{mOdS3_HW0hyFj( zT`vq5tvf13bhkmY^9}wQ-7&6lx_ei!%kj4h-AR}Ft&cwfGOF*j8Xlw-@7I<3Qufg< zr>d5FO*Nt_u=&P}-7O{tB@)yTy3XR7$~#y{Yz5HC*wUc@+JtcT7@Av!mbc ziY_R|jRSw)1;{+ujG*4;Wt9@sV#x!&hRvvh*ThTH_^*=qG>j|g~Llgba*~sLhpe9bhm+cPA>G35;w9ZToVdX=97v*Tr9oPpIn2R9H z2}3uf1+WZ~a&fxga;-moXCbjcc438oKj%9X_# zbz|mQDS~aFMh*mPz}vWd1&(1eB~i1J$vfjyVrF0Yo4rtmhcb{cw3i$4{l&MyI|eMs zVZ@T-YIfnjYD}|iS@YXshJDoDU|+Es?E0fqWPKZ~<1Ooi8Z3&yIzHBt-HCf9xfg`F z-$4CeQ3t|i<6Ci`cXSEQp-fpM=TLBM4Bpr4t#Tg_4P{1e?t#AhVk&bacrRrEpWcP0 zni>5yB9=e4yd31~?hlgxBSe0eCC7xHp@!cGMrFs)f6IMS9g_he21z;Vud zK~Oo;`lZ*e!G#~#)r}>GW07-dCN%v7yc5#BY0H*ihg6C%_~u`!g-6s`x^SL+2$z%SBnn&K6tyr5O1Z5IQG=bRWU44V^j*(jWHwXN zwXJ1vDQ3Yx3xRC>5Xi+)x1WN1_h!r@*aJdrTejrBO2nN@gs+8s9b?SHQSzWlumNMl z5>h9Jz@XS@fCsO#LW?lZ&u_(LM7}H;3)xXQhN)jyp|;JfWu3@Yv8uPiz2nfoBcsCf z5$SXuh2ZNdFmM@p3o#JIH+3h5GY-r;;FfY~TR8TZ8R5yj*(bq?(p6z$UAs&$e8~+I zv`LB>0ulVMDSBJ8@^u^prLYnq=Lr~1zL4bK|8CaWyw3t02LOk4SHS1NgQ8QUj^(|; z@jN(cTX=HbXy$lA?+3JF1*Qf4eo&b@@p;p*=|o=*G~Iuh8gJnGsZpLPE9FT$VR-U% z$O;rIr}+@cu5jR;c zMlm5x?nUUyEIg>mbCw!Sjwkv6pxr?!95-gQY_(z9Sl;0Tf-D!y)b7HWs@?lg%|KN) zQR+8Xv4ynTPUs3iL)uN}wG&H)HlW=MLhln=t=&0b)BXEFvpBFT!~I(ru0c8Z`I1Vg z2FDY6v`7uqb_SvQ3T>bUXA)W{v{D0o3`1U#XURC@R8=0X!d)090kO*{U>!CQLREN` z(6_j?up*#k1}Aa8FsVgPO%=@>>jI+lJdj_VDmtIgi&90yZg7awiQdhd{}cKYZXm|UNN!FYe+}E=rckas6acR zcL}XjKpThK=C0zkMleLTMP7MvxI%rx6)NO;h_ciQjUaTt)Cv_5IwG|~dlA~luaLeJ zrc4cfmL1~Fn}?2)DyS@hq`HaO98SK57Es*FI2IBbAvY2FcR)iLT14oLLL1P~eT2>y zTEB}DUchz`0pVXZ*LwyqX44sf|;lUymUJuZEJhFebIgx0^2I_M)*WY17Vx>x;s zmib@kx+fC{;Qoc`nwr@rAD34BV@*&w9NmcuCKFDsInfo-7U6J6lykZNR*0TPk=T!! zgq=fh_D!OY`R0BhI8L(gb3oVdjKm8#?!o9lR#%Lq`F{aBS)31|TR;@{EQHnq8uBcK zR(E!E?BD=6k4%=M$>JN~Cc^d;;Q>F9x31Y$LjyBZ6NfIrNc<4*Ck&@jY8GLje_Fii|J>bkwt zFjQRphP(oU1;@!D*Q4q{hFfowFj_gD+ag$-=^;-Ha|DRVh>5lGlL4t= znOW2$sM4!`7o=_C_2;}PC1lF&ggy%>EeM7aP+fWfP`3#~puaK*oi7Y*F?OH0w~x6X ztt!Wq&Ew?!G%6?0#J-wpG+)yIRXPq|O~RRHL#n-FEV&~;RUscl3S8PlGc~4VzHExD zN68?R-(70uzt%r59}RHpjL-;PPx=pkOlkI4guV=@8Nrz2wG-}->Y|#v;T@2^JlAm> zXv|#W?0OFlPT#J}Nq32q5YW@{gq|uTP-FsE_v5T_D|Av541L~!j^d}npyU+oIH0{I z-WcUfq%HC$N%j*GY+-+l!&kW98IJ*yw@5NjNOrGY=r#30&=o+x4RoNwCEI{{88+-f zmT)Mcj{@3(`*C)!x+1_&3k>kjBIR7+4>Y)v(DQ`fx|F#DohXFPrT9H5*!>0Tdb09X z94bBBw0eTo7eCQ#){YUBL|P| z<$VGn;2CfO0p9iCm55IZVz;Ve z0)ki|EyVYmD>=G+`^w{Y3HyoYfV%Su{TB{^$oIdtVKtMxcnz$t*OV@eHS>L2WCit+ zgiXYf`+E%=L}h;s8`(;dd?+N6H&*IQt}BsL~0(0EqAIqAs~nr7gov(97?`YW>Clt_zy}jVb`+&{)r=b2)J=kk{3_k-k_>kyV1$~;=a0PyNO^<|0J|f9ILW0c! zUd`(@{S&Z&l#fX=M@XD=g&`lAJ6g2Y3w=g`^}*@+n9HZC|_{IMSu*gAflnp$6-0Lb8tI;cufn#hV)su zuH|H%A_4<-J)Y3we_z+N5EQO!GY67y0*ff*cbv=!)%89?zXnvsMK`JIeqIB^A+PB> z{0;QZ=XeYV+(g!gMPQ(=?S$SW0t4n6*6TV53fHxFxUMC`A>^3Ux*kgCI8)ceNwMVU z>LY6o4^;3A$W4^QlBZVhS+hp~zMAlzV#(QF!%MUd@8G}2BH$k z*0ZhVtc{$3t;De_`N4pCNAN!_{BQ#(8mEyguAI1AHLgs(+05xwu(+T=6jpv0<#)b$ zk-Ib8O~74t^?9-1WM_uwUyg#Tb5~`jt(4bMKdBb(4q3xU{oF?zR4pVovkZQ&Y^xdE z{yrr)Ra)d-sY(8Bfa{EWTyDBG@tlzt{QyOX#yb!OL_f1nKk;d;eflS#{%M~+ z
b{PuJ72m92_r%m?h5kCE5pLj<}^f&v|#HYx$ru14qW!R@n_>^s*c$-GFk9|6U zPkrsv;e0BvPy6#}8~d~?pN86}?f6t^pZfA?w0+`zqS0OL(=Qlg(J}Uk9~6u3X`gtt zOLTwx^cJ5=?Grx$5IxF1J|oW$fwio(|kV7uuqrq>1_MNI5m2neL9&> zv+UC(K3!^`4#rbpzs&8U-8ef0H-mN&&-7e|10~!6i)LO8J4;iaT+tQjVv-&OQoFx_ z@f|G5NL)s;kwQj48rqrTZeJUR0td`1>TS5h_;RfJqSdIqDvQ~RKHwKJqw6pk;L9O$ z$4F-MCq8|Qp(?mM2ui#mC7v$(Y5Gedg#<6=+((}UpMz_Y2)fHSoE%|haGGd9gLPGO z3Ai~5;P@=G34Tap;*X=Ix=6SwqK^}_xEXk!iwPU8e%k7BsT7}1KD@r|-HGmTnvKPMqe5=i##JpqJuGL zHCL=*E)l&1AwA4!NSg@}n=mA7*IN#`$Ldo-@K}8>IWv`|_}TS93}BmcF~(E;5#Vfd zY6;*caBb~xAb?+kvVg?|@C5=6){Nhyw(ngHGF=^h_YO_YoM8 zS^;@PWLr^*8MdB9gl|I5()F0AQ!A&0$PbCs>U7e|iFiQ}R-O8C+ZjaM3xpmMZsXVL zsV{=Tcno-}h2aFu3IIw7m`>4VePJofiI^w|1R4_KFx6)>)OcM4X73(x95ZRHVlFxR zkkhGAheivC;8my6zW5dyi445+&z6K@Nk?$lK4F61hf(nC*yNG!z%iz z3okVRq7<6PV+zw*Xh^k%1Ro(X-3(%`pNmh&mThz{C$m_!nam0x>*Q!1U==;pRK({@ zmcNRBqYDU2SBDBLUp+zCO&T_azZdd%jv9gAusrA=`@I8+SVTl`^)-HLed*8YV&4U; zV|-S335gyjQMUT#E?r_dVWz}Y0?Sti5!Ot)Zt5k#a5OOPp?l@z@q;*W;5FTYzm26& zlto`4SwHpS#h9`e0?6&Hk8Ao1?mgoAsC$UJQgHYn?b*UV-SV#{O|F_vnkhn)QT=?) zIN|@ExI8tTxcvl&W6(PY|8UFSq4^Ia%>be4;mY^wz@M*%6ZcyV>z3&?e2X7m(>nZ> zGPWm8uKL$Sp!rB>vb=`Npqp4Sr{)SF*^?xF)n_DmN=W)6D<)$8$BH?WG%}`g5p4S04L@glhT)}OJm#c)IN0y|F zk)-LXE+EZeLNmOa5?e))w{$$DEN^$nJ+T_YGpK%W`KH_G%=wW zwptOqV%^&#$CI8WKU`2at>rg!mIbg(mNwpHJq51Lnm2KjeJUS89` z5N!+1MA8gYuao93p}}1#4I<}iE9Ww<8v3e5r1^``?B?omI{62wtBE^ZaCj&2DB+)A z`7b9;e>HOtI> zg4@$;cpE>wrq}UT+W3~HS$`gAo)?Jr6>>6Apa;~&;t|!e9wU9Iy3e7>T9*+_?R9#8jae_P8YbX}}{Ve~Rq&ZMc zA;1n-j?MwVf=!zwP%TM5`3xGP%SbpwK679#;$4sY0edz z39b&85Z7N_O58DmJIrf1K={X6{%c7C|3{jgg=V7D!Og@CR%40t1c%oQwqoVrHEqUU z(ZS=IKaVsC0AtA`T=_2$H&AUp2e|hHccj`u@7m6sH;hHy3kBYZxQ^J6ZlSNHbhbAkB6{Gu7!}p61_)xNd?w5py{f)z~M(U(vx$r0Ju2 zkmgGOW66_T`HP6_tG+uMxK{*sve)p0@IP$%pCV0xdYv?P3C$_iFSt44Ez)eO7Ln#J zLUXFu5EVHytQ_?jZ>W`VA`B-RXxblx7Zm3#M-1CAv!)tg* z_?eCo{_{!GPrXE%TZHD!kS$zA{6KXl@s|nyEU)2Ak#U-paSLgNs4GcxoY2g4b$E(6 zPn|}bz8~Ohufe|`K%{FQ&X>Jsn^Q-0%seoQG)D@}1+E?^k-wjsLfr0xyU=SGBK!j^|M{dDt%^v)mjYwSi<}-7 z61RgIK-`ZAXk*EXy$0sBye95;iymJj%`R%wnV@+~XlA+c~;bqmk8pJ<{7^Ds(Vtd{ekZ%yLYmVKBz-xifLVVs&dPVm(A$h+%<^A)I*20uI-U^83ZSqBt{p zFKJ%lttm%<2(Kp9P14tyxI`*80CUQ)%dScnij=q6yzyGQuGRb?N`b`{tpDcMYcX_C4%=Qv%O14p?sYX)KOjjz9bb3ZQG zU`McMq z2P29@kLo@D9Bi0oMvsM{#5$d~$&50yop>Ko@e!fla8~$q3vN?V9yZN#MgY}gLr|&ok_Xb+l!EL)48nm;4rVn@qN7kYMPdn9sQb^ zVzgh2qZ%HyT*EO#$43AsO3+z9NnhszhA)1g{>-yiXGixSF$Ofq6vC0z6{lx4Aj8xt2oi8JJTY&L>5_UQ7*ulS5`*HI%It)J{)U%$#b_apzW?zhF0e?*} zzvvgxO(otP*Tr#B8~+XK4O85h5MrI=-OT`}>$nzKWlJGno_JX(v?aZUMUWKPpF;Us zoGvm^ALv~=7^)vR;Qs2|X&8?<(y}_v0l>FBg?|(I&(f0Hqz~{`lk2dtV8Z*JLMhp7 zzPlanu=b9sq}mpH?|d(z3SThi2Urg;aaC^L;?LaQTr%;sI6Ybm)O0Iu zJ~88+xRCp6C2k~e!O==sU%-+1>Qrz-vnS4IP$a<1s)&(r@&2QnF$tA;DuODi2{Ei_!xlyHwr97-ZnlM zOjd!zthkZHM4Y&g0;d!A72YigC~y{GD*y{A@M1!j3Z-^;3kdi-0M^|Z?JXqy2EgUz zc+7zIl#TE3n17F7AhNXXN(eYrWYOUjs57wa5?z!Ma|kejK@Ar$gWz2N*294gkHrTa zUV++t3frYe+FUaHj+bS^;|CE?mRkL#4w;<4TSnq{K`e%${hh#;Qh@V!rope1`fgy1 zx!59C5q_;J(syw3Hs*yCpW@&GE@PnD7qzF$c=+p(%aFGii!^hp%P3IYq{-T4Y~q`Z zS+0Cd+)*Vi^*>le`^t>6p^3X= zExWwV5RZqo>^Frw_TI=McI;flFf3~#EMgcvZyBBj+s3`d790(g1_l)jX%oTw0E}B! zw1)h$7})o2M^W?n$rE{hu{S97)~~)&qPw6uDdAV-2y#RNcu}aU)w4bnw;fdwLugQS(vez7#FBX36cAguTw)N5XB2xtP_*<2=!q; z2bR)f>3ltH<5t_KW%#9+FmmT`|5lY(`GHmnqk*f1kQLZ1KCrxI6 zrXOe$Q|rYL`MMkB1{ppl0}okPq3glix$FeV9uJT`53&S8XycI{#iM)R7em7?poA~% zT?BTx0P0a(fY###q9y~?l?#|bq`qn(RsS=I+LnC0;eM4Any?VEYS;n`)l}x zjs%ZCc?bz(s#xo=;QV1P-QeqkPf9p*Hzp)=orgJcMBL4kX}*9xgMfJ?UPfYm0b3zO z0F#+XOa(B3z}2LW>^!udB!^L&{Z2ChV=1jwq~Y!mBkdbvhEQ5S0XkmWL{u7?TBN>s zozg!9hobP=%Yc4n@U_DCC1l~Plo>L);7Yq7%`DP9E;L!7SxYDH&lz)xy#d&I4iO$< zL=h60EFk7G&4&qpuo``;iDqsl=2T!X;bS=-IK&tbyop5n3OlQ|lEq2^e%a}RLDFBB z0FuXqBq$CcWI*B!l7AzSQUM!__pRNup?$hU6M1|I@MV&j??Osz3JLwYFy~8Cg;t<9 z3axxI4(S_h8bu_(QV{unav)7!CphW29TMiV(`u9Nkg(x=0KBHN1+0x_Jq3OMJz$~G7D+Ihbu7@e$+v{z z0Q|0Lwf4D*#1C3x?l{Fq2=SXBt{z_Vh9yiN0@NH!7$@QHAc-aSs2=Gx-HD%;GLMwU zTgo3u$@lu?T13VRUQ=^`x{%bPEcK71zE`O6zS|8#T_2z>B6Sk)&P&@if;w?|ZE`Uv zs?V-D%hsTTRI4l%hgYJ!Hu(^#9;{hmsme+9sHNIKs$Ka0zT8o(RXKwsb(Z9NlE}^J z7*Tiy4bv$5qBeOS>p6d@JnBweMaDACSRYAL$C3rr+jvb|K!^-N^e2#VCB#T6zD{<5 zaLVXC{P3FIz+YR%O%&79mj5%j;!g?nm0km1`SY4?3s9%?WlVkwSCrFE>iI(b7q8(F zlw8BPLhN2%=6upp{z6Lq?jK%vJzV4-5|CR+xiL$O&7b2%yhwaK*ZS5iJGl-T>e zS>!eag;7g+|r z2^Jp=bZxShM%HHEz|`7aK;lCzaT&IO4Y${EwX7{}M|cUVVPexkUVC5FZgS zgNF;&driE1jmX~(vYE)z+T>i6R=rnE5pg`m%@P?YB}UgKW5j)d3&FukJom7PpG|yV zut=6(Shl460`)5z4w@YDw~Ro9=0^zf8tczL z2%ztHA244?hDN$?oQ%bh(o;|LhX!f zM8dE?t~s1+Kf9K`Jvh&l>gZS3wjuGs?}Av~W;N-Pe;_}Yc+2tIu`Vx(juP%28DmxQ z8x_*A@@i;~#-KXaqB`;|<$xxZvFP~s)C51${pAYKRArfz&;cmW6({Rw^SNPepJEI1 zBx^y7MnKBFA_ZX{LX)taEGBxME96QkWUDFUV^T~JP9?kHiQ>2M`O%Tu5zCpwRaT~Ja$zii{}pbZ$&g3-|DeF@h3cFZ-g9n%BIMMPfX zkhDEm;#elksU^w{wR=5+;&{g1?be&qiAFz6UUdhjfFbt%%%F21Y((DIE6by*7JZ#d~_YOgYLA> zwTQ?&iPRr&cmAz}i1~uRO*gj2<%C`+vXC%M@vJk5EC&)}@(aW^0oBYUY9FAW8f*2i zH;nkoQA}XsUk^4AeU^RqGrV#FUrNc1G7?r_xyO1weu&4QWMqfq-0#wowKpxzNetjU zR|nSYPg7|i-%V5&Zf8%c{<;QbWkr7=lwWgA4C4y{eKquFLZgJ@XbNTXOHka+@q3|Y zSAZ)3<{h+y)zD*1r|nI6IpF9t(Yz3j2LM^$6YJzX3s=9RQ9rNYEtKXpy@tQ~{@kHz z#nDFE{gjpwkhX|`pOy4u$C&5}R+QU?@$2!6?fOT}0anU&R?0JEdI?OnPKycnhm-On zrCb3iiAhw#LB5E?tccgh@t1&zWdu|>5$zN)mLjsFw-9vVbLg08wp*41$3Z0bE3Zxx`@#1=wZ8| zw8h`*;VX`pX3$8A%MfF^L2Z>-YO7hgI~cD3qg7%F0Z{;C0*W$-ReJ?RQ1HEk4h=%B z;0;Ha_IDq{_6G!~6W}?)TtKSN(Nb48f3Rdln}~hUjE<}*%|Jb7h^2Xk*jYuTEw}$3 zDCVJW{08L_a0>vsLGM%48I+8zeQrh%Rr^}ry-9jrfVYT%lO68|x5>I_&e-ZiAUAzP=1d~2ZpnVeOqJO zBKt#3;&O|dOWYGaC)dV4=K^9ESWXVg1U|K)r7j}wQp<^0-Dg`&)XA2O^@dMAMaf+b zr^tda-D}tbUeRlM4oE984|8#Rgq4`uib7(0SfSi9@>@|v+;=!WVcH*VMG3KQYiwI& zd8ifT#64j-L#>!W)XkRd4c&@U)n=q9;=E;s*Aq6x@FU!cWn??eN=$9VDq@SR(C(pD ztS4@S&lzsTCSrS7PK=5`U!?B^+;=#QAngyeB9Ex|G^#BE!(?BarpB-pEAYhiQNxS) z5pKmSvfXMWrnX`(u~%B5blHi&*j`*f+-W{%xD|_tEw-F*lXJY~Tuj^u%Nc6LGNO7~ zws**u9eor3sI!q2p(mrssr7-;geg6d%SixVBf@^KjOW`agXPaVPBWD#*kIGhQd z_8@dGEtP>v^g$N6Ff4Wvi9E*|61$kVpXKFz25d&`lZ37Y6plsWp957%SZ3iqpm^T# zh1OI>#NFj^47Ro+zlDu2`Hr8F8GVISO&~K72s{>%^-RYa61$kVi4ONCV&NCn!m!Z7 zeZlBC#!&lY)I}F&wIruDFwSw*6Mo@2pro@uR zR3BDT8oiyM-!=kt2;aQ;5LC?seM`_7ej#l*K+I054+z3Ix?IN5O9ZtNlpQ?*lTW@v{>KJ@^2p8DoMDHT>V?vK& zo!--7&r&InPy|EgM1-J=-~lYy)34c*rU8<6{o9dXmX%3 zCFDwcVJl;gllVJh&{f5B^$#q_F)I`Y7B0)k`6M~9eVLL7T1DK=PO9Gw=LvOkiNdF; zGA%qHyQCQWlLN9{Ck3j$h(u#tAz?2*lJP}~5kF56HQOsTJ*vli;o+3|wx&%AT_@X1~ zd2D$Za+t;YP+TQ0w$@{{ko4Vzo=cEz)iVd1@q)=j6V^|!+UDBwz9!~bV03v@8B3hcAdH84^%qNqs?mEoAU^T2@-*Inbzj@&wR74|=#o9?j2pai<%Bam@S;seFO;k}3~?*XX|^tEOhXhL#s?nIfo_gLKS#$B1ZG<6Gq z^PD3cT~;%LU;fHz=J}nvv?V;JR~Bu-)AdNzGN%FvYsrxgeA*~y&)`i6KTHvPz>FO70?F&1;t``ucSu( zl;gTz08Xq+WO_ji?c+iL_5 z2}$Jr9uhkl3F-=6qPYV}Ti&p{gG^cBCekO86!v13Kdi8nQfnYZ6P!Y`PwRM+9^8gP z^=ug&kNPIOf@e8)D1`v$Q2}` z`l2Wl**YKyO+Fy(3POceD>Op<_lcjz$5BI7{R{^-xnusdx0;uFn)|Cn z^|nB3YmvR`O%U%;w9h@x!K2b9ututShLjfVEwcB65nU?&sM;49)3>2`)bG%d3psWm>)_ zvD_w2w#-|WNZsA6ONfQhrR~ZUVw{CcWpNG>PBerR^e~}VW;5lU*6b??{Zkqm0&n#4 zpsB4Pd9cX#{Q-5Rt{jv4?az!c8(MCQK)##2Fm|+&W1Tomnhr&Sp@3JC!l%7Vn#S)# zS#z1=?>1Kb5WAr3LyBIRU=@8wMHl#rlmd~udKFJ&L>~7FPYcN|az#@*%9fNGbVR3oKUODf;K_-4Hg zS8hk{01jU1=0u7KEH(kz>=HCrkV(&#`@1qq=CeTwl~H)drG%prP-*iEW#vd0Te0jd z7L*Dt)Vq=!3^dB9Cp#4IG#Bt$qfl}I%qtPd*1DHSrPlE>}{{-xk| z3GycbiveK#hf$*U8j1*RIM=Y>ynDwsn)}$i%fMwePCCE3ox&$DbTbC@588H+@H-Jg z4!3p%k0IJJ!uHm7e4$rH28n`aw%F#WK;{jDnjg9;VBh0)lmb#d5~V0vRUs+Qi;|yA zDJI37;5ytUU5dfN#6_?@yYwapmrN>w|V%x+_|c_{HWL)u>jB_APtJc>z-x)K~X`b!CVY4R8hzr0qIGggc?l0-8*A-P72HM=tRve+U~@^JZNaBYqe}uo(?fyW=mPnU();^?II9M8k13bFFv*G= zbB)vCh}xCg`|UP!ezzp1_r;Xb>-aNQ+OzwlSWMJ^hS#W!naSYq0L4T-=uos3w=OB@ zN^T=%t%K8XwnF!_aHKP)nfj(DiTO;vIc;Pb6Ef#KXUn*eqHM@;b>1(@l&0O);{TOHNRbY%atWBhUqqf%Z?zoAtT4HUZcxyeY zeZSqH|IfheL6h)^>za|6g*p{9SHWRlM7X( zZlOkmJ&LBOSxsb~6$UXo#!$C#rxB_j#5) zc-2N<9$bd_N^ROju&&7$`Y=)Bry1S?^8Q`CE^I;93PLoUxX=qF9`fe2Klmiai!oLe z65RL@#ngO=NQeRl@TTh#zNZwS>tSz?)7d%Rw7Zz{Nu7TqHT?3GiZ=cKrF2lco&SFj zc2V#kYjR`c7vgpbw@6r-<)7cF3=c6n$aSk9M1g{ELyT$!!NOqNgMtFE{#mS}dbNGd zu8%l|Rx%t72G?z_BXF<)b07K!0^BL%- zT^{mRfr=^do(Q-&Dwgftu#-&^HbEplOJa-hs7;kEBfL~FMo5~|vvI5;r9l)Ppk6rnr#8Cn9D!Dedjv!AUu%SZEqiT-4ED zez%}6u{c-TiWyrM?=~9#4pC-udIEdbO@efg@NW?~5C#mlG$0r30rH)W%w|`g_QpO;Nfa8Fn^nk7wz95e zH;kCAbBrjz6{8VWk2d(K6&&DmqncZXo-EvBj9!+x;4%Ivq?RypQ)}&p zbgY+UK80e8>lP|ASMZ0EN%dPQ@x~GI#&@WYd@Q1VhZ2LZ8BUDzcG}%$)^{}W8LW;W zvy^+C1nvib!h%^`JoL#;u;aYX3&IlfQY9|)B~J7W^-Z7B>c{ddjyIyv_qQZ{eAq0> zf-%yEHD71(*-8BUQ~A5K372ccx1z-llExMFj6D&pH^gKHK(21(k??dt=%ObD%m065 zNBlgLc&i34v6*61%5X{*4vs^+G9vUKhk74l+AgqN2QnRJ1?BU^sbZYu6xotamaolj zT$Xg7B~mw6&6FvZHDp^OHnnzs-W=y_7012X;P7K3jyiFKVk7hdhkCh5vEexmRPp^xQS(x+1yK(;CNZGmKV2T36kCEs-Z2qe4jfLd%X2Wh$S<#bTX52uQC1MGc z6OOl1W=p>zZ(oA^(`9JkWm>tPQr)HFo@O#M^2Xr*ZH~*rmh20blsP%tC+fGI9*69r%Qz2`nnFI zuEb@@aXdL$R}FP#J6$RxX7`5(Ut>3}iQ|#fb!UpMNV2Xr>Ux$Uj3bJ; z*KsMjo=0mOPA{GgxzOnv7U;?#;RL5EGz6V7Px@G z0056!;8X%T0eI2^(+CU$@T>*+?p#%E_E+Vi801gAom!L^P6L)Zg-`%`Aaiq5|J}}hvnr?vaBeA82RSYh$9cAU*huJ)fcQ)&ST^wcXneaaC8H3)!IHuKE>PyJ z`VrjtyCZz3B=tISl$WG_0;PLD^40Ih@2~Og(x;Tb#{kr{$pk?!3o;m$8C&6=eJ9*HM+CPxVDOrjLGRpzEXYN}4G|ozxTmkT$zvv7omFp^zq0`e>IK zkM0k_N5JK3VJm?<1(?~Hbp&nz5T4`kos-nbhu4)F#&;-~0LdA&pe5f%PSBx%;J@tU zT`y+?Wn>R>?gjXNI!VRk>MMP}?j)6x>5~r_D4nFeyxm5uZ)!0qJ-QNp;4*Qc5HuFP7T=)5PLobuxHK> zPw0o%HcVO^djPomgWIJ=1%dAO!evX)r+}30G@)yw>$+b-S;HZTL zBEI*nvqaa5!xXHS@@xo8DSMtDLgIF$I3{=RF9Z>pEq|gpCp{s=EM!gABIp~IcDA?Dh z+v^69%Qi2m{8qyoG>m0L>xgoJ+eQze8kq`GXFHkH{b{03m29qNfbQVJePDsr=8sew zsco3k=C3;w%`jTH$IMl;X5wGG!^ALov(I3gH_J&`3yR78_}Qo~3@hZ2x@5a(3Rstd z)y1fhz+!3jXU7Q51%xs-&RdgfL%E4?%nv0w$NfQ`&R`ubeHsjGbCB0YRlA9aQ5ol* z;R0DnN~Rx(26>@q(6cg?<;DZS_~F~^Q`tng=rj{v2^ig$ZH@&s3v%7hnbmrQZ8mQhra+OsU&K zQi=DVFv*McJ3}m0@;?k;+z%6S8e()w^ozm<0?`4YRDY3Ym7qnCmif3(iKYua` z?^+neZB$$%78p_MWz=@(U)(qH08jG_!HX402E*7%#uLS8O7R`?SB`FMPibZXfNVNqmzt zg@=In9Ed?Z5OhEJx8991nT4Gd@%<4!98o<6jauR~nU=zO&$OMJXf4@5N!a zqTH&a@;UubDqScyQDlcuD2)U%L!tN`Mh&L)os|=u{8F;N-EI>a6ZGg%%u-`BDbIpp zSIx{SjSimOOVkybx-V6xOrz3Hq3c9e>B#0?HJcG|T4E#@DsS4PIy8vCXZQ5>7GYl# z_atrR?7gdw#YIq3EF~_31^q@4QpPP92;GS&{n^?dF{P<>ffvpCK>8X?9prdhe#VO` z>8+>tC-hlT~AmwKLSW6@mq`5QtT3Ga!Z zrXrYIBB4bDog1{nFrxPp4K`C6N+&6cL<#m~`kvWgAYLqG`3%0x5%NelNrX`(40D76 z5)Kt%3<-ATfao{{vTt%PQcTKVQD(4B&JV7%C?)Cp*J$&E)oB@NsEBw8+B9)xq`fbi z#EJs33X=Zg#0F6e)zjF~NZQ?^O%4rGn+VSrJS7CT5v~&KhIfL>1Yz#wh<@q5>UJ_u zO=1=_Q4pqM9>hhB&W;W;4^Ltilr0E7ZfRD)oN+jqzj~GF;HrV34+KGTH4bDr%{t%M zn#3&VAwkgmRR4gvfSMO4F$yL zkpCuj4l=x=?|vnHtIJ)h~6%*mPax z`(o`BD3Jg%3LSF%8KHNI4ULJ*6>et0RZ6b=9G5!jo&*;M;Rpp>737-hxX?FH7e;vC$_ls| z$#t^hlH=KNm-l3+IA z8b7&_?E8tGyHuck6t#c+N2`5ivi3HzXE^O+0_`Hi*Q97~C;J;jRVI)yuC#QLvO<(f zo2y-f?giAl7F^D6$~y|^A}K}>8yW(+f|T(GF#K7XuqPhH(WFBG;aP$)Qc$rGR02q~ zMwV2bMlXR|y{}5Q&UFa|cLSGmu8Ro_k|tLG1^v95@#1!M7pYQmZWL_m@2w$&<&mrk ze9??);C@2fsG+h@(A|JwQi1nHnl&ktobv(0BxN=7E>c&gx@@wskQ_1T%GG2{u-Q?h zV?-Kk4hXufJ-PIQc(1Lt2xvCLXse*M5fb6xslYqkSyDwxhHpvyBIFjv(rBu2$1{Gr z)Ndo-`>U8hE^dNW1Cqu;PUA{)J_0x?ZZC%7)=7>Vq|3yu>N4jCW=sd^Vv*3SA_*~B zW}=Ws%88<2b}tD%Oek;1Px}`J^ZwYfkRqdvGK!dC#{{CeKzrBHPchod2>!g1(K88j z2>eCm;8~<>0L4TnJ|2QB1HNDC9W?}psd-e2Q~TLop9xBTdq{L2@6|5fS>4-f!3Q&` z@MfW-Sn zgb5%Pg^0x@E)Y@s>r7x}L@!lfXRc1$ZgAk-RFHD2DCMiuab=wHg%a5-bY7}np%**7 znAbP^ajD_dRK0CPk92xXcY&v}i0+rFSLkr37gK)HD>O4zZ#y-7{U4hS!>qkR-xC^2 z2cgdsWjYMAdWAkHG?We<)cZH5ca+sDbZ)9%q31fiZhlGV%v8Od)O(223l~o5D|BqC zUZLANy<@DsLVx);V`1!dE@s}bP`yzEbtKj|A^I9ouGsC7&W74hib;7~6pVa7`#C7I zWu)9HirLCw+U^R%wSq^&lVX*a|qyEbGyzbarOLJO zlBm@%DHrda6;F9--Z~slIv#NRoL)YBCf~1%H#k@itZI;^Z1{whZW6>K9;OU&il+?@ILG9~# zVGtum5bvo%PnWN!Umxgs(APshCZA7UniQ(+@O1|9Ei{v#fe?-e| zh~S=vj-afuZ!?go2t+T#)pq~JpOVhx^N_7rFi8~|ja-fol?c)lS%-h^n`CAg&n0l> zXqO*dHniCkeIJvB3Qenz_WZ7SCI<6#$UVn>3Az8}xNE!jaf%~#H>!!X>@Ks#KW7{K zm3V)}^47LxSX;!+r*-|9JI@^RXejUz_b~GqKLL&ki*COy(UWV>@4;*|#eX%)Z)UXK z!W_9Du-ocsl3e0f;l?AbA}6wt1GObxeG-THaj;fQ%7mT;PEW)15e+kkp)mAJSv#){ zMPK9#NM1MV`gCaF<79jT&}35OPEKE_1ikXvmfi$rY)r9sWn>it8l`}c)hvg4dfhL= zwOJuAdmCtcKTPVB@5grGm9Nz<(0OLdmsQ@5#7O*iZcE=WXnp``?atCVNLy`aQSXoC z_S_L?wkP)GWiMR_7^;l3>yPy?g#shcIcpdJZm_78)jQCYXbeEZWfR#rBR1+{W4d-6 zAYsS|$B>uZb8i13FeematutAMaV7-mtmucd$p_oqmTW`;|H9}fWh;DHDR)Nby=A0A zl7Jq&k7awGW3Geoup1zpOhpy~;e{{wP)!OteJ3LsX_BMppZup>#2krfjt@ zJGW&r3=9pyaTg_b=fde9E`y!cHp=nB78kL;l5-OSB99@tb?SKD!WK&YZ0~na5f8duBfveC36ZxeW-W-ZbH5AopN>eH|qizNxP zEbzSMc7G_!3!E`s_;36R>PS+b74>yd?-g~4q2io4F4)I!Ue0?|WZ^t~Lud!W*GcFj zBZPmeb3i$g6h3b?xBFvJPQY(-T`{P;lX{HQ!9qT26m|CfEJ;(8{ z0z#$Z&&N<~SQtfH0bz_kJ8%J8Hd+kTh>q=`kk25Z8Bj$qT^I+V*&gO3{E}Om14i>a zq^aAvw(4{(DA}}P5Hv?|>ua{RD+0GYU;TWBhrz0UBC3f>da(*Ow`CfNGTS6mZAJLZ zCsAWp%0v0Y&g+8lTBLNASyqnlTWP z7b;X!vusUrKG7aYj7KIhGB1NJ_(6CMCgsdU3F@}6!e77;2FYAEd>BQDPj1uPjSVFm z(aw*H?dDsJZwQu>%Usx!kEyb#cMg=qKU9@BNmfIS$Dn6!OLfS04*9XM6yBY9|K+!!EX#uMJIQ3VdMQ|21leAO zbI|0Xl+@)z)q;}sQSUskIh`HUd8~9Mr?3c#Ifg_yLiymQu6;@jawvR*+#ch(@Hv01r==Uo zx(=|$=~LEJ{l?`?6Dd!Il$b(8^e*zZU|+E&kvBF>_soEqw0h~n)K6lf)6_xyd}(q` z02}`*=W*u5MxfO|j0YeVPN)<jLG2) z^K?KgMm=c7Iqy6ywy#=Ky7BVOqaGu`8E79u6SkXc@|vh*xb&jQ!+K`WN*}IKBUlK!%jt|T@%YG@>3_!am!EbWlxTxQa*Aj?Y6kJ*SR$RSzYw%Qkc;I;>bU}t zVwoB{M8#k5?Ifpp9+G>g%{%Jch*gM*10NDKftZ-CJbgf$Zdz9#XF>3tz_kDjF|y zr|?abu5V}ex;>OWOj=vt;A-YHZ|O%^xmeIeHnXWW{IKrWrJ-1qF^EI99fWARrv}l-+bK1O z#O%4<>!Eqhj3nI^)cxPh+caOa)ue^sr6ZI?sa8B%8+S8Lv ztE}Pc3e;^?T)1r^_w_VHz%|yo`tew3n%fdZSA{NRK}pMs{U9e-*Rkp1$GybHPTx5_ zLtw@bpj<+>9vh+bkiN9o?-06iR$Kf_`J&!c;6YGW(KAECeD4F?UCK7cKMWA=R7x>e zi2w8J)K2AC!i|7k_!R`^Ci6w=k4BkFPJ@#Xypw6B%yh}5xczLZ&j@jLl5_WvcKedC zoaqJAH`|(sUIjlZe;+$oy^2X0J=p&FSB!yi3QWz%pfkP>C{{O^s-`1}desPoq4PCO zyoC;jUuj6qNK0N7gDjT@-ITac8uD$v2%00v4Is{BIOhQBT^se%q0~jbh6Fwx;d*N` zKEMt58Xhe`bxsT{=jf8=9Erq;^Qd9aIbc4-b`B<pmMHO`xHd5h3A%%V^LK^2FMbI$@{qN~$S!26GD+oQl)80fKG3f}hSZ8Wn zGKym=IBZ6s*|)N{sSrVQmDgp}lrnB?R=P;uUL;rKhq zziv~QpJ^SbzZOhXz7e|YWUG_WeS&v{WNN$5!i}MrS)Tz3j6L|iwKj@Jy#pW~yNrsS zN7nK0Ux6eZH|AUh%Q@Sf?eS_p>@|%YE)6KX^i6kyZ4(iWwp;mEy+pkZVA!)Nre-qb zim8Y`&ZdTvO&FqT1ax(kGr5yoUnCe!BPAlL5|3X|gk zL`bDDJyiIQLdwNwhi4lC$1QI-T zbeG}8BxR;-PD9x=1?U350Q~^Bhr7c}0fN_z0;KB(yW(3Hpu3=KlIjPggp=JmgFRVg5J=`4W=@4iNda{?0CRNx2lG| z=}7rUppmjS^Ug0)6;$%mf5S@Ff-zEm6aMACr)+P3G#@TZU2*ub*y)~`VXb@H=J^-5 z^y+0@O8tVuYvjMhFDKu|;2Og6n4EI*wUDRit%%ct`YuxNhodI%wws}2I(B}cCv*`x zlTifwxnNHm9ZKTD0t7M|fuPbdpYmCPyHHTl5_^W&O3BvS;jee>dAvyj>yyNGt9Ny9K?AM_%Xqz*qgx<+Yh+gW1?&L(iI8K5ZUViquxWn z98){P`)~u3$n=ib7FH-F^0Qr+eWgTbK)Sp4yK;1x5iUl?9#D0oRE<}CI|4%H0?ll1 z8Ggqr(0jRv>OQ|S!0pO5JZCp_sG5|-b#RC)dC8=5ph=Z9XH=x_dXxeuT|kVh zB|bP5TRVK*J=TYF62_G)Bh#i&sBeS{Q7N40#7w87g5+004szwPDy+FRO~N) z3>4;-ybx&Dm3qUHv8nA>&FDxioVsqV# zjw8dLz|ereeEW)N#{(bJJ{@m!_LUL;D{&qMN{?ULKU5A$yA-q_Rp&(N7xiPu7A}j& zA~2@)mHOMG%|_W<4b0l8ZLC6a1G5(h?EuIx63(o4QhGk3S^n-w(`j~+(gBJyYHqjb zaBpNo67F6z&=16)5@)D;71|`trh7es;lujp?B6#q5k0Tu_J)$%YrBW=t`BEZG4+*8 z5{KH-QD`nOg=Q!u{l@kd@76CrWw|!zM!42m)8gfk^KA zw}2xsS{LR0AxV#*$$_5!Rh0pM1p^tL#4jk@K|#?KzWDOPP}l2ZFlQHB z>wgM#Vdm??tpu7W@Q*+My?~$wLFRG{HzwN=O8hbIUy#ZyD>niR;*zl!)E$$gPS8Pu zP?3YU2p>f}xfAEtCj3&>bc)V#;M6J$4J#R*v;f0 z5#pcQ&4~dl&^$^?1}IGDu}G0v#)6Vtq~MQmyh5$sEk<<^`%a3kevc`ZZ(}d$aY4uj z%?fmp>n=c?fSZDV8cJ>vA#WTA*NZnf!HMg6NR#0HF29jM(2|`d*>LfJqqeV8UqCfu zw^lEFFmd)AL6cER{vY2BlGIMb*lE>CD2j;zYJ$9P5sUamTf${h7a2YSY16I;mUd8W zlL)Se2wEs;Uu*@N{pYZv3{2L?D@3%n#$4&=L7+8{T+_s*3uIh@6h1+CZq)lGoqf|v zd~QQU0af%jth~?G@6oOvMJd{c%FHI$K`e>3bkQOC-6f;6k`z9LfpD2ieE zH7H(`*@7a)zpp_b{20u?g@!;BzZT*eRO5_ltpC>C7Ook(K7C%5LkfL&F|+Z!src{?1Z^eSBPVJcn$sc(oHOiR;sSd7H#8)Q%^`5pkD z>kkH_n+wPlB+oZw)|1MT*nwL$n>A!QJ77YyDQJcu^%eFa*{HW3SYnb5RM#Qfyh!9{Adp5s!9?}z14!S3RkKpz;X zCa!NV^#_lF10lGf&x64qk;$L((<9?IP|)#aI6b&GBAxKdfc=6&;A!!N3kH_TSlGgg zd5pYfyU{}W%N@lOzf$66y4~p&q0A@P+!HztXlUmIHB1rYmXHo7G#U^m;=BAMDb4h| zPWwKPVV}Esq>LipzQI(TrEB?rSb=s9^_Q<{I-45F^ct94?_(C#st&WuXLc(Uxt39t z9$t)kry?kY&HkUn1`&CzmLdELWH!ga*x2Mmj8hkwZmry&BXG0$F%w2%T$~sz2PF;NgvFh0yI|zNVjwPT7{o`(2F);zR zlkyHJEk&wC2cxQ$ue0g>F^puoe+q5>TBFH9Wl|Q2cl0RVTtUj)9~$eSF(^o!bgHsz zZ*9o1_>+pDX?+XHKQoEntZ&p?Bgzptn}ROccL&xwLi;?+D7~Yklk1oWTh`Ky(8xuo z2eh{3GMijyQo~z-de{2#{*0-IsC@~=p{1wS0lR3nQ|uqoAI#R&VGoKDN|#)%7>O8g z#&dygBX^RW6CrtK$TCdi#L%9o;Cb!v@KCXn8|M9ChZ(g@lL=V#!*mC;drOn|DZ+Cp8wnKyqI>y1|5kM;IT;ze#c!lhhP?}LGPdrN#PiE*)ayE>z7+cc5Nn1>Byqh% zE^|SEF*c8kt&+vm*u0VtLk>;>X-h@JssWnihUp(Fy+zQ4EhfEjj>!-TDRHsFK!4R+ z^&!*gaLgK_T?`EkQSC#sityeRu*i zl$j!2FM?as6;vh2^?FGBWwwaN!ll-cs%ZeV23cU1;DbRj{I7V8Izp?qN@C&i6TI8E8K7W8i=r}?4?%nKb zxs1vLGn=Omc|z+;hdN{PC^2$tC4<6Bu1H#>O80(R&fdELEX)OCO(7M%`x0aAtP!+Q zP+#;oYrVRwm<5KvnEcB`#Oi~|NJ2LW;(pHh(kFTJ|1iAPMS|SMXO<(iFyDBO-pR0H#2GXNl>s@C)8%myasabd+w3kcH zRaQYW1%)PqO38Q#Q0GO}cF(Tj%&d1JVu!!Zo2Ve;4r1hff19I~MALwp3p`9O&_pn? znkg}Ye37~bk=n7VskIAQlYNe5Lh82Oh1gCt_dw0ume4N5H;LW=w0CXn1Y76%$8|v+ zq+ehH=hQ?U63mZ;h{sB0c@T+>6#1=GM!h%iH|WrGeQCb5xqKEhP*Av2{w;L;u!`9^ zfd!K*xi2OLJw4$?d|{Rry5)dds`&!A$6 zgY7IP{l#%^z=85AXqF(fKmP5X$x0^&B5s8D&N*n4YzH76L&)QI0D{s5;rfVB^Ha#= z@K(}DRECD>&#L1T+D^2U*J5aX=)X3-jgwwMxktbe6vqo9^}Q@U8s}}=s`y-k&|MjA zqI89%!{g|ACD)k!YX`&*@_UJE8m6zunM3X6jCvnI$nO)cLm(`xCqQ+4u9^~X+lMm` zLJ$!K(JFV}Twaht^v4$%F|)0F7k}^nfmYc7D3gDlp1_ksCiJQu{V=z;Z2yI7987U` zVt%2R2wHD$z>DC!_5jrV`Z+K$F<`a+!osxP=h2;Ygog zlSk-&Kxk1<8y4`Lj> ziq2Sg|7@kd^-%Y}PEL})(k+!&^1P6D6yuM-^S?nk4z3n|h#LL9H*V6!nYE#a@ox?6 z>?E)jKyV}+tLEg`qEDjM4nM!Dch$xEP;vF7d{nM?D2|1UahKZ6#ed<|9Y>8qOCVh<|?j;J^?!GVGT-zbH! zsYL`^uEhJEAm{$oF@RNoT%mF;OcMzYf?!%0yprT*Nxo*iMHc)Afx0MnlDnGR{_(2{ zlkp#c8yj6};GM>{^LD|jGp^7T7DMI_vc@g62%0R&y$YMahCUZcF(r0VD4|IXp?xI8 zDJiVTXZ^Y?@_&Kqt@sD!-R5n2zo@2v*U%M zDcB3hxN~E`N-_UKUHX7sVV!ush^B%C(cFBb#&!K`=UXT#l ztwO>XMl%RZ2jkZyP1oDYCZ1pEF0Vn^%;T(M`89A6V};%=_o6K4qwmIKMWNS>JN;C8 zCmsRqnb3~O0<%R5YM<8yF5X>8Wpx$)C31O3g8Q9kWn?zD{Fnx+0TtBZ&Jbrk^WIG#dwXK+CGl7+d)RdBbq*0?(&%#hR zmhKG?@syEgcf*79Ta9|dnq%y!AhDl_Y!Z@*H6+HLp^@gCkuTOr%Il(VasXYDQ`k(( za#46{cXir3<-E+uHWeh^A|emtu1?$YED}+YOv1I3ei`Yltez|bxDm$CI!HT3G>#)k z^KWeKB&|p^o_i(@m!lZDjH#fF5{-ie(u^^ABy2}Q%XuKIP8*MRNI_(=($y(;+x^)O z<1#`Xd6<{(J&HNb6};8NT&0nX#K-Z$@;i`u-p%*>w<(#rlT}{O2XiEl5Uf8SgA2yY$+)5Y7|mj zGTYGq_fytXpW$k48A)f7gzFQgcOP2&Bj16aO%x4rZ|jDP^fe9e=#3(APm-d(xR=R1 z8ZYLNWbVjFUx%4UTp?bKPZvZDm8Dat={sAN%W^*kPh(04Py&Qbbf{a}_WjlFPZ)6u}kM}plMkVk+|$HD-Pz9Vx6ln*9m zj!2ulDrk+Q;E!~HW?)(~ew*|m(E66E zU>Kq60Xd#L0+))XFUyNUxd`8KCaC=HP;Q$x8zcu>x{2j-WS~TH$#|~5u-bw)+0=-d z0Z_g(m51urwFEN(+N2ECphl9uz_O0`ZCi3P!M6aq`ly?moc&FtJ_+jF7CozkXd?aZ zA$k{3n1({@B-0!)ZMzIs?qFki3*u$Q?eQh3Y8Jf;Ibk||-Z)oxjVRe(k6>I5 z!;9!DhwJEOwl@VfBjs)_Lo3GE zxbH~at%z(Wn;Qqh+Wlc|QnnG?72wv{+(c3z$KPdY*u4b5>h}2+!(5lm&7`gcH7T1P zC;Bwd-nBM^TG_ZJTR$dbX*&gYYs$8>JW|(`95Y>Uaw7P{G5d^44hOh(%yjR_Sn}KM zITUsVjs(O9`ZRS9x@XK({ydVu`hhW=74#58h`tNdkKre>Fq|Kih@s!06;gn=ru!LJzFyf}hj8NjV$s5?=PB){$CLNP3(*f^g?=LDrH=mSa40XZp#l|;Y) zK8PWvD$JwWe1S|YUDEYx#S!qY0>64K)6NKMCPrt*c4XxH2Qa@Q3-Mk{UO$UW2IvA5 z-kKtxgblpyUJSXJ`i?eajU#SYq?9z&Hd6N$6@G^aN!SQtaq-(xhed!>_5@}M?U&WKc-Za!Xv?26bjM*6&V#F^` z4p7)x$pQ8w-?1qH;>4F#lSgu45ZYCmFZvi|T^pDf^g4YY=!6`*q%3Ws__tk3c_!@~ zzX#KWD({KnCy20>#DWBQf*KwL<|hb4(r$%WE?~dQc2*Y;hR~c)u$nDH+uED>FqHj% zRcRytGzC0u+qH`=H<|VX6Y7P!qICpzFn}u=9mF!EDcUeIr}n3OIM|;N{PJ7G!T6mR zzd!+8tRe6Lw496aj44?KymzDxtaDq}vJg5Iqlw=is9-GY`&pqTqF{S))q$(F_1EJu zl1!(8$)#2yfukwa5=9x}`Ub9`Bshfunn8haLNE>VCnu&$I(7ud+!mSYB#)N>y z%04^~zp0Sa22io^6Euc1D8pM*IM?E5CugMnJnAINGO+xwxP3#WS}-{yGkA$b1*Jl9 z>qqcZfWI2I0&?&=?UcBUCce9qOpTkQcx%esmNSF6jiSugm|0DUTiBJ}t@_ZA3*AnM z=OFQ`QLW@P-mH9Y%T1u~{-j^9Ln8+`*U74zc#12w2MLFEPZ{SZ_>5d2Q zD^!kFPGi{dwV92{+Zlqdh{iEAY5wd_0cnqjM(>Ftr?mVo&Ltgni$9mdEQ=Mz4)ET&k@>~+&nnNu z2tV;AcA=PT@y?%!0;vfv%q@}j6t1QZ#|f2%^F#ht&aCoMvfZfdaNeK^C@Zk#Z7fWF zv9nW!z2=-qh=Eqys^c;azBxbz;e%92`)tNsSLkXc+~WxAKrsZVm%}c23kax^0~4Xci+D zwY=Z$9b)8I(soEF@|dk-TMB<|ccfkG`fTVxN8GKQIN9EsaeA0=-t?Z{=_nrb#(KP2 zYcw-Jzb09m zS{&(rj4?L+YQ!lv-e`HnPXRw#FblWbRXZ)q!&)*pD8I$mGU|V6LBo_2+`;|?CI1LX zdn|Q3k2jD2X@nf0ai2V{j_DMNcoC9WFBZnwnhs6Jt z*!8I%Yt!hRS3_ykLFuQB^zR|ffL`}iB#-1uIRd@`yrv15Z_7y1G>b`j4T#SaCtn2G zjQk6B5NJevq)&VUL{|z6I4T_PlTO_aVd=&ewL(U>hPv54&tiycE`&|qL~rAKRwKh% zL2Vynt_2%rU_}JlT!j(od6G=^_Ir&Q%J2r>)SA>t!i`ck2Fe;DAt%FRYPY?=eHA&+ z2B*t*+~}Rm@isY19EYFn9}wOLuwN_NiHuO7jKQ+8%%JYXf>2^|#P<^?RTRf-!NJ_~ zpU*`-Quo_PzIO3pAzBW*8K^Xoup%H}xmM0&+8BG|pviy(u$aoi7~eAq&bQp{fKgb* zvI@UXoYLxh8rdjQwEAAldvA#MR?Dl08vOF@4gjDV%a2X+avOp?ZRe10fXvNDiv0FB zL7s~AHD_9wr?~9hm4gn-@CIH}Zik`B|}Tep}8b+EC+{+M+HfPBs`u2W{f)p{fx;KEKyGK zB8%-3WfeI$0@e~GrzPDACFl$%JY_5DMDIu!bQLL_OEN(x{(@jQ!91Y+E>bc;;aJ1<=%Jys#vK&(TS{fV^B?N@ok%eUiSs1l(oN7MfMon%;B+e8O2~N{V1Jz)3061HxerL4 zGIAU&T_$y=C?n0W4PEh=Z-_w&5jsF9$su90G}hfw)@blcoSoGt+y|_ zkig!1D6C4%@dLPr>aVsHPZKXu!zU^?i{XKBs#%My%^G;bK`QffX-i)3KbHeJmVS z2%*%aw@z6%?ez6wI z52L$@3t;)~`QTcXyvp&0%&6cEs2uHpI*x1)iLKO&*KFxMact|n>DdXSNH*1mr%=K% zE~JNg3FKVu{{`-#YX3x1P5~v{7`c@$yo_U7k79C7lDrxuxAujui~BzfQyG~ChXT39 z1#%WCKcE9Ofv`sm2A3-^?9^es)tT8H97JIQN%A7Te9xyKu6DH8X|1Odc$cqLW>lW& ztZ5>(7F4&FuK!b1-D-Bjqq(dtwPLyP|D=dr$vxchF_j zgHEi3aE>n~Ya(?+(8f8#%E#vvEE>u00g$gpfNCs0PdHk~5+Z_p8q-sxt-@(5K8%I3_{=idwG(-Gh`)j8AMovjGvpCQ;-`(Ybj0 zV|q`+P=2JZTeks~;0-XI7BS)XA6|!@hU{3Lvk=ogZOuyAZFwW8ogl=Gopy z^p$8}s%ANq#i^QwjyIa4)Vv1vVU8d&e>r|sABJKDZF_MHl!#$2nb9IK$y`7bFMh7d{e zvc0c%459QDQDF5l4+{1jcz7FS)%TWd$6k#s@|-QI{V^MT?q~F3S8X+JN)UdS<0gjk z$PP#}j31vt+-tq;AKo?lFX~&a#;FK0EF=Rao4)WZOtEF~|BEf7>De8)l`Z24@9u0F z^?%vY$JwH~3m26J{uQ99%jUb*eIvg}zu0{bG2dsnZ(P$t`f=_XlK}ia%zfuao=l4p znaxIqtwn)DINK-$^M2%rK*moW5FFol$Cu%dogIQnGfKWS)M~P^S?RuW41Kx#&UG5z zMQKskc@9|>E<(#_)Q_VH5K* z_ibZS?!IkoX1Q-0o2mHrJcgO^j?0To3A# zzQ#yRc3J|qo5^;OW7FI>%k>~|a(1^VD9pG5B`2nPP_7*8imA%+doC%>;iW#wwU@JF zy5=RfQfn3%jktja%7wksTDIrgu?rg}H=CQ8#%fg&|dtbSX$?!hcs#7fj!1M^$!AM3xz1 zK_eup9@RC}Mp7q<3ZGR}jIA_GTZNND9Ih3uN-MGBwv1J2Y4&Fy{G|C9&qOTL7ZE=5 z+Qh)n=QQqZ8sVmmU?gS=G0sFs7|Tb%T-9HpAz^FZ+SUv#6nWz@qZdFJ9Xf3o;G~Wr z?aH1p!;D-oG@jeC9?9zm^fUvSkrYra7pr8u5jqF+fLx0lL>KCb=_Bf`BiFiNVEP(g z(MwdcU6P`_6h&AYn%lA+wD>|_Q0VQ=el&+c!p3M=ZA&OU@r5KUD^Jsw#f{z*K|sTl zpMg|zIzZ5-L%_jdF`V)M;P5*cKz~$DsJCjPcND_HFd<;qxMPUT1_X~&)B!O+Ro5s0 zusYxvgMyGA`rb=5A)t>>`Q9hxdtZF_4apa#&?g{3{1+&koNCfR0I-!j;3zU8$n{}C zX+$rk%wB9xEc*wL{oFgM0J%2|&TxZMvJ1DROGHMNFNz|WivQdP5U>)Sc20~JkPNtRZ+#Tg;?It$UV-VN% z2tiFPqG^)(nII0Axj58dFrwr^!;Dd((Nr)Bny!^5xH#V4aP3rcW#MILBj;s@a{)G^ z(YJ}l6fjXd5nC)Qc$uQ8ys*)t7O3X?Fab}HAy65_8Y;uFhBCxDTmm@V*UA=z0pn(x zAn9aR5_!S&H*HJj()(9<(0>KC{t6HBZ9&PK>f3Kaakt%29h>+CCI4E1Gu@~$A#03t z5lz^f!Ssj8nKqX*b6b``#%0c@SdUTWaIETQ&K}5|_!rD(u5~Sf!{#!_NN<%tNb4Yf zka{+MR=^CU{oGatnvzAnE`+f#l{3gF=ngUpx`T{zT9H=?Ovx=n5E#fVqX#xCXbs?B zEi-P|&5YMz#7k~iYMT`B-K+S=EgyP&!`fT2EV0C7K;LJ3zhkXg-MLl}WHO6~tL^5CFu`<8xBODjF!QYyVX zN$F%`?t`mK?qN=szlb6oJ9I(GJ<+EYZN#lW<<|i9CV!4owgVP#i?j<#f7m7|gQWS} zBz^uFJ#6DTd%I@QZ(X9GLZS9nE%Cm|?Cn*lLuFm!9pA-4fh&?*=hI%v`Skssi2Wrn zLir>OU!iqn_O#gkZi#m`jxD)5s_U{#AixU0#Jh9=>^DBw67P@@U&Rb)7mkYf5h z>1(E93qiFecy9OZ8ffD1l&{V<|6?I{9puoF*a^@ALX}j-h14w=peTer2%idA^I5m( zy5C6M@6r6Zn}3VR@muLaIfYkL{~gMKqn47oi>PQtqI%|o({Z-Un+nK@xqGn8qq(_d zNd4Qra-f04@yOkiFtl#s)2cOE15ZN1LVDOSG@c;2lf6e@MKM zCSDrX476X#G|<=03V_lqadI}C@$|{3x#Uq0cMoQ6LJ!K1=dLL8VDwaSo8^p-eJ|@9H*(S zP2*tIyB$mjO-L>AvigPEo7chb9FrY2f`a4Yx<6&ezu-Bgn+_!v&;J#CR5~1=f62-k zI0w#@((y25x=a~wTMj`70z#phMT~_^ar1y(7=n!aKBKjtNVQS>?N<7$rK;)hs=eR#%QSw9r~} zR{8$q`FHf#Qtuit{n|n^HW(Q9&De_l)L6nzTo-ga{Ek;5LTZ!hFR-aJl<=v5mA6>B z!>*yq8T!NRL8Kl6s+=PvYZk)6(k+@`@NtI>8Fm$esp8|E;nlzyb;N{_pe8-4aAZ{x+Jo?Pz@hYT>&7O^rQ{eVU23DN z&S&uKb*&LYP$mHIm^@aJ+y(_yah*YimEUH_N|%OBRQNuoFx9Uj#*92lh&C5Hng1A> z#0gHSol^H~Q!2@tYau8=scA2splms1%>xp$)x@qK6Qt=2#ZTz&gcR9#%f-XOPlU=KW(ss1E|TL8tQ&WtJNGQXCfOh6vLs1dD>2)yDR)R zrTj@~Bioz>+1q^C7c=SD!2(0ozHuIkmSgBWASxD#4Yi%Jr-6z<7m2hP>08?}3M-wl zTs`u+nUf4hfCaC967q1VIHCOoZRDtx7p*QR`4InKk6hl!$?Vynl6zyr^f$?!DQ+AG zUKTB1NB_IOchsqPP?=5*<^$mZptNjSfFYd85hI70^|5ONqQb;-#jS4K?AmY6hV^%0 zD%_41-EMy2^MtF>oZG@_DD!XBy8;C1)V7))^OHqxu17X~qtYobvLj&f!|9(4*u*u#Vw7%4OY6h=P%Ixp#i^4jh`bBZGi z`Br&D$&!ZYYf&Janhxs!SS#G2xC&hZ6lyM}8otwB+nqr*d*G+kcp)`;=wsr4OI0J3 z3-3@fo@%~@3AmReGJidOL>9h}e{IZ9L(ChdZwjd_rpm)pRSMn5sC@4=s9YkI{UY-h zNac0-*ICyv{q~T)3hL{^I(1U63gwAhm^hF6c)Us*Bu+x}QoYog*YcJ%FIi_3buLNO zDfBN!=S1q{O(fVFG3P!WR5Tfotf!rNcp^8+Hlf8v&zG-4&*RdQ9hrX@epH`kZ9DwU z)IyWD9n|%wI#Xzp0~0l&4Z@);7y1@ZB*ZlcEOAtAcmFxRt)8O77*5DyYJVVAUg%9m zzKHSz$}eTvssZE*TMZ>Ik|f*q30^gpSTE)fQyzh{sC5saOR!gGgri@hHqBz~+ae730O;i|$)1#*4ib_;!tbV-C!z z_?}73pvK`;RxFplz7H|s_zwC%FxiQO#akYZ`FG5v>u#Vp|&Hy z#duvQ7G-3+i}b zLAJL^KQWHU_J&wN{}?rc$|`R|O_%4fNp-k&N;&$2$lg@dog-@tae9 z1-LUEcPY6Chq(vgBXK$#xY5;qL|(2mx_T5?vFvJC zo5}i2nDr^L4k-VD5#mWX$Jt3vYyyW;Qw=UV!&ZauNTHi(U7U~bGgytr8t^vun`28H z_9sf4+vFx_UqDLuot^fTs9N(jJ{Fs z*;{hYLXC&e{{Thfv1tvPBWx+tuCn{k?9VINY_3#A*Gla-2jWJl&}#zJ6kDM&qx35% zrPFWtE2t$Ze%Y8_g}vg2R729lR8>NEGpeQ~+4ni@LuY7&8!6n4rYETx7TN(6k(-@l zM;rOqh~H%7!>Bn*rj?{T1d1}UJH801j_hY%`ez5M8|jY}umLQ`R%jg)x}lrODs|Np za;TdXIyfAN*3pa_=L{;}K!;i zyVj#-fCX$Ls^qPpp*Zr$vhv)L)1=N42;LI~tFL9fAT=?5A(d zhYJ=^#u@}W;k6qB>1aD5&9ahq@a{gXq3+XcQ*mF`LMsU)i_)Sk3+kuJNG^cIvb-;& zG?GxrNb~6%xe?oqImX7Nxlf~@Vu7vHyKW|?7}8teC%u{8>J;S8%XVQi9xiGoDpJaI zM8|Dyhu;GAQG>cvejcgr_*^uMRem(MwSY)P=_sha&G?ku*vI|>Da<=X$TMe_b)qMH3qJ@C1T+xnYdRH97BqtQI)qMK4 znwC`?^mFBIa=L4Qn2h;`e~2yNR-0cq4An0j=F=4p^W`ixU$C?#ZC?})W4Mw*0|4g@U2bJbI5;$&@hKQD1@Oo3;@YYX9w^|UBe;Pk z(2<)1Cs79xDt-UYS`}i*yz^#G^xhd4m-CDytuEXF)V{Pix@GlkaKz5>OPPpJK5ef%as~ZzQyiHKj1|DRsntl`qs&~Y2Ah?YpyB+ zcVCmTXxv>gJ^%@mjN2s7_sNMzF%h+H{XCO3;S8D>WKacM9r#AWx2dZLx^VT4$+PFm zd(eH`bh-rdHnEIYAHVnv1*`gZ%P^A+ePZc8Ll^css^hf`6AVL!&+rBr*y&k@?F~Z^ zL^B!KomhrWc$^5Ludm@oGO!J|4C@R-rq6I87_bY~l(O>A*~+u6!fZ2&03EtqOvIwN zl=r;}qqj2na5_Vm?I!u3hu^PB{+4M)XcxAGZ| zv@ohO!_f|^{K5=`{5i=S9zL2r%xze;Cy)L=-rhSts-lYraX=mT~IcL1XB8PSk0<`kTJ7QyCzyEoRz*KH!mHP($_%k$-&?(Qy?t} zIY)g72!5|>2`a3>%^Ltm%J~ipyrjkXc3YAVSVt=HWkxDK?9;K^QBD2 z&Wm5y>Gg&l4vIuRnuSdDZ59-E_GBR2-$EOb{PS``+`x@L7{qKyx>8=S)3~3} ztEvD}HzcJ*Dm$+T-+-NlvsUG$qVrN|LsEr}IdfsMq{5uJ+%DD_2!(^@>TO~bIn&i2 zY9w#kz$u8ik)1-%L0Ae#SKx^_6m>wqb04wujkhuv{KA_^*3tjygy2>c?A;|%6 zCY;ASVnt0B-X5CGxiv@7P37hGCY@W2Xj~C6W;hWhO+^t}mzZ||)0y~)hk88kCiw^k z(_(Ip0WrC8RYQBr1_?EWYlCs+K^gS1^77aOr_hO-TG?Q+6;zpj@4#PN2jylxP&5P5 z&&+*bE#YSvzyT-NzyUjEfWn3ID1_rxRx$^{vB+5wT;piP#6Gdoc7Wv+xGUjo_PEfo zhc;}WXwg|RPIx&P*WfcUuEET>_@ibk?hZC+@!%BbPXKTXp$R@c3Byf*vD-7f?K_V8Gf)rnIOm9+xMQ|z;*zw3>cM0iRZ18w!_WdXxbVyJ(sZe)F zZP30KIvvt4{HFIqjEVGt7-cJnuZHYKACJ!I8|e!4C!9LvSD@i9raI|XBne1{ks@!X1Cl|jfO-QI>7GD3+QEyFUg>~hq}?45*Q2z|^Bs`> zh*1OUJ8J9i7&Wk>1Js`~YTzFjGKnhsYeo&+;{f#sjT*So0qSoWHE=nA+8EZXIVcES zq!=YiPCHVfY3-Ugzy=;*wgar>0p8>Qk5Zz?M;!Pr51j7izY&X z%L8<^_yKe%dCcoi0D^4W{*avRrwOFl|QpX_J|@mT8^O zu*)!{+3VpedB@5pzKFzKpDI^qeWu-8ep=awNc*t-w4a$4EkA7|)4D%huDoSTo5Hkn z&d5j@X=V9yy@hTn+bciBrXBn6z~0rrb68|jLue*&1tOY293)VSlMzxwF9T7Tba;{d z&X{99iKl~DuUTtEX^f=F%~f~(s0YcIsMvWIOgay$s#Setq5_;TJ219DW0=)3f^q@M z)fa~4;1wTBVqqZuFyq3s%tIBh7agn0+t8&%UWNh~S@%`v_mcrzrM&M64!gtZTwjj5 z65}om3ecYN-l`n+kNn1**m2<6H^Brzm(ku)0%S_iw> z0K!{FuHpiiJCULjYrBaV`Ykh8r5Lo>N%`)fayV8xJrHGV?_BDGLcNv81o3ItGfiECBBNHKGBAVD8Lm7Y%N~sSwJ;Zn*~J_nTugs0jHyhA zo=Gcok~wAC`3kvW9L}SH!wXH))h;&GiU$cr()s%VlYd8{NQ*%987Oasx}nsp@P&9r z>II_D3G59#{e2=;0?|cyD^ULPF+~?B!dKOv+;Ya?HW9NFPg^H0CVs9Jeh+^m%>vOE z_a@7euBUcBat4Z9`-y>2x5M9Ohj{XkJ z@JD?}~NEv^tKDgq(4HOhD0uq-N18%|qX zLh8JSkf=JMXk0SxN5v|K%IJp1lZOBdR>^oBUKxifaas?%QSvkLI1Q${Q*=9lr2#gd zu=5BzS6~(MYsmGMc@Hw-YZx#RJKLX*S2WDEN+FNcdgUKlJqi#8qMJoH0EsP^PnjM$GZbXJG^=o68%#_|C{J5&OoPoy4)i~5695w#G{|Bga=}P zEyn<%_fbO(jqwV6uwU#Iv5dHFDS}4&7s!F4z!?ZtiJ&SWl~}dCrbHP9isI@`eJ;T4 zL^~!dUq6$jAgm;UlKrS)`Pms-7I~E@B+EGt%j?f%DG1|*<;|wRC!WDFt`eOj%gzqV z)H7KMLYA-wD-E3WbSinwnOmzJFdK?(L3ghC>y z2f>P1PXNoq676A}v3l@urQxKYIH$i5=w+gmrEc&lRo1m8d&!AU30Hm3B`EbhWi`R8 z8mMA>#^s2|{A$49!HzupH)7)lc9e0_7p}pYjwZmZIMSv>>II|itxyo9>TedQ8H_e7 z@L6Ft%G?lle!&s{5DvFxtTiv01jl9}uTWFnWO%S|)&{1X#gnb1NhrNBD67 zKs*nBY&Ju|Xv>1l{+^M{V6<()QU4rDXj0J2Umr*z5>E_9+ZEjGA5Dx_1;hN;5u<6r z)&4=ic$gSh1*5GC4*2U6qea1EcmYPEf_B0~n*FxHXq$qD8sofzn*JrxDl| zuvz8+XEO%=UUSe^a^!Vd84f(e8Gf7^_ZZ6@7(Y<`(^0}(>|vLk)N)V7OfCm=vI_0H zlQ4ur*NsS2L`tHYiz-q&G|IZILaX8W#Ci-oUC-mEUjWtmy?Md+mkc49&e;fw9; z$b!U_eF!~?!7Bo-4UDoJaW|AJuD|LWpN*rWUrl-~PIFD+?MqDxdPDs)tQXc1pcyboY8n6JI}de}_0DFKz(tNz4X|E>`k4E%#W{J=+le z2LEt&2RZ|tDtX&@deKK5^>d)pv%6WD`kvq=0LxehOM1t+gt!$ki>!_vlR9veNYjBN zQ`dsSy#S2>%_CG{`u0)TuI{8YW7?HWE2@jLU~$50f3TDWM`j9R|nB7|));p_sq2_XGc z(1DyraRZX0?sg#GYDj-I+JWE`EaD7MgB-|x8ZuDz(2)GOk&u(O#T5NZDf7lXGJVx8 zz!CERn@AR_3mvNO34X$*5;4}S`no`JeV42L2ukT6+h84T z<0R~;z)+;M8iRV6LtX0Z-EBs2Z-7x_+>(CfCFo-cPY{|AfnRvG+Jt>I;&lQ~7dRSN zhg~PKJ1Ua~+9llc@axB+Y!(#Erm89MA9zk#+(vZ94IA@(fSZ8a)d_1C#T$pbg9E&2$Qxj2`57gD$yrGUPs_+0L>(| zu5jtk!Mk!wA}`y|K#Id)K5==rB_`(ijgYYlp$}-bZaH2E2KJ2}+I7UbMzBnc?VcA& zLe`EThaj z9;(Hp>g@<~`;27-xAw3o@X#!0Vl_vSVHyB}eH12=eTeW#0-IE@iQJ!8hh;VyY0}ue+Q~F_b9F=3Pd(v4-a#)X zjomBaoW|}d2htCa$XrLYnN;mKzBhLoynNtEgEyNgyOCmQ zCQmj-bjPq7afRv1e|%U+@DkM^dWfZrnWs~vD>m3o!mQ8?(nZ3y=8*7!$nKBDyFuw_ zsj5lp7ijz>bp%t__Sf6xwGi!``(8jmpfEpYRKnz?j{e`9%eD#hFSY>p`k*%$t1w+4 zn?eu`3BvO8fbh?6QYp@hnwG(a#{`%HI zw|-8&03!Yy6A_?@9Ek9^#C+o10vvMvbs3fu%vGV}vZy&vi z`C~6(h4$dx3jctoN7tDxq1Q(W`X^Z*6(?Eqi}Z-HN?w2|i;%+2h3X=-I=)h<&=*}0 z^bHnQkVB}kC(}7bc{(ai2{7u5lAzfH8haw-1*11vp;03K`grkjeoPMt@tCSg3OH{2*CW>^yU^0k2BFb$Wh)`-WB zbPF{?i7RkCLat{11AZiU}r@y1$< z#jPP}pd9Se7hR0LTZFKScsK*9OJxpx($qY(rLcRNT7wdGO@QyGrsLYK5=Gs-a&@Yoqz)V-*n9g_k%UfgM@%{|mob8-t znzN>DL4PIaRThdZlBBB2ACH0L*pAjB!8K5TRJ8%~rNO=4WXY$gzFxzicyaIr3YX59 zw~nT034EAJoy4&@xvCKjQzh>+rc_6Yy>lSla*P$)fEO$LD8|9us(mN8+MfUvh`uQ{ zctw(Lz*x&u3d#9(CC?wo6i}(!2bC1>DU5XXWaVf(s686u#kaE&b9LV|y-MC61osD+ z+AReKdyvTcP~=@C@*clXouQ@T<$goxV(5noVWhSKxn>Yrn3E`}`jYJuNkh5oW=oj?<) z{EEOTSfOj7oE3f;KMmtuGla2euPt!#RicRYYzW#&8@dvjy47u22e9jRkmWKHPvTcl z55s)+WndbJz9iXdhj%M{0iLkDwuF)A)AGO=wK-UngUPxQ6+x+DMbEuSq&~EiV}J(d z%>zHR!&saLgW0>Upqy7lPMxllla0BAL^&zt$q6RNnMyei{EVLt9jdzmrDnnkb%E2>6m7)f+y-kA1 zV6?6ks@0nE#-RYkSF2#!kldUZ$PpdEXYB#Dc^j$sN?j7_R{T|ySq(nuPfqo$P-+!& znvBUu;Z%gJF!Yp%N$h30j4baImY8culEPK3$Z7&u1)|@J9k`{`3U@*%E8O@6vzN(9 zGHK=N<-0}oFq(BFPz|Mi-_dz%i+&ecp=!{_3j31JEWzyQVq)<3c*;AV}_pt*I@KUE5w^rF(r()Q;PBx^j!(rT1`G9 zz{jXN1bpmKpbtbp7jL*+^z2=Zp0f(dDZ8`;J*##B|C9S%J&(dN)RSgOP^Aq~w*VEN zxIwhfQU`!+Z^@xD8$=mZgZXIF*he}!c8(R{ zGGbot#T+hLvk>PpLhK2Zg3%s0ghKRbi3TdM5O1AYj&T&&cnh&U2<@MKqH#=)OHmRu zkL3J^z7#Xk3SH2h*VVL+fxx zA%-Q&i>u!~x`F*0dznwe{!^4wd4)KFm@~bYj{{S8WuGCIv+su*fhe0+D>Oz_8i{A3 zeO`E=9Q!mumb~To6=l_itig^}Ek#y|s>jS%2j5_HlodMJhdDovr<7w|^yCTVtA7zV zeZ9w%Ke~tgHAsTdOe@syd~$ft;lQKA*%y7vTKkG1)v!XUIZ7H^ocQT>X|CENNQ!vJ zfTu1-2WU?b}#bKpa|4(^a}PuVOZM=%@u}^q#%1(1FLC;?i0Y>A_2yE zT#uIY5Gj_!nCA6S_v}kV^Lz1(V7jg(mcy7OdJr#5@U9|WO$qXO_k0O6`U)&B>wGfQ zpG4$CyG)o4z4EIN>2G)otnpJet$}l2hDmAPo^1Su7lOmS@_GG1=sF$D52~p!A=HmF z#uv~~Y+5G%{=FktjWuw5QNlq6C`pr_X4e5fjhhb!r3$-Y&@X8qv|~JY=F0t7mq6pr z&^XuEQME%6+FQg+IB@fW+w7ugl7%jk1+h^w@AoZnOKM;baQI^E3j;ZP<@F2=v%+%Ok zG(Aor$;FEm9)PFoh%QAnbvxLrTPfo;@CZiF zwL(t_%SXH{H^2dKlGqt6SCi$9!g4NIUQ3qel4VV@ybe49(Z`Ttg=S<>(N1VtTtz3I zg=>9`TkUjLQ3Qzf$agI~Lw!tNI}L6&Tho!82yr*je1gWdU)>Be@=jK7GUN5B;3(h( zqT58l=BOALV4>hd!Ep#IjDq8hf(7@u3S!<%DW2#F1%pKwx=5i0uU^-#~PUm0BpAq(c>_-LnXGtJrEwc)up%4D^-lj05{1KdLQV^bLN4)k;V1j(G*fM zSHt4U&+css9`?s*jf2tgR_HanSm7mjijEsFiy}R@GfS!ex_-EfZ0{gjuLBA6dJ)Dj zTTP&_EXo-Q#)0TlVvf<0r5WcKQ6nHq8*V!?WVaTLunVP*XjB7Fn+BF`EEVv}zu%rE zzuQ`&KhgbJ;lp@F?!nFxD|A2rdk7fAjUvDKe~b+0u9KtwPb0b5pkjsA2+As=^pf2z zZ{gK{Fw%*8QjYkyMOp=;=UJhr1Z_Ui>S8a76>0&$2O46V^R3W0{`gi*wGc6&m`ZoO z1JDe(QAvO;cMbT1Gp)9~53+-$S*@p*oK#?KPETM^GCIDnA8^cCyT+ zmRf!%;-B8i-0JL1cQ|!r%0Z-HtwT5o>UKem%g#S2id^OMl*JH|zUE=t%3*pfQ^J}l zG8MVNG(o%Xkd_XWyfCL2%Mmyc6{W46w>BC}`wm3ivO($wyjbC(ct$SA7ALHQ2;edT zx^WX0qT`qUg{Q#T8e5?@l6oFf;cShpP(8eAXKP}GxaHLUr5ir0s=TB2OcI^zVfVDdZZ=cOHaiPiaZa|FX+I;)agDJK)l#N> zp{c|*1a+mLmgi*4iT|{R)42|(6-@DaI0@>Vf*O~d1u!+vO!Z`H8%g_mn69toRB5KP z)=a%lcJG8lCwmy(l6JCp(O22&7#Rnm>!d9`iWvqgJP{LsoXls)YlWhi2t?2MJ3hB? zMsC#+>ZpgnM$M8gu2d~SD~(C^$?A0&Tr+PC5W|kSPEyz;DP`#-_HI+yW$S6?uYIDa zQ+`AGAw$EzHBFM%CLiH|=^!_OFv4+y?yy$jrxGD4LRjHD(EA9{ z&xjjH^t2(G1tc|qM6ZB|&K}BS5E(8!W+>h@6t{ZC)MXWHPX#9mStqQ2;l&DHkEaNl zV#qG^3fj-Y_?yMqUC72-q4R~Ti9>do#5EW^=VNE1f^zarzd{s=2DY?tkm|l^avzkJ zDGVP9L%e){e-y*EubDZv5hghsUM0zYF!?X3dy=4Dg++r(B!9JqgF4NiN<8`-4RyJo zUX7(F;o9EiI>gI$4Nx7|%EH=!eflf97QTVZ6IL&f)v1ouJ0g1Del7)X!E8LbV>eP6 zNYc+hnybq2w7(RJ`9kqN-mUOkc)B&^;67MpH1tq6-~mRF(HQJnp-W+RE6h(NV0>?^ zxtsjQl7HTRX^b1bAsHugQAD0$U4(c&1Wy97PQbHELBZ1_pY;z-U|WA6&@%*`AuPr| zjn2Zj4KWXVNd-8Z1LiT5uFa^Br!aABGf&B;)y(vUwuU-O4d0I~(-fWk-Dga)j zCokA-?{5n~*o;Xfwiz4Ij&e2pRNW4iW^B5hR#a`l&VC5Ef#@5e z{``8R{s^tBsQ(BkF@7N3gI>C0sQLC_p?gc{dWh7nUa1o#+~SL}KIwi(0zs zuBND^*}-cnm}H^eokJk)P5LDEhVo--fvoBXs~Oa#4OwktM^RH)4S=OV>etip z%?z8;^_opwxsua2Ovn>X`(bc3mz=(AO}h-l(a3ng(a3mmOnW6qBsHQml9}z_g}}z? ze^agjyXjzOMw^l|lxc0Hw{{T>XFk@Lz!>p`>&1+ArOP0fxl9qk75!F*jEvq$jNV1XbNpkq2q<2ui$n6FcEm4Fu^2r zDT>vte1#-#Nn(1#2~a20b3v#?1XTg4#L9xX?25vE0_HzjQs2XPy81T%pZe~m$QA2o zq{`}T6oI-2F^0VY9D>o?vC46nmF41!9){b{f3r8*hPwJc3~?IS6iL;G$LidkgGZs-_X`J3+hK3a!P96<&>}p#Eech~ubf_S=H= zfEB78l({*keOL3yM=mOAjm%mat*v&;gcW{ecKB%rhbXMgvkG3X-9v+ zYK2}zcY=L?AdGZ!zKGp|bSwNNo{>h*7r$d8s0u&vtJ!CPTcE7)DTF&B;2Vj0OA+%< z&c^Ue5A>?vXgbxk*Q1p0EkX`GUG5<#bt_YcAyqX(5k|n!G$mnSs>rlTUejT~>IAI3 z?GUbfctd8KmZlF=YXT-)&s8p*Uu|ItW=TFj5~G}w)sMgMWIkUIm=f3l!jRAB1ooZ4 zz9kGF_C60-!9g=?cL?DV+NSt?oK^<@n@Ni5T3@{wz9YL-Qa2wuGzgz<_^&G&o0j@@sQk&Tie2E9}jIgOAjjDGO z|L0F(p;8RF^k>ahhzIytVYW83(2HV?4M?}bMR?Lei^Up<5%?RPut;!zI1SG@AfE6U z!f@20U~yx2O>=UFURC=5;t{+E<8RFJs!t9YAT*$k#{BjmePHdJkp@Y1mPjD z-@wD3AmnR={8}Nu+9975Bfm|PPg8AU>%=pM@1#4 ze*2ox8qLTi)i+5Uf(_x#XRfv`90@yr{xRG8j%p3CFuAL~gD0UScl$HBZq@CTz9Pwd zlH@HxHn9HqlF*gvPtB7lQ`R|Jpl*^~Hsisz0NZyqqxO@nknbOAKbG1@5&MevrMYS% z!+Bj<9vMck()qXnbw%>g@ND@g90jHRU9I!+_a|C#hSUhyUa339&(4}9Qm-MklclY~ z!epsE#Y>h3qYRj(J5aCHaDeTFO_`;8&@5C8 z5NeTY-GRjDLJTz#Pn4oI>+3M4*5Mmu#cm;D^Q}+~y!Z#98yXLRzEs_>WU)Q?fD!nq zCRFb}c7J_Nkb~+8Faw2$(S|zs2N+|`A^z8bf3Fo^tvsU8B+j~?R+!4n7&qp+-UJ@8`6AT$yWkOQT4#y!Z16NfWcxa#A z<9ijMQ3%`O-FzA8mw`T4{feiW09oo5*1=aBQ)LeLtx#{|%?gJAku1NB4xPP*X9QLM zX7CwHK6$3d^HHweA{UI_B54{WB~!>{A|wbQ9H`AnGXk!11jLqnCs06&S3u1K0fJGy zl3C#iN@@{3=s+WSMincx7kv+=SoXkzDXKB}`_gp@e+~au69KS45Zvlkh@Vec;oZ9> z0}0zhMuKa3+e7*q_!-+n*m#-kA+^PNcOx{Wrwm6ex5r5;#{1U8JZ4G|a)BUQK&*Km z!ZN0*7(Y~+3Q)49KLuAXJxbiJkP%~HrrjUH2vRMhpm!^sq^)6^?!UIfN@iC`9Ntv& zcvA4BZ+jScXAgN768kn{WAsT6P#2*7L~bunyWPa?S-y6X)-4$&&Ztk6Nq0$JHr~{a~jir zP4KH?{|8>I@FRG_ael!#$yZt9K1SS&h&xSiEj0LoI}T5HeuCpPUsJy0R5fsq<6!eo z3eI1|?xHT@5WQqRubh6Z%`LFS;T5!fNA)XgCu_p6Jm!x^32Ca3aytoh9 zT}(GzgldEZ5F1>$ZD%OViJfYdu{ZMvfFhM}WyUu;jo5oY9KnGIu-`6pc(h*|GB7sr zqZX*<98BI;pZ2b1g|5Sk70$&IG%p*PztJ4|s%kq9B+c(gu)6{&5M_I1g&GUlxg@Kh z@tOnA=C|yD=;MNNsvbH2g{NfoT;W}+Hj{UXZ<_i6PC}ha0kC%hEf9T32tTbv!oF+- zQq(y{rEw(Vp{f|*tb_;KuL#9Tp?Fk872*lI>_@lgV6uO)rvZ+`o~_U%X=KKr8OOeo zkAOz|R3+mK&3H7>RR!kt3ZY5CxkJMGLb6U(a}3RoaDLypnx+j!)I)k8`lBe5Dio*B z6^fyTVks%=Yl;(VK%tNxh`u8f+wg9Mza~YJYDV?()e;D(-t8o;rU{Ek__h$v62hm2 z@G%l5D_a7lW0>_p1L$kQdu&v59E70PTYPZEG4GLQiK;8SqbifUt83ol$om@MJzHnv zAGXMOr-72J=7G1*(wLVJvlTFd(Jq*HUJLORjnj z{_D%sjQ&6is}=y?-d&f**eP;9m-nCe9$tla@U%QUkCNxp4$puh5pIwq+e(`4Gi3W8 zvYjQY_5q{d#X$5R{`z}?T@m_yw}ZYN>;}Zx5jj`=jk@Yf(d-729j7tvuEOpRFyR04 z{u|%J=V&c&^RQh`wtv3s^!tiLxoQ#FR?uvZA>>j|k?l`)nECI7?Iyfi;dOX&M8u(| z6?z}PFb>8kRgcK;mjvf|;$TD+7T6<#BlYZE#JEoGvhIKyw>xS?YC7l*(8OBd+IVuv zNwyerPN!mMTiTf(?Xf|oM~mv6XuqRvF@qU8r`m^y>{m)Sacd!k{{0SnfB-nFBd{*l zK&q-QIQ}F$WvWfkwqt^(0yY1Z8!Yht5b+ep^$ zzYTAZfd3}6l=g?UXt&pZg((!gTj7OxN|ArcF^(Rw{4`JsO}@d?K>_wJ$Ik{%xC_j$ z2XnLUYy$kl9xmJ&m*V3q;ocKZw7-wZ`01EB_&&5bNBi!@C`Yvi33f9fds)abgzWMP z(in|2WN(rzOOqv&Y$?eiHJKNBf)#2B-TkxR9jy$>6q3}^B;TSq)FhIu6q2PvavORu z|6IxXXXxe8XdcEN_9cg;g*&FYkw;C<);P$0Tlc-)A0D?AKO;WJh9S&Bc# zc8H%Ry52J4ZrH5(TeMjj$kjzCcDBynLY|{*Gs@Wj26hIx;_!YebmANe`4dm%?+W53 zt3F1>$2_Er?U9s3P?CC6Fw6#l8{rZ5YH$cd=ZNA=(e<)c{0cY5$G53@ zyQ$-2C}KvL&Q{Q=laPneZ!!;inSLG8^ZvzK9@|iLxkks@wM(&(6zyUZEr22)_X_{c z_(iE~J=HeEAQFh!mgxE*SX!a}z`)0hco!qr7Cn!tr{eUCz^q<9d)x!5AHL!0`4-YW zdcL61y?Txy#q1bG0Z?Lk7UCCuV=??(wT7Pd?O8PETv72lyd(a>(>3QD^yprNz9Rec zW9%DJp<|%dhO2(2LJ?9NTjpjV0vn<>dUZZYl&yjy*4zXX6@uHU2l24Ks6iE95f$IV zyA^&DPx-ueAic!>#QIIp*$a^tjP@)*H_R;nV(iz}#OGq+WC*+|rqlHlSf8>+3H7B` zXn+Xni>K3pY$H({5aFocz2N)ZUVLf#-QJ{~M|Rl@_Z2_C5(*|wser>x&~envJK`GU z1k7c#Inn5<9P}D;K!mp8mq3sB4erk3a1{9*O(R%h`ezr-S$p{emUw zdmFS+FQ(!w1AGsVzeTl>8hcPRz+b5&QU~q=sTg$$8^NKOG~<6TpvDXKv*IbHyb&P) z93rmx@?n^)*WD7X3`Xi3__b{blN|H|4SDF-Wd$Ssr81z)V@#upVN9Dx_XVTO_cr2vT%8ZC`$#UmlaArjrQ=Oyf573sZ5?D$=O!u z9^r5YIh=4&h7o0~p!6=-;jfwZhnv)sN&O|Mj}_`F)E!7&OcZG>>JjBUzyi?)09v8X zwm^lNT0_Bz!ZvmV!FUoF1s7T2NOfb+>Uv&FU8L)&X|H|;1?%ZQbj+D7kM$r3M4u1= zZ{ZyqcJMSk-LbyX8%yb3j6xN~@)iPF6@U|F>RR{;)Wdl7q>N!oMM;^=6b2~Ri!#t5 z7^g-NT=plpOz|MJb`Y*qmlB+m3WVVV-mVQ&*&wJSCZ7UZ4gcdc;IOhvC1)bDSO-~j zC^r)$#n(b@;7cmv(>iEa?M>C_BDvUCxf_%DwWQoV?04DlsFxE@O# z0npA7<%U_IL#SU?I1Mc;l^cpl2ho-Q^*wrhk42KpQLc)sTysacai~8&3(9R38|m5A zD?Q3(JDMD%s~Gj#IKZo^-pf^KyAf9CF}zsed3aL2Yp|J000nreZt?1kfw)B5O(0Bc zH)|{ffjGSd%A6ez}mRqM}=&yvihR0|+LL;=cXA zGuw;_^!P%5z5F{Ec|Vw}KOLRLp(Xraavt^EgDi6#9s!;kbz~yY^F|#5N%RhgOt|(6 zh&)lpQ}~(CCru#5^cY3Hpu|NTQ;9M{P^3W`0u)sn-lS^KrLI9f15t$#-U{`UJYU48 z9v5C{8s4eBOqOwMSL}R%t?*4YZDZl=YCQ}nTirTAly|Eei_<=wPAMfKsNpC2hgifM-7^{0N%#@I{(8`TZE+V=|&Ud~-G)e3*ZTA_>8`S9$ep2iYUZHXilmDeAql64bd zy^&5_M>IU9Ho!7!I~x5+BVU?6yWtc-9Pw9B{ox2Kh!+8|c>;YP`iEp=AKtC-PCRkA zVXWL&fGJMUaLc_77C7u>i)a=Rx>z`usCSLUj0v!Y2*dB zSP#H{EY?4$_n|b}Le zxVoRD%ze)rneQMqL8c&lN(A*0%7J$JLS!FPYw_1!fwnjhjf%{gNY~*(oW1fzX3T#^ z%!14bWU2SfjWK-hCcp8*?}YHXn(ch}3OwWZohSTa_FqPR^<(_948Nx2S4;T)1Aego z=s5fD1zwzAkk9t#s23`JlKK*sW`1`94+%t z!5LXSV=411@+^K9nZQiPE|`$WHjvd5Y{Yk&9E@0@W+1>&65bS_vlkI(>xJs4*^*U<7TD>4{R4SHdfsVRhJt#WMXS}+sui_z z<^+}#QU?&3_cSUc-1vaI1(t!kTla;_&(AP#mih-~q{tG<;~upXL8f{X%Guk6rh??> z6TDmD5AkFkQv`PEH1l}NU#ujamc|c8Xlb0IshiD(g7-q0oYWdPA^aX+8{D7lTn!q( z$liwd{ivL?I6lm1H~@@U9i1t(fy8V;Of?Ko9#_U;vmEe^3GAbMFTt_}6vQm<1?L0% z$kSw@*FzSQd@lgbS74)x|JBPgOPTT+QijPDsrC_uA+clHwlVo7A?(jD2(dwJD?yKv zc?|6UVbcW7J*;d$VYdOsL&W7;5k~kDK!zs}G`K?TF*{CaZ!pA$l%7`G;RCqrBRs$<_CmLCveFB2C{49J(@!eCD zgFT}A(IrLdN=oJY%820iLT{{%CaHEHG=WZQBVu(I5y6wP@dbEP)iE+&1C6Re88yKB ze()wrvYG|vhJ~Z${h9@2;|q_d`W|`X-&@IH6I#?rCOCA{+NG$=z`#8pGlb&U^(0*Y z-w3HG_j7^@=UJ!Ag4sHzek`fD_e_nHRBR|XrpAM{QKGZS$Df@gAG)^76u%tR6;+H_ zsLl>}vFc8B>Oq}Xz%~vyMZJ#9`s(O18wVn~NZllyMN0Q@bUJ`BxZM)O_|~_fTDI4C z>>+|{0IWS$T-=()B_)z-e@_Vm=kOEEY(}oknV92Xzs#X78YzoNn}8H3%0MMIAIJ)H zIiQf*NOg6j)*|vkfJG{<1I7`Rlkb#2_zt8KQ>STpJP{a)4)j)m){N7luV|r>`jE7b zAn|+CMrz$2lhGWev~)#A3LVAAFu`(38mh2EGM*{N7dW=D_np?Zm9th?r6G*uJ-UTC z_=>j4q|}Z@k?N~zv(s3z);aHTGOnajce6^>)5Y^S{Sr+uNGjyFDa&uE?t)jzV7D&N zWbRL`he#A%hCXrdF%(V&`x!x!mS0Oy52Ml2hYmgsRD4!}Gk&%rfjl}%zM9FQ%bws0rRP}yr9qq*?8u6A95-T(+L*+6yJWn8i= z!3zLpEtp-3j1F^OhGUX*rX2N>UTttsVznCtw!!n0xd!?ej_` zb9`dYOryft@_SIaoV>n`tR5!K+Lp=5G-MMV?jvCbzKp|1U{x@2W#0}A$Z4`Rnu(6w zlW>hrXt1`prmIH^DJ~H`TJmG^)M;re(JCc5j{AL2U6orn%_Qonef{aORlG}#$G_{c z+(tHkK1u`NYDzWc(z3Eu^oNJAl>%KY>Xn);f6;{Dx|6j0^m#cgHXzhNCh*&76{;t+ z3K|PpMJ-3~=1W>xeP?n~?#dr`@R={~&+@5yUIK~yK#o^2@Ky-)xMlfV5p97XU%EO5 zFL#y2ylq<- z_7F(tvJp=Ah3)Yp+5AAj;4nA*c3g{EGE$II^YyWmxO&PY_L+dhUXqwb&6*?-m*ykA zv7}eduS3CFaYNoB$QsCguL%nj7BR(yV$HhFEmk6=!r|}7{Nba#-Ea4{f6IW6?BkZV zL63NvcMXCYN_U;Be!v^a<;ZTG_?eryO21|1Dg^1?2#rP59@oOHwLmHDj~ z%+b#JVmtWA4C`5fw6P@$F}K}ZsWQI$m+tCB_(RZY+vrXh;hVcg8o<}pu|cQHRyM&~ znUtwH+q?ynDqMzOC}W0uwmG=1jbcYgfB5m*6BXo|l~|mQSx-9){BwC&M6CRf8#ujQWzE;{8969_PJ*S_gC_K zklh1w&Nit<-PvCdSFa>3JAqCaJAwCg9Gj)n2H0czQu) zUvG8$Db{6OFy8y)dSK1a=G9ZV>IyuWgIMLzq#ff(b6r39ilkM9w7Qp6`}qejpB9&J z$5{^xWZTgqn%U|@cy+~U+9@8|BIMN-xs0?=#%N#j(w22?NnidMHU~d_8JB?_x&W{o zx%>x}?v%Pp1mH?OokM=9LF1f)m&6@WkJW0sWlY>9cva~B;`G&0gGK^|JR+e47NMkf zQ66e^xg;Gr!a}i|j)r7G*y?}SE8?c3bbZs&bp*Z)VB$?j)u1g;_M(a)Gv)ZigM40lP4bCY7M(z&X&QfvAU3wz)b%QW-x=>gf|~ zbG%n4uos3D#d30-fx9By0xhfwt{Xs?tG>h&_kST(N+MdxUt4Z+4&PUDzI%fzV`IM>-9-=S4%Fh&w&8iJCzp**rqDGm<#A)G_rS(Qr$5x8c zF@`CNTu0S2)B{L`y?EhOe1nIbjP{dYi7+Koje@=jv&21!a4!+mJW2-Ey(U-Ej;$=b zJO$yJ7%LC)UXr>USZ=0Q_VXmuW@=De@<>mzVlrFT7CECK_`pD_SeII~dKStI5cU_rA%m&P6UC;ZQ_9jwewb0SXmyiU^=CkmNYs z7HH!--9YR?wg<~d=5J~_7Ox4kQLuApcX(-6leSij_JT8LS$?ZPjxMRDb0zvy*8G$YD1B>7`flL*IK z0Gqko0)C2($Now(i|05{uDV^MfNd(KfLf?g_!;3M7p55|W5Ov@T@AiE*b_%FQD`Qx zZ&4itoA$s-q|cei1d%A%#ePF;M5@_tE-pv91QFO_neGG;g@bAaPXOoa^NkUFfMD~Y z5$t5gQLv9^xDo8B$C)B(6J}RB_;DZ6^H8Dgd{`4 z(!3-gDLY2hI4&v4ha^W9HiStrG?|L&DXWPXBqDTqO2nf7@swS%|KaS7MT+a}nfMvsn52juX%y3##C&W=oR4Ab=6LfOZ-O@BhkuBtCA2b_;dYJ6 zqGc=N6m4dF(XKuZnYk5Qa@7Pp8RKQd7j42wfQRzh-ADi@a2r^GHX#%y9)iEjnd!=< zlKxQWaRJuaE+Gvtu{6C=>d~Rnm=@Z*Tp?{Pfaujoj}tA>rG!HCkNE5HG}ec!b%FDH zs|@{3*-VP4qQ8>67w9(*X9)bT80d#N?*VZ18eo?ZXtItcsym>b}YC-Ed5}p6gym zq>luN6KdzGk&ckhnX(8eT1ez+khpeOg>j`!86$W^b~wfng;QFCXo9fAWEGZ8aM>Yx zQLL5X!axV950U!0GV3YzxihoPl(vq{68SETvwj5E5&|4RC^upTqN%d}_6ek89~9p0 zUU+quBkM6ST$A9I0@e$mvhEhvg?}Vg1bGWY^@98c z0T&Vcoq$gf5V{YH{Oj$t0@7PCo)t{4gPU(lxTB(AzZJdZ-xe=7bsvpe_L& za7h9Ws5uTAey+1oD8}HI73Oji$&&UnV?t*N=yM%cC0#R;lutGNg119Mfi0bVh4Frb^7|b-cpID)E z`~nUZZuNGbD6)?OxA1f_J)|wvd%J|0=KX%i^hA!Z&zk8m#P4W`d8ZVnA&B28g`Wq$WzmN(XVVd&qiqzA$)fLq9*QI-h1aE}!lV&I> zlEN+tU%bLLo!Y}TtAC^U*!lJGiXOdR zM@YXD(q-NV>lT@ao6B;dkp=8GB`R5!4tJ2H*4QLZRws~M1hPV2Fj&P|a7A`%Fr^_= z&XxzWSh+EWRU_`UTgg}}`1#o~mR6Qi%In;Z@$SB_xocCw0!dh1A}eg94cZlhC-8d} ze0XhW?he8g5|WjLKm6H;OJ& zLq3~GmB#)w%)x`>@ae=Gc=b<3K#6Fvf38{#32@EF0ksd{5sc!~hs}7wE=)Z6>CWJS z6@HHIG{N1PfZs0IY=`mLLP3E)*L1N~P}Y3$^`4>|X5b}I=w@~n)U3ESi3xl7%PB*MvYM`_6z6+dnOZ}l?1ug zwbV&i%!HsMFe2@SYArXrRs>fooP;O0$c)2?%>H*UyF1;jt%l-O_(dAabXmA0!6IyB zU%=33>h5Y=CBhc8;HO10zkYu`W>YJb)g7`cIkF=eny8?yzcs(mJ_6?GOX0QnZV5A* zJhO_z3o`5UP5IyGY+geu&DCG z0>c&qbn~lFwDOsMR9Y=`vbgMWFx22YWQmbcQo}UYTd4$ZAX3Y*oQ};O%kak_%{e!g z<7SrtuNLt1cg@H#WjZ;gPEL-~O^&I%ljGThVecE6Y&n4KCR>oGXH|Z}Pb2Sc%8ND1 z^NGC}$)0OhA0>=;`q`~=oe;(for8CrHGn6}^mp*KLSoAqwz5k zU#c6+;Wo1FEaKo#EK?FWIV4jjhv#F0m1QdNlPS|BgjLD=kxY*4N0v~glhD8!K~F%C zeJ_;Zns#WY#A8oq&_zqt>ghTM$)`wN@}Ex3fM2$$SZKvfAxVn5}ZmL_0e0+s0v1yUUlRCu(fsp=YZ zEoFmFl?_snJ!mHo2k?&IOOeA2&pNK9Ao7#eQ>fbxP9b>i*4-^i{ z#eCZquP9HU-c0G>D0B+WAPUvh3hjl0RH!%^ZCzz(_%#3s zF2`8C=sK#jS(3wouk~+06q(W zeb{oOO5qG)-DGLlZA9cvIBQfgm=&MF1OI{0JP7sFoc)9i1x)22fby!+&?D+{M-*=$ z)uM{7WcmJA%-OmJ%^5=bBBF8Kem=mp~<<&bOt<(u_wbugyRP#Y&?jV9(b^BF$T2U7{$ciBgpZk#$;O-=%+to4@AwDtO(t@giC3M= zpq-9MBYj0P?E&B8onku>qWKYw?La2M?^TQ~%W`%^n!%?E2Yts2TGJpl3mIVaM3e}e zIGFQYdgOY9_z2hh?MzIzN5^DO^noQh?{zJqsaAlh45OI@#;aH(4CDERF^sY`3Zn#b ziqq|0Aj5`NXr^mZntE%W$L+8l!%LzScG9+CwNFypQQP$=vJAY`#yy}%;Lp0kOQPRL zGX3$e<48l$TidgMg=J&w1FY3@o;<34W*Ou5#Q}6$JxV@)1)cVpPP%u{qvZVp;|;s9 zQSut;X18Oi!jZ9RP%PO9BE55w4e0FyHV$^g%!}b zUL}7#b*E1bFg^u_r>6EM>~+8#HO3I|v>=HZ%vOFH+6y)ork#0_IQhVl>!zH!3-JT1eUkbCKkZy$ zwp^H9f_E$21y3WcW+evqCBBM?el-s=y$?lX*9Df`6uMHn&*A6|MTdI4Zu&k0EB_)my)MXQXsOvu({65<`%HAuMxzr1hJ>c90+ui`8pLP^N1M? zpaG(|hjO+Q=4@f#jJ*I`s5!plz;1P2sAvWVszTm>_oEUUh4+5EWJ%2KugDT;9wnLma7G-K9>|)JENL)Sb7QGb3X}6O-~BDwzEjnxjDUYtf?^ z?^bvho<@(4Du^B8+-AE}OT%IVS-dAKHVKP&B#LbgQ?L#FTwo6g+hC0C*mBqwfRp1f zDTprYPkwMcMp$c)aZBMDR1>>9cw#lw3LURZ&6~tTBxw;QA4gNfO^wn+U<6N=wx}eN zC8;S7!VT3&Fq*ylGMeTk$-~U%6tJKc`vK!xj<)NlttHy(xypCnFeBX0nR5JlGs4AO z&ezfdY$KQ_bxVc7F(Uc(WjGD@RL6dX=>{PR{2KE*_8iD|s2I-Kug0i)ViPN8G{mV- zsl_1FRFP{;u1_UP=^@u>Mmzrq#yEo~R}{rZcO}lg2zQWQND2KQ!E8z#hF6mG28sPG zA^~p14gD$Jel*Q>k_B3f>tm;h{sPdQd+IyZr0qV%?0`{htfugkL5V7$Pv0g&aB=&; zGWp7KE$%LWK8rA;9RjO0cLIpD>9Dd91AJMZBs#XpHQC zdsD;jrF2U%4`PM+;kSs}&RTMd$^ouNYB&6()HwcaFwnBIgg@Ig)k0`Wy?tsAqWr#H zbSq8hP$g|U)6{Qxsy@_gEHn#7>*B6eykNDgj#2AUsKv2iF=QaL!Rc!<2T?1@I5%qe z7RB4q@K@@I%Gd{*Gs+a<|-w~Aitk5nrLpTdC8G(DU`WWeCm4P-H=ov)c!>%tN=s33b zPP_mePoU2;=zG~>rK!D;t==U15JAU@y}bmzJDyTbZ9o9JYlW^v4T0l9%u>?jldc{R zox^%lh4eH=8eDytkp#J+T)3qFCw&|c!nZ#`$Q>XhY9AdS6$kZRyNx+O-@ip2g*~+C z(6bZ{+7iDRO>WJo0&F;-nGPC)VvlZh8?gXInoS~l#Lf6B{^LjCvK};C;QkAL74H>Q zZCRrRLG?g1D2iW%cl0>S3|iTl0y_koTj5&~c8YB*W`JG)7&lP8br?=iLqmtK9 zpriI;LU<&%>8(XzqS`nxST`V^og>03ovc)2Jk@=0HTx+HFy-*aKT`REQ>O}ApsZ8X zi^!5A@+d`qyTxe_dH5qQ>+of&UErZ!#{k#98jPHCAG^!@Pt0|=9p1r?Mend1at+w| z9d^#Sk8{bflA247!^rVp48jA^ePX*_P5FLMINn-OI3{^GE+@x!F^(k4Ro%!jMRg;` zisZ6W8E)>mr3nFxFeH@HZVKMIv_4P8? z$%MBRQS($9TdX9hrn(9axfVIk|5mJwWuKL|vZ37Ml))sXUN5P--#+n@>9_Nl(i16| znU)?~P}^!oT+MYaj?{8y62F><)7uWG*-ZKKn;0iSJph22(q3PdkAIugCy37-#TJw3 zQ^C=S-Q=)a%9NKhJH`hm;9m~aI;QbT9B0Y2wL|qeQ|{DMk{v-EC8&tVJ-3tU>}(_c ze>|Luml(r*&y*G(PJ()lpvnxrlbw+;b*@rq_Z{_)l9X5CIO-KTOph~VGg4q}WGaH& zNu^)wdBV6=Nny?=&eo_;*pFbBREb)MqPKfsUNso)fP*3NVufWk`f*qU_v2cjngXlN zsn;0-YlD-b1ojVRw5 zx~nC11yftgMY=WNlVH*i7wLk@w-IdoY=!%ImvLdHeZf&HeBCkACQp^RiJ>m{DQiy#?!u1D7FekH@sWnL5%qZ(t{XF0B=UAwqr3nhBHhnB`p5)#~Pdblfv{EDY&wiDT9-qXE8 znv(2Ql6?U@xz6OVRFbWt3ZEg<59O?vGI}Vd$nBk$f|ZUY9~EXr`p(7g5LZ9~g?tIO zLG!P^7f_Mf2)~o0E!daEqTxtGg2W;SIwRzqFajm<frA}_r`S?@*A|G&tFOg}}8o&J~9eRt-(HgO? z$x%uyM^SNr^{Rr&(ebgAEaQ^l+OmwKUxkGKugn#WMCLx);K|&t_~B;mJ;pmynI08Y z)~o+Ql&ZkYwdle^!WAdHVb=;*#Zxl#uTv$|1yI0=i0=VgZ$#W?6a@FCV69@pjVO}b zjLE9ISD|LELP=1_UeuX7G(`M^7c2ZAo}vS*C5xWk#LPSn`>S8jnd!`|hmq`YKn_Ho zX32y;l4;B1S%&-)Lw=hfUqJF#T=Ll@KTpWX7#5Iekrj;$`AKoO64e^yIJ9q?y7zOf zP7Uf@(us1{3E>ZT$AGvAIynq5)(Wh{DYjBK;_3SMS};@(qtMkuQt~BgGmTsc*AUbP zYn`dlqVyK^zLS(>lD4S6I*AtPi!w2;*7px-JDtXN=4g}%?{+gI5^BSHn2q&bMaRi| zm`n7z*u4H&%e@b|wCf-va$R1k;9=) zTnoZnj+`GvwiCW;5`;xWP#@w+tVO`G+d)IzFlU9DS_o>Iio59sxkMcoJ4|L1o4MuT!;hoZ7ypI`9x9B&py!701T~q`$7j2LI znh@aP!6)#7v!?KL2^Pc%w!%>AdJ^0(1h~g;ybz2Q0yI2>1-V3BN;R$l)VcAYr{Gl5-Oh))QpsS!d02xRR5-Ax-a?it&4%AcOi2+(Q z!)_GWWvEfWRPE4f+uM+iYmKoZQ_xpw^q-JU>$fNRxvD)GzltR1c8B6~$UCHw-!;g| zM6R!ri9A)1-w{>E6K0}-Z|Gsw)Hg7*eYw!E@3TTjen;WuAWyuX z6>S(|WXyQ`vUyOXy5?IGp)?%_hnl#StdyE5ZhuToArNty>d2P<6;`dsg>;#aP8ZTAGr>Pa zJx4<1?=VZ|9Cesp@d-QhF+%Y&C<=yQ19TnH<}QQ1hS*tZ4Y9+-?jqQ)3;%~AtegBK z4f^*q6!SjQ<}*#}kwzx$^X(}hk<;HN%B=YxXsxk6TL_u>Gs}qP zWqHtkGwL{?otc;cigpyr(v{67?p5AMVgh$U}V3J^kCGFEgypZD4uLH zaiOl*Iy|ey(}2uIhK!p$Sw#Qcf@r6_Y3bE@Z2v!%9$AkumJ{+EAZ7yHe@5e)?MBf; zeK)DqTs&3rIy`pcVV`P4ZKqiw8!uM)XFNG%E5KRXc=aC?+ifzXaQhn0xmvU4!yLv0 z&*5uyL`24t4@h?K3n#Gw*O`LhG-3P<%Y@sYeDNoq?2IAgTR=>9ru~oX2=!u8t5tZa z8pugxn(lvcMXoUsc~1FXJkRKPR+Hp%vZk|EgRv5N9zi%?WcS3ASm)EE^H}z8wWc*2 zSRsD~ty%V$=^h`Xy(bVO1dKrRTk)rR@ot4D;z{@Z6>2ApF2Iw;C3J1Qbi5l-mB7E$uXxz$Kn%#PNbF^=N*zjCc}V{N zZ&&2|Bz>2pZ;(zr-yd?++J$Y62$_r9hy$fI)vI1<`Da zgpU8MUGVZ9$}w$u536kdN*NAd+>rhd;8j~V2b2Gh6t`NPGyx>v>rU}L5|Z=rjZGE! z74Zr^k`IyOQyxkBDYafYBXJ*t4awD)g5>oekXtzkCuY$3W}od=?8QQFlUNgKNymGy z2@zu@Khm`xrMQ3N$7wBuZU`0D7sk#)ARvtW4qdQ;nsaDZy^l7;m?@!(x(gJTvt2QYt>x{Ve;rZq&<@qL*3t##@W{mEto{ybe*nfY?q3(sL`5 zLWSGo33i1A8wD_$K?Zc^j1iz_m@Y*Gn?1=jp>qUC+|CD3uZm;Y$pYLwR2aesuEzuu zE<#fep@ayV(2|{lUCF|Up~C6px9BVU$<4wovX*BnVR;qE2Br#R0;?@>`R<&;P6Iuq zHJmB9^9MV0xb=X`?`jjOjq25oX~vyU<(_4(vumLdi=YW?(McCZP6!o_$497W3>krg zI39P+OTyXsm5Rz3Bz*PId~xzZI9dadc#|16s~e7{GR01^brn{ecu^BZb9~Ce>s+S{R_u;pu8aIxqU5)RVbe|f%NA>UwBeZm~@Fz1WQ+SNW$Pw4h zp!oc$s!LH{>rCb0t-Qzaf$=sj1d`M%S*^YfQRNt=c-@LV3nIIi^;8 zo7Ul6geZ}R<3-US@Z)gZQR}+1R*CEPU2?Q2}|w*=Bf|z%f`0=AWq+8D*YA=eDM(~YJ*=_lO3gnNQ;<- zDpq^R_i=)7Yu1KPQR@S~ZuECp4|FaTjDIOUpSVVNYfDTo1hl%4{mNe*Dc0yv;XZs|zZHHp=q}ORf%GDRb|C0y0y-vZ6V4Q6SsaoISb7GUCJuNRdJfkSM2WcLB>Ateh0ooMK|M@M+cv&Lm94+wDC;CAyInE zP~my_OCJ)QCx2&2j7hU}Yx+#+f}QFnwFgEKk(KXrU?%!e@_WIEwmNsAyO<145C(BJ zPQ90A@m~PGS`IUHc3^%zr}BL%@&eQf-r&YJPjfscX^W5_DtaBi-W%=n@E2Ic9)srr z!?)p|NVE!KSxL||Ec$b|0j`- zQ3Lq@bC|{71F6;D6rut@o|(1$&e%~7F|P)u^EYM&?Gx+Y<2zLJ4Sp%$3nJj>lD3{{ zINC5@(pKOvEno@$rhwZI>Zn~kBW)Xd;m-*}K5Gf(Ebg~OmeJAZ=A7vul2ggS6y92u zLMGwYRmROAq|T%WeMA{(Oqd4`ORZ9K>9D#8&aJzt(pbkL)#(a4xs`2j{zJ$%@sn*1 zvgthLPa21za1NnofC+W>M?j6XBU1~7scra1b>mlB^eWM$)Y`{>yn4iYSMcaLLxs-@ z-V=gnqWpQl1*-@Suw_Tji(KlqakUT@s78oCGrW|dn{aYK4F+4#giE2aj6XRWYJBx= zsIju+-N%LAi1RJV%wS$2^U8)*C&EyCc*V@SlX6?-U8}7Xmy@fbYgHTN>R% zsIc=s40U`@ca9gBF@%9Dp%cbiWB7~PmC)Pwp|rYtIB|!BgtoOchdnzvZ_*U7JjxSG zM9vzMJ<5H+bANUl&fDOj`AzB~)OPe==B>$7vbz(A9A&l7{+Wx30@M>gYuVa13L~T&I=VjS=T0rHophQ>>bQ_a1_XR z1D4WUQ0{G+CcVH+zHA2LUP|9qs1-yx@&-qRM^UH>0bAV!1v#@?k);c8DhMCAcLKj; z>B3Oq#ZX$P=)y|lO2a{x-Ul%mqQ>qYgiy{SEXnFPg(*2mF_TFb2HC~JLyd`_!9*D? z>`o`U_v2G7L!CQcwUt+Q)DCX)*L=LMP_{5G6<(N=w6A1Bc|Aa9=M!l zlbkBWn(=;n1(qA!JwqNgyw2cmBYr9CG3Nsb`aD6c%%x13ixeaC$Qm-c<*Xp+L@8$) zeia`hQlGKy|AJ}eoXRaw07l~Y4i#<2uh_@O(1o$+SHG0jX4cs^$zw=v(^w|G#3r>K z%|hJ+qCTUld`(Lg*gg78KDhY;Ibj_j{fJL>Ho3V*xLGRPTp-+>i(lR2!B>j=%V>-! z8|wtL6^xyG3d%2na-yIl;TQSUFh8d$zVYxQUVqp`L;DtBBHK?WP0o5r*Hoo0NB5>y zKmcdgiB!k}p|=L#sDJ#*nX@CPZhIgwmHpwUD(6jP=2qfu$fpJNQT*EaX+9HT{_-m8 zN8W~9_Kj>^*8b~~ZQ>(vdLv;RkApYit*kO-${<25LM@qoze;_;xS&0lo16Akcy8J* z{I|?~!tvYUBe0%dp+cvV@Pg+Vn+h+9_!VLKV4(0#%CkWXjH``Q&u=G?`?Rc)*I22vk0Pg%FFs zQgtPiC7q;BGDtTI65eSXD}7@IfLy4{)IpjTG|g9cdAVF+Zy|jOeqE@m)u#rkoj?uE z+LnzO8c4u`uU2o0i5i)b)N=;-Kns$@8;;-L0}&m5jlnP7YO1HYAFGFoYX=oaa2M}> z+nlRvH0Mueqs9-v0>j2W>eCkJmcZ%#sv7g*I|;f;KrdB4;9qqX{Ex#|cXP~>k>?9j zRj3fdRI+7C+YC2{k+D3O*#E)U;5jIb&$p4WNAWM4Xzh%RAZUL99j8W;v6o#b z%c*=qn#H5L*_OuOSIp}fFpjpQ@9U}$4CtJEErkLwi2vhd7RP&4eVaOByABpw4#05a z6tx}ys$MLVJC*JGmV@w(^H2CS+Gw#wS5YF``t`8z$d%~~Mp5FsAb@?$UDRBB*u)$r z;-N`3ReyBRk8jT;$n(I{N3gHppNx0(pCdJFV-3s9NJk7P`|*QImOTk>O6{m&Td0$m zcnCDqKQB=kY)$HQ=mo4Pq-bT>i{)w_NVu;6%2)!xaO5<#0sltE*)qQ7UzF@!eo*oY z(Tv$TPHs+9#&ej><>QJ_Q3HHP1JN^(TS)a9py`3rR?Ju65}kNwe>3X%W3X#?n{Gl1 z&sbiqg=HF$IIUR< z@^cNL{i+la+D%tS=K~7|mL(V}JAnFd1GK~chJschKdipOFKB7bhJv>03^l0s_;Job z{oD5^dx$M`#;aH}4N4pnE+bpB{UN)CXs-opF`{u2Fv zZZ)nL$g9^NhqFOIdEHyqf3jck4Cb}%;u$2`!*vLhe+~2!ZK|z|MJ;2WHb?NI!cPXi zLq)ga*Hp&n&!jRU`l#L}wG@`&YW8aOEKuhiAgkJu7rwfiQ>mY_>@KvDNelDz&#|p^ zkZhi4!mG|7($(@i$|PzuSEH&5Ssd8y{qvZDw=>_!|H$l zt4~U6vF$WP$Ktx3x+h()08GqD*Tu#y_F1AT(lM-sS|jJHKk)}4%K^!v__CFA9@xb5VY*(AvR*^zLYTb)*=XjY z4CB?9Uh$?HcS6x7<44KZ#2S~u{g~%T-n6ov=(^Mg(4bmIHCiuM8iUgYIJ#NxLaBPF z=C^Qk>@N1K6XuX%MQ-wCAMRcKd0L0R*%ulGnL2q~aom~YzXQ}8d*!ER4LU8jIYf337Z zU*Vh~vM?4xtz3&g2-y>m4zJs^?{dC~?@-aR`1K0?w~kZ&g(@;1Ec64A%q{btj$FY) zKYWG?G=)a-2Mb*aNN1Q7s&7<0T?*}vUv`7~Mn$}U1+z%PQh;a1^)(~3lM>M2P8NDy zqvow^{Z{)n)Mz*cpSmL*i@A2^RB$09Y<-_&CR&5^50}FRxWp=d^v5609MJYPCiac* z8og~2BDMC7J6Xt@ry;j3b_-J$BgI#2jj{a@*YbowJ_)FK_@&13QJmUOo;C|lQv0r0 zDNlp`xFCIsC5^l#+p1kT-cQ?lC@7Xv$5~L_r%_buzY`{s$> zApEwcz%MK286d{&xDkNG1c2rJh<_IXqcK#G} z)T~xUDM?m7=_*4mYYiwPxG!o2;nxA)Oq%V$C&lGkhfcU2#XKw`4Z=6ZKlr81>zhWK z02YD1xI*i?kGG#~UkCVb`gD+1eELu12U+OZGjhVsC!Bf-zfM0ibbCW?2YiQ$ zTH%)#P$la6?rvYZ_^z`M^Ar zm{y8-rgTAy(ft1+g-|*0h?XK*%2$eS9jftYC(ac3EPL1TwfGJdU5;PcYP{6IWYj>Y zDB&Raww`UE4vMum3+3fPD~!hWtI-f9UExnV&?-f_e&?}*0$fjKh|GB}HpWrInZ8mNV_Qhe_Xk zYj+jXb|Q^aU~+}tW~Qu1ihG?V=hf^LniETq`-afq!+W>I^WnYYP>G3hCQ`BsC7W*| zjz%^fte?$$L~zS@Qo(pUgEv;4am^7X4_(HI+}VkdB>4!d?#~%{b683m$f#c-0**8C z@~l3mlS>?GP0SpszC`-+2}H-^8)^@%80*11_)nbL%70p_u4q_jUu)1_tNRf&JrBxP zyPl`7!#v$Wf?@d)FZZggAcudRVp1Ko9M)?kDt!^Gy#H@1jRI%I@ztZ%(y>&je*-Xb zl3Iy>s4e}5h)-LGUIOy{K*oim?NstjM!Y|md?S*jI;k7R!NG@Uo4*X0R4Lbeh*n;O z8~Qok2sM}UCljb0fC3NEN@{&wYJ0WtMpNp^1U^t?jYzD{dx$obxm%D6kK#Qs^px ze|eOThf@{GcoYJUGVt9+zLq_1V>+@#)fA41cL&60eV^ToGqWcB zPc(z*P+Xdkm6F{WfP~!!YjFYEptHSVS4@7D1U+Waq<93fR7W& z$Hmzf30+_+2aY#7l3e^iVknKNzcLj!ZPd-`=1ZN)RIgwI`wdeYrmtneXZs6Y9*5Bu zuSZ{-z?;?M(B|dFOc?IkItUo;Ux{n^O0xZ{@!C3=n5eThf!BQ3XF5Lw2juKuz!3^M z4>&?y|CMCu>A!FxJ?YKO=P?n~J&MBj0pE9}{kCmbO}&{9GS`lv?w@j`I=vnO`Sdu< z2QHhm49~$W+qIOxllgkvvgmOBz98Sb_^U!6Y&k|D9q*2WpX5a|nr7M^c`z2G)@D%#>n zexb%g&s;}M|L#cj^0va}+5|4B^Z(NE-*ojKa0-Yu_$M8vn5|Yap;|3rLY+DXveg?p zD>PlbVA9S}PvFZom2z^^Ubx|t#cxw3Y=SJA*5A?sZXw_wv#5gZu7mktHJq9DHH(p@ zUkUctBU{OlKfU6T-vpJng$hG~yZ$~Bh90htZ z`*v~}EYAP5KwoYxWKXBZ73jI}M?LdL;MHMqJQMMLt$8@OAs!9}ZlM2&HbkS6#}Qg$ zb1&w=)1P<>FLQo;xx5PuRk1=XEARVRq5m;&CIx_AtrduB<0=7MXeUrbGZW`qKYd05 z#uIa7#KM~uWvt|qCRV1#>f*z~>mRR){SAuRDcl=<>ILWS9y5ii0Bu3 z=(eH~(fnMSak=;P~LUBshohfm5HGUjz`mkT1|(i0+H z6A(roL%!cbtgm$exc)Wa#tU3q(}N3Ys)t%znWyP8gB4doW*c~jNiq5-vlUgfFnfrI zn~-CqJQlM8_o~2IW+mw{54E;3r|U9r3kaTy{>8b{L-fi_s|nXPP^O@E@=)EnMSoV) zP$>1$!?o0HF*(?Q93ypuTGaJPZHRk`_=1OMoL9goct>{)Yf8a_iIeUj8kqx#7uSZ! zRUD_6huF|s6W?VIIIJNZkI`7HlY+Y;vAzGeayO2V8x(aUiS;k%eZb|EC3eTmNm(Lh zNif6>Uxe}KYa7W>>;S{Eh_4qlC zM>*t4wdlD52p`cBp=A^G@dOhS-$0ZOKtVJsyiR07Q=w6JIp@>D7pb?$aEQRMr>kI& ztW2ElzJP;Kd*g!fi32z3ht5%H*u;g)jS~yTR}I`Sdowm`pNSP-XA!!!xOH;XwR?;I zjj@o!3HhLfoXOhr+AY>IinF%io<+^%Ipm?UQ zhMwh-_;@Wd>S9yI5p1T9!?X>r%y1@wKxnD&F+CK|zS-9`&~Vm4F4l(_5xY4b02U<^ z)l+nKNR(IW-C9PeqMPI-6!rICt`=Mu6Ur+*2jXSlG;=YX3LP&i8fVTh}(=~YL{=~f}Q``wmF}21q>ZS52-s2 zYwJi~pV3I(?TvE=Np_+-B;+zqvut6cg>#_@`(mtvBL&xgLMzwQsFe26dn{)Lti~ojW<}q?qg-M;-d8oZ_go4W(6$Nyt#yvv2)Ae3kild6GMQo zm1>f~%m5I}vn-_&vyq2s!Y?1@DF%}V=KYuxiMja?w@ef8_%IJ(*hFqO$8gJiX3i5H zrs=AEnC}6zh8j;Lt^62TC8RaNqh)$hAFYVt;xqB5p5*1kZ1&$UdmGFTW6Io1%u7Kc~BrGx~swy}+Ot)$0a$uSarD8TSa%?N?_GvbkHBnX zu$ajuNUl}f66WS1*AsWBuL33e1|ruGx15+4`smiEDYXX^67sejX3?tB7eW(d%9+{AIfRW=c!&we?pj2D7nPHOj?IJ)4ydqQ)|Nv1D6!C`m6!5?+bLp~H)S zq0%bFpt#y}hB^~da6Gt^r2d01u5De5Z0A0V%IO-f6^Xovq?Cn>5sCpDj)_P@d0&e4 zYtG7v)Y?Oe%j^lQN*I}WqBV9W7sigIvbX+(Q1!8r)t7wC(TzyMo)r_Z6g}^cSg@rR zek;Qz_@ofTE2$({2P2e(D={C3S1S|jtCbnu)j%i&*30Uv#1&*LJc6wpN$Ml9)=D*2 zbd0OaUdD$r335^`&qElL~KROvfpC_DQ02Iqpps;Zk3Tam$20w7LmSZAucW52pfN$U36NR82? z>=1YN1;+V)LX3X_!;ZYlnQ*F*u>D9edOK74#@|tTTT}Y>7(uoW^}x@y2*MdS-3r_q zSvuVnX&Q)Pk>U}GS4HtwAc7Wt5!%t0Jl$P9CST1IkD1yQ1jHA3fY{zil8*DRJQv{x!veA!%R*i-JO-lpgW+~;#e)SQNkA;el5~-W<@p(xV*xom!0~|?j@y!{ zo#c4)ZsECu@ca*!x@{P^rk%sAW2sEj^~u9PI& zbPPmD;6VzW*bxX#1VNsuC3BK7nHd#7kZUO-u^Q8TbXRt|kCBiDEhgxC0X57&#y6PZ z$Db06tcK|?5abnrK!U)a$lE`Z+6f@JLIs=v`TR&+I@ZH?`)b*EwShWf7yD2q{vfdY3UY;)))2{i?{&^O84BA*o)%;2SJTyrxXdkL`Zs|TK` zhV=Zzb>WEmD|jF^QDG@g=)WX1E26k@sj=#2X`ntHz;lKb>5ItebW`q6+%nl%#Q|za zSPO9jvRuirTqjCy-Wf6%?UM$jXGrswpkYU@0yfHK911onHZ{|$9s+64N(z%cadcp_q&Bi3k0dR#LAZfJ`%4r zGXmdcIHd)Q?*iy)0uBGEz6E;7>SUICT#UvANsKwI^03T>rq}Cw#^hGu*B!)2WMv%BKmpDo+4|T^$eImI1gY)25J9^x<{FP1)uDZAcSIV2%*5h9pV%cr-mtWA=c|*|6U^%Y^-zB$5UU8}?6T zLSG?a!~SPrO*Ez*KY5&O#J95u4MS_%7;-U@|N7RIsgaFEL-`-W@B*+Ug#FZmwZU7= zJW?o+U6GYpkRBH#E3+i!dUQN9y*Pk%ZB49El4Q+P2o3TG9h0G#eGHXSii7}ZNjmfm zl|VQA9u93;M#>4jU1u4UNz!UbvW!U5JCY>r<+#ifXqLZV*kRgy_(z!k@l1Rj12mI3 z7>U;T_9B3|x;a>Uu&J$(>g4K5qg~g_ygf4B=b?KWo+ft#o4tjB^U=NHk&^SJE%O9Z0>3vMnvwT6E8wDq<{uq9gC&uADGCFxZ zb6fkMvhA5S0?h7e8bA97i8Q09ar5E$?2Bc-Z)kKp?l#ZbpRK3xM@EO^%GIp?+5IGU zOte3qIL!LS8QPl~&H&!(YeXNa_zrg_iA>K1th5$W=nU zfh;vh>Iy=x>cY3&cx&4l(p-Qvd9B=f3?>!}$+p<0&|0+}VCQg{GZi`3nG4OE1hnTG zY!$=*V%2~Jpnw|YU|9n(ytAqv@7ll(u;Y<{i%=xl-F9JxPK9=ydMF^L>{?Gz!rg)Fv}Z8 zyV3bS;fn_=??txr0c60vwxPn2C=pMKqQB%tKTWfK#-oV{3YJa6jA?k;wft2>zot9Z zf<)q$^}zGYVZ)-jy~VEU9JoM6!e}r{9JFIjWwj44k^k zEz1h4Z?Nr@*Du$W{Xkfa+H>sed&BBxctwT|BLDx!RH#)joNe!)lDY3 z2ZWr@4l|gVj?{qaW-yhnN?O(J>T6V&&zu3sq3ZU09;-UO4iQ#w53Q-X-)}jl>MjVY zl5dZ#n-O8veD|@l&qK@##Rn|7<96tBJ+`&vR^sO6_wa$o6YOF&Y`@)4`5XI#btjvs#=ta!wmSzd&s4x?8;?-|rM;lKBVWYW?qa6?gw#Lkn4HsJ_bo;K(+A4ILF z>T@WMP8kug_2f>%n(N@pX0SD?zjmQ6I*OIofS4{2lTeuf#Xh_Z)iJ0ks{;fddQ`g|P?kSPXH)P1JBvh{giI_fihCV4+=Cu*)? z`h)x~LoGTB8dC$fDgO|xJ5+RAPy+!uru^xXV~p5~KaiM%cJIl7PGjjxUwsZF@+=m6 z0gLS|#hx50Y=@6f(O9V8s?QhUC8t2vjhkaNz|>_(t=`1gp0E4b*^oMD6o}gpaPi)t zsEku@^ySa>=f_2pTn*wpz>$B!C_(QV4TC)j44+{sE0eszagDgToXngGX6!ocPV}77 zI&OV;LwyA6dm=n1Lb$~s)pc%u7Q`@B50wr0$fvS;m?<`4xx{2~nVn4k!~{~ zqF1n2eMQZ%nqhH>5sF|9RuNP@$A@N+_BcS9R03VetVTX@F(;d(njl0lP$5`emhDP>go@t7FGpv1kogTsc$o=p@q8`A-^queQN#s!|6{J?&ctt^`|5*UwiXAq zmnENuk^_PLKBk_8)R+q8!-!$^*nrpyH9?{JEVowhOOKIAZV>hg&wQ{wve z6W!^^^DzOW-e9PHjp*t&tY!F!C-(=50Y2j8Jq+=anbY17U%T26w}zj>+&Y3sGu=-! zWmw=NJ&_>aY@jYQ-#1y(H!$a8TE|y+%%29ySRU2 zu@8TDw||H7J_1hd*4KOhO5jULG1k}A?`6X3?0(i-GO^_p-fJnA9MIi(gTb*RG+hX3 zeY>TNu8ZbS~18~T_{o!n#bJx--@M2GbzvX6v#)t3p)H2+Abt2#3Qa|Qv2@xlfu z;=<$Tgm4xA2(+zGQ6K!dHh(G_Bf5t=1@gsL6^mwz!fH$#qznXGpRbE)(tVk_9I3u0 zEqx{UNBoCH!C-gsHWnUy-sN%VDHxE@$5sn7PCCA7adYJ?a(FBwtC`xnCL^tck+-nL zILJs>&B!tctA=fXdQOE_aw|K93a23~!Cm10;JAEk>Uq9)^^6^a@)xb8dVIavIHo?0 zRH(=HW>n96ND8Z#nkyaHm7R!H+x!g5EWcQ6ZKBTNoXK1!MjbbbyAE0nDs3Kps#e-q z5-@WmzRos&Fc@hj?D+=Ub(wm24N$!Bo$T!s_NHMUcTi~uzmwV%rG+p};rt0@=sHmm1mNJX2Z??TD^vpe){DP4_&cj5FXa@2d$o$BeK zlz)Mo^NF7vu|xSMLj;Ufy7ffAtWkrExwTRV@MJLbDtbjytvBl{0rrk zYZx5DEr9ZYMcE7IBNdOe8T^<~Z7;dHSh(`l-ae+Dh18hZ>k4hyF-U)WWB#MJuO>T3 zx>?ne^+Z!K>YKZ%+dP0qo6-oXKv|EjohD!lGr*z3e=uea6;&}E>z;Vho*ZZh!hRfQU^Ku|ifL`>-U>tzP! z_)wh<(+`sTD3Fg{Z)s*?c8{=lb>lMB9tj=!iJX;lQsfLXUD(dhRn-#=&{qO92y+Ll z>k73_{*DI{=xMulTFRutaiPKlnN+Aom9p3v(=0z5Of4&q(c5aKmLS!qH`){*Qw^(* zrw7!wm%y0-hT0%Y0S^!cG?)1=E9I-xAb|eEnr-`=Fy(Yhz@o$IIBG*JI}Ntn%U$U? z&bGmfW|0P%vDV8xYcO0!!{#14HTX05w2lxox3X)f@F1oiLPfi=W4ac(OV0t*WvgQ3 zUd+_jks2fSBajX^`+y(6xe)k%0E^rRm5wdDdg_nh;r8r6<&fVb=>+|`>3&G2$)`179;mdOf5xfjNHp0 zU0C%7KR&t337ijL$X$!j$MR1ru-Xt-`%Z;y32Nq7;CKouh-c^vua}y-$~Rr)>-tiM zqPP=dIUdH;IyE_VkQ7!ApcEg+6A8TaBU4i?Yhk)YuyVG6*Jz7K4^us=7uZGpgQ~Mi z2Iuucg{jaM?#xEmp++pnib;ML3D(jgb(YQd&p^)nUh=%*ZhR_O8X_#o7P8Po)9Zjz zoKPAGO4UpFTOd@$eIyg3sbC}`vTTN!uzCs0RIe|ScJC2SCFu7bQeMoK1VtM;#kixP z1o{v_$k*3|M2{CxPE#Ff!o5XPz6N10rY|N&p^)`eyz@3%n7max4 z9D%^mNP|<4q*23lFVJPB$6cOMugQ+(mHHOP+ zs6g0pPgch~WaGOdzaIkk_?C?m@gK>z>_yukUCokikji$z`7@v{;=F}Cn8`$`PIrUN ztk%Y|myiX%DrwhbOPR1038;K?K5G!kYkb=ir67Qkmi7+8Ujlfvc@SdW&CrqT0oj3E za8O^}{{@mTFmwmLscDp7%JNtIoCH=po>*Q~mn!A?PRbS28&4+kDL@XYl&LL{8l%!9 zND8asuAYiAV=8q48TNBmPEzaNH)esr#+rrWfG>F(_Df-K6Mk!9@DTB513xfKs$lBf zNY$K)_JxSsX zH96?}q6{z?w9Ec@A9^v-cPyv4EdhHAVUr@a8n=#l`tjJU?5n&jgnwP&{gwBhoc|g7m$brhM%hXGe8dG_nLxQl{*5#+hg(Mtz)S0BS?vB$+2uxi{AEycA>C(0tYNW&~xeW z=L6~IrDRB^t`akc1oE3Re}m-rj_nxFK%XzozZrpE29PsdyJwGnGPCA*^c!SqAL4c? z%#TQZTieSp>C)PZEW6zl*@r+W0D^V)^{jI#wi8QDBbM{G;u!=#PH6hgv@5`JE0gh9 zBR)b!P4Mf5Fx@ap4yzk1MKo_e#Vw@x&U?l$_#z~^=o@cWhYG(t%sO0iu+}<^zX14m z0Y7N_OuYiBu&-m);nq$ub(l;fzUU--`K0>XF>a9^OLZbp9Dr(5PbxF_Er~Hp1j}nV z;^vD^n8M<;04Ei;LL>Zlhvq|;lQOW8%(O4PD@(3GS&ls~W_OgHY$(4Fh$A{ojyj&b3n%Sti?>2CPlT7Qvn&+9Z<{gyo7KU0WQ#Qyu{SONUh!!J+oH4 zazeBcJm1X8YNj41c$US2=7z-|nD^7WGW`mY7?U5sxH?hw!2+1bjgj~v!h8%E8LnD| zWSrzq(S2yN`U$o&<1IMcSy}BGOo_>R4SBAa*wZd0BSHCQp$rFLJJ;y&7(0mBP?y2$ z4Alfp(8dJnmakx_jl~SmQ+?K6ABquE9ocempe;<0R_Rp3t0cW8NiF0rRk{!JbA*@siZZx16=^{LOFYXfrmRL(~PB>}K_mV(6ApnIqd!UEhO3df7JqJ4#`RxaX;(S`~+oKOW?Gt>v?L)kpgweUYTa z9ZTGQ$5M7al^!0`gt+VxT}~-}rA>euMG_;JLDccFs93DW`6Wyg^%QfM73X9NEsTva zpk2HbD-lJvlU9RRTFx**#ZIg~!Uop@gbmDmxojLF>c+QYbmKG-RE%|a4N9o! zfC#S{ZypB5yjTnn_5}n4nI<46;Lu%10t${c5FYB|(|HkOxncJ)J;^Q^i9Y6vNvF?$ zEvkedO}(P*0{L|EZTpmt&^ciY|oS&|} zwjfLD0K#$$^1yX=6=h{h_B`$h&ImWRB*DF4@vyOHe#K+K$v+DzDwkBB{74V?%yk9v z?!@6~YR-Gy)QeMyRq16AOijg{5l*K;$=EQj8e!UrCoi7^lrB~F$+L?Agf|>Z9f$Jx zF0h=alS7Ee5S`|4?eXy9rIdr{$eHBiBiBi3R6elcA7;4 zrI5O&b|#bDnl~teZnAbFKXXJ)xaT}L?~qI9ns8GDPWlb^GN5i+HdE{j7CT13!q_MD zD%q`i7Xl2?)S$!pKQo5mi)V@I0kodz$pH%Gq|n5rAOgQn3YZ5GX{|??58AFr0KrtZ zgtL7m;PhZ@3CWkBgg0K7>a{#hUbm-khP&50^6Q z=xfIIabMwEpc6%1(>;SyFHph}+zKqNBlf^AX80OM8mJRdc=f1?=r56Gsv*7w!P;8t z1Q2~qh=y@w6i7YrGHgb#{b0MjGIcYp$lIQQo3>q<#%E^oxN*rVb!@s%z&<(c;h|1 z2ARzx@r>m3#qRAfuH-o#TK)Ye#o)$Y4%}9L+|vU*HD~_c3&>Mj(}U?HI~`Sdnn)$! zCIDLfSrthJpOlRai?taAN)y-uDGhg1OK>AeQzglUh{IUa4M<{$SP{7pf{FFnpf~<_ z3JG(BeNQCpK#MNDx3}b&kg0|`w9H5>!Ls( z6xu>!#U!?>tv@MSl9CDe^%`ma!_we=E` zTKA%#6i1n%{9OD74f_kYoyaI-{g0!;h1Gf3p6vHs6SZ^qce$^Ud3ShtkvnMFAc(ZkfL2w zn`kqLbc!HJ-I;B!IN#p5HqkQ9sab9bN&Gb5-G6Xrd1%`hczk~%l>fWI2^9F)Qd@d=kwHs zr7lV9BuRQt^udo3Y6+66H?7*8fIC%k|E~K$!g9=x)rrGJD+io6@P$!^j|qf4ekQWP z1R9gaL@OT?9TqiO2Z~VQSe-mh5 zv?+?`Uu)A2@E z)JF%eJ_I?_Mg9j&MNyKkGRshk-`1t(1?_C0ML93g5mnXO%ulq5^nh06)e?kVVRa4W z8N%vU-us7OR+3&rk{(gEt%JkvsGpq5?JUJ?u*<|^Fp{{>!c9t-q_6!+xC;qT-}#d` z(9Nmb;ZN!%NxS_?*gl?^TY0xj8}0&sXXwA(NeaPR@5h7MKz)NhNuy4y4fRt$oM!AZ ze-atXt&F%_ka})qru%nDO55n7xQs3DfHXQ+Ir$HtQ{kKV?+Cw%sM6OBuW1cv1lkoe zSP3}SJi}1tihAsWS0d2P>=Ef{@`Fb@b+~-}NY-FafP15EkgktdfPtr3vH_k;AchL?@2jlOK&BkFx-d=o{A@idfAc z?c7m$nByLxzWKR|?0efZ_NGIEvZthLz~othyH;ZcAHL0=EZS(zn0?~eW(qB2-fPiJm7nt)Ya$F{T8rj0kw~#5@83P(Y z-0#Zx_?RQo>%U%?b)!pcehX0V4wU#U%^|O296QBzK6Av#3TW$CrR}(fd|gc~UXTWP z_1rlHwS|&_HI+>%tt&ui6rVu$-P5$Vs8D&EouR((XBM67dne{>V^zY0Kw&Slol`Z$EO*P{OxrtabW<(3i8jl|yp+-X9ti#%B7 zr!bQgxGe`1aw>D6KWlVG(mU+m8CQD5gRn6kX5esGlUMvi7XQzqrp=;v^%tMW;-8N< z#nT03@*J|ezFdZhH(7KO0da;lM_Q}DJJ}2e890eF0Xa9_D*mb29&jyoJtwb<})G$S93?L6i40n2dO-_fV^)piX3dn0?xDyJD2uY zweaJ$mtvNq9`P(+t9b6HWf=1Ec?xmHb~G`hBkIJioq_)WoTV{6<>D~>H}?;~(f2l{ zQcCJ`g!+)`-pC58Cci_>6#2Xl86a}S7L&z_UWYU3knyhX5BW@|&IoWJwVNJ*Dnr^@yF6s~Ph%VrCX4La%{H-(ODzmQsj8^y~tR_@>mFRjR_+bC( zmQdasVlJ%Ef;!Q`>^Tc(BPmpri(j5alKnM2@g*021nWM35IdXS4nzLy&@*I}W%rD9 z|L-XOoJEwCL^&OuM^=aIcE=#z5s+BDJuegW^hXh#8Sguz688OD+QEfx&A6TS2Pd=h zPE<26IA-T9*YTk9)_0XWZ*nIww?5X2etrtAQpXob>J3eGluH$XCe?ze>#pu`-^(x= z6zyaPyO(A(^#BGCpibl*^$W*Z7n9urP53;Qu*+^!VJKZ~#mKiNy9c^Zm~^#-x%DGA zsli}Z?9uGMoCM>^sgz+y;b<|W67)s^L;4bWgU`~2v|j$uSKs~V&v5Vu&OiJ^d+}R` z!FyQ4o*X&NRIOF$N01v0!OYJotjKxIs8G34OM5n3?dl6 ziScx_vYz6>jU(I;)rfHQ@e$7tsp|Qf2c;RN>_q`%$}Z)z#h?6k$znTylQkglG#+R?H5*_;(TpiV}!28ddwgBWSL3p=53;nW>^Yrl(nHH|^Cb`w*Njng!&x)G+j8mKLYSN zXhnZzpfa-NpfV;_vUg_3$lVK7>JsX}H+E=25#(M$(}Uj+%v4}{(V#cg;>{n}p16eI z#|OZ@X_&dAxS5rqogQyza(WI)8Es+3zNwJ}I4Sn_2mc^%Z0F|ih04L)br3g{N2eLV z9U{`X(Lwwh#lr;UoC+WE#kVY#Z^SpEKoB*>deN7iLy!}3LI|b8>g<7&#|P5zw^Ueu z7_w!IGh~Lc&^A&~MuSL_x`tXmg^8VQVye23iPF8FXA|#I{dE0!&Vj+^+O+-t5UL~_ z8eKKZRsce%2ES0IP+lV}MOnR<6Y3ckiXoH=Ds>T@2bDSxLKLK_+{$TQ{FFQ$*jEX5 zAb#4f*M1zd<0tC6OceV%SCt$ME=mB z78T=WJft(EE>`$6-ohVY^~<5!+vg(ROhhQ}XOyi?1fkYg3ANTCDO6NWrfjGsjMqV^ zgWD<_%z%#neh@`K4|Hfj3#-?M7Ir5Jm)qspoxYYm#EroGlvz zqp~xyai1&{X!z(s?7NPMJ>?AG!C~Y8Y6PI1UrnSoXr{J0Jti@6G^Po3Tor07&KYKP znvE8$b3Q(-K70s7u|P*1@=8UKU+rvjOq>%?f5gF|>)J>*3#)&Mps5QCZ!5qkTf}@_ zE4nK=)ABYLyqU1z2F&%;PV(Has`o5PL|7qQo@u!}0xk`9w_{?bh1I%w$L1H=uOZuc z3jEP83^V*PItQ1UUssnOw?3v`ZVRi)b8FLO(Xnyvz$GcfIfgE8!AlxcwdaJKH^CPC z!!dicnR&kEbT9tEtt-F%->n9{T2`&L-=`nS_xEa21L)PXos5TU{$B0QLb3}Z?N1|p zB^O5exeUhWuGp*XSJNr5*Q?3i$mmGDc###!PB+iaMsL=O7g;}KyN|D4l2ggWi>zVU zsep>dXY^dXc#+j7yDgI7l5oYGUcAWqDEoUP!DrQpw#%v9jeoNm2`z3D0E<86gT>>( zBKll+T>$+?V(7h5SXa$RSOycWlfOPAVL3nSu2MQHoaQ)zV$_eEq8j6a=;qN`_gyh{ zhOP?qZ!Oe6`ui+S9e&GUfIg)*w1AOKWAzUjuw0kcTM}BT?=dBjQ$}IK>J8}B84PI! z8T^6+Av!i+zJ=%&82uQc`{!t)mGGHDbf+Y=R1XQ!AB5;7B>E%dBGE5>M34A5t>+Pa z!VrDY5`EAR#m!jYR1=LO(T5Gu`abcy>jDN*72hFvH=L#ljTY)K+MICO#}M5I33AK& z;?54}!#T%Loam$Y~9F*)Jzi_7ar6iI3<; zAJK*$(Ps?N1(xU>Llh%t$gYVdkmzHE=rW%|7wYd5v6`nE`w+f>tkIju!Z*5DsngB+ z8^>c?s&6r0BU*Tkp#LK1cR615Z`I%J^)jLEwy>+&4UB$7G#mSnO$)9SE^i4o_1c&J zxXURpCwe>^(9M=8K!=*~1!ybVvwe}ytnbN5DDT7Lwcl(hjO%D_xfTLDe9;5h+4SZl z@hC``vo5+1f-MIRq9+sVHVuaTPjywhSrEewrc#+b+GT{nR0Vb{_#)KnQK1Z`#zg7% zH2X7%)l#s$7rN(;+K0)~L{%RTy3b8p=!<`fD!8_`Fs#lM6=z~xk3YWG`tFQBJgG`a z`NIclktzUIPOv95m`HWrOf8j}Vzfan=8YD*!OYxIuZnNwbZdq4Fe=R~@fQA$?@-Y% z_??^fQaHWjspIP48mtpOuc~(T3YaYW7QT(|>=Oj!B@J>2i#g6m0wT-6g|Fc|RP-W# z1?&|K_9?-h6fjzMs1SikooozfQP`^lIZnL_kmyw7Y9Gq}Qu5x==!ML?()ip9voY}r zyf-!8oy;48m1DSU%q}3Krh&8u+Dt>J1A1_&(RleIl%F9ECP|&|&m3$r zFEyD*{h0?%<{*>#5NyjOnWR1pX5K1C`h){P^BzF*jRA zGqrQUv|;aN2+4ST&)XP)=9ab3Evtt|TXO-7g)`~|ceHAHD#3#0SOB1E-gXXTt(xOPuU%qQ-q~Hrn)i2==+?UhiaQ3KO13 z0<>c8OsEHX!Y^Ofw)_qN6HY^v2v)(bF31bhbb#={u#hE}HObr`SnT^xg6x4&P#fItS{JxjU{2)P#HrOxP z=|;5IJ<$lmK39X9poF;y;jG$W5UF^;D7^hS4y13hAXWiTMTc&Y`%oW2%p zw1+g+ARR_e1EjEeh!|pp$|l`MEBq7jD{JTs;oMA?+$Xh#33u2^Yn`FZbFt1j1N54W(|eic@=7~ zFss|#akQx6hSa5gj2GpPP~H=sjT~$3@ao8Tce5*0-PCyOQQ(|@49kMY6H z7D*$_3j@oTa=pycYFG5cVzB*drpNZQJv0%~fI+G$YcY|Q`;dkiB#Ca0r8vB}hlYQw z+MdaZsLanIv}4}#{XY$Ga&WQGasX z(*;05>p>^=0H|HgcC&ga88F^qss7`PV^yDDm+nyIRVt>!He}wXX0tI50`ZHfPnHx;zV>(lZOFMNLHDbGG0W3}QCJimY*;^X8 zMr@ZkSwR1#L2Hfc?miZ3fASlzF^?6~omo4R|9c=d2Ti56Kx{#M6Nq*FRZK*B!fWmY zaE(AL%Yq)pe7X2yL?nF)DqY|YIyI~o-3L2pX`J0rznQhuQp5yepJD_gt#b+7w$tq{ zFAytb!ih-m0&ZATVh>XBE&w6CH6IjI2RnchB#gR2<0uHDgQ4aGMBPzi&nPPbEB1N znPI6=`q^jh`5w{+gM_1+kOtAp?krnXgKW}&m~Mq(Ztn~(u~k(%zBq5YV?kXIirlTj z_aGlTCM4peRyfX4w@Ge>N?~sO$Yix_Dnx57qGf~%+g9@?hn5Gihv)(mxly#Sw~J`O zZ3kF;0WKCzoynGB#g~ znVTk|fJo!sCUrq9<#>$noOwRVp?rqlJeA}{5|)kT1ir%$Y<4{y`pPh@<10oy9`h;0 z8Yoyenxl@OMMb$ez>6Qp65=F*2zzIa$}<^6`Up)V*nwNA1rpjoLO1e|QB6*Z3HphE z1`ipX4^9I_O9=UlK(;m7mZVv3IU`X{1c!)xrTB)>SHDgpJh&aaVA7g1Aftgo(z737qhRuOknHk60pSN?Y6YE9x#QWz3o1@tVwl6Nd zl@gZuCd|^x$&j9FD}M%sFTBN06&9cm-$MtMp9~*ofwmB6rT}>pa-7Ut>D~~I67ViB zK(ICIOX%ln_mEXt?8ATCkZ;cG?3+a1{OsqW(FZrm|NS$y<(`|FI1juWjp?nK_^wxxz3}ow*YH0fD;_vD5w@j27^g82FHl=>G6pcBE^o#YucpERwSH zIHomFxcoYO4KnWZYlx6H0Mc9Bm*}@y+~Nmym>L)%9XBev3p+HqMZoJ#8MCCwBs;@GS25WQ&)ZA6L!a8|Jycd9Q?;Q z+;tJT#HEG$3&RtIRX>3E%J9*fNP5{qPuj*YiWRU4fnxW30h&W()a9c$ne=)IU>C!( zB(+5n|2EO5S`BQ?G@8V8r02~6?*$O`m;;glkvJ=vJP{;kp;5H0+AS=4aXM8ayILWA z|8{r>cmZ+|MX!s;CG8&+9cY0$E7$KA*> z@u;*8+#YfORygHumJ`Lw-hoJpO2=QCpNz(lY|b#e4@E~CMsR;Du9m3<|2$`*%|A$nB)?B`BC$ zXqr4I88Yc$bzN-%l?2ymLh?M}3)^ zCLE>bf-Dh7fstU9&w~HNc4=Q#SN#yE>XmrB2Smc^;muU*O3s&}s`a6zd-MT9xhSTN zDuCj3Rac>^@5f(S*hZAV-b%9^({82@NyOafXf$d=as?n!ALQ5t11|E04dMwlnkEWEEq)?lcE>73Px2GjIS8D zIW%t-P9Em34?V_zd*ImVe(sjp50%09>~~j@QS&(USKTk2uWr7yoqPEc*AhtjYIFM! zu7~M&D*-+NfIc+>oWO7oGUTltOu9;yA4HQ_BK1A>v+36v`_Cdw{Yt?Ne77#U)^=%=u!XXCv`U z_!tQ=5Hq)54k6s-J1{@oN2phTP(duAdo`iud`<&%wQW#)q+~4%J+#Zx4`qg>6Uf0( zAEo9@=pA6`3G{pjwXM{uxRor(AaEpXUBF_$Xh5NMM($cD!adf3{ZIcf>g@pvRPRYp zC)K+WG-_5=J~wV=(pgtFyJsZl+1I_ zM}^f_pZN-!n>G)%!Qi>E{Hr?QOhs5N1`G=rqiqVUf?%enIYdPqzLxcfz8sQ8`vmfv zW4Pk%l>D{^MUvL}P%HvY4$Y3^bmGlZw0`K&h{f(uW`VDYcHJ)WA}rV*Ytnrijg8 zEB{lfD~8j(I>8`xfU z`*tQAhO@KmolSRpt z6*(1K#GIa_ysED3Z|L@Rl^Fl^Adhy6U zc-h^T;00=ZBMx(?{Dv-xmL8d8h#~yhh4ByAf;)99oHyU;^VP1UP_YL=Tz5Uvk(9gz z2JQm`o?Wy?sIGTk2XFFvtBx1HrK6Z|c03lTBTU4CURA=_gzI#8RLY5Y6c1 zg!he3ZeY$`$gw&R&}%g)cBqRvPgp4NkSK8m5r#-UCSmLia~ZfO*xd5P{Eoh&USDpC zdYL)(d_|Qo;g8G7RgzR;l=tmPRqA<-Lj?H31K5v2b zoTrgv#S+lj9w}wYQtG^Mtk``839L9RB9X6h$&OJ!Au^DheCC|1$<9vOU68gLZN!{a z4CQf5AW2}Yn2@c62Grz1Wn344`0FxC4+wkNrr_;iDqYD%@XZlh_+uow23b}nfn8!L zTsCl(WhDcfeZd*nC?QU*nZ5(^c5?hlLQp~Et+E^ zOh7TT(0Uk4_%vMz=3c5Z_bGLev{$YPPOE|j>Am)=+wrMertDBP4U&7nEK|u#KU# zcgtterlCu_6zG@;)E77^m?~@Fu&n`aSp#3K zY~XVO6~c6Ku?g9`3yPD;9GoQ5jTXBG4uOn2n9F6R8sm+Pn)MO{zHd0B9tI`nm3uSOr$-s=-YsTnR$%35NlQgG{;xCH{~w(f#)c5`6l-p zrw}1>kMaz4yvEk?aRM}mj(Mzpz>32UFF+TQ_niZ9i^$N~_8PCejJ-ym+-vaU-79Di z{W*EzEM$$s^}KK|Y!U_B$wBh&5N0C^xW9$MDHMX{ilY<+qWFi?R99##Pj5dOA*3sT zluVX7lsQG=K=FF_r)l2vR>*Upm1}IbW{|P8Zp=K-F?kkqT5%qy@FC|ndK4q)rGTIh zn14jh29Q$ra^VpO?rfMe7UVZbkN{!k*KUQKmhLMoA*7QWDZ)LUnL_k2h9D3lJinulA>kC#(v&MdYo015o+6Gu9^#+Rs6J83yPgqWu&=;w`6GN-*6KyC~gX{cqrK zi-Lk+2@&-0HV~%JZ%e8hWKRJzYQuC9<_#PZZ?T76;>~*mx=b-(B`SjEV<0wu2dR-P zS7RGq{z!E@RJ+&zsBMlMJc&8dC2vNeDrg==vq5t`8iGHO@1b6Y`oj%g@za4+dbARsH*`P@jpu0NX)HA`CZbrZ=AzDR6Ima*t3$0%>B1e zXXng%oK+wDkvkZzpQ4YSZ?5d)hkz)u*NN;MEIIs@|6EucggbHo(VBBd3?llp6wxUR zvs^^i!7G%D=$;oVMRX6?!uP+Qq;BQ9hG#5CKaD=r*5}Ug!6J5k_UGB3f%Dnx-)GB# z{X2G+mheaX`)rE*$rHrbKKz0yp0K#fe|NH9>S)A&cgd>00W3;9-i;j(q5v*tq%MK6 z+miOL@CuP&vd(;P6L7CkIyk|h4d!PFiXUkplG(`*nzMvXt~dV*q0$24GH-=eMBe`( zMofnF6uRXGDh9vsC${HX;0&?~}KuXzS>Jxh% z%kCaI0sg9N{C#HpB=xzF5U=E;tTLB^VC;F@=){iL+)bw5jqNs^l=`~x{5{`;Em6)G zK51I<6KX5WXVODIL~r+Xlm2-9%p%_TfUPo~d{}V`Y0fvRUcLGTQ%Bl{UV$j~(46o% z5k^adbBdQD#JkA61l!*+o^sJ~?}ERuqKt0gGoY&}(Uo3Ph4%6Of4D-9GP8tYy>6+n zzm!g+)muTd*rfnwOFUU&hv%f7b`S(tu|c`;xsp#R2aP{*gxHowO4lU+Yqa zi}$}BBJ;Figb3qP93vu$I4H$IlxKTm3&vV2JL130W+TrL`5KN(PwAZ`T+#v-XW80A zgmJBCO|Ux4{1=im<1ZcLUwpHErGP@>cV;4CYMZ4mA-6yJ>UtUj1i**IK|kgowT`_^ zSdRll>lilu!aDeE656_<2$}yMA?@dMi>WEKL!7_oAsC;+nvPolqbY%fXzyC{?6=g; zjA}xtQDG)W^>9=$^3E?u=AL;C+vXpkFJ5&cRUNAx>0NN=dspLozB8$T%K$v~`t)fh z`I|h2F%bOSn`n$m3kwPK2M$_5x3+(;I8;oRhP8xHpD0l)jQM+p6%nnyg!NA)ECsrQ zgTTIxd5)W)3LEooY9In&1@r9$Us={L2i0&8F+WygJVjr=xfJ>}=>CH71pl6n@dBQF zPF`dj;FYGgMffuL+eo&s?KpMut4@*+&y5HLV+1Fu;wUPT%y5^y^grkxHgd5wxa^>8rt`SsBsZLsvZkkK5VTtiKhsPeZ)RBV zvA*5&jC)BmH=4&AY2`G3jp*vohhN2wTDj3_c&MzAJE)OwsYYy$omcFmievbRD0$NY zU*NrAf_}z#F+vEzZ!@i9<{}RTdcdlN?ITSyHJ0ng;;om}c>H({wD=@gHQ#;k+yv%2 zeYqaD@vDwJ17PqFCFO4p;lU+y&V96|7Utj!^0WsS-7TXxpgzx0u}VnP-~F?N3deyA zR0;KD1?s^PD)Rkow7P`)vkKIa5-N2y`WGA|ufM85{dfr#PKu3EicO-v%2DaIq8L_l z33Vo+{%Z;K4US4sfqIERrFRR=0&wh8vdKSH;Jpr)2T2hgiEj+A2;~xei{lZgXzxe~ zZ#LoKoe3Q8J&s2pfw#YeM|{&Z>>SP*5s$@qj`r|O>7vEWvuFL|BqM3D(xS)BHl*JK z>@ZE=BQw52Iwlc`o~lJpyC(eOm85?~0&VZ`8FKCRDsvIPJB6Re;&rsId_X?gGGBqT z`TQOvL^4-^U|w`jYW_h!q41KC;>GksRc!QW*npkCD$ZX?1E2j8m+Y-m@b|Iv@VA}c zDJonpdOkKj^Vnr|ekAP@O)PscDrBG?_hQ|UH&p+av zKAJxt&CiKuafzm&Xr}SkBuv@QS)w_G3>jzX&hdnz!Oy^)ub(TSr_lo?ntnxd@hClp zI%Pj@qS;lVi7A>HqhCKC%?6@bSEAWo#5;>g1{aOxrtD-J5iBYZBQ!XAEraCg=y@WgMIr;R6&FaKd8ryDXU?iMy|T!;3P3(WDQh>`u{Vv(A^XE#Jnxd8D7 ziK>MnhJ^E?MFAcPKcj%OFa205Zkv1ru)SQCqD^zh!?fbkMA^Id^#8)`+|2tjM?OcA zI*p8mK*U%5`|-Gf013HQ4&i3R(AYcf`4jpu8i?0x&9~vVu&VVxd2T}PZOqpR)NkHK zpl-sNVZJ~h&0I;KAc1C@_u|^Tod6pM;4_B_kiuc?a^pS%Z8mcR+AKhC5y)ls5vYSe z%=pm#09|f&5oj3>Mk@hY%@qV#LVzIxtTC4o;4%UnAb`_+KLHp4UL!!aSw+`%58!&K zc@E5)zZc^&zDqqpC@&~E;rbW0>)+b0Em@iizRraXA|Xi%;)91U0r&zj&78HL+u_y5 zZPev-6%}rz()H$eHN`sU$ZFiY|C{ubP{9k}v$h^B1i+zTsq!~O??8mg2}P>>%XiDc zJgrdi>WcJtxY7ZdTIsibfwMZ#*hS1;X|^fmtVYajsEZ&jn&o1We;dj*zC-ZoW$^ugtH#wshiI|H z7i?{{LYPsU^X%{`j1LG4#x7CUYnbspYWb3~mRr&C=m}sdYSp~6qWNo#!;`7sgT6Y%0mo zGca@y6%H5wxDCc7gUfSx=P&euyRGoscm?-kBr#-V=ngEm4h(?I9j9N26R8QM-{NHc z1_g7@x1p7}U9ZewctCmhHPDanV=x&v-@^0=nt#UKedT69iR)55O&`3h?QztSj z-h%pxW|OuvKP0kK0(>n{;IKcB)E=cJ%!iS|MtL_vGRXac9|Sba{;voq%vK+&r;j>c zj_WJ%kCn?h(>49mM_t>?M5EvwNtOw2uTwY#tNf_`6^?4Z67ND~qVw7Q*Wz0J6I``R zGN9}Afv_jo$yh4U-wxoIZg6OiX9-#I{79 z5c+p&x9PboM;OXwV|pCuS}dAMvBJ(FT^lS$b8*ozOJw5u4lP?OXxRZR7tIXn0Bwt= z5^>Gz3HwCgd;4_ z4^}gE&K8U~r>)OIKDk67%zAq|H$^(T{j4|A*%fBqKv$RF8|e)6gdxsQXV2O&t8+Cr zwKTOZb2qiJx;B?<*|HXwbD6ufxv8b4xz*VUqMmS|%g>ywqqEB&W)c6Uh%dB(c{X%K zLVf_cJ>GSlJ$~j1bw<{)u-DVWK3uo7VfT&owJUa2-}1?it-5~Y>g6?CZU;ulvzfK~ z*LL=>_RWmThMJEsU*`tq3ow5dq=iFg2lMy%Sciwo9f1%7ptCy|fB}HC6MY7J^xq4< zpg|VsU_c56I(s61oI?Sx-`5-Rvyk5#2>Ead`aKbxBE9&5_sBXw4gnSk_4-+4a}d($ zfq2*kPl#4ZCf;#i1w#+&A}X6M&G9Av|?V5 z1B=@r&}uZ6PC(U}LCvwwp+O&xO%4l`hXv_)zkDo}1(}vF= zR?llRbJEd5%+LlB7%5dS$BL<2sUWbm#T@lE5(o5YFV;G0HENT@vwW4UMzx@3FH09w zg~U*5C#LBDOg^raM8R@;teDFuw&|L11k7P?%28u$H@`Dei0+VDfu3kgzkc1Xu`hS;V6=9xnnR2gwWAB0M>u#16Ic00oXO~Dj~vSdUSoJ6c= zvc*BjxEv*?4<_=kfcy$Ak3ppp13T@!+MSH%tgm-9H?z`Ew1m)JGy|8%Sz(m~-JVTh ze*_~EoKEt0jzEXdO08{N@S=Jw70s1PpZh_}j7qxTaIUQc`C7}m;Sr0F>3|l?X7Yt- zroer4R0CxezLdzAW4W!{jE)WqS*cttyg3~4cQYm4xpgn-K0Un=-lqTWc)LfOSh2KiW1x`letDz*2x@26J zVoBvKr7(HWxoDLehPbrr9&0rgQ@&Vpm&jdSX@u!wzMvUV_=XhRbV_roF4baQKC5j* zs}}RR1_p(t!Zv(|&u(B2zHHd4%QRA2?OBN@(mqXqs5XElfKLuFF14({qak+5W?*I( zNQDwyMj*CxN=qpCEc2k$A}xe#{UKW;a)p^R2eoQvO}Qje(SAKO+3gCjC27qvIT{c} zE{tOkdt$BO{95=d8jHc-^63oUlS}LIM6{q=97@L}75|AMq9<65-P_w*rd5&DUCspY z5VablrNuVWOVo}`7L5;PY?_m1dW)>tf;f*m3vND9nj^ZHBIiToUd4`fo@poD1E~lk zA-|`~=7I8>Lq)p|4a<(^z%oMijS^x{ELVDN8)gNVkgJ~ZF~S83Z(Fi9l6_p)hY+V= zMZr{-j>z34-Hy1(??i2S+XY<_cc=rY=pYX=Hwv%CZIzW*b&(H~6<{G9&FmzSGy)vU zX!3}dD7sj#X*|M=czO_WZA1u(0B(B@L&2iS!w();Ay)3~Suf%;Z@}lL7;i0;3xYIu zgp?6K5Gjn~M_T8Uf8wI{gu{M>kUqbc`8RpH5KDULzl-(wH?p9|yB?8Xa6N+2a4>+t z(;EnGW}fyi^MpebtW&cg*3lI}tl7~OVO@wLyTXV*eLjSr2r~h1@5C^=fRDo(ub#^x~zT$`@D6rN5CN)kaT6t(IQQQId$fpI9M#m@)N}y^G z8>ni*dJU`3_B&e;Nw397dsxtq?&}NsjsmNXM+;F_-=EL3`h>XF`Kig*>}hr4(?|z= zn#5%XKDHvSl4a|fE?8OV?hsxp7q7Ew1jv%I;sB#A`!tu8oIbC!j9=#Tlp{2@m6x6F z@^aIp2HMLJ8kHUtxJ6xvb6Zm-2NeX%%JH4f3XUo}U}RzTkGG-+d)-vmf4{{^({6N$ z<}TcT9HJtq>ln!pjGz)_Cb-6Y`r%*Tf^#*ZT;fTI|#b%F6- zpyA2HY!Y|N5mu7ew3Vc()tc>t0U)Cy)Q9XtY%5YES{iA${+$J#!ci`1ZDlkbr^Jv& zOLRQ4mld?#Nu(i0qTiZ;At-t%M}t6<*<5`(k;&#n6GSgVDk4RAK8U?K^~ZIpty}^T z_s6#9qDwdd?42hVb44WlkdliTdTc92VbyZ;o3G`25uAA5SxhNv_NM3|nK^75Kb Pb9qgB3Z3RPM9KaiRaXwn literal 34834 zcmV(hK={8)P(w@PB?16J00001Mv*2LLXK;4&&M{gp_Z2kISrw_APP;w7#aX>y078;6TOArw3ntF%%pw1w#o1xWwfN17HPsCBD6ChuU^m%XPk~7 zZP5?b-qV97mGJaK!qzLcX4c>8ib8|)yY!bWwHLXi{Sqo3O^+jvGXMB7l7!S(^hR1V zAfpJ>Am8;QA?3Cj(?<>h?wA};dZSW@^{li1Glgi;mIU<9m6aEf`Ie5@mQ;RK=Z(Co z!A$M&hCN2OCE_$UJF?HOg~gMBI&)?^rt7UuZ~P)U?ckxt@_f#_=)Gj{vEhtuS8DQkDmzb#!=UcvtA0_&IYUr(73YqN7eAtNgjs*{YRM( zPg3b=>%Lq+K+cv-m)5i~yjRmw@Eziv>tAf6lh&-AA@7}Q0AY~GLljNq*+Leb(_p$W zaA?z-z-%~1I4B;v5a{Q6y~=D+j10t!qhcn{chwRU3=1n86wnq@-Tf!fXbR`l1Gf|c z%=3bY_w}oG!*gr&O!BfxK4!1??f zvi?j3dy_<`90sZh8*5DEeqyJp_ia~on%rp_grYkZ~BcP7Q0Bq_~Yg`zNt2?kBE>pP&L;zPfl8YJ=CcIzTlgk zvjCMjvHWa#CMH9{A|)#Ki@j&K#arNJSH$?j*y-($ag;c@X+UHK!d1S>3ZA~wFc!Wh=?2!l|yQ+&5Ci#qDpPlhIG;EmuDsn7GWKIVo@ zX#>ZYz5_L0u9}?=H52!41jP@G6b>Q|P}t%sXtrb1z>iiLXAW=Gc; z^qR=UWeh5O$duGohV+HH^-*Qp9I9thub1%>D`4Oem=g*=?)s!PRdt<3LQX*_R~z!M`c>ZhsFrt`^i8SZ*fjg@x&fwGCRe@3v7~2&jV{T5}Oex#4RXD z`D3wL8RQ}}YUFCLU5fE_)xZR+StHRsuFEKQs3@L+%N;FzfkV+l&;?{RN{^{~v8l== z-MD6Rrs%#$ls7(rfooDZ;9EBQ`eJ@*QmL|gS3Qq3$fj#pB%Dw?=wl;qH}d|?;RuU) zCloD#T+r~0r2jvcIDt3XQArSzcoPIvsiYi?ZxMRlBX0~0Lv)+%OOCT-1Qx1 zHM;?~A}ybL)A@IzmlGoMag1dP=axh8+G;Vn!lXBj>d_i+{=i!Ak$9*eUjEIOl9ERF zgzk{Q6@J5V?!~F)9-gyst#T!nwXE?sjRe@&T-(88S0gjsSur)Jn(rsvl_Ni;cFnP`6j@u^OP6xw2G{*0-u1g#8FVLC2^+629JCS#0>>hPn3y^8898z-*s$Nvni@G zX>&B`4Nht@-L>&rs**k&?K8Z2b^Ln(cL{;c1fN6Tq1ggF^L{%E!Fo|Y6c*qk^r-~L zma~uVt*{J-wBu~Cu-xcHdx@B77+dx8)}oO_ZhaOE!o@(;?*uo;eEXEe&d+v@Cl&AI z8hNIQ6LERwkx5#n7aSB8q}sqiL+7-KdnfmI!34FP*38))GS+zTMRpkcfUH5)@P2gV zH@r-0>D(Q9d`;28*i5)Re_g=rbLDA84RRLZ$OEz#5|6a$6hE$25F*e|p~^fQsbLQy z0i6uCimod#@&9Yg48~hZik!|Y{R23$jIiAq4n4&C25V@VNRi|Yf3eYrjf*q zuI}6VGk)hk-2zRg>9Uysv297Yd83!1wrdHH7gL=d0AxuHZaf>Ig`z@jVd>5|t()Fn0$zJd%G4Ow-`1p+kb)<+$X!z4X}ryH~ApDhn`$m|{;E z?V;3{kn?S?NP^Q-5)=p(xiStX*Olqs$?;#`A~DAUDg-gf!ESMiAeq^#$mg)`N^fVF zt`!PNr84Iorz%xCkpPfKya?(@LZ3ll4{WtJQbC!MT|_?R*N<$f&MdF`uEgx@nOW&@ zYpTZ#HGJ-=ZpwZ#^ z>QCb-#jNz)K#nxW0j4&~_dtG>m>JzzLyonsULejd-dkysE7v$qLA^#N7Fvz+z5O2m zM(hMh)E4ghHvOp4CklmurLU?41)-<1DMz~HXN2m4#H4Kn=Cn`J&p%(^DdSL=?iotv z-zJzSQz7HH28SXQSSOWHnbsZ}fMVlnOEFU{e`qW0}TomOcBx^VeW z!&kMcspI4P_PLXODXsujN(`z`KmHe{vgyEpOm(Nnid^<%&{b{8!4}s89Yf!$Ck@60 z&?H;?7CGR`0sZlq`o+x^U0+^P3$IlX6Do6v$m)BTcl=ENkBhWzZ9a)8%H>6-1AG3; zXPMY*N};ZXy%2+{k5>||Y8|+8zkO6D?BphmUL?(6Q5O>Q!A4y0@tY3z>{3t%aQGVa z=HQ=?CtZB(YtB0vAC?3w4T9WC{<@1`wK+5s+6}Ul*Li-%<&C??khVmv^h2|7!!4rnVEKx{{v3t2*H`!1kiC``*)2Uj1KT`kw4xDgECy2w*}{sx%lFM8LAbM7R0y6ix~#OnWyQhuOLE`P#z z0s6PeGW)LcGPU772U_iDH7d500Df_vxKb+@&RM1Yz&1}xm|eK=b}7lu;>}RafEic* z`guGnE7_XA3nY__#Sp0mbe*fp3l9!Lm+lWAlYOdk8q z&9;JjU=H$IHimUKIoB13Zjm zoz+;r2=BRG$_A`&;|d-9Iug`qp;ojxyhfjGf9vQU7fc67c*e3ziBVFemD1uc%AV3A zxs6#z-LBZAB>m2;WQ?invG#w72$^om(EtRTTN8Yg--O&9pgGkL=~gX9#FS%iEhz|R zfyiRyl`z#4(vqy~+0R+WR9MIDaqf>(0rNa%>G+#sVOtBn-Cauup*8?hEhaQr`bXiE z=SN$#JnUJ8l7I2%L|7yaE+S8yA3=}>Yo6*;a`8-|wc(@#k-G@@eqYY-xk*2lzLi$ot;_Y6`d zd@k5#Lt00jj7G+%C9BPkmyg-0C6{}->##@kSJ<7wSG0j;g>r;|YvZKz;G;dh2+YKs6MP{TqG&C-!TFPro&{3RLynAcfI-xh`an5sGUkgRDa3*;S2ZR__+4SU=7> zyBY%kM1|BdqTgv?ZeWBf#n(@?CoSJavgT@-D{1+CbtKmli$|V+quUxX-c$wAXCzJ? zgFXBe<~C2xLo#aP)W^zx_3w6b^neD4?i87!M zft1w&qUhmJfwI}wraD?e+YtvR)S)3;%JgLdyPHHMXw?-~uUYQ=MzFjgvBO60|MCH~wrf;|3~n!Sq2v+_@8mFoDbQ{D!p zRY_M{P-;N@xm3PfV!}#RlDmT}D1?z8v^EVh?Q*L~3%)Va@pkD&jTRht) zhntXJ>sy)##yTP{!12h4f^y6$h#*(XQ8R%%j>*+73j<8_3Qpokdr3V${SMb0jz-I&~2}-k7c>$AGYO z%SrYaulz0hO2%MRZIXLY?Xnt>hPp0-ZyGNHDDIHmO&qH{UW(h}z)O0?@3!!~=DkHv zvRF~~$FJ`_l^p9jPXsET7KfXI7z+`>vxmcbB?Z>$g7`VvbQYzoWw#Rj337=bMnH4~ z?alHXZ65mG^?m?L2Mu^n8~Dqxc=cHzOk6Acs#LJU(5O~sX3tv`7{!H zw$x)W#Ty{(xFKGstGLQ^#+ieBAfi&Il>gEOZNwJ07|--<^+|^6Pl+Z?g&R^?C@Ct7 z*~}BW6I@(D@ki&u$OH+0m^T?_;_d$(O6v;D0Uv?K&(<(m4o#reG zO(6hu1TyqBjcr@L>^>JWq~d)1#S@ndqLOb0{Xjh>O+GYm(fFQ+x7<7)x`=9qqhl*D zABbP};RrN2(DT#c^#EC55}*wlMlF-3+Egp2gbXPOYtIHIF;Rh_b?z!ywmdcCtq^CA zS|v(CRwqG;XQQ!Mj6hq{aTpt1Gu6VI>xLDR_9W%xVJq{8JklRq2Lxolg$O^0`Q$$A zoD^PJCY)uH1WLKTWo^ry$EL2~Pl zgEXM3@LITaW@NNGwRk~h>9e%+8?vK90%O@N z!`3r$=pe=cn(cs!gjh3N(0r(Jr$w~8XGqcZ8l6z2Z%X~!&H<*MTVc)PE{M5UhPn1Z zb;hhUATlyR@)7KVL$bENet2VJ+Wc6fj>S>3wNU3(?htTp^~HBcJG;^MVrhh#baCzA zQ~^YA5(vY?TEs*N`|3^Gc6@fiukh-~jIPkfuIKb&x0*R{ZR(@$&9ztGlTjF%+f1h& z}5hHxi(ZO4+n|xUffNcs8BP5iy5F7q5gIOx=|= zy0IKlJhhL4Sy9%$O#{`vRuIl}T z{*UKe@8%<>G4yz0R-_wM&DfUPE@E(8$xbL8hF+O@Tg4mC31I>DCp;nKUl`3!$H)xV zJgn=7E6BDL{D@O?L}bTh`{ig|vgW8@%bQD^HO#E(au9{d5#F>D;$XZ(6@Y8xHKs|V^mN31mDUy< zQNIV@;Dn@QeiR|kp=YXDyE4zvm<9!iUXMhz1u$&B4I@lAqo924mdMYV`B4A78sngR7X>8PX_ggY(VIToig zRDqv9*bE}q6!^o@r8qEP9z85V6uq%HPG|WSf#3+T-!k`;V-AkLJW;lxFikK=WE5NLahwuYrA`1!7L+TL!(kt4xuRtc*J$pd9#iQdwcyc*cXXJR z^`WMRS8H`s2WyHVG|CYpgJ}~1YCs21y3UJkCg~PUGa@l(c0taxBHap~aVuZt{+qz; zLb*|KnY3_prR=5R&>Nj{__A`$+-F2Vs6(vVEvE%~;w2;ovA1K@aL(AUQrx_G%W1o` zz5=H|naqv0&_h|xtw8*FUALa!srMThCj$R z{t%@scQ*lJQP#In^$phK&HIQQI0+JiO~nC58RVF<+Jd&D5x(LfF5GjYrD3t={r%zT ze}R#x9v;XI$_B)2+Uy~;giYLvi|IiSw=GMreP-Ft4n}PetHGJ^p$i=V+M+s{wTD@R zC%Y6?N>I0lMjyh?FotBaO=2-n4J}lglEpo^e|;j{TzvQNq6|`<4_{ThO>5$HtexAt zOb4)+%IA+mLTQFo2wa9l#(67zNbR48v5sjv%C8QG7F(trcl(7=8ss4tX|3u4Mvtiq z5+t?{LMkp~Nssl8!i6X0;4^RL?iHERtZZdeai8NOV>@$b1iGU0w0eG+MW3v%evXM-gNtU!=#?I84*Q94m49Q)S<$%Z5STEb?Jr;7 zyCm^DyjX93p@8!Qx79liKM=caA}#?{uVN!YfLRYao_BF@=6xhFS{WZ;5V*VrIS2B~ zy|;$Ith7VK;mcE8&N{^lcx6Un60Q)5w17@QO$Vd3OZ>inMZnd|96w;rhj2)?@$U3O zufv15czQmy>uLr7-b>zIT@jJp#1l9I)o{%eQ`(d82P zL{*X*)OEgAqrq>!?~?}s)KaJ=@C2iGtPNz)iAfZ=jGLGa7!}2JfBzlj8RsQwjx83B z+&&pnp|8+&X!C7YaDn(-`ie27eNnlHWG!$p{#Ls*0l#X~rV_`*+%lNr4EQ+COY(aI zb`py?L-d9|-9GAZOY?`fQ^(5!*@Vw*Z{YX@JYktbNr1NqJXFe*>kNKWVz?dhZ`~jR zlp;GCN0Y_GzlXAc53y2CcL_j$t1Oib1aa*Fdxdj@YTL}S9{LqG@Yo#=#YNhs6<@#I zd>W=}#62OT#OqRALaA<8wIll{bY-E8O($SidG9G0g+$l4>T<6n1dZr}BRWbniB%c$ ztiJ)dYMFLx3du~-zePoy-Epc{yx2g~vIs3AM^)Rvv@M04)(c4)$}d5N$rwi1olk1c ztDU}>cn+lS;bUpqX7(#!JW-kg92oj&(8zexDHML1N!J+DQQ_8OLQAEgNL)LGkz3^NUg*2#o)aosWor&)j1a7()TyO5< zIY(jhc+fRb7|{^@s@kti9V5MAy78PXe|Pfky!@5y|6@91o3L}1;C(g!uwk7^6owBR zpXK47r-xB!wrGOmczeTdfr%)Eyv_=Oji%#ov|+glBOMqXo1JG5WgZ8Yl%8OUF9wg$ zr@iy?WQbr)U9>F?Xrcd3-l{@_Z_3KLxaeQpf}<%3HMw=J{{4yW+f0xAblYVpM(>Z| z7jp(^cvh(Xc{Hz_x6T91O9*Hc1r-go|5eprb$~^2oI1G6>U6%O-zQ z|0SHo5w7s?&xXs7Ek>*Tr+A_3RE{+9>d3f@2z{rpI|8y-o6%6RarVyvMct-|G>Ve{ zH7sw@o&KN^AcqkZ)?^)_l)=iJW@@-9rmQTsCkXUP{w9lY&)yHYhXW18`mBMjq2QLjh5ncMrt5xg8+wt$ zYY}2fO37cmJ2u5TFty3)JK07bDrm^oVkb6@dT0U&%G)RsyPMlRMt-VJmem57yRY0} z)}46A-vo=#4dopo)|dFfCW_>OwW;aKx+De7X~1FCUGK~Zd{h!L`H zZpR!hS)oof@Hj-E}uA4#-y1h6TbUHI#eN_@Jx(ojBe!%IXi>+v$EN! z^#oQ<9ARU3i%NRQcG!K`W6&-oF_Z9!l+kl6VcSoK<`h3Yx#1lSu-LfC#soc zql(Ku*6Kd~f&bw6!5-mr`13w&(--x-2}&&!D>xeD{Mz@VzEwa*%@7R^&*6EWy#;rr z;f&=MqB&&^_%7-cbba#hM4yTx80FO4WfN{?;kUf<-}mR35?+{QOu7dqRxv`)%5$o= z$N8;pF+JJhw1zJaKi+^QY4T71A8|pn;NZ%jB>UyQ3>2+__00M2!!=9t z3mTDM3k_PdODq?t#J%TqD%uTWbd6Vq(s|^}r=YmhH{IdAY!-f9#tRYh)wP*R^~Ua5Mp-)6SQDPe(BjD{HfB;+H$|pcwiVRIE0-xr^Ii-fIA;sw1Jv=Ib&I5&{{hgw4`FpNHu9{l+HKzR%x>Pm8oPdKh zpU|LFf6@Hu7J=|Wvf?u(8OTwWGM2w@d9@!BF%p?99|9-L~@F;gyK4|B6X5r zz2v3NcP6P*-tUG&Okx2RRdW1{yWJBz4U5$y=Gr$}W9;uCHiE76rK(5(nHQcB==3NG zUggdUQLkNGI6Uxy(1=Q9<46KOM{?v7dw?{j7eMnNL&tx3_Foe&Ts^>ffV7$FlsB5b zj-8H=E6@A=_DniNxdGB1jnds`;S?|zy>p=Nup9w{wc0vk?tSX`o9oOXWtdVuqL%;Ey}*!MM~r4hio#ttQSN^$}Gt=7vSD!Tmj3gQ&Q>8nJscM;$t? zlDfSOdmg{kN0CV|WQeX1_>mXd4Xs}iWhQjDlGr;#S#pkTNUmUEI4gwQvn4-#Jx;}n zwfAGOdBe^8ZJA-I8PJfNoWKw&&{5`{?#ChO2h*0|1yK;>;L?!yRFSf5Q#s)Pp(+;<0&{xbGN1ihoPa?U~gg;VSqQHuIq`213GSXbotK`fuU% z5ear}ZgIxFVgmLulwSMpXMr~(w!815-s)l^cSLV~Q=7~_7~wh{=%*f^& zl%3?Nu7PbXzyLHQ=eX~j2o-@;0lSiLNi;;r^x6y3V%p?{lNuW>e!|d01X-L}MB9Bt zTWjj3;_O&QY7?Z{_LR;Us_w9=KKv$a@xXSu4*~gqqjz92frT-Ut!9>*v|zmTJQU$m z+$#+>St&u>p__-$`ywyC^nN${?u?@;G4L{8Z%{WEV2tUkP+RTtRJLfa{O%L@c2w44 z+heIW?(vxr<7Kq=6m+~k@HkT+C97bgMa`0aB@K3Gs%pyU-=*g#YW@cBJ*e5(a#tYP zclxBxCRsv{H&#ZV0~es)`~*S&1YX_ob}`+tC=#DbYB5^eR_FW(TNH!>TP6=}vaZ0E z4ejDDpMFaC6L|gT=B6%f@EvjTINps3JEVy-uCK}qG%CcwLYsa`vVt)QyrvY$4kYE6 zf`dc(wGz(%t(^frrs)xnFm%{G`w-5mrNsPMDGSn|d9#uW@%!UWQ#pppBuHAXbPwm} zRTJcAlg`WC6fsk5qvk8f0pJS4yb(sA0+Obo{ZTdDS{%o3tC!>0del3RBVHG8NT5>u zB`E*S=XMX`2_9g6{%sCpS%_8KVS>8iEaWnn`E=Kb6@kiqVM zNN&4y1rvXF_*t+)Fb109ObS2RSNjvhJpZbl(6_x2?Z`grROw`6Mujq=rS{;FG};!m zlS;y7Pfyz432&VJQ+DT3$i^*mWqLcK;1IQ=j0{OZ-YrGH~b|ap=yTVzjL#Etg@$GH|7tyNReK zS$v9c$ONNmld^SwQFTOmdUPl*=pBcVP!ESB1lGgkP?GQbKnl;Oe2E=*Cyr52@}4=S zb-DPxtWo)HK%CdGGaE{M3qXg@uU^X>i`eLTmY%MYBq1H})8aLc2FnKhRN}>=h;hd( zOLv6a2~(k2t+PMP7MU)cAP71Nt|M>aXsI@5=_{>7DkY&)t*;21-qUpM`7l>z^iiIN ztV2U#Za3U6VgK>H_(1uQ25z=`uUy!b9yYD7+Ny(2b*pikO84Y3X`qL5V}utmRtYv& zK_S1>1R-(fUsO|$ma_U;whh{LX9uL$sIpTo%V6Sa^t;FY?x`KH$ozIs&~M!gm7nmKboJEwQ;HZJo$M{;;5}SjD4-Ahqxum zfGEIzbDQ!z&c_Pu*8Q({G=lj_05F0&*UK;#0{erCH+f)$wA6sVin}HT&(vd_e zZ@_8h2U-TqJWVRUG90HVC<2%q4kBZ`vx|gca~PY=%Ryo-zkc0!a@b0pcNSR!sx1+X zRel|%)yY5;gM|I;|ArrWIiXU7{IHL^o?%t%yYiQN?seSxl3rW{^&=v7>yGLobVvr^ z2p^tKPZNRy2zvPtxiC)@8s`s;=)QX zi$J)|APRx9Njd?sV`PeCQWzI2koeOyX1iJ2-t#{aA##AYBsr1f%y9GDCE|P^E#kB< ztg;|a{xj{6)CKjuqXbTfY~dE)@I1 zhjhe83k9SMV@{bTO!0@D@8ZgljX$!*?)NT7vf0T5|&oMt;tC!u)k5{p&-L zYCIq&%p0B%5k%4XgUQ2Q?R~%|-g;z$ABdDAxtIt4b%39b1~TW)u^!CB3D=w+Kdya; zD)bA>_JC3zNhqV~WLZqdW38FYVC?lE2itz$L7^je9)T)r=}^0w0| z?BP7xUU?$boS~-HaMZr9`7cM^yIO~Sx7@41KuAC#?Gbg&v)1&d#EEB z=7+fk1hfFSWLLDHz?GEDS(DUkT>*ANXN%``kQVb=p%V2rzqK4;zvm)-6s*j2+Mr`1 zL6Tq!_=>16tV7a7^Q%2ceG%nL%nn!VJF&Ezo`D+xnaG=S!beEuGD%b$V%_U5v$oFj zxww)8n>+4z>;CamDw#l*XYWIF9GnVJ^@%n=gAkdx|2p|%A$Cunz!bebsERA^+FeoT zTu5(GVN6?&M_rFXd>Etb8K}2K`=xbsnbjM!GmGPTin#jTZKuYuj7*ATT4OxDP7lw1 zJ9o&>ud>qYpX5jNXw5Yl^G*_*Y;Rga)JGGFV4Z==3UXyU#F@B`eRh}sX1bof;O0zV zj-v!n3uw?&(-wk@?eG*~70F4>qgXINJDJRAhDiEH^)oc{{M4jl!MVlin>bC8mN)NL zzsX`861h5+c?!hEB!%M{O9k?N)&0$lQW8b{Mh_ylRD`0%SLPft=Aeo(hAC zrE;^lE14kbZwi$&V%6^(YJ85~v}E-{1k;dV3P>?6dW=YPuV%IoCz0R3FD!~f6#A?? zF?b8au~*4l96kOTlt{8?OQRm-OAg;0P-_g2K(W;@MJI_$50hJ<=Lh|x?qaie%7kK|sT;9+rWwwAz6xwUX6yxAZNH9PqFfrd(&LsD z;|cR>IOjE4E2FQ(pK2$#T}#?xncn-)R$Gu*rp$BVCyiT!2G4JDAc2{nJ0Lwh%DSa> ze3@eYk1v%dgVmxPj1)W^{(vxoZYo2{yfo85(Qof`5e0p9DXJ2ynuM&pK!BJ8@Q=8{28-$8Qzo|Jp6G4u4jINts`_;m?l5snQH}$ zm?bTf1cUKhK@Kqn;96@l_YCU%A(s)*YPI3M>A-oot;Ac=6n^Y{Wu5??H1HJ2V?SkE zpevxi(KkG-q=xz8k)K6#UhMc5Uc}R$ig-nN-wgEDs z3{sHC0+##8TnBCkhfA@G`SZqR7GKa%iSUs2;k?J}JLSVd54S<5A|mHKFjo;VZ@$q& zOyJa;4!K%GEL{TWk?;ttBtE&P3(o8LVa8BnL>AdCLea(Hb1z&Dbw%4#5iF;aC+wuq zJQ)D6^My`CsmfT*Jt@XWx+ROU8KOlfuStjwYTEK&W9TApThVGU3AHHL^X9|guIGMcRPZzb*kdw$0Y0ChX(CQw! z8ZJwhA91=esVSSn>d!d?tDN4R5h!6aik~Wq$pZ&8aPZfB)9;+Kie@Ubati6k^nTv_ zLo$Aa3;P-4ct z%|69@+88B*nVZqrV;~Tj6BDQ1&_efUgEPiG#X7AWkzr?y@hYfTSYj~07mPCkam;2| z#9zHc@*kBh5B*Qn)#~dCLEilrz+QxNJ81Es;B&o82s^c@Sa^xa(Cy!$a6R79`%xYj zc76FRYYC3Q8U}^J&E!3GIGDh{Ka#{AA_4q3w1NFcX{k4 z3oOP>0BnB$?&;B4*j19o)1m@kg9mZ3zhnu?<~KbZ4mK^XK#C4F2edD%;XD%j4cTcJ z8k{~nGa7aoLc&axZdpoRbsnScsQG*k9|2Srn%ed0I_{)OB;u+aQ0xq#QaQ2t*R9%) zSv0jYb$e!rRP#dDJe2nV9|Nh*@+07S zCD%s{J6GCqv$5yJ@ay1AoJ7QfyZLA=z}c&`MP8Ti`FA-?CYVT`9i@rdJ8ajH>FFt! z{YO^(sR(TpHf)s9xp;Eg;v(0|7&_RGFsOaDOWb0Gi69~*vd=i?I#aB8aU?aZ8c@;r-L8GSxw zS0UKRq>hs5lwyc@p@Z0F4t>Ap?cf_d?4F z_U1i19JCgk>?=o&ZC}~?iDO$!Sv63t`x?QLD+M}od6VBxq++K(*KcUffWo%cxFSfD zVc5(r6_=J2j^-%0awFx_>V*HH{3ZqwDMGT&1ea`B35##Y<)h(0^nzfM{|UHfN_qd zp$Um*vt&zeqh(4gD1dW$hASs!B%OU~(@GcJcewf+rC&GdE!qoQ7g*b#9d;IvyI@ql zagItI#78*Mp|&+NO4ZueG!s9upS+=r$IGmn2W4ZPRhwhGGlpd6noWq7XwAN8cfeRr zh_Qe~J~W~GQS5mo%vUw7wgq}XM^`&l?ZE}_Z4yDS4(V%$@kbUjcVU_&Tjv>6ao8M` z3NW%yKH$)1CTlOObztami;K^vK^5bl!wpcorc!p3hf}`-V-PMl`t}^AS#0Evqe*Gt ziTo)p`<=+sdk%<4dRXuQ2<|>r^)l~@5_qkz9JKwWW6HeIontB9D}+5^LUn2D*G}z6 zePZlUV^glCkQX&GeTjOlSXg;62z@%0F3ZhLMT)&E(VhXzpH(USfKi;I!M`UW`(e`5 z(1YKNQ`kzfkrVKiaRJK5>(U6$XCbrD`=co%X(~Uk*l-bZ`-zUSoqAb?6e>i?rxX>u z{}b?GXqn?y;rF+=qN*%FX|Jy# znKDrEqV6EUz_f9!ohNh2S@o)pJaAm#{I9cs7d>))?o*!7Xg|Y$zyJ_$sTw)_nPT@k zm=3e|pWewpBuY$ABb8Dkru1ZHgt?p34(vnM^3Dexzlyh=oEIx5b*Z*_WKa zaNJ=(P;3Jez2<_w2KO9YI4B&#iK;s5RrD9a{w$lB@Y}sB3;P*Z0tbqWan0QO1u-SoPHx7XXXp zOacwoo_ck|c$)A|#<)awTwCPK5;1%`G})tT*n)l$6Bj-oi01n!3Bx*q-dnv3GpMx0!K zF@UEK+{IH5lDP&l*p=8JH^#g;k=-S=+G6>Yt@KQ(D4Sb$f~cx5C#)IQgdW*{e<%4s zRMvRV@4506Yz=CjbuI^e&V?; zZYu?kkT(%pN%YMlPGr)F!mvH(vWz|FkI+{;B=5yM@jAA{#FZkCfqJQYmFhoE15-Zd zS==X{0^=clk%;3sbWaaIFfA_h;3cL`Vv~LYD#G&_&G{GedU^^mckcSbE)cUjV=M57 zgOoVMV!T@|PROqvWk1W1gr*(6Xt+#@EtvlT$#q=rmdd$s=2ftElMW&cPX|-&3scet zyi;x$-4#;htXk%f6NbP2zNy-PD38#kx4~6tHcSvPJ(tufg9(n8AJ%#f>!05_)>rNr z*n>mkSfd0%kfdgVqVLVUo&tlNC_SU|;``$VW^Ur4L^T zflMXivKE5vgjsx3&QOo?Xw4SG`S4vlGMEo%Q%;#7Elw8ZHDZwOv9(W_>j0LaNd+^y z;wv45^S+&_c+mJWbjST7b}Pf;3tSb0fMkjO0`i#Xf+$GFL5DH%kW`g&inuz`T^Z%h z527-t$4{#X_^Uc=g>rSv5cft}&37Fby$&S@*GySJ!R3XGGq4TKa!n+Vj(&&NlAr$s zPq-6d`G*)x!DbW7sBzS!8l&r*L?g%)-2SF)8JpU-@S2ohNi_*@fx zNUo2_S&AQfh4JrD6Mk{|FdxvyjTMDE*+PD$cD+9|cyV3YrR)L>yOzxd{AO;6%#|}F z0&~+vmfNYnx)7N%C*$7~Z@*QU9M)v@^#fL7^&l_awqO9X;}P(iRsOM2++(TbUOEw3 zQ@fTN9)iH_fAFgEt@A*rd!PsoerbtDk=ylt{UEk^VE}i)?o?fA2)f-sTFY<4I1+)e zt=rQSYAv?rNOti;?u!k0XJzTKl_l*4$UAo*O6R!qHUHjF^{0fsgP~XzJw+yCea+k% z-kvgmK&T8FpIBaue6AX7BRI~3|8QsMQqgwGBoa3R`MQUNo-ZzWf03^JeS{<|+lZ_$Iq@U25!!P#;~ z0-l*e{3XcQ+?FKGLh~J@7A{S1%!DIW3oPH)KP{wxQuEkvca|diWizTR2wiCXGSe{eONL^Zzj@{-nL>XM|`Cs6w7;BA`21bqu)vb()Cw3m;bgQ z+A$!Ue5$QH=|o9ZB<3o^mxwUaCt}yXddJe-i7lqU%%#S+vaq%6pvzZqJa}qtRm16z zfr>fy=vQ*V5dr@CRY;GQvcvQ`YHPkK&>2t_zG7_w-R%S9iHG47XO!Gbhb_XlJha>M zC7KJoqcDC%ZmZ0@kfWxKnZkBFwc4pwu<~LuE6IOaGv{(}SjSmg@7jnAf-cxjEXHTF zC3;AodS;2@?myhnfWplKad(SGY^bbnIY;-!s8pkA3}b5!Sba_mTb)1vS(2GzH&fgHOK424jLXMdN~-$LSc7AVq8)+S~mKd z9V=&=%soOMzdJ_USV%+nD*ezP*BpGJk#(%ZXnZtB0&yB)|Dr5GjSGH({V+W2=$)Xz zS>Ez@+Jx+$jBG1yc7Ld=>(B~U56_0sr{)6$kQNxLM3qv7cq&-ThaUv7*WG?$c|x$1 zCNNsyr_#^T|6=xL>A5e7?hF7iK+eDPuGeX@VvTuI+Neg?^$C`v-pQ05(F!&s-;5Wv zKfacAbagY?+e>a`ehH$H6a$uo(LBpu2r^|kCrisa6os|1FbQ|9WGropB$uF<&WU2_ zqrQg6^B@^C#UY8vS<=8S14H;E-X*2^LCYt|3uMVFz(zT_R%rwtb0y!E8$ua~8f8cY zFXiq2db6e}P}@wzlO?DG=t@>d6`UF$5C=rJQ;NTcGBWX4+9?`mD4{r~_ z@Iv)?J*@5CG?YlT+~yC!Pa?5V2F?tTOpz_khNhWHT=3V7%;^2oz*`;H-G_PU)0r2I zBJ>`wXcPM$sOk$~2zt3@#wb*N|CUtQcXq3Qf^Poh6<z5uC6h7Ev4)W zzyEa@0NYN*}y zHeSx`s_%CSOej;yf(RO!Z`C#^cojaVaW0Qw=Kg9;g6?OJY7Aq6)Wp4^&Zn+uVPc9>SgKqyWP1FA^t(8={co-Zz(S7wmKKQlu?9a9w%#t8{X%8=ERScOiZP= zaeBX~13AfY5tTbAdtcLZNcE3R2h3d)kSL?}<|8zBVb+?f)t?&wz%P5Q3F1Y6j!OYx z4&&1TL|j4NE-eg@Cz2H6xS{po60sZ`frn>+r3Uyj|I#GyPa{a+`K5vk#}kqkFoc|U ze(cVmRv8mqcvg6T1YEdeT6(79&=VvuGEP*tf*(TGt4^C;*U| zw|IM3!w?~qi)HEMAmHRVMmaHupiUGv^#bF#c`>dHSW#7nJvJ(0woLMwyz<>G!7#=s z%FJM4p5kX*WbVBuVLs<#IYu;ot2h|%VLfn0!|;)homZRzQ*gnzhHVD?{gp)%#x+Aq zrcw>WM$23%8ZW>{gaiBuMv0P5DXa63Yi^5NHeI`dTnUZ>E9nY=Q;n)KZhJvH*XU5L z?<@~&jo=Cm)r%6%CSWnBL`daZ$gXQnn zQ<;dVkOxT@Pc+EDy6;a@WqQ!~O?}RYnHIwb0y{cEXiwQAQvjr7r7uM_*@H7%#VOzN z?daG%+_OkS^Cu*i0uZ~Ze9-n;c3xB$i<2YF4k&=FH1`h{bGMo_gu@cgkhoOI@lhzc z>hN59%dQ9d`vGhXWnA*{@8l9~j9OTdc1Df&{XAKNL^pvES`xDa3|+mL{KHCz$^ zUH!W%jiJ)FNlKeGzgv4`&5M4Wp$2}q@=V!sJ{4g%WS9@-D3IRU;V;<^k<^MtX5GHI zE%6Nk4!;g=5rZ~iSx47kn)yQ11Oq3gWQ8g2Q@8bMn`)7_cBxqp!v;|!udE&>(QP08 zps*>ui^Ra9xS#T((hsIT7`%}N90Gmw1+=v?#Ki7EEkDVCM(6dVVPH#7x%5VH>rO-A zg(yPvA15Jah#owcAzQ`xqw;h2hRiY6B_S6xVS=O9Fp z?XZgYa$8Bjv?Lot$M@&Rr#&F5M7rH3iX75nqh$?@It?RDels)mP`SW4YfH2k12;I0 zAFu~^Yw%GXKx;HZ(+S#Z#HZMTrx zX?7*H6bgELR}m6_YJTQ{8~q9;&itE}1B<7BX}nt`ETN@;KzZ7!KqVDz^a*V)0aLu6 z7(oexvuNzK{}nX2x1A~+QV5dB{STM?1C=V+W=_dhxpsObZ3H1Al8F}fZj7ZB z{TlNkcQCQtH|(D>`;BMEynazN>(OYMVoA=qj3b zMU8|wATnrc+CAWL&ZB4z=GE;S`m;OFNdlng1~i)7PdHfhaE{C3D$351FTJT$?LB}d zSAx)s_JDC~3itus6L_cY{H1dFjQm|m^RXtj%#^Vbnm6RsM7p|hu1lgYiH&}LEj_VQ zWvWBExf)61{3cl_LGu&Z8|w+KUL04z)Xr))+Zv0}xdBlTKMs^OIS&q_V}s;WmJZ!8 z0#4tk?ABCiK*3e65&a=Vtm%W|Yqn6_7)0+_TGzakgFz2XVS;&@h%Q-}c%`*=#Ie}ZqIe;Uv@LIQPW3x*S-e!=* zMAIo9!Wpf1+i0)re`rPRz1F#h$dsAJXIRvvP#GY>K3k610$z;$gHr)|2Ha71=P$A} zbL$hykohkvJ-rOuJuGy?z(1%UHjLy|gQPB$r1PN0w1RCFsu_QT$hpO$*tU07tmgIj zFr)m}=&F1~rJea`UQkA~Hyk^*-7V@fv8PKH`tM!(;~V4Zai8ihon>SzL5B;ZaK=h3 zlZu)ySNKYv{z&PV8k+HBZ-JJmmCU%gWoX}+*S=LmILYL?5tHt`;ee2yoE@@Od>0+= zVM-I2tlPq+BEcH-zm5PZ-3xv5LLl-)OYqOtFP z2&U2S0*e{ANmyCdnB$^H)<4?p6NWMt%I3kpIhjJ0vUX)PkcySSBlkXC(OyS#^KtA2 zgM#YcpO>0|7gnV|3KKt$-8}{kNaEE;Cj0!RKeGQUKPoL6daE1ST{FbnI8Em9?FEz0 z)z%94UJCSeC+O8oew?Zg%cUZ+5G4_Vz)zzMioyKZ-LcjW1GM^`JW`*8q5)QL5ke;L zA-oWh(N-%}b}?3st|dU5XnAXNx=KUO0peb+?F$yTbHeH$XaKlrsJJMcHj#bgz_RX8 zrb9pka`IlC>UKw# z9H@x)R{FWLMaCPONJk@r0+R;Js8t>M|6B=0Z!m2-IQlftL>oCjx~ZRt+>_~V_u zEcra2T2!g>ltk1EhHEgArbBMx1CG==*}9Y**S$?QrXj&e1AT;rUe`6@wC!E+Oj6VP zh#)u-4M1YpzVFF*b_QSq?Rp#^qr@Jn4Kjy3JS{I3odIB)3!5Fa@yy{lSL zaoMj{n`#)ud85ApgeWV%S}4WnsS(iCvT1>1zCSDe(!t>3z_l|%O1#bd`)w^%KO65VfLM~ z;GX252uiGll>R{tgx`e#G9dVunrOjdG`oqg|5&$L<W@v48peq1*U*|jkw*hfr<+(DRsDa1Ogh7WR}s;S3Tf|C$YGfI|kuYpU!u>gB5 z9V_P1(5U^Fz>%Wk+*x6SAz4kpKX_{8oyB>;qU~#fM0MX0%d!nob_#bxKg`)7#eKWB zpTkc%$cMX=rjaV_(}y`@n7NX4KGD=@c-j>l*loT{Ivg%Y<(mej>)+)L9i>ReB4SDJ z;82w6*=H-^AE-(N2+`zIr~GjIN2CxrMjVoMpg~=UmYY(Yl$@AyV6cc`3tRMd2GFm9 z)&0MZGo94N-cvQZisOj^H2(v_p_)5aq~u#yRS_nJdkmm+sa|XMcNfLw3`#7ZVp%j{ z0qi6sYMULUcbGJ?HZzu=DxX#~;~*(V0kfLA^B3_>DdEPP9%Hv7_6{ z$4`q?KDl#I-pyheWV{x&IN=%7OkKT-0kysI8t!D)^yi9uQ?Un!2JDAat=((poG{hk zdLPygId09L2{$=Fh?pRc^C)1Y4Q%H^DJocJD@P%rrx6`94LwhCv@ldYjCQv!}? z7w=68@8*UnxPxqJ4T^N&KQ(7%tC~Qw!^%i&)hGO_wG!LJV3>T0(2R;jQ}Bq-y)% zex8h-XOZ(C({xDy`}I9$2}=2gjrCLZ7xv|RkWlf ztkGWiY7KWX{lg1$iPqU}y<}O`nV&zdmH-Ny8arV%bS~3@X#TFFCuVRaGzqeUB}f1i zLuUGJN!T}&H8BD;BIb?A;)me-Q4xYV;-bATPTAfGHcJbPf}AQdxq*<6o_#U=znQn! z@Jr*jzP5UQM2wLThvEM&FnwF41LAU!<`SNFhF4E)u9AwwW7%->&6=~`NslNL+SAJ1 zGnGT6AoC@tHY%Ob9f8@x2E_g|jhsQEs0c(vjFashmMe#~!g12{k#Z(4J4@{$VTpIKrNz!>skU*9c*Bg*-#7FQ~y$3q>$1wO`D zIM*GiP_=V=SUm120#OB4Pw}Kq6tK&KEO0`zXShS>@{@_AdsV=(lo|J{5SWykxCECX zQCu~>%+A?^k&@vxyitN&!sqZ+&-%DBo?=_z!iiMPG#Q#YbDo697Ht(FEhB5{eo2a& zgun9tCFpdwE+}J3!d8b1s7(A6_2E>prrh=PPtR|V!1WAxyU8@Ia|SdXLOGs7`z5KO zDTV+s`~ZwmR)(7m58oDZOqWeY<~+g=`RI_z812fKy%8d7oXEH|W^Hi&AhVqW4U@^{ zKR8j6=z*LGu`tLv;lD|mb3J$0m9Q<`Q5p#{uND*rT%_wzyc1*!j^;+1hY9sM+jmw? zU=;-#2W6c@Q!ZLhi;S)_z{Ode!4NlywoZpxxpMS#-HR+ve*m_QT1At4)?Zpca-ox;W%W)dzWL88z`H|B5bYgh2PAOa*v3P4UP7>o1=C_Q-6et5LpV8O`)&a3l zuN|4y9J1JtUk=Fx=e;|rX(_QeDb9x~3S)dXmm>N5Y08g=0_J+e0KEbD)b-uZ85$kU zzO`pC>$3)IKoO%#nw@Ljw~r5gmm*aV4|7=QpUZjKfy@q93bmC64bw@6rtXCty`C09 z`sS1X=w-KI>n2_b+T~x$rW+byakXY=#vZWJW1kK%_4Gt2|B>?>+FK>@bX_D=!GQbV zlg;D!Va{@!o;_nF`~WfBW7$WGOU=}=65mQNMdbT`ZWsrwQe5dB$l5j2G%?S%S&+={ zA)u*%O3gyJkvR&mHY{3M(-q9K_d;+t@|;S9!#q4u=p^@Zihr2~zG#+jZBgbU_F^>g z%V9;OkAfmGeYpQC@Kq@YG*XxoSL_YL<8vgf*w&SniJ_Ah#*(MY)Iyyy+`)I>sZU|M zjg1I!7&&QMr{8b?txuAY_Z^SK0Hx+=vW7VF4BWyf7OH41Wwt+(UWVBu{L$llevdYAiM<@Dph*l zL`4L8)nS-f@3QJ1vbl60)8 z=3l&hz_UyM8Ac%wR#_nSQcCNdZW5>3s+sscMsOXEpBOOONZJQuees*;^Oz4o%C|*~ z=fvgb1p%{)I8|<8iufF@4^nTo^~hW+6`jgU4^*8mX@;zHEPx+eKc@(SP=AM;dnd0F z_6qnv#H+tf*&xoHL0vl?EHseANooubnNz*)Qh9DD^P z&5ygSn2`7|tCFy#uf;1<3U#Nb9D7mU2nF_Id(LO9P)hCFw9R_qwTA8D0mqVi?*!iO zXbCCOLVQvnU34~l0hEKUkr{(ECu|~xmXUpa>L;-pRaHR+3FR|W4l1}2X%<)^lMd?; z*kndvNj&z!3ju7qKVsrpHAZ@+6GtG@?B)ptA04ZAIBmK29OrxabbzODHc2eDxa_LM?8$FaX;-bWVsEX!=4`NYtoH$aGa(NW3-^r=3!VO|LiIFnoACH5%gD z!=Im1YW;Q?dr=joTcLX3m{I*?sAkQ4p?Yjow@4J5lw-WHW4QC^VbNV=b)vP=YVW+EnDO-6d{w8AfJ?Fp8N!uOo=v8< zMpl69vZC}l^(j76rtQHgbYM8nSwO@#|CR?3ujidg5p;VsiZU549 z5J;a6)<*ITR~^2BWc5VyrBe{?g*skXli2lqG=2sZDSY3m(2@M-$>D-&RJ4zRL$A%Dz5yKQ0O;tOTbVDDLcvT2rk7COlWUMX=(W|*}YcE>jxtE>nYKjkEv33q@ilg>n?2nA1gGx{vYx?IB?WJHs85=k_e=}_zO=<0oLj6o|ftyKJoqKX)A#!wjHN}CxjPFS7 zb5@q3|I^u9ns(hSzv5A{r(6L;p@okAdv>E`X~!i*(-2Nf8xs?HSNMOs8cEQ~ZP(eA}aEoxjt z`1I#Bdi%%W6<#s3boAv&6l>Sgw=*9DLNjXLW)FlR(r0-7)_>j8F7GjFnVRE0aCC#- zObNKuFyw8nTjsqC@%r5M-T!!GsgBU{7L7f6f zjp>MB1>A$(V~=zX4T@mYk8uZ2mXfH0w5EmWzsVzjsdp6xa(*o-)+kzV3gp0q zllz~x-Bw3YKr<&y!Hvaw+ReU#;%*qy4`?`CqyzVN#&lAVV979xhjsAL!ITY1`Ld6^ z;E{SWt_M%9OiB~*kJeAEH~M+VqK94Yb(dTzP}_htlNJ;_kpA&3x8S&4KPSY!g5quC z>l7GgvYXxh=f2$HvFWbzULM&Yq(xsS1~lfz2H5fKm=( z*b3j*K-biDwOr;E_vUvOBPc7@i^->V?-t%OJ&+tLS8@v~G&yW7z1!M+4o^?AI1?`3 zJmU}$)Ml8*I-RAx5>%jpa!rf;MAKN#B(YT2@sSRdXX@H`sZ{3jBt7`O%ZAUF@#yr_ zFX&e02}buLWbgbS$j+F|*?lf}$Fidc-vMrp0;@y~RxrdGG{#&-?W>=d4CCU~sNTw0 z^wA(VLPq(GhQRS6>z}f7B30;$NiM<}&!k_p-y< zn8q=BoucI!Y!#JBMZ}(N%HGt@;El_!6}{!&W~SdqozUMg=Ucb~Gp9_ll7O)st7M#N z)Dp(%`~Z^_mB*MNWfBG{9Rj4_uM$5FbainR5Fa*6tfa_7y)Av* zpUWbDQ4f$dSfE_LDkH$FW5r_(X4RJ?4V5O?@p$zvO50cfdW;B$jj)8MUC}Eo-|R;A zRxlX3+5CCCgJu(co`wPaYudQm50dt5d|Q5IGRkZSAXtjmW#L*$JzS_t-KjOmDc6b) zWPs!4LF4f8>xc@FIb+e!eBxY?JwBF19fx?cq{0yE2G~>V=scqC)RQb93a2nQFH&c8-Mstj**;zyb{m=FZ2y$ZO=47OD*v>hoH=Qn8OP>0iO@J zUDc!D;)B`!#?ZES;rTmzc)w3p0^?MkjFGumx}gzA5qU&uKa=U&QN`T+gwagx%F=>T zm1B+IxkEl}hfPV}1e^*`6`*edoD;*79)_viQtP)1{jtS9WZc?2(|Bcs(l)BArr5|n zjTwG+veA?sHDjJc=2Qhnj!%qlxnVDBj-iv5hG~PHK*Vo^jHx4Bi^@nJXI0cQfrTk% z?76yr$0b(M&EMucOowVj1u^hUy|XK2%1lA_Y%>u0oxDWzmENy^ddW_*ZSH%8tu>Sg zpEigyh$lZ*2FXcNLr70(_`7SJyV%u}GGO?a+2pT3JQ(79ZXK%{JM?|fc$oLb=uTzy zDhK|JzCE2ov&dR3j?dK~N$gIOnNs5m4yn|?KGV4>G@@6>5%MbTc#V0wu1HEyciD20 zE*_rx9u8#Ne)kkj&66?MLzDRv=M1i?|09;bXiRxBbfc6osrR=eJRE*{zR^R|gtWCij$mvV=!WL+6fabTc7-=gw!v-#W<&o25VH^ANU^6#d3 z>`s;hXX(r^t`R0IX-)>(rDVNyy-M|y!{(V`6CNpeSH%jqH3kIx{v@?vW^_vrDEsVt zo>(ELJBaD@1IO#26uLBs#Fq~{lgYAx!Cb%rBMWb-YB(KIfIx#L-LovruG`CdicJ2*@90XMq^>)fX~n5S z4`2%0nUm;7E6L2*lw$SNHYr?Qm($3i| z#RpgN%*<<$?VTrc625M5KQvK3kM0G2Gz{Z5Ab`J{8fBiLYW)=!tLkiJWG~!5L08JmvKvlmoS+d{4bR^sep%o^eFW5;xJB|aA zw}Mwu7x5(&7CUK5{x@5-Yvv|^j~ z@7oA4x&=--iP=-@MWH7#ZIr)2(mFI?VV>cE@1g*0Zs?Ui4gQc?$bLca;KJ;h_QddL zdjrcNok2R2p{P)0;S=F?W|CCL9um_xxMw;?&Z32W$jMULMFo>~Myf5&{lH^x2RgwO zq=0HC>1iDV@&$RDiHMV~9KnyRklXWo|7LB26)Vt-0=ZUr0KHmlcp!E@P!R=dtZ3=R;Pu@LbT6AyFq~<6 z71$ZLM|^7(J+>;s0S}Q1C7UL_E^)ioqu&t*v&zHFdZn&!bd?7si9o#dD=J8&PkZT9 zr_|B6p6qj`J$HG_$RG#kI~u~#mmCMz@waher>oeNaLPh;pbneoP^MGqU+1XBhhd}< zh?;WkyeOm^zP{9VHw(NYq4V2Z(@j^p8=rtUi(3;14~EBqy3ALK(m0%Zg7CTju#DCP z3?o#V>oNWQHYlNCI)LVf4&^eR!U)i*4~52-W8c*^Ff&-LrvmJYno%!Yx6E~Ua zZ)&*lNp|Ct!7EdpX6vYmMZnN$eSwu`$2*9HmledEbp#c&1-8SUbhv`aP4r7M)t`uZozpWq7JB^aDTEy8 z+vjSR+J z(7A}Qcb|QWqri3!>Bv0lHRglvg3_-pq8n%P)Ebk{PrD7g<>k`C$EL|E)dFkt4dk;B zuTtnvlzkpKeF(q>@DFg1-ave=-R=fq;{Y5*XM^joj z(M))}d_2Ef6v}qu*&DT*tr>1%Ht!M1CswH8WxCC=3B5LredTUda6p|n8a~|0a*2{Y z@aL^-Bm3b0)qn@y7aIE>L9No0)pI~)gVO6#tiQWzx?FL8y%0CI!-^symk z3RV-yL=MEoQRvxMgv>6f-&b+2!}=?y7r^B`AoPyVU`- z$Gb#2DM7PJp52L7rU_>9@GQ>@7wXs9^&nA@uYPbtVXkJr=+hrm`IkeEIK!!~Zsu)u z#0M}mP-EC=B3mMbs^z$T7}~K;n*5LB$g!3ft6@5y zhM&9Jl&m>w5zK;_L8W}?ZENUwFCs4B^CvSR>I@QTx7KM@4&l1FY(7)}BKwj}-WN#AzyN zi57=;Zp2~c$nBf7Zk#(rX_nFIS=kz;|CbEcm&Nz$(bstU-yhw<5<54&vg-X>ZCPFz zYn;qDjd8mz&I1_3&v0K!V*+zXU?&ObEGyh79;i09=sotC{Jbj&;YUM)*EdmmsRTd|V zV5JIPXN}PppWs$`aH1?V1(Jee)O97FRShVp?@yOn!RFEFkgOkDW^4|D5ZVg4_fza` zZi&J)a6Q?P72ZR{Ogr$XgFUg~AEh657#@a73}NmMxGsvWi$oeL{2GV={<5*~4a;Q{>fCmfV>&l&UoJ*<09fdJQ58LG(|ezAEw4}A7)L`M zvab;#rcza_u3K)1B8qRVKev;su0C_v#Edfoqxhrz6Qi6Es=JRtwwBspe<8Z&&VTj| z2l*0b07r%wPzQW}-$2E>$+GN*?DS85eztJ^@|z8F{oWE}AF|Mk(TnGu3@4J4c_e_5TzMY&R9 z3E^g!_)vdslS2X^ zd(up-l&YNsY)F`2DU8zz^WZ`P7aZ5wvnB%{{$ag{lP&go~`)r z_q2wWrfpYQRyi|_?xNaJ>hu=@(lKE?ARTQ*iIDsZ?7c#`o|g5X_B>mY(K=clp1c z@q%VA0U`fu5;Rx1rndEuU7R6ym8ZRcJ65*PDHmIyTufiiM*SDbyAl)o(AuNR1u_n?V-806@k_QenKmjBaPSc^o2T(Z-W>rpt-3} zS}m$k)M0&SWotg(Fs0O9Ecw9rUWoobKD_NXuUvQn`0!Q zL3rD=GythIX?xrUS6!2d5SRIYs;PA#V+4VUPA{rRYM$8^hW_^R7zK^g4u@> z?875ad)((Hru;B>ukRCh?+cB%m*@CR|7N&`vol^l)FA;(geF|03DDm3kba_``38|I zH2*HJsWU7Zs9~C$QKTk7+XL%P4lA+*aGPufBW(x)d|5Fb7!e3pQPI*Qygl~kUka87 zs+qxjHr6~A>4qj}-RSiA;{Wil-s26{@vjh(Enr0)lA0_y|8#os_lP6ULi-xwdjM2; zZPq|g&wK4wRsd4|snrNg_BJj}qk*I(r5X!jdo;I$t%pI0U(JLb9>0%;w4(%872OoK zJYWn$*4#$aQ$OzTPDyL8)B-bBH!1N}V}+8kyW6yFGU?v~yNQKSoZK6y;?V z%i$W006%)X-4DXQWVp|M0VKowaG$-CI;eO;Ay5((X?;5L zK2Xgyhe;9vxJ=HI8mUm43D;mhggM2PcP98T}!AmSmCQbdWQ?^GNp#A?m zv5OKPI(%D-m7RS96}p77bH((ia;3Nv%_~V=h5nYva6Ki<oowSpT1?mi( zY5iD$TEW2g<$TZ?F-mw^eXLOj{zN>nT(vHwzU+=jv>33yj!P!Z}C>c^b@gfL1=c*6*+LSkOD8XN;E4DP*kVS~Y% z08OtBGqB5a#<#2!teG@JRS>X-w$EiAY8G$fMMVH@8BYCrNmn{Lw7@h4algHDsg`*> z#$050cA%V+Lr$mck)CSKJ;!jf`pT)++n=^!5S?3CGIDsMF2$Px6AlVE;!lc64VcKA zYO8=~@;_~xm|9?pQTlqeIEEuVk3l6S(*u)&a!j-$3EdQ^JAY+UF|0XG_oVck#5;(X zyqne|tIOFKwx9Ur?8gDxajWfLWi-h8O#Ee3Bz83|<_9G>i#3DtEO=X+JGZs^?7htO z)|BJ7xw-w%21BnYK|9r%5nHQUzy~f_ldj*K!93QY5@c4h8#G~i4ZE~yC(HAcz&!L} znWq)OPZZDzVd?h>hizZ@nK%z|ChlZ@j_Et_>PUOF%ZIBP*LJC6#G?QoGWk9p?H-LJ zO#Wwh3lF825VpY8G(0P%+(H9xB0`2X{tzQuTB(})?DrL>%LSlqy4E0$B1Ia$cI}6l zw}~?najK~l=OCfG9yI#MOt@`r>GnV?U%f>b3=@~t$`mCXhM3FIWwH|rUdiK7h>1L2 z8keEUUVUCO4OSM&RT`M!ZWO2-0|mBJAcae9nM#J$UA-2*ix>oK{Qa0oyb~e8OwBMC%n-nvSCmj6PZuiK ziSJuPgNH&pG@BEmai&=-R`y%N#O~P0NU_}W`X}$f!i=YE-S4+PTurfO%&-dhHzBBr zxKr{(xnXtUOzE9KRb-~GGpxKlQY`7}4KjN6cJB+mR!gP(`3Mt^oMj#GoOzX*CZ&^=@;1Uoxt&J_$|0WiGsv zjEnHLAVs!=af5-8LvY-K%kWw@bp%)G<-vLEbDkHq0!0P37>PoxiO7yu9y2Mn*x(#C z3sr;RSt^zBE;(Oz^8fZS-6N4vzPsD+I&JnVE^L?TrfCXKxg^tHD7#_Yt>tk#Zqk!M z7&FFbvMIU@D_%{QqxJ;&Cd9H|6e@X+$qJ(@P|Kr)j7H^Q`8jV^lo6Hpeb(~@O5^!l zw~M^iye5ZlA+_Y`-~uTN)jhfcAC4Po)_jJ!J~%uet(t2JLDd-yKHh+33dQTvdh`)9 zw8CD`@$tZ-ZWal1BF}^PED$8AN+N2!R*YoQq6c=&rl&O{MjYHMt_ll+=^+C5c{0k1 zg<==*+<>*Ta9?r|!Rs(Om4<@=nuW(B`wr6+J~u4zNtZ@kU``LB(lTCmZ*gq!)1Wu28@$%nKdI+KBHr4g zI}ilkOnbV~fl402n`?$ixLpbW$Tz{UN=&EmG(tezY||*dFuCEzt!kUs@IHsI+JYG0 z_f0|~>+K<NRRk?{Wu2kMUW+V&$=SBL0Vp2O_YbeoRc7y5|mi~e)0}pg3GzawZ zT@D%!H~&xu6}}=g$=lqHSYzyqQ%ISfN{)TW<4TK@7H9^G4wJq|jxvfjqI3o@{(0h5}JF&4CGJJs=TX z4bz9tO2>f|&SKSxZyNRMKxZf`a zn=*QIT=-;e!?eR;o|Nns7E;v<;PWfXk?4WDUN^jk2tB#;-7FR(GEGAnqf3-jnCfIM zryYg28T4J_+$0VLU=uLx;F;^u_WqsJ?!=F#l-m#jadaxVZ}PLAxwA5l%is(6d48OL zmv0ttj07^r1vy;5!h~W%!~!*$yhYffC%$iA>s$pWsf75e&hqB}+bG8NfZ2S1HYx#G z2j0E=&GitkB|(i@$C%v8wSl18TkI@55K+Gx^VZM&mHuESg4?V0 zB(cne-@BN($at@uNgW)2tm2USeL*1CfVI|nctw2gpFcQpjs1IKLT$$V9!`s{3&%@&=^Ayl> z+ZS=6+)dN2?jQOgAVUjHXAHCcuS+j$i>kQe(nr`AFT9~Mt3Qt*nkB|ooJcTCXwww* zb@%1kArFZM*u<08uD#v-zx{(a{m1y6MnFXP#(A4S#0{=ClJ#M1Nd5A-doyQk^FB@MmSU z50o5gKyU?8PL5!(X@9HT{|8Io??up~vDcExv$>w7Z1Sk3XB^%*zG;Siv0zID0Kg<+ zctZBr4MO2YS;&^>b`KP#H{TnRnIc+`ou4&YBLU97Y3tu@o9(h)XS?P#CU9= z$GEyR7a=3p#r50$K;=r?2hME-g1?<9Ants;YRY3wv*~5B`iz{g9s(20;@^}aGAiRe zUcDFEC=!OWnOFF&;(9(#n~MF(#1x&V%Y>xM*tNU`ht&;*DkpIq{?6Bj3>BOKBo6$J z;5dN~26M_Au;QDVAGBc!q2ef{N~|AG0D>FR@*B|4okL#NLWkuK*pPnO_<10`>7?V2 z;YANPXKy0PqE#+_=h?9N=Xy4^{?xaP?RDq-Q8}1c16r&ZIJ$+JKzX#(*V}B$kTa-{ zUcLa=^01l$d^C){B<4~nMd`&=XKKAs&9o%&Dck8^(cA`UY)N=!Zo{*HEB4m-h9q7$ z*>5AEy9Iyks+FQ9z7|c;68M1ge-V+U>LeVQK_dOE8%|+sAH1k&SurKOmi#DHQDZzA zwzdw_quQ@}@&W2b&kzk8a$8vdo%N%*)HlTLPURT&pS~4k<7U?*=aKGJaZ751X*0Y{ z`|F5xhBm|o)I(FN`@j5MF6oDq$ivg*UIfvS*p6sn83UT!oPM?WWO#|y8Op}V{vT!E zFQp|<wFrGc;XE&Fs0EB&p{MpDM!Hx*aieeU}(lZENlW zkl+Q{cgOlVQUrr|0GxQyU(apnkiQ@-%X4;kToakdFfUadStc8{iv%%sJA1K$oe(AS zw*dFCYocRAqC!lni~h6VvywUog}n;)qjg<NR773Ul zHZ42}Unwll*45mZbk{8nOY+y@H&5G-;F!I;N5LRW?LF(lA*#bSK_h!E!lf0vqb+8? zbaQbN34?!4J#!xcV0!9Wo5z$%MFnO+(gQMzT9!4{{six3;1<^>q37{8TaV6qN*?V*_@9W&2 zaJFYm4)xw_QsAR~jkN58w)6)kf24_3XjJnD9)pE>&9W1zjK@|`%g;o|D3*j^=+fTb zv)+^xiW#eJWZdr~fb%=6AUP*$^zZwljs;S$9FaGCEewMzAd^UaGhC7#4I`NO;I$G& z99e@&kgaM(k)RY)SX0(Go62}uS*|luGYFz6QxC2?1z}!l zxh@20`6X}cxC+aG5v4PlEa{fwNv{qe^$T6fEX$lF4A&yKdn6ZBX!``7t)0OSgQ?*7 zG+zwW$a0UdwpqNfS1j1`6EO@2Vh~7YXYI)jRCQ<0qEG;SOy59CO&UQGzB(#B5)rg- z%t>m8h<5k}UE8sohgD*$o#%D@$L)!s946zlKptXy zIW?PzCUNO;>a33y1OB--meeqU_;=5fwbt?vqA#(_}%2 z%ScQn@EA+b)>IqFXqak2Yme8fjJ!PLlzR0>?U=5 zH^y&!bZ(CzpUS85ZnK7+ zW(sj7X$^S$aYuLBPX8#m&Y{)!Stt z-G4foWehv?apHR55!Ry)i%W`&XeHt~o8GdkgvRbvg91zceRP5K3;E+hty4=4m-CJ6 zSGg68@n7mtE>SUzT45PkH8WU<-$N%R^$$-Y)3B=DwlLHb@s1SV&cL_O^;uB0C5nlgSB~Q&Qex| z5L5ClrqE%WlQduSR}};bJJDG8YF&AX9V0>A$oNlvL!_OJ-K^CWUtFRGAODMXh71G- zF$nWX{&au~aZ$RLS%@n7D!q+HNA-#Wpt=>=y)OWGpX3DpcZ}CDf?9!#!+o=(ODb29 ziYc0WZ`3xBW~wA~;1v#4i7QdL;;jXxA}3oJ8~v(yagniErB*%tOAEb@?S;C0VrX5q z*0zLfOP&+Fe;To8SA6~;untxYyjB%rrh19#MrWmffcZ{unrADA>>#I!F4aeU?1 z>8il-Ix9v&BAh@XP-}(pvwBCfqnbI5G!-;KFa0_g?XyBfk)w$xA9R5hXCmnZ-jh zT!^-{7E}6hAr6>(y<-xo)asPCJj}bD=ij(3r)FCtX|0x zF-TeIjh-=g5{^Gb@HturzHL4@q#6k-N3C9@@|qSq_fqAh5Bt5 zu1KUfI2HXYpXC7mX~!t(F8)4(2m&|3k@qPeGrq$y>Y^#_9zzQ^;2-b1wVSl9Pg=4; z){lA|hC&vut8YbS{rft(5N=zXU~LF`8bId9A8}IKE{{H7T6`>0Se2hsz*J#RYP91! zTdZqFo^n?Ik0##Cqln@4GXGRY2xcT`4c%_OyZ9>V20iAW?poSpv+cu};FH0kwRTWZ zr^+v*+7Z&THon|gUG0P8isk&UpIeTaKpr^++86!xcPBrd9Zg%$+Q2 zW8Bpdg@$*5A8p$i-^0fMayqYM_ZN4qQPzk-PhbgVqLEn5RrLag#_rJv5iY z!6)vOJm@=b3CjY)gJQ~b-(7uu=m}d-ck{D~I zf^}g*w6NYgVHOd|x68M6x_n^92^sq4q?;ReEHc+sSYh#1lY{;c4{B+SEtT82LIJN9 zhlqXaxHp<5U_M;pxDfagGbOa=)++JTWAg{#u#{z98$ALf^aQUxqmJJdppMHotK$rL zdCNfajwPyC0D?p2j)YBYD7gJY5u86pI%$Z#m-uRr-rq$8OxA9hFl5}YP^)2wk`-bU zS)#21SSFJw7$6WCXKx}I1TOZPNOgN50m_b7$^~@O?H4OPXPa()AhpXWv zB1ek73>T17z$r}X(S!dzp4J>7f*Tlt|77L;Sv^sm+0F9O20WPexid*MmGSuj7aPsF z{anvMBA33!#-$5lqtcw0Ol@Z%IHB5-rnL)nLX4h)ik0|r@75Pwv8q}tZ{T+3>g<8BZSN=)Q@)wvX|N-s_VJpcog?e!X?{gK8edfIat z@LGroN3`XW;a<>eY^J&dIpMMRvmB|+YjC{C_q26QR``?noR88pHvOPV|LUXrYzFp1 OXGF(XB&Yik0003ecD2|5 diff --git a/programs/develop/oberon07/Docs/About1251.txt b/programs/develop/oberon07/Docs/About1251.txt index 4268ea8158..9eeb905aa6 100644 --- a/programs/develop/oberon07/Docs/About1251.txt +++ b/programs/develop/oberon07/Docs/About1251.txt @@ -1,192 +1,250 @@ - Êîìïèëÿòîð ÿçûêà ïðîãðàììèðîâàíèÿ Oberon-07/11 äëÿ i386 - Windows/Linux/KolibriOS. + Êîìïèëÿòîð ÿçûêà ïðîãðàììèðîâàíèÿ Oberon-07/16 äëÿ i486 + Windows/Linux/KolibriOS. ------------------------------------------------------------------------------ - Ñîñòàâ ïðîãðàììû + Ïàðàìåòðû êîìàíäíîé ñòðîêè -1. Compiler.kex (KolibriOS) - èñïîëíÿåìûé ôàéë êîìïèëÿòîðà. - Âõîä - òåêñòîâûå ôàéëû ìîäóëåé ñ ðàñøèðåíèåì ".ob07", êîäèðîâêà ANSI - èëè UTF-8 ñ BOM-ñèãíàòóðîé. - Âûõîä - èñïîëíÿåìûé ôàéë ôîðìàòà PE, ELF èëè MENUET01/MS COFF. - Ïàðàìåòðû: - 1) èìÿ ãëàâíîãî ìîäóëÿ - 2) òèï ïðèëîæåíèÿ è ïëàòôîðìà - "con" - Windows console - "gui" - Windows GUI - "dll" - Windows DLL - "elf" - Linux - "kos" - KolibriOS - "obj" - KolibriOS DLL - "kem" - KolibriOS ñ àäðåñîì çàãðóçêè 0x10000 äëÿ âîçìîæíîãî - èñïîëíåíèÿ â ýìóëÿòîðå - 3) ðàçìåð ñòýêà â ìåãàáàéòàõ, íåîáÿçàòåëüíûé ïàðàìåòð, ïî óìîë÷àíèþ - - 1 Ìá, äëÿ ELF èãíîðèðóåòñÿ. Åñëè 2-é ïàðàìåòð = "obj" (KolibriOS DLL), - òî 3-é ïàðàìåòð çàäàåòñÿ øåñòíàäöàòèðè÷íûì ÷èñëîì - (0x00000001 .. 0xffffffff) è îïðåäåëÿåò âåðñèþ ïðîãðàììû, - ïî óìîë÷àíèþ - 0x00010000 (v1.0). - Íàïðèìåð: - "C:\oberon-07\example.ob07" con 1 - "C:\oberon-07\example.ob07" obj 0x00020005 (* v2.5 *) -  ñëó÷àå óñïåøíîé êîìïèëÿöèè, êîìïèëÿòîð ïåðåäàåò êîä çàâåðøåíèÿ 0, - èíà÷å 1. Ïðè ðàáîòå êîìïèëÿòîðà â KolibriOS, êîä çàâåðøåíèÿ íå - ïåðåäàåòñÿ. Ñîîáùåíèÿ êîìïèëÿòîðà âûâîäÿòñÿ íà êîíñîëü (Windows, - KolibriOS), â òåðìèíàë (Linux). -2. Ïàïêà Lib - áèáëèîòåêà ìîäóëåé + Âõîä - òåêñòîâûå ôàéëû ìîäóëåé ñ ðàñøèðåíèåì ".ob07", êîäèðîâêà ANSI èëè +UTF-8 ñ BOM-ñèãíàòóðîé. + Âûõîä - èñïîíÿåìûé ôàéë ôîðìàòà PE32, ELF èëè MENUET01/MSCOFF. + Ïàðàìåòðû: + 1) èìÿ ãëàâíîãî ìîäóëÿ + 2) èìÿ ðåçóëüòèðóþùåãî ôàéëà + 3) òèï ïðèëîæåíèÿ è ïëàòôîðìà + "console" - Windows console + "gui" - Windows GUI + "dll" - Windows DLL + "kos" - KolibriOS + "obj" - KolibriOS DLL + "elfexe" - Linux ELF-EXEC + 4) íåîáÿçàòåëüíûå ïàðàìåòðû-êëþ÷è + -stk ðàçìåð ñòýêà â ìåãàáàéòàõ (ïî óìîë÷àíèþ 2 Ìá) + -base
àäðåñ çàãðóçêè èñïîëíÿåìîãî ôàéëà â êèëîáàéòàõ + -ver âåðñèÿ ïðîãðàììû (òîëüêî äëÿ obj) + -nochk <"ptibcwra"> îòêëþ÷èòü ïðîâåðêè ïðè âûïîëíåíèè (ñì. íèæå) + + ïàðàìåòð -nochk çàäàåòñÿ â âèäå ñòðîêè èç ñèìâîëîâ: + "p" - óêàçàòåëè + "t" - òèïû + "i" - èíäåêñû + "b" - íåÿâíîå ïðèâåäåíèå INTEGER ê BYTE + "c" - äèàïàçîí àðãóìåíòà ôóíêöèè CHR + "w" - äèàïàçîí àðãóìåíòà ôóíêöèè WCHR + "r" - ýêâèâàëåíòíî "bcw" + "a" - âñå ïðîâåðêè + + Ïîðÿäîê ñèìâîëîâ ìîæåò áûòü ëþáûì. Íàëè÷èå â ñòðîêå òîãî èëè èíîãî + ñèìâîëà îòêëþ÷àåò ñîîòâåòñòâóþùóþ ïðîâåðêó. + + Íàïðèìåð: -nochk it - îòêëþ÷èòü ïðîâåðêó èíäåêñîâ è îõðàíó òèïà. + -nochk a - îòêëþ÷èòü âñå îòêëþ÷àåìûå ïðîâåðêè. + + Íàïðèìåð: + + Compiler.exe "C:\example.ob07" "C:\example.exe" console -stk 1 + Compiler.exe "C:\example.ob07" "C:\example.dll" dll + Compiler.exe "C:\example.ob07" "C:\example.exe" gui -stk 4 + Compiler.exe "C:\example.ob07" "C:\example.exe" console -nochk pti + Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.kex" kos -stk 2 + Compiler.kex "/tmp0/1/example.ob07" "/tmp0/1/example.obj" obj -ver 2.7 + Compiler.exe "C:\example.ob07" "C:\example" elfexe + +  ñëó÷àå óñïåøíîé êîìïèëÿöèè, êîìïèëÿòîð ïåðåäàåò êîä çàâåðøåíèÿ 0, èíà÷å 1. +Ïðè ðàáîòå êîìïèëÿòîðà â KolibriOS, êîä çàâåðøåíèÿ íå ïåðåäàåòñÿ. ------------------------------------------------------------------------------ - Îòëè÷èÿ îò îðèãèíàëà + Îòëè÷èÿ îò îðèãèíàëà -1. Ðàñøèðåí ïñåâäîìîäóëü SYSTEM -2. Ðàçðåøåí ñèìâîë "_" â èäåíòèôèêàòîðàõ -3. Äîáàâëåíû ñèñòåìíûå ôëàãè -4. Îïåðàòîð CASE ðåàëèçîâàí â ñîîòâåòñòâèè ñ ñèíòàêñèñîì è ñåìàíòèêîé - äàííîãî îïåðàòîðà â ÿçûêå Oberon (Revision 1.10.90) -5. Ðàñøèðåí íàáîð ñòàíäàðòíûõ ïðîöåäóð -6. Ñåìàíòèêà îõðàíû/ïðîâåðêè òèïà óòî÷íåíà äëÿ íóëåâîãî óêàçàòåëÿ -7. Ñåìàíòèêà DIV è MOD óòî÷íåíà äëÿ îòðèöàòåëüíûõ ÷èñåë -8. Äîáàâëåíû îäíîñòðî÷íûå êîììåíòàðèè (íà÷èíàþòñÿ ñ ïàðû ñèìâîëîâ "//") -9. Ðàçðåøåí ýêñïîðò ïåðåìåííûõ òèïîâ ARRAY è RECORD (òîëüêî äëÿ ÷òåíèÿ) -10. Ðàçðåøåíî íàñëåäîâàíèå îò òèïà-óêàçàòåëÿ -11. Äîáàâëåíû ïñåâäîíèìû òèïîâ (TYPE A = B) +1. Ðàñøèðåí ïñåâäîìîäóëü SYSTEM +2.  èäåíòèôèêàòîðàõ äîïóñêàåòñÿ ñèìâîë "_" +3. Äîáàâëåíû ñèñòåìíûå ôëàãè +4. Óñîâåðøåíñòâîâàí îïåðàòîð CASE (äîáàâëåíû êîíñòàíòíûå âûðàæåíèÿ â + ìåòêàõ âàðèàíòîâ è íåîáÿçàòåëüíàÿ âåòêà ELSE) +5. Ðàñøèðåí íàáîð ñòàíäàðòíûõ ïðîöåäóð +6. Ñåìàíòèêà îõðàíû/ïðîâåðêè òèïà óòî÷íåíà äëÿ íóëåâîãî óêàçàòåëÿ +7. Ñåìàíòèêà DIV è MOD óòî÷íåíà äëÿ îòðèöàòåëüíûõ ÷èñåë +8. Äîáàâëåíû îäíîñòðî÷íûå êîììåíòàðèè (íà÷èíàþòñÿ ñ ïàðû ñèìâîëîâ "//") +9. Ðàçðåøåíî íàñëåäîâàíèå îò òèïà-óêàçàòåëÿ +10. Äîáàâëåí ñèíòàêñèñ äëÿ èìïîðòà ïðîöåäóð èç âíåøíèõ áèáëèîòåê +11. "Ñòðîêè" ìîæíî çàêëþ÷àòü òàêæå â îäèíî÷íûå êàâû÷êè: 'ñòðîêà' +12. Äîáàâëåí òèï WCHAR ------------------------------------------------------------------------------ - Îñîáåííîñòè ðåàëèçàöèè + Îñîáåííîñòè ðåàëèçàöèè -1. Îñíîâíûå òèïû +1. Îñíîâíûå òèïû - Òèï Äèàïàçîí çíà÷åíèé Ðàçìåð, áàéò + Òèï Äèàïàçîí çíà÷åíèé Ðàçìåð, áàéò - INTEGER -2147483648 .. 2147483647 4 - REAL 1.40E-45 .. 3.34E+38 4 - LONGREAL 4.94E-324 .. 1.70E+308 8 - CHAR ñèìâîë ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET ìíîæåñòâî èç öåëûõ ÷èñåë {0 .. 31} 4 + INTEGER -2147483648 .. 2147483647 4 + REAL 4.94E-324 .. 1.70E+308 8 + CHAR ñèìâîë ASCII (0X .. 0FFX) 1 + BOOLEAN FALSE, TRUE 1 + SET ìíîæåñòâî èç öåëûõ ÷èñåë {0 .. 31} 4 + BYTE 0 .. 255 1 + WCHAR ñèìâîë þíèêîäà (0X .. 0FFFFX) 2 -2. Ìàêñèìàëüíàÿ äëèíà èäåíòèôèêàòîðîâ - 255 ñèìâîëîâ -3. Ìàêñèìàëüíàÿ äëèíà ñòðîêîâûõ êîíñòàíò - 255 ñèìâîëîâ -4. Ìàêñèìàëüíàÿ äëèíà ñòðîê èñõîäíîãî êîäà - 511 ñèìâîëîâ -5. Ìàêñèìàëüíàÿ ðàçìåðíîñòü îòêðûòûõ ìàññèâîâ - 5 -6. Ìàêñèìàëüíîå êîëè÷åñòâî îáúÿâëåííûõ òèïîâ-çàïèñåé - 2047 -7. Ïðîöåäóðà NEW çàïîëíÿåò íóëÿìè âûäåëåííûé áëîê ïàìÿòè -8. Ãëîáàëüíûå è ëîêàëüíûå ïåðåìåííûå èíèöèàëèçèðóþòñÿ íóëÿìè -9.  îòëè÷èå îò ìíîãèõ Oberon-ðåàëèçàöèé, ñáîðùèê ìóñîðà è äèíàìè÷åñêàÿ - ìîäóëüíîñòü îòñóòñòâóþò +2. Ìàêñèìàëüíàÿ äëèíà èäåíòèôèêàòîðîâ - 1024 ñèìâîëîâ +3. Ìàêñèìàëüíàÿ äëèíà ñòðîêîâûõ êîíñòàíò - 1024 ñèìâîëîâ (UTF-8) +4. Ìàêñèìàëüíàÿ ðàçìåðíîñòü îòêðûòûõ ìàññèâîâ - 5 +5. Ïðîöåäóðà NEW çàïîëíÿåò íóëÿìè âûäåëåííûé áëîê ïàìÿòè +6. Ãëîáàëüíûå è ëîêàëüíûå ïåðåìåííûå èíèöèàëèçèðóþòñÿ íóëÿìè +7.  îòëè÷èå îò ìíîãèõ Oberon-ðåàëèçàöèé, ñáîðùèê ìóñîðà è äèíàìè÷åñêàÿ + ìîäóëüíîñòü îòñóòñòâóþò +8. Òèï BYTE â âûðàæåíèÿõ âñåãäà ïðèâîäèòñÿ ê INTEGER +9. Êîíòðîëü ïåðåïîëíåíèÿ çíà÷åíèé âûðàæåíèé íå ïðîèçâîäèòñÿ +10. Îøèáêè âðåìåíè âûïîëíåíèÿ: + + - ASSERT(x), ïðè x = FALSE + - ðàçûìåíîâàíèå íóëåâîãî óêàçàòåëÿ + - öåëî÷èñëåííîå äåëåíèå íà 0 + - âûçîâ ïðîöåäóðû ÷åðåç ïðîöåäóðíóþ ïåðåìåííóþ ñ íóëåâûì çíà÷åíèåì + - îøèáêà îõðàíû òèïà + - íàðóøåíèå ãðàíèö ìàññèâà + - íåïðåäóñìîòðåííîå çíà÷åíèå âûðàæåíèÿ â îïåðàòîðå CASE + - îøèáêà êîïèðîâàíèÿ ìàññèâîâ v := x, åñëè LEN(v) < LEN(x) + - íåÿâíîå ïðèâåäåíèå x:INTEGER ê v:BYTE, åñëè (x < 0) OR (x > 255) + - CHR(x), åñëè (x < 0) OR (x > 255) + - WCHR(x), åñëè (x < 0) OR (x > 65535) ------------------------------------------------------------------------------ - Ïñåâäîìîäóëü SYSTEM + Ïñåâäîìîäóëü SYSTEM Ïñåâäîìîäóëü SYSTEM ñîäåðæèò íèçêîóðîâíåâûå è íåáåçîïàñíûå ïðîöåäóðû, îøèáêè ïðè èñïîëüçîâàíèè ïðîöåäóð ïñåâäîìîäóëÿ SYSTEM ìîãóò ïðèâåñòè ê ïîâðåæäåíèþ äàííûõ âðåìåíè âûïîëíåíèÿ è àâàðèéíîìó çàâåðøåíèþ ïðîãðàììû. - PROCEDURE ADR(v: ëþáîé òèï): INTEGER - v - ïåðåìåííàÿ, ïðîöåäóðà èëè ñòðîêîâàÿ êîíñòàíòà; - âîçâðàùàåò àäðåñ v + PROCEDURE ADR(v: ëþáîé òèï): INTEGER + v - ïåðåìåííàÿ èëè ïðîöåäóðà; + âîçâðàùàåò àäðåñ v - PROCEDURE SIZE(T): INTEGER - âîçâðàùàåò ðàçìåð òèïà T + PROCEDURE SADR(x: ñòðîêîâàÿ êîíñòàíòà (CHAR UTF-8)): INTEGER + âîçâðàùàåò àäðåñ x - PROCEDURE TYPEID(T): INTEGER - T - òèï-çàïèñü èëè òèï-óêàçàòåëü, - âîçâðàùàåò íîìåð òèïà â òàáëèöå òèïîâ-çàïèñåé + PROCEDURE WSADR(x: ñòðîêîâàÿ êîíñòàíòà (WCHAR)): INTEGER + âîçâðàùàåò àäðåñ x - PROCEDURE INF(T): T - T - REAL èëè LONGREAL, - âîçâðàùàåò ñïåöèàëüíîå âåùåñòâåííîå çíà÷åíèå "áåñêîíå÷íîñòü" + PROCEDURE SIZE(T): INTEGER + âîçâðàùàåò ðàçìåð òèïà T - PROCEDURE GET(a: INTEGER; - VAR v: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) - v := Ïàìÿòü[a] + PROCEDURE TYPEID(T): INTEGER + T - òèï-çàïèñü èëè òèï-óêàçàòåëü, + âîçâðàùàåò íîìåð òèïà â òàáëèöå òèïîâ-çàïèñåé - PROCEDURE PUT(a: INTEGER; x: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) - Ïàìÿòü[a] := x + PROCEDURE INF(): REAL + âîçâðàùàåò ñïåöèàëüíîå âåùåñòâåííîå çíà÷åíèå "áåñêîíå÷íîñòü" - PROCEDURE MOVE(Source, Dest, n: INTEGER) - Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest, - îáëàñòè Source è Dest íå äîëæíû ïåðåêðûâàòüñÿ + PROCEDURE GET(a: INTEGER; + VAR v: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) + v := Ïàìÿòü[a] - PROCEDURE COPY(VAR Source: ëþáîé òèï; VAR Dest: ëþáîé òèï; n: INTEGER) - Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest. - Ýêâèâàëåíòíî - SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) + PROCEDURE PUT(a: INTEGER; x: ëþáîé îñíîâíîé òèï, PROCEDURE, POINTER) + Ïàìÿòü[a] := x; + Åñëè x: BYTE èëè x: WCHAR, òî çíà÷åíèå x áóäåò ðàñøèðåíî + äî 32 áèò, äëÿ çàïèñè áàéòîâ èñïîëüçîâàòü SYSTEM.PUT8, + äëÿ WCHAR -- SYSTEM.PUT16 - PROCEDURE CODE(s: ARRAY OF CHAR) - Âñòàâêà ìàøèííîãî êîäà - s - ñòðîêîâàÿ êîíñòàíòà øåñòíàäöàòèðè÷íûõ öèôð - êîëè÷åñòâî öèôð äîëæíî áûòü ÷åòíûì - íàïðèìåð: SYSTEM.CODE("B801000000") (* mov eax, 1 *) + PROCEDURE PUT8(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + Ïàìÿòü[a] := ìëàäøèå 8 áèò (x) + + PROCEDURE PUT16(a: INTEGER; x: INTEGER, BYTE, CHAR, WCHAR) + Ïàìÿòü[a] := ìëàäøèå 16 áèò (x) + + PROCEDURE MOVE(Source, Dest, n: INTEGER) + Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest, + îáëàñòè Source è Dest íå ìîãóò ïåðåêðûâàòüñÿ + + PROCEDURE COPY(VAR Source: ëþáîé òèï; VAR Dest: ëþáîé òèï; n: INTEGER) + Êîïèðóåò n áàéò ïàìÿòè èç Source â Dest. + Ýêâèâàëåíòíî + SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) + + PROCEDURE CODE(byte1, byte2,... : INTEGER) + Âñòàâêà ìàøèííîãî êîäà, + byte1, byte2 ... - êîíñòàíòû â äèàïàçîíå 0..255, + íàïðèìåð: + SYSTEM.CODE(08BH, 045H, 008H) (* mov eax, dword [ebp + 08h] *) Òàêæå â ìîäóëå SYSTEM îïðåäåëåí òèï CARD16 (2 áàéòà). Äëÿ òèïà CARD16 íå äîïóñêàþòñÿ íèêàêèå ÿâíûå îïåðàöèè, çà èñêëþ÷åíèåì ïðèñâàèâàíèÿ. Ïðåîáðàçîâàíèÿ CARD16 -> INTEGER è INTEGER -> CARD16 ìîãóò áûòü ðåàëèçîâàíû òàê: - PROCEDURE Card16ToInt(w: SYSTEM.CARD16): INTEGER; - VAR i: INTEGER; - BEGIN - SYSTEM.PUT(SYSTEM.ADR(i), w) - RETURN i - END Card16ToInt; + PROCEDURE Card16ToInt (w: SYSTEM.CARD16): INTEGER; + VAR i: INTEGER; + BEGIN + SYSTEM.PUT(SYSTEM.ADR(i), w) + RETURN i + END Card16ToInt; - PROCEDURE IntToCard16(i: INTEGER): SYSTEM.CARD16; - VAR w: SYSTEM.CARD16; - BEGIN - SYSTEM.GET(SYSTEM.ADR(i), w) - RETURN w - END IntToCard16; + PROCEDURE IntToCard16 (i: INTEGER): SYSTEM.CARD16; + VAR w: SYSTEM.CARD16; + BEGIN + SYSTEM.GET(SYSTEM.ADR(i), w) + RETURN w + END IntToCard16; Ôóíêöèè ïñåâäîìîäóëÿ SYSTEM íåëüçÿ èñïîëüçîâàòü â êîíñòàíòíûõ âûðàæåíèÿõ. ------------------------------------------------------------------------------ - Ñèñòåìíûå ôëàãè + Ñèñòåìíûå ôëàãè Ïðè îáúÿâëåíèè ïðîöåäóðíûõ òèïîâ è ãëîáàëüíûõ ïðîöåäóð, ïîñëå êëþ÷åâîãî -ñëîâà PROCEDURE ìîæåò áûòü óêàçàí ôëàã ñîãëàøåíèÿ âûçîâà: [stdcall], [cdecl] -èëè [winapi]. Íàïðèìåð: +ñëîâà PROCEDURE ìîæåò áûòü óêàçàí ôëàã ñîãëàøåíèÿ î âûçîâå: [stdcall], +[ccall], [ccall16], [windows], [linux]. Íàïðèìåð: - PROCEDURE [cdecl] MyProc(x, y, z: INTEGER): INTEGER; + PROCEDURE [ccall] MyProc (x, y, z: INTEGER): INTEGER; + + Åñëè óêàçàí ôëàã [ccall16], òî ïðèíèìàåòñÿ ñîãëàøåíèå ccall, íî ïåðåä +âûçîâîì óêàçàòåëü ñòýêà áóäåò âûðàâíåí ïî ãðàíèöå 16 áàéò. + Ôëàã [windows] - ñèíîíèì äëÿ [stdcall], [linux] - ñèíîíèì äëÿ [ccall16]. + Çíàê "-" ïîñëå èìåíè ôëàãà ([stdcall-], [linux-], ...) îçíà÷àåò, ÷òî +ðåçóëüòàò ïðîöåäóðû ìîæíî èãíîðèðîâàòü (íå äîïóñêàåòñÿ äëÿ òèïà REAL). - Åñëè óêàçàí ôëàã [winapi], òî ïðèíèìàåòñÿ ñîãëàøåíèå stdcall è -ïðîöåäóðó-ôóíêöèþ ìîæíî âûçâàòü êàê ñîáñòâåííî ïðîöåäóðó, âíå âûðàæåíèÿ. -Ôëàã [winapi] äîñòóïåí òîëüêî äëÿ ïëàòôîðìû Windows. Ïðè îáúÿâëåíèè òèïîâ-çàïèñåé, ïîñëå êëþ÷åâîãî ñëîâà RECORD ìîæåò áûòü -óêàçàí ôëàã [noalign] èëè [union]. Ôëàã [noalign] îçíà÷àåò îòñóòñòâèå -âûðàâíèâàíèÿ ïîëåé çàïèñè, à ôëàã [union] îçíà÷àåò, ÷òî ñìåùåíèÿ âñåõ ïîëåé -çàïèñè ðàâíû íóëþ, ïðè ýòîì ðàçìåð çàïèñè ðàâåí ðàçìåðó íàèáîëüøåãî ïîëÿ. -Çàïèñè RECORD [union] ... END ñîîòâåòñòâóþò îáúåäèíåíèÿì (union) â ÿçûêå C. -Çàïèñè ñ ñèñòåìíûìè ôëàãàìè íå ìîãóò èìåòü áàçîâîãî òèïà è íå ìîãóò áûòü +óêàçàí ôëàã [noalign]. Ôëàã [noalign] îçíà÷àåò îòñóòñòâèå âûðàâíèâàíèÿ ïîëåé +çàïèñè. Çàïèñè ñ ñèñòåìíûì ôëàãîì íå ìîãóò èìåòü áàçîâûé òèï è íå ìîãóò áûòü áàçîâûìè òèïàìè äëÿ äðóãèõ çàïèñåé. Äëÿ èñïîëüçîâàíèÿ ñèñòåìíûõ ôëàãîâ, òðåáóåòñÿ èìïîðòèðîâàòü SYSTEM. ------------------------------------------------------------------------------ - Îïåðàòîð CASE + Îïåðàòîð CASE Ñèíòàêñèñ îïåðàòîðà CASE: - CaseStatement = - CASE Expression OF Ñase {"|" Ñase} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. + CaseStatement = + CASE Expression OF Ñase {"|" Ñase} + [ELSE StatementSequence] END. + Case = [CaseLabelList ":" StatementSequence]. + CaseLabelList = CaseLabels {"," CaseLabels}. + CaseLabels = ConstExpression [".." ConstExpression]. Íàïðèìåð: - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END + CASE x OF + |-1: DoSomething1 + | 1: DoSomething2 + | 0: DoSomething3 + ELSE + DoSomething4 + END  ìåòêàõ âàðèàíòîâ ìîæíî èñïîëüçîâàòü êîíñòàíòíûå âûðàæåíèÿ, âåòêà ELSE -íåîáÿçàòåëüíà. Åñëè íå âûïîëíåí íè îäèí âàðèàíò è ELSE îòñóòñòâóåò, òî -ïðîãðàììà ïðåðûâàåòñÿ ñ îøèáêîé âðåìåíè âûïîëíåíèÿ. +íåîáÿçàòåëüíà. Åñëè çíà÷åíèå x íå ñîîòâåòñòâóåò íè îäíîìó âàðèàíòó è ELSE +îòñóòñòâóåò, òî ïðîãðàììà ïðåðûâàåòñÿ ñ îøèáêîé âðåìåíè âûïîëíåíèÿ. ------------------------------------------------------------------------------ - Ïðîâåðêà è îõðàíà òèïà íóëåâîãî óêàçàòåëÿ + Òèï WCHAR + + Òèï WCHAR äîáàâëåí â ÿçûê äëÿ óäîáíîé ïîääåæêè þíèêîäà. Äëÿ òèïîâ WCHAR è +ARRAY OF WCHAR äîïóñêàþòñÿ âñå òå æå îïåðàöèè, êàê äëÿ òèïîâ CHAR è +ARRAY OF CHAR, çà èñêëþ÷åíèåì âñòðîåííîé ïðîöåäóðû CHR, êîòîðàÿ âîçâðàùàåò +òîëüêî òèï CHAR. Äëÿ ïîëó÷åíèÿ çíà÷åíèÿ òèïà WCHAR, ñëåäóåò èñïîëüçîâàòü +ïðîöåäóðó WCHR âìåñòî CHR. Äëÿ ïðàâèëüíîé ðàáîòû ñ òèïîì, íåîáõîäèìî ñîõðàíÿòü +èñõîäíûé êîä â êîäèðîâêå UTF-8 c BOM. + +------------------------------------------------------------------------------ + Ïðîâåðêà è îõðàíà òèïà íóëåâîãî óêàçàòåëÿ Îðèãèíàëüíîå ñîîáùåíèå î ÿçûêå íå îïðåäåëÿåò ïîâåäåíèå ïðîãðàììû ïðè âûïîëíåíèè îõðàíû p(T) è ïðîâåðêè òèïà p IS T ïðè p = NIL. Âî ìíîãèõ @@ -196,677 +254,147 @@ Oberon- çíà÷èòåëüíî ñîêðàòèòü ÷àñòîòó ïðèìåíåíèÿ îõðàíû òèïà. ------------------------------------------------------------------------------ - Äîïîëíèòåëüíûå ñòàíäàðòíûå ïðîöåäóðû + Äîïîëíèòåëüíûå ñòàíäàðòíûå ïðîöåäóðû - DISPOSE(VAR v: ëþáîé_óêàçàòåëü) - Îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ ïðîöåäóðîé NEW äëÿ - äèíàìè÷åñêîé ïåðåìåííîé v^, è ïðèñâàèâàåò ïåðåìåííîé v - çíà÷åíèå NIL. + DISPOSE (VAR v: ëþáîé_óêàçàòåëü) + Îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ ïðîöåäóðîé NEW äëÿ + äèíàìè÷åñêîé ïåðåìåííîé v^, è ïðèñâàèâàåò ïåðåìåííîé v + çíà÷åíèå NIL. - LSR(x, n: INTEGER): INTEGER - Ëîãè÷åñêèé ñäâèã x íà n áèò âïðàâî. + COPY (x: ARRAY OF CHAR/WCHAR; VAR v: ARRAY OF CHAR/WCHAR); + v := x; + Åñëè LEN(v) < LEN(x), òî ñòðîêà x áóäåò ñêîïèðîâàíà + íå ïîëíîñòüþ - MIN(a, b: INTEGER): INTEGER - Ìèíèìóì èç äâóõ çíà÷åíèé. + LSR (x, n: INTEGER): INTEGER + Ëîãè÷åñêèé ñäâèã x íà n áèò âïðàâî. - MAX(a, b: INTEGER): INTEGER - Ìàêñèìóì èç äâóõ çíà÷åíèé. + MIN (a, b: INTEGER): INTEGER + Ìèíèìóì èç äâóõ çíà÷åíèé. - BITS(x: INTEGER): SET - Èíòåðïðåòèðóåò x êàê çíà÷åíèå òèïà SET. - Âûïîëíÿåòñÿ íà ýòàïå êîìïèëÿöèè. + MAX (a, b: INTEGER): INTEGER + Ìàêñèìóì èç äâóõ çíà÷åíèé. - LENGTH(s: ARRAY OF CHAR): INTEGER - Äëèíà 0X-çàâåðøåííîé ñòðîêè s, áåç ó÷åòà ñèìâîëà 0X. - Åñëè ñèìâîë 0X îòñóòñòâóåò, ôóíêöèÿ âîçâðàùàåò äëèíó - ìàññèâà s. + BITS (x: INTEGER): SET + Èíòåðïðåòèðóåò x êàê çíà÷åíèå òèïà SET. + Âûïîëíÿåòñÿ íà ýòàïå êîìïèëÿöèè. + + LENGTH (s: ARRAY OF CHAR/WCHAR): INTEGER + Äëèíà 0X-çàâåðøåííîé ñòðîêè s, áåç ó÷åòà ñèìâîëà 0X. + Åñëè ñèìâîë 0X îòñóòñòâóåò, ôóíêöèÿ âîçâðàùàåò äëèíó + ìàññèâà s. s íå ìîæåò áûòü êîíñòàíòîé. + + WCHR (n: INTEGER): WCHAR + Ïðåîáðàçîâàíèå òèïà, àíàëîãè÷íî CHR(n: INTEGER): CHAR ------------------------------------------------------------------------------ - DIV è MOD + DIV è MOD - x y x DIV y x MOD y + x y x DIV y x MOD y - 5 3 1 2 - -5 3 -2 1 - 5 -3 -2 -1 - -5 -3 1 -2 + 5 3 1 2 + -5 3 -2 1 + 5 -3 -2 -1 + -5 -3 1 -2 ------------------------------------------------------------------------------ - Ñêðûòûå ïàðàìåòðû ïðîöåäóð + Èìïîðòèðîâàííûå ïðîöåäóðû + + Ñèíòàêñèñ èìïîðòà: + + PROCEDURE [callconv, "library", "function"] proc_name (FormalParam): Type; + + - callconv -- ñîãëàøåíèå î âûçîâå + - "library" -- èìÿ ôàéëà äèíàìè÷åñêîé áèáëèîòåêè + - "function" -- èìÿ èìïîðòèðóåìîé ïðîöåäóðû + + íàïðèìåð: + + PROCEDURE [windows, "kernel32.dll", "ExitProcess"] exit (code: INTEGER); + + PROCEDURE [stdcall, "Console.obj", "con_exit"] exit (bCloseWindow: BOOLEAN); + +  êîíöå îáúÿâëåíèÿ ìîæåò áûòü äîáàâëåíî (íåîáÿçàòåëüíî) "END proc_name;" + + Îáúÿâëåíèÿ èìïîðòèðîâàííûõ ïðîöåäóð äîëæíû ðàñïîëàãàòüñÿ â ãëîáàëüíîé + îáëàñòè âèäèìîñòè ìîäóëÿ ïîñëå îáúÿâëåíèÿ ïåðåìåííûõ, âìåñòå ñ îáúÿâëåíèåì + "îáû÷íûõ" ïðîöåäóð, îò êîòîðûõ èìïîðòèðîâàííûå îòëè÷àþòñÿ òîëüêî îòñóòñòâèåì + òåëà ïðîöåäóðû.  îñòàëüíîì, ê òàêèì ïðîöåäóðàì ïðèìåíèìû òå æå ïðàâèëà: + èõ ìîæíî âûçâàòü, ïðèñâîèòü ïðîöåäóðíîé ïåðåìåííîé èëè ïîëó÷èòü àäðåñ. + + Òàê êàê èìïîðòèðîâàííàÿ ïðîöåäóðà âñåãäà èìååò ÿâíîå óêàçàíèå ñîãëàøåíèÿ î + âûçîâå, òî ñîâìåñòèìûé ïðîöåäóðíûé òèï òîæå äîëæåí áûòü îáúÿâëåí ñ óêàçàíèåì + ñîãëàøåíèÿ î âûçîâå: + + VAR + ExitProcess: PROCEDURE [windows] (code: INTEGER); + con_exit: PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); + +  KolibriOS èìïîðòèðîâàòü ïðîöåäóðû ìîæíî òîëüêî èç áèáëèîòåê, ðàçìåùåííûõ + â /rd/1/lib. Èìïîðòèðîâàòü è âûçûâàòü ôóíêöèè èíèöèàëèçàöèè áèáëèîòåê + (lib_init, START) ïðè ýòîì íå íóæíî. + + Äëÿ Linux, èìïîðòèðîâàííûå ïðîöåäóðû íå ðåàëèçîâàíû. + +------------------------------------------------------------------------------ + Ñêðûòûå ïàðàìåòðû ïðîöåäóð Íåêîòîðûå ïðîöåäóðû ìîãóò èìåòü ñêðûòûå ïàðàìåòðû, îíè îòñóòñòâóþò â ñïèñêå ôîðìàëüíûõ ïàðàìåòðîâ, íî ó÷èòûâàþòñÿ êîìïèëÿòîðîì ïðè òðàíñëÿöèè âûçîâîâ. Ýòî âîçìîæíî â ñëåäóþùèõ ñëó÷àÿõ: -1. Ïðîöåäóðà èìååò ôîðìàëüíûé ïàðàìåòð îòêðûòûé ìàññèâ: - PROCEDURE Proc(x: ARRAY OF ARRAY OF LONGREAL); - Âûçîâ òðàíñëèðóåòñÿ òàê: - Proc(SYSTEM.ADR(x), LEN(x), LEN(x[0]) -2. Ïðîöåäóðà èìååò ôîðìàëüíûé ïàðàìåòð-ïåðåìåííóþ òèïà RECORD: - PROCEDURE Proc(VAR x: Rec); - Âûçîâ òðàíñëèðóåòñÿ òàê: - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) -3. Ïðîöåäóðà ÿâëÿåòñÿ âëîæåííîé, ãëóáèíà âëîæåíèÿ k, - äëÿ ãëîáàëüíûõ ïðîöåäóð k = 0: - PROCEDURE Proc(p1, ..., pn); - Âûçîâ òðàíñëèðóåòñÿ òàê: - Proc(base(k - 1), base(k - 2), ..., base(0), p1, ..., pn), - ãäå base(m) - àäðåñ áàçû êàäðà ñòýêà îõâàòûâàþùåé ïðîöåäóðû ãëóáèíû - âëîæåíèÿ m (èñïîëüçóåòñÿ äëÿ äîñòóïà ê ëîêàëüíûì ïåðåìåííûì - îõâàòûâàþùåé ïðîöåäóðû) +1. Ïðîöåäóðà èìååò ôîðìàëüíûé ïàðàìåòð îòêðûòûé ìàññèâ: + PROCEDURE Proc (x: ARRAY OF ARRAY OF REAL); + Âûçîâ òðàíñëèðóåòñÿ òàê: + Proc(LEN(x), LEN(x[0]), SYSTEM.ADR(x)) +2. Ïðîöåäóðà èìååò ôîðìàëüíûé ïàðàìåòð-ïåðåìåííóþ òèïà RECORD: + PROCEDURE Proc (VAR x: Rec); + Âûçîâ òðàíñëèðóåòñÿ òàê: + Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) ------------------------------------------------------------------------------ - Ìîäóëü RTL + Ìîäóëü RTL Âñå ïðîãðàììû íåÿâíî èñïîëüçóþò ìîäóëü RTL. Êîìïèëÿòîð òðàíñëèðóåò íåêîòîðûå îïåðàöèè (ïðîâåðêà è îõðàíà òèïà, ñðàâíåíèå ñòðîê, ñîîáùåíèÿ îá îøèáêàõ âðåìåíè âûïîëíåíèÿ è äð.) êàê âûçîâû ïðîöåäóð ýòîãî ìîäóëÿ. Íå -ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóðû SetClose: +ñëåäóåò ÿâíî âûçûâàòü ýòè ïðîöåäóðû, çà èñêëþ÷åíèåì ïðîöåäóðû SetDll, +åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL: - PROCEDURE SetClose(proc: PROC), ãäå TYPE PROC = PROCEDURE + PROCEDURE SetDll + (process_detach, thread_detach, thread_attach: DLL_ENTRY); + ãäå TYPE DLL_ENTRY = + PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); -SetClose íàçíà÷àåò ïðîöåäóðó proc (áåç ïàðàìåòðîâ) âûçûâàåìîé ïðè âûãðóçêå -dll-áèáëèîòåêè (Windows), åñëè ïðèëîæåíèå êîìïèëèðóåòñÿ êàê Windows DLL. Äëÿ -ïðî÷èõ òèïîâ ïðèëîæåíèé è ïëàòôîðì âûçîâ ïðîöåäóðû SetClose íå âëèÿåò íà +SetDll íàçíà÷àåò ïðîöåäóðû process_detach, thread_detach, thread_attach +âûçûâàåìûìè ïðè +- âûãðóçêå dll-áèáëèîòåêè (process_detach) +- ñîçäàíèè íîâîãî ïîòîêà (thread_attach) +- óíè÷òîæåíèè ïîòîêà (thread_detach) + +Äëÿ ïðî÷èõ òèïîâ ïðèëîæåíèé, âûçîâ ïðîöåäóðû SetDll íå âëèÿåò íà ïîâåäåíèå ïðîãðàììû. Ñîîáùåíèÿ îá îøèáêàõ âðåìåíè âûïîëíåíèÿ âûâîäÿòñÿ â äèàëîãîâûõ îêíàõ (Windows), â òåðìèíàë (Linux), íà äîñêó îòëàäêè (KolibriOS). ------------------------------------------------------------------------------ - Ìîäóëü API + Ìîäóëü API - Ñóùåñòâóþò òðè ðåàëèçàöèè ìîäóëÿ API: äëÿ Windows, Linux è KolibriOS. Êàê è -ìîäóëü RTL, ìîäóëü API íå ïðåäíàçíà÷åí äëÿ ïðÿìîãî èñïîëüçîâàíèÿ. Îí -îáåñïå÷èâàåò êðîññïëàòôîðìåííîñòü êîìïèëÿòîðà. + Ñóùåñòâóþò íåñêîëüêî ðåàëèçàöèé ìîäóëÿ API (äëÿ ðàçëè÷íûõ ÎÑ). + Êàê è ìîäóëü RTL, ìîäóëü API íå ïðåäíàçíà÷åí äëÿ ïðÿìîãî èñïîëüçîâàíèÿ. +Îí îáåñïå÷èâàåò ñâÿçü RTL ñ ÎÑ. ------------------------------------------------------------------------------ - Ãåíåðàöèÿ èñïîëíÿåìûõ ôàéëîâ DLL + Ãåíåðàöèÿ èñïîëíÿåìûõ ôàéëîâ DLL Ðàçðåøàåòñÿ ýêñïîðòèðîâàòü òîëüêî ïðîöåäóðû. Äëÿ ýòîãî, ïðîöåäóðà äîëæíà íàõîäèòüñÿ â ãëàâíîì ìîäóëå ïðîãðàììû, è åå èìÿ äîëæíî áûòü îòìå÷åíî ñèìâîëîì ýêñïîðòà ("*"). KolibriOS DLL âñåãäà ýêñïîðòèðóþò èäåíòèôèêàòîðû "version" (âåðñèÿ ïðîãðàììû) è "lib_init" - àäðåñ ïðîöåäóðû èíèöèàëèçàöèè DLL: - PROCEDURE [stdcall] lib_init(): INTEGER + PROCEDURE [stdcall] lib_init (): INTEGER Ýòà ïðîöåäóðà äîëæíà áûòü âûçâàíà ïåðåä èñïîëüçîâàíèåì DLL. Ïðîöåäóðà âñåãäà âîçâðàùàåò 1. -  íàñòîÿùåå âðåìÿ ãåíåðàöèÿ DLL äëÿ Linux íå ðåàëèçîâàíà. -============================================================================== -============================================================================== - - Áèáëèîòåêà (KolibriOS) - ------------------------------------------------------------------------------- -MODULE Out - êîíñîëüíûé âûâîä - - PROCEDURE Open - ôîðìàëüíî îòêðûâàåò êîíñîëüíûé âûâîä - - PROCEDURE Int(x, width: INTEGER) - âûâîä öåëîãî ÷èñëà x; - width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà - - PROCEDURE Real(x: LONGREAL; width: INTEGER) - âûâîä âåùåñòâåííîãî ÷èñëà x â ïëàâàþùåì ôîðìàòå; - width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà - - PROCEDURE Char(x: CHAR) - âûâîä ñèìâîëà x - - PROCEDURE FixReal(x: LONGREAL; width, p: INTEGER) - âûâîä âåùåñòâåííîãî ÷èñëà x â ôèêñèðîâàííîì ôîðìàòå; - width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà; - p - êîëè÷åñòâî çíàêîâ ïîñëå äåñÿòè÷íîé òî÷êè - - PROCEDURE Ln - ïåðåõîä íà ñëåäóþùóþ ñòðîêó - - PROCEDURE String(s: ARRAY OF CHAR) - âûâîä ñòðîêè s - ------------------------------------------------------------------------------- -MODULE In - êîíñîëüíûé ââîä - - VAR Done: BOOLEAN - ïðèíèìàåò çíà÷åíèå TRUE â ñëó÷àå óñïåøíîãî âûïîëíåíèÿ - îïåðàöèè ââîäà, èíà÷å FALSE - - PROCEDURE Open - ôîðìàëüíî îòêðûâàåò êîíñîëüíûé ââîä, - òàêæå ïðèñâàèâàåò ïåðåìåííîé Done çíà÷åíèå TRUE - - PROCEDURE Int(VAR x: INTEGER) - ââîä ÷èñëà òèïà INTEGER - - PROCEDURE Char(VAR x: CHAR) - ââîä ñèìâîëà - - PROCEDURE Real(VAR x: REAL) - ââîä ÷èñëà òèïà REAL - - PROCEDURE LongReal(VAR x: LONGREAL) - ââîä ÷èñëà òèïà LONGREAL - - PROCEDURE String(VAR s: ARRAY OF CHAR) - ââîä ñòðîêè - - PROCEDURE Ln - îæèäàíèå íàæàòèÿ ENTER - ------------------------------------------------------------------------------- -MODULE Console - äîïîëíèòåëüíûå ïðîöåäóðû êîíñîëüíîãî âûâîäà - - CONST - - Ñëåäóþùèå êîíñòàíòû îïðåäåëÿþò öâåò êîíñîëüíîãî âûâîäà - - Black = 0 Blue = 1 Green = 2 - Cyan = 3 Red = 4 Magenta = 5 - Brown = 6 LightGray = 7 DarkGray = 8 - LightBlue = 9 LightGreen = 10 LightCyan = 11 - LightRed = 12 LightMagenta = 13 Yellow = 14 - White = 15 - - PROCEDURE Cls - î÷èñòêà îêíà êîíñîëè - - PROCEDURE SetColor(FColor, BColor: INTEGER) - óñòàíîâêà öâåòà êîíñîëüíîãî âûâîäà: FColor - öâåò òåêñòà, - BColor - öâåò ôîíà, âîçìîæíûå çíà÷åíèÿ - âûøåïåðå÷èñëåííûå - êîíñòàíòû - - PROCEDURE SetCursor(x, y: INTEGER) - óñòàíîâêà êóðñîðà êîíñîëè â ïîçèöèþ (x, y) - - PROCEDURE GetCursor(VAR x, y: INTEGER) - çàïèñûâàåò â ïàðàìåòðû òåêóùèå êîîðäèíàòû êóðñîðà êîíñîëè - - PROCEDURE GetCursorX(): INTEGER - âîçâðàùàåò òåêóùóþ x-êîîðäèíàòó êóðñîðà êîíñîëè - - PROCEDURE GetCursorY(): INTEGER - âîçâðàùàåò òåêóùóþ y-êîîðäèíàòó êóðñîðà êîíñîëè - ------------------------------------------------------------------------------- -MODULE ConsoleLib - îáåðòêà áèáëèîòåêè console.obj - ------------------------------------------------------------------------------- -MODULE Math - ìàòåìàòè÷åñêèå ôóíêöèè - - CONST - - pi = 3.141592653589793D+00 - e = 2.718281828459045D+00 - - VAR - - Inf, nInf: LONGREAL - ïîëîæèòåëüíàÿ è îòðèöàòåëüíàÿ áåñêîíå÷íîñòü - - PROCEDURE IsNan(x: LONGREAL): BOOLEAN - âîçâðàùàåò TRUE, åñëè x - íå ÷èñëî - - PROCEDURE IsInf(x: LONGREAL): BOOLEAN - âîçâðàùàåò TRUE, åñëè x - áåñêîíå÷íîñòü - - PROCEDURE sqrt(x: LONGREAL): LONGREAL - êâàäðàòíûé êîðåíü x - - PROCEDURE exp(x: LONGREAL): LONGREAL - ýêñïîíåíòà x - - PROCEDURE ln(x: LONGREAL): LONGREAL - íàòóðàëüíûé ëîãàðèôì x - - PROCEDURE sin(x: LONGREAL): LONGREAL - ñèíóñ x - - PROCEDURE cos(x: LONGREAL): LONGREAL - êîñèíóñ x - - PROCEDURE tan(x: LONGREAL): LONGREAL - òàíãåíñ x - - PROCEDURE arcsin(x: LONGREAL): LONGREAL - àðêñèíóñ x - - PROCEDURE arccos(x: LONGREAL): LONGREAL - àðêêîñèíóñ x - - PROCEDURE arctan(x: LONGREAL): LONGREAL - àðêòàíãåíñ x - - PROCEDURE arctan2(y, x: LONGREAL): LONGREAL - àðêòàíãåíñ y/x - - PROCEDURE power(base, exponent: LONGREAL): LONGREAL - âîçâåäåíèå ÷èñëà base â ñòåïåíü exponent - - PROCEDURE log(base, x: LONGREAL): LONGREAL - ëîãàðèôì x ïî îñíîâàíèþ base - - PROCEDURE sinh(x: LONGREAL): LONGREAL - ãèïåðáîëè÷åñêèé ñèíóñ x - - PROCEDURE cosh(x: LONGREAL): LONGREAL - ãèïåðáîëè÷åñêèé êîñèíóñ x - - PROCEDURE tanh(x: LONGREAL): LONGREAL - ãèïåðáîëè÷åñêèé òàíãåíñ x - - PROCEDURE arcsinh(x: LONGREAL): LONGREAL - îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x - - PROCEDURE arccosh(x: LONGREAL): LONGREAL - îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x - - PROCEDURE arctanh(x: LONGREAL): LONGREAL - îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x - - PROCEDURE round(x: LONGREAL): LONGREAL - îêðóãëåíèå x äî áëèæàéøåãî öåëîãî - - PROCEDURE frac(x: LONGREAL): LONGREAL; - äðîáíàÿ ÷àñòü ÷èñëà x - - PROCEDURE floor(x: LONGREAL): LONGREAL - íàèáîëüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê LONGREAL), - íå áîëüøå x: floor(1.2) = 1.0 - - PROCEDURE ceil(x: LONGREAL): LONGREAL - íàèìåíüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê LONGREAL), - íå ìåíüøå x: ceil(1.2) = 2.0 - - PROCEDURE sgn(x: LONGREAL): INTEGER - åñëè x > 0 âîçâðàùàåò 1 - åñëè x < 0 âîçâðàùàåò -1 - åñëè x = 0 âîçâðàùàåò 0 - ------------------------------------------------------------------------------- -MODULE Debug - âûâîä íà äîñêó îòëàäêè - Èíòåðôåéñ êàê ìîäóëü Out - - PROCEDURE Open - îòêðûâàåò äîñêó îòëàäêè - ------------------------------------------------------------------------------- -MODULE File - ðàáîòà ñ ôàéëîâîé ñèñòåìîé - - TYPE - - FNAME = ARRAY 520 OF CHAR - - FS = POINTER TO rFS - - rFS = RECORD (* èíôîðìàöèîííàÿ ñòðóêòóðà ôàéëà *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END - - FD = POINTER TO rFD - - rFD = RECORD (* ñòðóêòóðà áëîêà äàííûõ âõîäà êàòàëîãà *) - attr: INTEGER; - ntyp: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create, date_create, - time_access, date_access, - time_modif, date_modif, - size, hsize: INTEGER; - name: FNAME - END - - CONST - - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 - - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - Çàãðóæàåò â ïàìÿòü ôàéë ñ èìåíåì FName, çàïèñûâàåò â ïàðàìåòð - size ðàçìåð ôàéëà, âîçâðàùàåò àäðåñ çàãðóæåííîãî ôàéëà - èëè 0 (îøèáêà). Ïðè íåîáõîäèìîñòè, ðàñïàêîâûâàåò - ôàéë (kunpack). - - PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN - Çàïèñûâàåò ñòðóêòóðó áëîêà äàííûõ âõîäà êàòàëîãà äëÿ ôàéëà - èëè ïàïêè ñ èìåíåì FName â ïàðàìåòð Info. - Ïðè îøèáêå âîçâðàùàåò FALSE. - - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - âîçâðàùàåò TRUE, åñëè ôàéë ñ èìåíåì FName ñóùåñòâóåò - - PROCEDURE Close(VAR F: FS) - îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ èíôîðìàöèîííîé ñòðóêòóðû - ôàéëà F è ïðèñâàèâàåò F çíà÷åíèå NIL - - PROCEDURE Open(FName: ARRAY OF CHAR): FS - âîçâðàùàåò óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà ñ - èìåíåì FName, ïðè îøèáêå âîçâðàùàåò NIL - - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - óäàëÿåò ôàéë ñ èìåíåì FName, ïðè îøèáêå âîçâðàùàåò FALSE - - PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER - óñòàíàâëèâàåò ïîçèöèþ ÷òåíèÿ-çàïèñè ôàéëà F íà Offset, - îòíîñèòåëüíî Origin = (SEEK_BEG - íà÷àëî ôàéëà, - SEEK_CUR - òåêóùàÿ ïîçèöèÿ, SEEK_END - êîíåö ôàéëà), - âîçâðàùàåò ïîçèöèþ îòíîñèòåëüíî íà÷àëà ôàéëà, íàïðèìåð: - Seek(F, 0, SEEK_END) - óñòàíàâëèâàåò ïîçèöèþ íà êîíåö ôàéëà è âîçâðàùàåò äëèíó - ôàéëà; ïðè îøèáêå âîçâðàùàåò -1 - - PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER - ×èòàåò äàííûå èç ôàéëà â ïàìÿòü. F - óêàçàòåëü íà - èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè - ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ ïðî÷èòàòü - èç ôàéëà; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî ïðî÷èòàíî - è ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â - èíôîðìàöèîííîé ñòðóêòóðå F. - - PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER - Çàïèñûâàåò äàííûå èç ïàìÿòè â ôàéë. F - óêàçàòåëü íà - èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè - ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ çàïèñàòü - â ôàéë; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî çàïèñàíî è - ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â - èíôîðìàöèîííîé ñòðóêòóðå F. - - PROCEDURE Create(FName: ARRAY OF CHAR): FS - ñîçäàåò íîâûé ôàéë ñ èìåíåì FName (ïîëíîå èìÿ), âîçâðàùàåò - óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, - ïðè îøèáêå âîçâðàùàåò NIL - - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - ñîçäàåò ïàïêó ñ èìåíåì DirName, âñå ïðîìåæóòî÷íûå ïàïêè - äîëæíû ñóùåñòâîâàòü, ïðè îøèáêå âîçâðàùàåò FALSE - - PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN - óäàëÿåò ïóñòóþ ïàïêó ñ èìåíåì DirName, - ïðè îøèáêå âîçâðàùàåò FALSE - - PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN - âîçâðàùàåò TRUE, åñëè ïàïêà ñ èìåíåì DirName ñóùåñòâóåò - ------------------------------------------------------------------------------- -MODULE Read - ÷òåíèå îñíîâíûõ òèïîâ äàííûõ èç ôàéëà F - - Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè ÷òåíèÿ è - ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â - èíôîðìàöèîííîé ñòðóêòóðå F - - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - - PROCEDURE LongReal(F: File.FS; VAR x: LONGREAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - - PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN - ------------------------------------------------------------------------------- -MODULE Write - çàïèñü îñíîâíûõ òèïîâ äàííûõ â ôàéë F - - Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè çàïèñè è - ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â - èíôîðìàöèîííîé ñòðóêòóðå F - - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - - PROCEDURE LongReal(F: File.FS; x: LONGREAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - - PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN - ------------------------------------------------------------------------------- -MODULE DateTime - äàòà, âðåìÿ - - CONST ERR = -7.0D5 - - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - çàïèñûâàåò â ïàðàìåòðû êîìïîíåíòû òåêóùåé ñèñòåìíîé äàòû è - âðåìåíè - - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): LONGREAL - âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ - Year, Month, Day, Hour, Min, Sec; - ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5 - - PROCEDURE Decode(Date: LONGREAL; VAR Year, Month, Day, - Hour, Min, Sec: INTEGER): BOOLEAN - èçâëåêàåò êîìïîíåíòû - Year, Month, Day, Hour, Min, Sec èç äàòû Date; - ïðè îøèáêå âîçâðàùàåò FALSE - ------------------------------------------------------------------------------- -MODULE Args - ïàðàìåòðû ïðîãðàììû - - VAR argc: INTEGER - êîëè÷åñòâî ïàðàìåòðîâ ïðîãðàììû, âêëþ÷àÿ èìÿ - èñïîëíÿåìîãî ôàéëà - - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - çàïèñûâàåò â ñòðîêó s n-é ïàðàìåòð ïðîãðàììû, - íóìåðàöèÿ ïàðàìåòðîâ îò 0 äî argc - 1, - íóëåâîé ïàðàìåòð -- èìÿ èñïîëíÿåìîãî ôàéëà - ------------------------------------------------------------------------------- -MODULE KOSAPI - - PROCEDURE sysfunc1(arg1: INTEGER): INTEGER - PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER - ... - PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER - Îáåðòêè äëÿ ôóíêöèé API ÿäðà KolibriOS. - arg1 .. arg7 ñîîòâåòñòâóþò ðåãèñòðàì - eax, ebx, ecx, edx, esi, edi, ebp; - âîçâðàùàþò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. - - PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER - Îáåðòêà äëÿ ôóíêöèé API ÿäðà KolibriOS. - arg1 - ðåãèñòð eax, arg2 - ðåãèñòð ebx, - res2 - çíà÷åíèå ðåãèñòðà ebx ïîñëå ñèñòåìíîãî âûçîâà; - âîçâðàùàåò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. - - PROCEDURE malloc(size: INTEGER): INTEGER - Âûäåëÿåò áëîê ïàìÿòè. - size - ðàçìåð áëîêà â áàéòàõ, - âîçâðàùàåò àäðåñ âûäåëåííîãî áëîêà - - PROCEDURE free(ptr: INTEGER): INTEGER - Îñâîáîæäàåò ðàíåå âûäåëåííûé áëîê ïàìÿòè ñ àäðåñîì ptr, - âîçâðàùàåò 0 - - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - Ïåðåðàñïðåäåëÿåò áëîê ïàìÿòè, - ptr - àäðåñ ðàíåå âûäåëåííîãî áëîêà, - size - íîâûé ðàçìåð, - âîçâðàùàåò óêàçàòåëü íà ïåðåðàñïðåäåëåííûé áëîê, - 0 ïðè îøèáêå - - PROCEDURE GetCommandLine(): INTEGER - Âîçâðàùàåò àäðåñ ñòðîêè ïàðàìåòðîâ - - PROCEDURE GetName(): INTEGER - Âîçâðàùàåò àäðåñ ñòðîêè ñ èìåíåì ïðîãðàììû - - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - Çàãðóæàåò DLL ñ ïîëíûì èìåíåì name. Âîçâðàùàåò àäðåñ òàáëèöû - ýêñïîðòà. Ïðè îøèáêå âîçâðàùàåò 0. - - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - èìÿ ïðîöåäóðû - lib - àäðåñ òàáëèöû ýêñïîðòà DLL - Âîçâðàùàåò àäðåñ ïðîöåäóðû. Ïðè îøèáêå âîçâðàùàåò 0. - ------------------------------------------------------------------------------- -MODULE ColorDlg - ðàáîòà ñ äèàëîãîì "Color Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) - status: INTEGER (* ñîñòîÿíèå äèàëîãà: - 0 - ïîëüçîâàòåëü íàæàë Cancel - 1 - ïîëüçîâàòåëü íàæàë OK - 2 - äèàëîã îòêðûò *) - - color: INTEGER (* âûáðàííûé öâåò *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - ñîçäàòü äèàëîã - draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà - (TYPE DRAW_WINDOW = PROCEDURE); - ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà - - PROCEDURE Show(cd: Dialog) - ïîêàçàòü äèàëîã - cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå - ïðîöåäóðîé Create - - PROCEDURE Destroy(VAR cd: Dialog) - óíè÷òîæèòü äèàëîã - cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà - ------------------------------------------------------------------------------- -MODULE OpenDlg - ðàáîòà ñ äèàëîãîì "Open Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) - status: INTEGER (* ñîñòîÿíèå äèàëîãà: - 0 - ïîëüçîâàòåëü íàæàë Cancel - 1 - ïîëüçîâàòåëü íàæàë OK - 2 - äèàëîã îòêðûò *) - - FileName: ARRAY 4096 OF CHAR (* èìÿ âûáðàííîãî ôàéëà *) - FilePath: ARRAY 4096 OF CHAR (* ïîëíîå èìÿ âûáðàííîãî - ôàéëà *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, - filter: ARRAY OF CHAR): Dialog - ñîçäàòü äèàëîã - draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà - (TYPE DRAW_WINDOW = PROCEDURE) - type - òèï äèàëîãà - 0 - îòêðûòü - 1 - ñîõðàíèòü - 2 - âûáðàòü ïàïêó - def_path - ïóòü ïî óìîë÷àíèþ, ïàïêà def_path áóäåò îòêðûòà - ïðè ïåðâîì çàïóñêå äèàëîãà - filter - â ñòðîêå çàïèñàíî ïåðå÷èñëåíèå ðàñøèðåíèé ôàéëîâ, - êîòîðûå áóäóò ïîêàçàíû â äèàëîãîâîì îêíå, ðàñøèðåíèÿ - ðàçäåëÿþòñÿ ñèìâîëîì "|", íàïðèìåð: "ASM|TXT|INI" - ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà - - PROCEDURE Show(od: Dialog; Width, Height: INTEGER) - ïîêàçàòü äèàëîã - od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå - ïðîöåäóðîé Create - Width è Height - øèðèíà è âûñîòà äèàëîãîâîãî îêíà - - PROCEDURE Destroy(VAR od: Dialog) - óíè÷òîæèòü äèàëîã - od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà - ------------------------------------------------------------------------------- -MODULE kfonts - ðàáîòà ñ kf-øðèôòàìè - - CONST - - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 - - TYPE - - TFont = POINTER TO TFont_desc (* óêàçàòåëü íà øðèôò *) - - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - çàãðóçèòü øðèôò èç ôàéëà - file_name èìÿ kf-ôàéëà - ðåç-ò: óêàçàòåëü íà øðèôò/NIL (îøèáêà) - - PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN - óñòàíîâèòü ðàçìåð øðèôòà - Font óêàçàòåëü íà øðèôò - font_size ðàçìåð øðèôòà - ðåç-ò: TRUE/FALSE (îøèáêà) - - PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN - ïðîâåðèòü, åñòü ëè øðèôò, çàäàííîãî ðàçìåðà - Font óêàçàòåëü íà øðèôò - font_size ðàçìåð øðèôòà - ðåç-ò: TRUE/FALSE (øðèôòà íåò) - - PROCEDURE Destroy(VAR Font: TFont) - âûãðóçèòü øðèôò, îñâîáîäèòü äèíàìè÷åñêóþ ïàìÿòü - Font óêàçàòåëü íà øðèôò - Ïðèñâàèâàåò ïåðåìåííîé Font çíà÷åíèå NIL - - PROCEDURE TextHeight(Font: TFont): INTEGER - ïîëó÷èòü âûñîòó ñòðîêè òåêñòà - Font óêàçàòåëü íà øðèôò - ðåç-ò: âûñîòà ñòðîêè òåêñòà â ïèêñåëÿõ - - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - ïîëó÷èòü øèðèíó ñòðîêè òåêñòà - Font óêàçàòåëü íà øðèôò - str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 - length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà - çàâåðøàåòñÿ íóëåì - params ïàðàìåòðû-ôëàãè ñì. íèæå - ðåç-ò: øèðèíà ñòðîêè òåêñòà â ïèêñåëÿõ - - PROCEDURE TextOut(Font: TFont; - canvas, x, y, str, length, color, params: INTEGER) - âûâåñòè òåêñò â áóôåð - äëÿ âûâîäà áóôåðà â îêíî, èñïîëüçîâàòü ô.65 èëè - ô.7 (åñëè áóôåð 24-áèòíûé) - Font óêàçàòåëü íà øðèôò - canvas àäðåñ ãðàôè÷åñêîãî áóôåðà - ñòðóêòóðà áóôåðà: - Xsize dd - Ysize dd - picture rb Xsize * Ysize * 4 (32 áèòà) - èëè Xsize * Ysize * 3 (24 áèòà) - x, y êîîðäèíàòû òåêñòà îòíîñèòåëüíî ëåâîãî âåðõíåãî - óãëà áóôåðà - str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 - length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà - çàâåðøàåòñÿ íóëåì - color öâåò òåêñòà 0x00RRGGBB - params ïàðàìåòðû-ôëàãè: - 1 æèðíûé - 2 êóðñèâ - 4 ïîä÷åðêíóòûé - 8 ïåðå÷åðêíóòûé - 16 ïðèìåíèòü ñãëàæèâàíèå - 32 âûâîä â 32-áèòíûé áóôåð - âîçìîæíî èñïîëüçîâàíèå ôëàãîâ â ëþáûõ ñî÷åòàíèÿõ ------------------------------------------------------------------------------- -MODULE RasterWorks - îáåðòêà áèáëèîòåêè Rasterworks.obj ------------------------------------------------------------------------------- -MODULE libimg - îáåðòêà áèáëèîòåêè libimg.obj ------------------------------------------------------------------------------- -MODULE NetDevices - îáåðòêà äëÿ ô.74 (ðàáîòà ñ ñåòåâûìè óñòðîéñòâàìè) ------------------------------------------------------------------------------- \ No newline at end of file + Äëÿ Linux, ãåíåðàöèÿ äèíàìè÷åñêèõ áèáëèîòåê íå ðåàëèçîâàíà. \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/About866.txt b/programs/develop/oberon07/Docs/About866.txt deleted file mode 100644 index 02b992cbb4..0000000000 --- a/programs/develop/oberon07/Docs/About866.txt +++ /dev/null @@ -1,872 +0,0 @@ - Š®¬¯¨«ïâ®à ï§ëª  ¯à®£à ¬¬¨à®¢ ­¨ï Oberon-07/11 ¤«ï i386 - Windows/Linux/KolibriOS. ------------------------------------------------------------------------------- - - ‘®áâ ¢ ¯à®£à ¬¬ë - -1. Compiler.kex (KolibriOS) - ¨á¯®«­ï¥¬ë© ä ©« ª®¬¯¨«ïâ®à . - ‚室 - ⥪áâ®¢ë¥ ä ©«ë ¬®¤ã«¥© á à áè¨à¥­¨¥¬ ".ob07", ª®¤¨à®¢ª  ANSI - ¨«¨ UTF-8 á BOM-ᨣ­ âãன. - ‚ë室 - ¨á¯®«­ï¥¬ë© ä ©« ä®à¬ â  PE, ELF ¨«¨ MENUET01/MS COFF. -  à ¬¥âàë: - 1) ¨¬ï £« ¢­®£® ¬®¤ã«ï - 2) ⨯ ¯à¨«®¦¥­¨ï ¨ ¯« âä®à¬  - "con" - Windows console - "gui" - Windows GUI - "dll" - Windows DLL - "elf" - Linux - "kos" - KolibriOS - "obj" - KolibriOS DLL - "kem" - KolibriOS á  ¤à¥á®¬ § £à㧪¨ 0x10000 ¤«ï ¢®§¬®¦­®£® - ¨á¯®«­¥­¨ï ¢ í¬ã«ïâ®à¥ - 3) à §¬¥à áâíª  ¢ ¬¥£ ¡ ©â å, ­¥®¡ï§ â¥«ì­ë© ¯ à ¬¥âà, ¯® 㬮«ç ­¨î - - 1 Œ¡, ¤«ï ELF ¨£­®à¨àã¥âáï. …᫨ 2-© ¯ à ¬¥âà = "obj" (KolibriOS DLL), - â® 3-© ¯ à ¬¥âà § ¤ ¥âáï è¥áâ­ ¤æ â¨à¨ç­ë¬ ç¨á«®¬ - (0x00000001 .. 0xffffffff) ¨ ®¯à¥¤¥«ï¥â ¢¥àá¨î ¯à®£à ¬¬ë, - ¯® 㬮«ç ­¨î - 0x00010000 (v1.0). -  ¯à¨¬¥à: - "C:\oberon-07\example.ob07" con 1 - "C:\oberon-07\example.ob07" obj 0x00020005 (* v2.5 *) - ‚ á«ãç ¥ ãᯥ譮© ª®¬¯¨«ï樨, ª®¬¯¨«ïâ®à ¯¥à¥¤ ¥â ª®¤ § ¢¥à襭¨ï 0, - ¨­ ç¥ 1. ਠࠡ®â¥ ª®¬¯¨«ïâ®à  ¢ KolibriOS, ª®¤ § ¢¥à襭¨ï ­¥ - ¯¥à¥¤ ¥âáï. ‘®®¡é¥­¨ï ª®¬¯¨«ïâ®à  ¢ë¢®¤ïâáï ­  ª®­á®«ì (Windows, - KolibriOS), ¢ â¥à¬¨­ « (Linux). -2.  ¯ª  Lib - ¡¨¡«¨®â¥ª  ¬®¤ã«¥© - ------------------------------------------------------------------------------- - Žâ«¨ç¨ï ®â ®à¨£¨­ «  - -1.  áè¨à¥­ ¯á¥¢¤®¬®¤ã«ì SYSTEM -2.  §à¥è¥­ ᨬ¢®« "_" ¢ ¨¤¥­â¨ä¨ª â®à å -3. „®¡ ¢«¥­ë á¨á⥬­ë¥ ä« £¨ -4. Ž¯¥à â®à CASE ॠ«¨§®¢ ­ ¢ ᮮ⢥âá⢨¨ á ᨭ⠪á¨á®¬ ¨ ᥬ ­â¨ª®© - ¤ ­­®£® ®¯¥à â®à  ¢ ï§ëª¥ Oberon (Revision 1.10.90) -5.  áè¨à¥­ ­ ¡®à áâ ­¤ àâ­ëå ¯à®æ¥¤ãà -6. ‘¥¬ ­â¨ª  ®åà ­ë/¯à®¢¥àª¨ ⨯  ãâ®ç­¥­  ¤«ï ­ã«¥¢®£® 㪠§ â¥«ï -7. ‘¥¬ ­â¨ª  DIV ¨ MOD ãâ®ç­¥­  ¤«ï ®âà¨æ â¥«ì­ëå ç¨á¥« -8. „®¡ ¢«¥­ë ®¤­®áâà®ç­ë¥ ª®¬¬¥­â à¨¨ (­ ç¨­ îâáï á ¯ àë ᨬ¢®«®¢ "//") -9.  §à¥è¥­ íªá¯®àâ ¯¥à¥¬¥­­ëå ⨯®¢ ARRAY ¨ RECORD (⮫쪮 ¤«ï ç⥭¨ï) -10.  §à¥è¥­® ­ á«¥¤®¢ ­¨¥ ®â ⨯ -㪠§ â¥«ï -11. „®¡ ¢«¥­ë ¯á¥¢¤®­¨¬ë ⨯®¢ (TYPE A = B) - ------------------------------------------------------------------------------- - Žá®¡¥­­®á⨠ॠ«¨§ æ¨¨ - -1. Žá­®¢­ë¥ ⨯ë - - ’¨¯ „¨ ¯ §®­ §­ ç¥­¨©  §¬¥à, ¡ ©â - - INTEGER -2147483648 .. 2147483647 4 - REAL 1.40E-45 .. 3.34E+38 4 - LONGREAL 4.94E-324 .. 1.70E+308 8 - CHAR ᨬ¢®« ASCII (0X .. 0FFX) 1 - BOOLEAN FALSE, TRUE 1 - SET ¬­®¦¥á⢮ ¨§ 楫ëå ç¨á¥« {0 .. 31} 4 - -2. Œ ªá¨¬ «ì­ ï ¤«¨­  ¨¤¥­â¨ä¨ª â®à®¢ - 255 ᨬ¢®«®¢ -3. Œ ªá¨¬ «ì­ ï ¤«¨­  áâப®¢ëå ª®­áâ ­â - 255 ᨬ¢®«®¢ -4. Œ ªá¨¬ «ì­ ï ¤«¨­  áâப ¨á室­®£® ª®¤  - 511 ᨬ¢®«®¢ -5. Œ ªá¨¬ «ì­ ï à §¬¥à­®áâì ®âªàëâëå ¬ áᨢ®¢ - 5 -6. Œ ªá¨¬ «ì­®¥ ª®«¨ç¥á⢮ ®¡ê¥­­ëå ⨯®¢-§ ¯¨á¥© - 2047 -7. à®æ¥¤ãà  NEW § ¯®«­ï¥â ­ã«ï¬¨ ¢ë¤¥«¥­­ë© ¡«®ª ¯ ¬ï⨠-8. ƒ«®¡ «ì­ë¥ ¨ «®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ ¨­¨æ¨ «¨§¨àãîâáï ­ã«ï¬¨ -9. ‚ ®â«¨ç¨¥ ®â ¬­®£¨å Oberon-ॠ«¨§ æ¨©, á¡®à騪 ¬ãá®à  ¨ ¤¨­ ¬¨ç¥áª ï - ¬®¤ã«ì­®áâì ®âáãâáâ¢ãîâ - ------------------------------------------------------------------------------- - ᥢ¤®¬®¤ã«ì SYSTEM - - ᥢ¤®¬®¤ã«ì SYSTEM ᮤ¥à¦¨â ­¨§ª®ã஢­¥¢ë¥ ¨ ­¥¡¥§®¯ á­ë¥ ¯à®æ¥¤ãàë, -®è¨¡ª¨ ¯à¨ ¨á¯®«ì§®¢ ­¨¨ ¯à®æ¥¤ãà ¯á¥¢¤®¬®¤ã«ï SYSTEM ¬®£ã⠯ਢ¥á⨠ª -¯®¢à¥¦¤¥­¨î ¤ ­­ëå ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨  ¢ à¨©­®¬ã § ¢¥à襭¨î ¯à®£à ¬¬ë. - - PROCEDURE ADR(v: «î¡®© ⨯): INTEGER - v - ¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨«¨ áâப®¢ ï ª®­áâ ­â ; - ¢®§¢à é ¥â  ¤à¥á v - - PROCEDURE SIZE(T): INTEGER - ¢®§¢à é ¥â à §¬¥à ⨯  T - - PROCEDURE TYPEID(T): INTEGER - T - ⨯-§ ¯¨áì ¨«¨ ⨯-㪠§ â¥«ì, - ¢®§¢à é ¥â ­®¬¥à ⨯  ¢ â ¡«¨æ¥ ⨯®¢-§ ¯¨á¥© - - PROCEDURE INF(T): T - T - REAL ¨«¨ LONGREAL, - ¢®§¢à é ¥â ᯥ樠«ì­®¥ ¢¥é¥á⢥­­®¥ §­ ç¥­¨¥ "¡¥áª®­¥ç­®áâì" - - PROCEDURE GET(a: INTEGER; - VAR v: «î¡®© ®á­®¢­®© ⨯, PROCEDURE, POINTER) - v :=  ¬ïâì[a] - - PROCEDURE PUT(a: INTEGER; x: «î¡®© ®á­®¢­®© ⨯, PROCEDURE, POINTER) -  ¬ïâì[a] := x - - PROCEDURE MOVE(Source, Dest, n: INTEGER) - Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest, - ®¡« á⨠Source ¨ Dest ­¥ ¤®«¦­ë ¯¥à¥ªà뢠âìáï - - PROCEDURE COPY(VAR Source: «î¡®© ⨯; VAR Dest: «î¡®© ⨯; n: INTEGER) - Š®¯¨àã¥â n ¡ ©â ¯ ¬ï⨠¨§ Source ¢ Dest. - ª¢¨¢ «¥­â­® - SYSTEM.MOVE(SYSTEM.ADR(Source), SYSTEM.ADR(Dest), n) - - PROCEDURE CODE(s: ARRAY OF CHAR) - ‚áâ ¢ª  ¬ è¨­­®£® ª®¤  - s - áâப®¢ ï ª®­áâ ­â  è¥áâ­ ¤æ â¨à¨ç­ëå æ¨äà - ª®«¨ç¥á⢮ æ¨äà ¤®«¦­® ¡ëâì ç¥â­ë¬ - ­ ¯à¨¬¥à: SYSTEM.CODE("B801000000") (* mov eax, 1 *) - - ’ ª¦¥ ¢ ¬®¤ã«¥ SYSTEM ®¯à¥¤¥«¥­ ⨯ CARD16 (2 ¡ ©â ). „«ï ⨯  CARD16 ­¥ -¤®¯ã᪠îâáï ­¨ª ª¨¥ ï¢­ë¥ ®¯¥à æ¨¨, §  ¨áª«î祭¨¥¬ ¯à¨á¢ ¨¢ ­¨ï. -८¡à §®¢ ­¨ï CARD16 -> INTEGER ¨ INTEGER -> CARD16 ¬®£ãâ ¡ëâì ॠ«¨§®¢ ­ë -â ª: - - PROCEDURE Card16ToInt(w: SYSTEM.CARD16): INTEGER; - VAR i: INTEGER; - BEGIN - SYSTEM.PUT(SYSTEM.ADR(i), w) - RETURN i - END Card16ToInt; - - PROCEDURE IntToCard16(i: INTEGER): SYSTEM.CARD16; - VAR w: SYSTEM.CARD16; - BEGIN - SYSTEM.GET(SYSTEM.ADR(i), w) - RETURN w - END IntToCard16; - - ”㭪樨 ¯á¥¢¤®¬®¤ã«ï SYSTEM ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ª®­áâ ­â­ëå ¢ëà ¦¥­¨ïå. - ------------------------------------------------------------------------------- - ‘¨á⥬­ë¥ ä« £¨ - - ਠ®¡ê¥­¨¨ ¯à®æ¥¤ãà­ëå ⨯®¢ ¨ £«®¡ «ì­ëå ¯à®æ¥¤ãà, ¯®á«¥ ª«î祢®£® -á«®¢  PROCEDURE ¬®¦¥â ¡ëâì 㪠§ ­ ä« £ ᮣ« è¥­¨ï ¢ë§®¢ : [stdcall], [cdecl] -¨«¨ [winapi].  ¯à¨¬¥à: - - PROCEDURE [cdecl] MyProc(x, y, z: INTEGER): INTEGER; - - …᫨ 㪠§ ­ ä« £ [winapi], â® ¯à¨­¨¬ ¥âáï ᮣ« è¥­¨¥ stdcall ¨ -¯à®æ¥¤ãàã-äã­ªæ¨î ¬®¦­® ¢ë§¢ âì ª ª ᮡá⢥­­® ¯à®æ¥¤ãàã, ¢­¥ ¢ëà ¦¥­¨ï. -”« £ [winapi] ¤®áâ㯥­ ⮫쪮 ¤«ï ¯« âä®à¬ë Windows. - ਠ®¡ê¥­¨¨ ⨯®¢-§ ¯¨á¥©, ¯®á«¥ ª«î祢®£® á«®¢  RECORD ¬®¦¥â ¡ëâì -㪠§ ­ ä« £ [noalign] ¨«¨ [union]. ”« £ [noalign] ®§­ ç ¥â ®âáãâá⢨¥ -¢ëà ¢­¨¢ ­¨ï ¯®«¥© § ¯¨á¨,   ä« £ [union] ®§­ ç ¥â, ç⮠ᬥ饭¨ï ¢á¥å ¯®«¥© -§ ¯¨á¨ à ¢­ë ­ã«î, ¯à¨ í⮬ à §¬¥à § ¯¨á¨ à ¢¥­ à §¬¥àã ­ ¨¡®«ì襣® ¯®«ï. -‡ ¯¨á¨ RECORD [union] ... END ᮮ⢥âáâ¢ãîâ ®¡ê¥¤¨­¥­¨ï¬ (union) ¢ ï§ëª¥ C. -‡ ¯¨á¨ á á¨á⥬­ë¬¨ ä« £ ¬¨ ­¥ ¬®£ãâ ¨¬¥âì ¡ §®¢®£® ⨯  ¨ ­¥ ¬®£ãâ ¡ëâì -¡ §®¢ë¬¨ ⨯ ¬¨ ¤«ï ¤àã£¨å § ¯¨á¥©. - „«ï ¨á¯®«ì§®¢ ­¨ï á¨á⥬­ëå ä« £®¢, âॡã¥âáï ¨¬¯®àâ¨à®¢ âì SYSTEM. - ------------------------------------------------------------------------------- - Ž¯¥à â®à CASE - - ‘¨­â ªá¨á ®¯¥à â®à  CASE: - - CaseStatement = - CASE Expression OF ‘ase {"|" ‘ase} - [ELSE StatementSequence] END. - Case = [CaseLabelList ":" StatementSequence]. - CaseLabelList = CaseLabels {"," CaseLabels}. - CaseLabels = ConstExpression [".." ConstExpression]. - -  ¯à¨¬¥à: - - CASE x OF - |-1: DoSomething1 - | 1: DoSomething2 - | 0: DoSomething3 - ELSE - DoSomething4 - END - - ‚ ¬¥âª å ¢ à¨ ­â®¢ ¬®¦­® ¨á¯®«ì§®¢ âì ª®­áâ ­â­ë¥ ¢ëà ¦¥­¨ï, ¢¥âª  ELSE -­¥®¡ï§ â¥«ì­ . …᫨ ­¥ ¢ë¯®«­¥­ ­¨ ®¤¨­ ¢ à¨ ­â ¨ ELSE ®âáãâáâ¢ã¥â, â® -¯à®£à ¬¬  ¯à¥à뢠¥âáï á ®è¨¡ª®© ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï. - ------------------------------------------------------------------------------- - ஢¥àª  ¨ ®åà ­  ⨯  ­ã«¥¢®£® 㪠§ â¥«ï - - Žà¨£¨­ «ì­®¥ á®®¡é¥­¨¥ ® ï§ëª¥ ­¥ ®¯à¥¤¥«ï¥â ¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë ¯à¨ -¢ë¯®«­¥­¨¨ ®åà ­ë p(T) ¨ ¯à®¢¥àª¨ ⨯  p IS T ¯à¨ p = NIL. ‚® ¬­®£¨å -Oberon-ॠ«¨§ æ¨ïå ¢ë¯®«­¥­¨¥ â ª®© ®¯¥à æ¨¨ ¯à¨¢®¤¨â ª ®è¨¡ª¥ ¢à¥¬¥­¨ -¢ë¯®«­¥­¨ï. ‚ ¤ ­­®© ॠ«¨§ æ¨¨ ®åà ­  ⨯  ­ã«¥¢®£® 㪠§ â¥«ï ­¥ ¯à¨¢®¤¨â ª -®è¨¡ª¥,   ¯à®¢¥àª  ⨯  ¤ ¥â १ã«ìâ â FALSE. ‚ à拉 á«ãç ¥¢ íâ® ¯®§¢®«ï¥â -§­ ç¨â¥«ì­® ᮪à â¨âì ç áâ®â㠯ਬ¥­¥­¨ï ®åà ­ë ⨯ . - ------------------------------------------------------------------------------- - „®¯®«­¨â¥«ì­ë¥ áâ ­¤ àâ­ë¥ ¯à®æ¥¤ãàë - - DISPOSE(VAR v: «î¡®©_㪠§ â¥«ì) - Žá¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥­­ãî ¯à®æ¥¤ãன NEW ¤«ï - ¤¨­ ¬¨ç¥áª®© ¯¥à¥¬¥­­®© v^, ¨ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© v - §­ ç¥­¨¥ NIL. - - LSR(x, n: INTEGER): INTEGER - ‹®£¨ç¥áª¨© ᤢ¨£ x ­  n ¡¨â ¢¯à ¢®. - - MIN(a, b: INTEGER): INTEGER - Œ¨­¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©. - - MAX(a, b: INTEGER): INTEGER - Œ ªá¨¬ã¬ ¨§ ¤¢ãå §­ ç¥­¨©. - - BITS(x: INTEGER): SET - ˆ­â¥à¯à¥â¨àã¥â x ª ª §­ ç¥­¨¥ ⨯  SET. - ‚믮«­ï¥âáï ­  íâ ¯¥ ª®¬¯¨«ï樨. - - LENGTH(s: ARRAY OF CHAR): INTEGER - „«¨­  0X-§ ¢¥à襭­®© áâப¨ s, ¡¥§ ãç¥â  ᨬ¢®«  0X. - …᫨ ᨬ¢®« 0X ®âáãâáâ¢ã¥â, äã­ªæ¨ï ¢®§¢à é ¥â ¤«¨­ã - ¬ áᨢ  s. - ------------------------------------------------------------------------------- - DIV ¨ MOD - - x y x DIV y x MOD y - - 5 3 1 2 - -5 3 -2 1 - 5 -3 -2 -1 - -5 -3 1 -2 - ------------------------------------------------------------------------------- - ‘ªàëâë¥ ¯ à ¬¥âàë ¯à®æ¥¤ãà - - ¥ª®â®àë¥ ¯à®æ¥¤ãàë ¬®£ãâ ¨¬¥âì áªàëâë¥ ¯ à ¬¥âàë, ®­¨ ®âáãâáâ¢ãîâ ¢ ᯨ᪥ -ä®à¬ «ì­ëå ¯ à ¬¥â஢, ­® ãç¨â뢠îâáï ª®¬¯¨«ïâ®à®¬ ¯à¨ âà ­á«ï樨 ¢ë§®¢®¢. -â® ¢®§¬®¦­® ¢ á«¥¤ãîé¨å á«ãç ïå: - -1. à®æ¥¤ãà  ¨¬¥¥â ä®à¬ «ì­ë© ¯ à ¬¥âà ®âªàëâë© ¬ áᨢ: - PROCEDURE Proc(x: ARRAY OF ARRAY OF LONGREAL); - ‚맮¢ â࠭᫨àã¥âáï â ª: - Proc(SYSTEM.ADR(x), LEN(x), LEN(x[0]) -2. à®æ¥¤ãà  ¨¬¥¥â ä®à¬ «ì­ë© ¯ à ¬¥âà-¯¥à¥¬¥­­ãî ⨯  RECORD: - PROCEDURE Proc(VAR x: Rec); - ‚맮¢ â࠭᫨àã¥âáï â ª: - Proc(SYSTEM.TYPEID(Rec), SYSTEM.ADR(x)) -3. à®æ¥¤ãà  ï¢«ï¥âáï ¢«®¦¥­­®©, £«ã¡¨­  ¢«®¦¥­¨ï k, - ¤«ï £«®¡ «ì­ëå ¯à®æ¥¤ãà k = 0: - PROCEDURE Proc(p1, ..., pn); - ‚맮¢ â࠭᫨àã¥âáï â ª: - Proc(base(k - 1), base(k - 2), ..., base(0), p1, ..., pn), - £¤¥ base(m) -  ¤à¥á ¡ §ë ª ¤à  áâíª  ®å¢ â뢠î饩 ¯à®æ¥¤ãàë £«ã¡¨­ë - ¢«®¦¥­¨ï m (¨á¯®«ì§ã¥âáï ¤«ï ¤®áâ㯠 ª «®ª «ì­ë¬ ¯¥à¥¬¥­­ë¬ - ®å¢ â뢠î饩 ¯à®æ¥¤ãàë) - ------------------------------------------------------------------------------- - Œ®¤ã«ì RTL - - ‚ᥠ¯à®£à ¬¬ë ­¥ï¢­® ¨á¯®«ì§ãîâ ¬®¤ã«ì RTL. Š®¬¯¨«ïâ®à â࠭᫨àã¥â -­¥ª®â®àë¥ ®¯¥à æ¨¨ (¯à®¢¥àª  ¨ ®åà ­  ⨯ , áà ¢­¥­¨¥ áâப, á®®¡é¥­¨ï ®¡ -®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¨ ¤à.) ª ª ¢ë§®¢ë ¯à®æ¥¤ãà í⮣® ¬®¤ã«ï. ¥ -á«¥¤ã¥â ® ¢ë§ë¢ âì í⨠¯à®æ¥¤ãàë, §  ¨áª«î祭¨¥¬ ¯à®æ¥¤ãàë SetClose: - - PROCEDURE SetClose(proc: PROC), £¤¥ TYPE PROC = PROCEDURE - -SetClose ­ §­ ç ¥â ¯à®æ¥¤ãàã proc (¡¥§ ¯ à ¬¥â஢) ¢ë§ë¢ ¥¬®© ¯à¨ ¢ë£à㧪¥ -dll-¡¨¡«¨®â¥ª¨ (Windows), ¥á«¨ ¯à¨«®¦¥­¨¥ ª®¬¯¨«¨àã¥âáï ª ª Windows DLL. „«ï -¯à®ç¨å ⨯®¢ ¯à¨«®¦¥­¨© ¨ ¯« âä®à¬ ¢ë§®¢ ¯à®æ¥¤ãàë SetClose ­¥ ¢«¨ï¥â ­  -¯®¢¥¤¥­¨¥ ¯à®£à ¬¬ë. - ‘®®¡é¥­¨ï ®¡ ®è¨¡ª å ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï ¢ë¢®¤ïâáï ¢ ¤¨ «®£®¢ëå ®ª­ å -(Windows), ¢ â¥à¬¨­ « (Linux), ­  ¤®áªã ®â« ¤ª¨ (KolibriOS). - ------------------------------------------------------------------------------- - Œ®¤ã«ì API - - ‘ãé¥áâ¢ãîâ âਠॠ«¨§ æ¨¨ ¬®¤ã«ï API: ¤«ï Windows, Linux ¨ KolibriOS. Š ª ¨ -¬®¤ã«ì RTL, ¬®¤ã«ì API ­¥ ¯à¥¤­ §­ ç¥­ ¤«ï ¯àאַ£® ¨á¯®«ì§®¢ ­¨ï. Ž­ -®¡¥á¯¥ç¨¢ ¥â ªà®áᯫ âä®à¬¥­­®áâì ª®¬¯¨«ïâ®à . - ------------------------------------------------------------------------------- - ƒ¥­¥à æ¨ï ¨á¯®«­ï¥¬ëå ä ©«®¢ DLL - -  §à¥è ¥âáï íªá¯®àâ¨à®¢ âì ⮫쪮 ¯à®æ¥¤ãàë. „«ï í⮣®, ¯à®æ¥¤ãà  ¤®«¦­  -­ å®¤¨âìáï ¢ £« ¢­®¬ ¬®¤ã«¥ ¯à®£à ¬¬ë, ¨ ¥¥ ¨¬ï ¤®«¦­® ¡ëâì ®â¬¥ç¥­® ᨬ¢®«®¬ -íªá¯®àâ  ("*"). KolibriOS DLL ¢á¥£¤  íªá¯®àâ¨àãîâ ¨¤¥­â¨ä¨ª â®àë "version" -(¢¥àá¨ï ¯à®£à ¬¬ë) ¨ "lib_init" -  ¤à¥á ¯à®æ¥¤ãàë ¨­¨æ¨ «¨§ æ¨¨ DLL: - - PROCEDURE [stdcall] lib_init(): INTEGER - -â  ¯à®æ¥¤ãà  ¤®«¦­  ¡ëâì ¢ë§¢ ­  ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ DLL. -à®æ¥¤ãà  ¢á¥£¤  ¢®§¢à é ¥â 1. - ‚ ­ áâ®ï饥 ¢à¥¬ï £¥­¥à æ¨ï DLL ¤«ï Linux ­¥ ॠ«¨§®¢ ­ . - -============================================================================== -============================================================================== - - ¨¡«¨®â¥ª  (KolibriOS) - ------------------------------------------------------------------------------- -MODULE Out - ª®­á®«ì­ë© ¢ë¢®¤ - - PROCEDURE Open - ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢ë¢®¤ - - PROCEDURE Int(x, width: INTEGER) - ¢ë¢®¤ 楫®£® ç¨á«  x; - width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤  - - PROCEDURE Real(x: LONGREAL; width: INTEGER) - ¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ ¯« ¢ î饬 ä®à¬ â¥; - width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤  - - PROCEDURE Char(x: CHAR) - ¢ë¢®¤ ᨬ¢®«  x - - PROCEDURE FixReal(x: LONGREAL; width, p: INTEGER) - ¢ë¢®¤ ¢¥é¥á⢥­­®£® ç¨á«  x ¢ 䨪á¨à®¢ ­­®¬ ä®à¬ â¥; - width - ª®«¨ç¥á⢮ §­ ª®¬¥áâ, ¨á¯®«ì§ã¥¬ëå ¤«ï ¢ë¢®¤ ; - p - ª®«¨ç¥á⢮ §­ ª®¢ ¯®á«¥ ¤¥áïâ¨ç­®© â®çª¨ - - PROCEDURE Ln - ¯¥à¥å®¤ ­  á«¥¤ãîéãî áâபã - - PROCEDURE String(s: ARRAY OF CHAR) - ¢ë¢®¤ áâப¨ s - ------------------------------------------------------------------------------- -MODULE In - ª®­á®«ì­ë© ¢¢®¤ - - VAR Done: BOOLEAN - ¯à¨­¨¬ ¥â §­ ç¥­¨¥ TRUE ¢ á«ãç ¥ ãᯥ譮£® ¢ë¯®«­¥­¨ï - ®¯¥à æ¨¨ ¢¢®¤ , ¨­ ç¥ FALSE - - PROCEDURE Open - ä®à¬ «ì­® ®âªà뢠¥â ª®­á®«ì­ë© ¢¢®¤, - â ª¦¥ ¯à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Done §­ ç¥­¨¥ TRUE - - PROCEDURE Int(VAR x: INTEGER) - ¢¢®¤ ç¨á«  ⨯  INTEGER - - PROCEDURE Char(VAR x: CHAR) - ¢¢®¤ ᨬ¢®«  - - PROCEDURE Real(VAR x: REAL) - ¢¢®¤ ç¨á«  ⨯  REAL - - PROCEDURE LongReal(VAR x: LONGREAL) - ¢¢®¤ ç¨á«  ⨯  LONGREAL - - PROCEDURE String(VAR s: ARRAY OF CHAR) - ¢¢®¤ áâப¨ - - PROCEDURE Ln - ®¦¨¤ ­¨¥ ­ ¦ â¨ï ENTER - ------------------------------------------------------------------------------- -MODULE Console - ¤®¯®«­¨â¥«ì­ë¥ ¯à®æ¥¤ãàë ª®­á®«ì­®£® ¢ë¢®¤  - - CONST - - ‘«¥¤ãî騥 ª®­áâ ­âë ®¯à¥¤¥«ïîâ 梥⠪®­á®«ì­®£® ¢ë¢®¤  - - Black = 0 Blue = 1 Green = 2 - Cyan = 3 Red = 4 Magenta = 5 - Brown = 6 LightGray = 7 DarkGray = 8 - LightBlue = 9 LightGreen = 10 LightCyan = 11 - LightRed = 12 LightMagenta = 13 Yellow = 14 - White = 15 - - PROCEDURE Cls - ®ç¨á⪠ ®ª­  ª®­á®«¨ - - PROCEDURE SetColor(FColor, BColor: INTEGER) - ãáâ ­®¢ª  æ¢¥â  ª®­á®«ì­®£® ¢ë¢®¤ : FColor - 梥â ⥪áâ , - BColor - 梥â ä®­ , ¢®§¬®¦­ë¥ §­ ç¥­¨ï - ¢ë襯¥à¥ç¨á«¥­­ë¥ - ª®­áâ ­âë - - PROCEDURE SetCursor(x, y: INTEGER) - ãáâ ­®¢ª  ªãàá®à  ª®­á®«¨ ¢ ¯®§¨æ¨î (x, y) - - PROCEDURE GetCursor(VAR x, y: INTEGER) - § ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ⥪ã騥 ª®®à¤¨­ âë ªãàá®à  ª®­á®«¨ - - PROCEDURE GetCursorX(): INTEGER - ¢®§¢à é ¥â ⥪ãéãî x-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨ - - PROCEDURE GetCursorY(): INTEGER - ¢®§¢à é ¥â ⥪ãéãî y-ª®®à¤¨­ âã ªãàá®à  ª®­á®«¨ - ------------------------------------------------------------------------------- -MODULE ConsoleLib - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ console.obj - ------------------------------------------------------------------------------- -MODULE Math - ¬ â¥¬ â¨ç¥áª¨¥ ä㭪樨 - - CONST - - pi = 3.141592653589793D+00 - e = 2.718281828459045D+00 - - VAR - - Inf, nInf: LONGREAL - ¯®«®¦¨â¥«ì­ ï ¨ ®âà¨æ â¥«ì­ ï ¡¥áª®­¥ç­®áâì - - PROCEDURE IsNan(x: LONGREAL): BOOLEAN - ¢®§¢à é ¥â TRUE, ¥á«¨ x - ­¥ ç¨á«® - - PROCEDURE IsInf(x: LONGREAL): BOOLEAN - ¢®§¢à é ¥â TRUE, ¥á«¨ x - ¡¥áª®­¥ç­®áâì - - PROCEDURE sqrt(x: LONGREAL): LONGREAL - ª¢ ¤à â­ë© ª®à¥­ì x - - PROCEDURE exp(x: LONGREAL): LONGREAL - íªá¯®­¥­â  x - - PROCEDURE ln(x: LONGREAL): LONGREAL - ­ âãà «ì­ë© «®£ à¨ä¬ x - - PROCEDURE sin(x: LONGREAL): LONGREAL - ᨭãá x - - PROCEDURE cos(x: LONGREAL): LONGREAL - ª®á¨­ãá x - - PROCEDURE tan(x: LONGREAL): LONGREAL - â ­£¥­á x - - PROCEDURE arcsin(x: LONGREAL): LONGREAL -  àªá¨­ãá x - - PROCEDURE arccos(x: LONGREAL): LONGREAL -  àªª®á¨­ãá x - - PROCEDURE arctan(x: LONGREAL): LONGREAL -  àªâ ­£¥­á x - - PROCEDURE arctan2(y, x: LONGREAL): LONGREAL -  àªâ ­£¥­á y/x - - PROCEDURE power(base, exponent: LONGREAL): LONGREAL - ¢®§¢¥¤¥­¨¥ ç¨á«  base ¢ á⥯¥­ì exponent - - PROCEDURE log(base, x: LONGREAL): LONGREAL - «®£ à¨ä¬ x ¯® ®á­®¢ ­¨î base - - PROCEDURE sinh(x: LONGREAL): LONGREAL - £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x - - PROCEDURE cosh(x: LONGREAL): LONGREAL - £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x - - PROCEDURE tanh(x: LONGREAL): LONGREAL - £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x - - PROCEDURE arcsinh(x: LONGREAL): LONGREAL - ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ᨭãá x - - PROCEDURE arccosh(x: LONGREAL): LONGREAL - ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© ª®á¨­ãá x - - PROCEDURE arctanh(x: LONGREAL): LONGREAL - ®¡à â­ë© £¨¯¥à¡®«¨ç¥áª¨© â ­£¥­á x - - PROCEDURE round(x: LONGREAL): LONGREAL - ®ªà㣫¥­¨¥ x ¤® ¡«¨¦ ©è¥£® 楫®£® - - PROCEDURE frac(x: LONGREAL): LONGREAL; - ¤à®¡­ ï ç áâì ç¨á«  x - - PROCEDURE floor(x: LONGREAL): LONGREAL - ­ ¨¡®«ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª LONGREAL), - ­¥ ¡®«ìè¥ x: floor(1.2) = 1.0 - - PROCEDURE ceil(x: LONGREAL): LONGREAL - ­ ¨¬¥­ì襥 楫®¥ ç¨á«® (¯à¥¤áâ ¢«¥­¨¥ ª ª LONGREAL), - ­¥ ¬¥­ìè¥ x: ceil(1.2) = 2.0 - - PROCEDURE sgn(x: LONGREAL): INTEGER - ¥á«¨ x > 0 ¢®§¢à é ¥â 1 - ¥á«¨ x < 0 ¢®§¢à é ¥â -1 - ¥á«¨ x = 0 ¢®§¢à é ¥â 0 - ------------------------------------------------------------------------------- -MODULE Debug - ¢ë¢®¤ ­  ¤®áªã ®â« ¤ª¨ - ˆ­â¥àä¥©á ª ª ¬®¤ã«ì Out - - PROCEDURE Open - ®âªà뢠¥â ¤®áªã ®â« ¤ª¨ - ------------------------------------------------------------------------------- -MODULE File - à ¡®â  á ä ©«®¢®© á¨á⥬®© - - TYPE - - FNAME = ARRAY 520 OF CHAR - - FS = POINTER TO rFS - - rFS = RECORD (* ¨­ä®à¬ æ¨®­­ ï áâàãªâãà  ä ©«  *) - subfunc, pos, hpos, bytes, buffer: INTEGER; - name: FNAME - END - - FD = POINTER TO rFD - - rFD = RECORD (* áâàãªâãà  ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  *) - attr: INTEGER; - ntyp: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create, date_create, - time_access, date_access, - time_modif, date_modif, - size, hsize: INTEGER; - name: FNAME - END - - CONST - - SEEK_BEG = 0 - SEEK_CUR = 1 - SEEK_END = 2 - - PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - ‡ £à㦠¥â ¢ ¯ ¬ïâì ä ©« á ¨¬¥­¥¬ FName, § ¯¨á뢠¥â ¢ ¯ à ¬¥âà - size à §¬¥à ä ©« , ¢®§¢à é ¥â  ¤à¥á § £à㦥­­®£® ä ©«  - ¨«¨ 0 (®è¨¡ª ). ਠ­¥®¡å®¤¨¬®áâ¨, à á¯ ª®¢ë¢ ¥â - ä ©« (kunpack). - - PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN - ‡ ¯¨á뢠¥â áâàãªâãàã ¡«®ª  ¤ ­­ëå ¢å®¤  ª â «®£  ¤«ï ä ©«  - ¨«¨ ¯ ¯ª¨ á ¨¬¥­¥¬ FName ¢ ¯ à ¬¥âà Info. - ਠ®è¨¡ª¥ ¢®§¢à é ¥â FALSE. - - PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN - ¢®§¢à é ¥â TRUE, ¥á«¨ ä ©« á ¨¬¥­¥¬ FName áãé¥áâ¢ã¥â - - PROCEDURE Close(VAR F: FS) - ®á¢®¡®¦¤ ¥â ¯ ¬ïâì, ¢ë¤¥«¥­­ãî ¤«ï ¨­ä®à¬ æ¨®­­®© áâàãªâãàë - ä ©«  F ¨ ¯à¨á¢ ¨¢ ¥â F §­ ç¥­¨¥ NIL - - PROCEDURE Open(FName: ARRAY OF CHAR): FS - ¢®§¢à é ¥â 㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©«  á - ¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL - - PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN - 㤠«ï¥â ä ©« á ¨¬¥­¥¬ FName, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE - - PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER - ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ç⥭¨ï-§ ¯¨á¨ ä ©«  F ­  Offset, - ®â­®á¨â¥«ì­® Origin = (SEEK_BEG - ­ ç «® ä ©« , - SEEK_CUR - ⥪ãé ï ¯®§¨æ¨ï, SEEK_END - ª®­¥æ ä ©« ), - ¢®§¢à é ¥â ¯®§¨æ¨î ®â­®á¨â¥«ì­® ­ ç «  ä ©« , ­ ¯à¨¬¥à: - Seek(F, 0, SEEK_END) - ãáâ ­ ¢«¨¢ ¥â ¯®§¨æ¨î ­  ª®­¥æ ä ©«  ¨ ¢®§¢à é ¥â ¤«¨­ã - ä ©« ; ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â -1 - - PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER - —¨â ¥â ¤ ­­ë¥ ¨§ ä ©«  ¢ ¯ ¬ïâì. F - 㪠§ â¥«ì ­  - ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« á⨠- ¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï ¯à®ç¨â âì - ¨§ ä ©« ; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® ¯à®ç¨â ­® - ¨ ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ - ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF. - - PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER - ‡ ¯¨á뢠¥â ¤ ­­ë¥ ¨§ ¯ ¬ï⨠¢ ä ©«. F - 㪠§ â¥«ì ­  - ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , Buffer -  ¤à¥á ®¡« á⨠- ¯ ¬ïâ¨, Count - ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ âॡã¥âáï § ¯¨á âì - ¢ ä ©«; ¢®§¢à é ¥â ª®«¨ç¥á⢮ ¡ ©â, ª®â®à®¥ ¡ë«® § ¯¨á ­® ¨ - ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ï¥â ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ - ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF. - - PROCEDURE Create(FName: ARRAY OF CHAR): FS - ᮧ¤ ¥â ­®¢ë© ä ©« á ¨¬¥­¥¬ FName (¯®«­®¥ ¨¬ï), ¢®§¢à é ¥â - 㪠§ â¥«ì ­  ¨­ä®à¬ æ¨®­­ãî áâàãªâãàã ä ©« , - ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â NIL - - PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN - ᮧ¤ ¥â ¯ ¯ªã á ¨¬¥­¥¬ DirName, ¢á¥ ¯à®¬¥¦ãâ®ç­ë¥ ¯ ¯ª¨ - ¤®«¦­ë áãé¥á⢮¢ âì, ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE - - PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN - 㤠«ï¥â ¯ãáâãî ¯ ¯ªã á ¨¬¥­¥¬ DirName, - ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE - - PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN - ¢®§¢à é ¥â TRUE, ¥á«¨ ¯ ¯ª  á ¨¬¥­¥¬ DirName áãé¥áâ¢ã¥â - ------------------------------------------------------------------------------- -MODULE Read - ç⥭¨¥ ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¨§ ä ©«  F - - à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ ç⥭¨ï ¨ - ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ - ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF - - PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN - - PROCEDURE LongReal(F: File.FS; VAR x: LONGREAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN - - PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN - ------------------------------------------------------------------------------- -MODULE Write - § ¯¨áì ®á­®¢­ëå ⨯®¢ ¤ ­­ëå ¢ ä ©« F - - à®æ¥¤ãàë ¢®§¢à é îâ TRUE ¢ á«ãç ¥ ãᯥ譮© ®¯¥à æ¨¨ § ¯¨á¨ ¨ - ᮮ⢥âáâ¢ãî騬 ®¡à §®¬ ¨§¬¥­ïîâ ¯®§¨æ¨î ç⥭¨ï/§ ¯¨á¨ ¢ - ¨­ä®à¬ æ¨®­­®© áâàãªâãॠF - - PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN - - PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN - - PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN - - PROCEDURE LongReal(F: File.FS; x: LONGREAL): BOOLEAN - - PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN - - PROCEDURE Set(F: File.FS; x: SET): BOOLEAN - - PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN - ------------------------------------------------------------------------------- -MODULE DateTime - ¤ â , ¢à¥¬ï - - CONST ERR = -7.0D5 - - PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) - § ¯¨á뢠¥â ¢ ¯ à ¬¥âàë ª®¬¯®­¥­âë ⥪ã饩 á¨á⥬­®© ¤ âë ¨ - ¢à¥¬¥­¨ - - PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): LONGREAL - ¢®§¢à é ¥â ¤ âã, ¯®«ã祭­ãî ¨§ ª®¬¯®­¥­â®¢ - Year, Month, Day, Hour, Min, Sec; - ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â ª®­áâ ­âã ERR = -7.0D5 - - PROCEDURE Decode(Date: LONGREAL; VAR Year, Month, Day, - Hour, Min, Sec: INTEGER): BOOLEAN - ¨§¢«¥ª ¥â ª®¬¯®­¥­âë - Year, Month, Day, Hour, Min, Sec ¨§ ¤ âë Date; - ¯à¨ ®è¨¡ª¥ ¢®§¢à é ¥â FALSE - ------------------------------------------------------------------------------- -MODULE Args - ¯ à ¬¥âàë ¯à®£à ¬¬ë - - VAR argc: INTEGER - ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ¯à®£à ¬¬ë, ¢ª«îç ï ¨¬ï - ¨á¯®«­ï¥¬®£® ä ©«  - - PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) - § ¯¨á뢠¥â ¢ áâபã s n-© ¯ à ¬¥âà ¯à®£à ¬¬ë, - ­ã¬¥à æ¨ï ¯ à ¬¥â஢ ®â 0 ¤® argc - 1, - ­ã«¥¢®© ¯ à ¬¥âà -- ¨¬ï ¨á¯®«­ï¥¬®£® ä ©«  - ------------------------------------------------------------------------------- -MODULE KOSAPI - - PROCEDURE sysfunc1(arg1: INTEGER): INTEGER - PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER - ... - PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER - Ž¡¥à⪨ ¤«ï ä㭪権 API ï¤à  KolibriOS. - arg1 .. arg7 ᮮ⢥âáâ¢ãîâ ॣ¨áâà ¬ - eax, ebx, ecx, edx, esi, edi, ebp; - ¢®§¢à é îâ §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ . - - PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER - Ž¡¥à⪠ ¤«ï ä㭪権 API ï¤à  KolibriOS. - arg1 - ॣ¨áâà eax, arg2 - ॣ¨áâà ebx, - res2 - §­ ç¥­¨¥ ॣ¨áâà  ebx ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ ; - ¢®§¢à é ¥â §­ ç¥­¨¥ ॣ¨áâà  eax ¯®á«¥ á¨á⥬­®£® ¢ë§®¢ . - - PROCEDURE malloc(size: INTEGER): INTEGER - ‚뤥«ï¥â ¡«®ª ¯ ¬ïâ¨. - size - à §¬¥à ¡«®ª  ¢ ¡ ©â å, - ¢®§¢à é ¥â  ¤à¥á ¢ë¤¥«¥­­®£® ¡«®ª  - - PROCEDURE free(ptr: INTEGER): INTEGER - Žá¢®¡®¦¤ ¥â à ­¥¥ ¢ë¤¥«¥­­ë© ¡«®ª ¯ ¬ïâ¨ á  ¤à¥á®¬ ptr, - ¢®§¢à é ¥â 0 - - PROCEDURE realloc(ptr, size: INTEGER): INTEGER - ¥à¥à á¯à¥¤¥«ï¥â ¡«®ª ¯ ¬ïâ¨, - ptr -  ¤à¥á à ­¥¥ ¢ë¤¥«¥­­®£® ¡«®ª , - size - ­®¢ë© à §¬¥à, - ¢®§¢à é ¥â 㪠§ â¥«ì ­  ¯¥à¥à á¯à¥¤¥«¥­­ë© ¡«®ª, - 0 ¯à¨ ®è¨¡ª¥ - - PROCEDURE GetCommandLine(): INTEGER - ‚®§¢à é ¥â  ¤à¥á áâப¨ ¯ à ¬¥â஢ - - PROCEDURE GetName(): INTEGER - ‚®§¢à é ¥â  ¤à¥á áâப¨ á ¨¬¥­¥¬ ¯à®£à ¬¬ë - - PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER - ‡ £à㦠¥â DLL á ¯®«­ë¬ ¨¬¥­¥¬ name. ‚®§¢à é ¥â  ¤à¥á â ¡«¨æë - íªá¯®àâ . ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0. - - PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER - name - ¨¬ï ¯à®æ¥¤ãàë - lib -  ¤à¥á â ¡«¨æë íªá¯®àâ  DLL - ‚®§¢à é ¥â  ¤à¥á ¯à®æ¥¤ãàë. ਠ®è¨¡ª¥ ¢®§¢à é ¥â 0. - ------------------------------------------------------------------------------- -MODULE ColorDlg - à ¡®â  á ¤¨ «®£®¬ "Color Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *) - status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ : - 0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel - 1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK - 2 - ¤¨ «®£ ®âªàëâ *) - - color: INTEGER (* ¢ë¡à ­­ë© 梥â *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog - ᮧ¤ âì ¤¨ «®£ - draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­  - (TYPE DRAW_WINDOW = PROCEDURE); - ¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  - - PROCEDURE Show(cd: Dialog) - ¯®ª § âì ¤¨ «®£ - cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥ - ¯à®æ¥¤ãன Create - - PROCEDURE Destroy(VAR cd: Dialog) - ã­¨ç⮦¨âì ¤¨ «®£ - cd - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  - ------------------------------------------------------------------------------- -MODULE OpenDlg - à ¡®â  á ¤¨ «®£®¬ "Open Dialog" - - TYPE - - Dialog = POINTER TO RECORD (* áâàãªâãà  ¤¨ «®£  *) - status: INTEGER (* á®áâ®ï­¨¥ ¤¨ «®£ : - 0 - ¯®«ì§®¢ â¥«ì ­ ¦ « Cancel - 1 - ¯®«ì§®¢ â¥«ì ­ ¦ « OK - 2 - ¤¨ «®£ ®âªàëâ *) - - FileName: ARRAY 4096 OF CHAR (* ¨¬ï ¢ë¡à ­­®£® ä ©«  *) - FilePath: ARRAY 4096 OF CHAR (* ¯®«­®¥ ¨¬ï ¢ë¡à ­­®£® - ä ©«  *) - END - - PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, - filter: ARRAY OF CHAR): Dialog - ᮧ¤ âì ¤¨ «®£ - draw_window - ¯à®æ¥¤ãà  ¯¥à¥à¨á®¢ª¨ ®á­®¢­®£® ®ª­  - (TYPE DRAW_WINDOW = PROCEDURE) - type - ⨯ ¤¨ «®£  - 0 - ®âªàëâì - 1 - á®åà ­¨âì - 2 - ¢ë¡à âì ¯ ¯ªã - def_path - ¯ãâì ¯® 㬮«ç ­¨î, ¯ ¯ª  def_path ¡ã¤¥â ®âªàëâ  - ¯à¨ ¯¥à¢®¬ § ¯ã᪥ ¤¨ «®£  - filter - ¢ áâப¥ § ¯¨á ­® ¯¥à¥ç¨á«¥­¨¥ à áè¨à¥­¨© ä ©«®¢, - ª®â®àë¥ ¡ã¤ãâ ¯®ª § ­ë ¢ ¤¨ «®£®¢®¬ ®ª­¥, à áè¨à¥­¨ï - à §¤¥«ïîâáï ᨬ¢®«®¬ "|", ­ ¯à¨¬¥à: "ASM|TXT|INI" - ¯à®æ¥¤ãà  ¢®§¢à é ¥â 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  - - PROCEDURE Show(od: Dialog; Width, Height: INTEGER) - ¯®ª § âì ¤¨ «®£ - od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£ , ª®â®àë© ¡ë« ᮧ¤ ­ à ­¥¥ - ¯à®æ¥¤ãன Create - Width ¨ Height - è¨à¨­  ¨ ¢ëá®â  ¤¨ «®£®¢®£® ®ª­  - - PROCEDURE Destroy(VAR od: Dialog) - ã­¨ç⮦¨âì ¤¨ «®£ - od - 㪠§ â¥«ì ­  áâàãªâãàã ¤¨ «®£  - ------------------------------------------------------------------------------- -MODULE kfonts - à ¡®â  á kf-èà¨äâ ¬¨ - - CONST - - bold = 1 - italic = 2 - underline = 4 - strike_through = 8 - smoothing = 16 - bpp32 = 32 - - TYPE - - TFont = POINTER TO TFont_desc (* 㪠§ â¥«ì ­  èà¨äâ *) - - PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont - § £à㧨âì èà¨äâ ¨§ ä ©«  - file_name ¨¬ï kf-ä ©«  - १-â: 㪠§ â¥«ì ­  èà¨äâ/NIL (®è¨¡ª ) - - PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN - ãáâ ­®¢¨âì à §¬¥à èà¨äâ  - Font 㪠§ â¥«ì ­  èà¨äâ - font_size à §¬¥à èà¨äâ  - १-â: TRUE/FALSE (®è¨¡ª ) - - PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN - ¯à®¢¥à¨âì, ¥áâì «¨ èà¨äâ, § ¤ ­­®£® à §¬¥à  - Font 㪠§ â¥«ì ­  èà¨äâ - font_size à §¬¥à èà¨äâ  - १-â: TRUE/FALSE (èà¨äâ  ­¥â) - - PROCEDURE Destroy(VAR Font: TFont) - ¢ë£à㧨âì èà¨äâ, ®á¢®¡®¤¨âì ¤¨­ ¬¨ç¥áªãî ¯ ¬ïâì - Font 㪠§ â¥«ì ­  èà¨äâ - à¨á¢ ¨¢ ¥â ¯¥à¥¬¥­­®© Font §­ ç¥­¨¥ NIL - - PROCEDURE TextHeight(Font: TFont): INTEGER - ¯®«ãç¨âì ¢ëá®âã áâப¨ ⥪áâ  - Font 㪠§ â¥«ì ­  èà¨äâ - १-â: ¢ëá®â  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå - - PROCEDURE TextWidth(Font: TFont; - str, length, params: INTEGER): INTEGER - ¯®«ãç¨âì è¨à¨­ã áâப¨ ⥪áâ  - Font 㪠§ â¥«ì ­  èà¨äâ - str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251 - length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப  - § ¢¥àè ¥âáï ­ã«¥¬ - params ¯ à ¬¥âàë-ä« £¨ á¬. ­¨¦¥ - १-â: è¨à¨­  áâப¨ ⥪áâ  ¢ ¯¨ªá¥«ïå - - PROCEDURE TextOut(Font: TFont; - canvas, x, y, str, length, color, params: INTEGER) - ¢ë¢¥á⨠⥪áâ ¢ ¡ãä¥à - ¤«ï ¢ë¢®¤  ¡ãä¥à  ¢ ®ª­®, ¨á¯®«ì§®¢ âì ä.65 ¨«¨ - ä.7 (¥á«¨ ¡ãä¥à 24-¡¨â­ë©) - Font 㪠§ â¥«ì ­  èà¨äâ - canvas  ¤à¥á £à ä¨ç¥áª®£® ¡ãä¥à  - áâàãªâãà  ¡ãä¥à : - Xsize dd - Ysize dd - picture rb Xsize * Ysize * 4 (32 ¡¨â ) - ¨«¨ Xsize * Ysize * 3 (24 ¡¨â ) - x, y ª®®à¤¨­ âë ⥪áâ  ®â­®á¨â¥«ì­® «¥¢®£® ¢¥àå­¥£® - 㣫  ¡ãä¥à  - str  ¤à¥á áâப¨ ⥪áâ  ¢ ª®¤¨à®¢ª¥ Win-1251 - length ª®«¨ç¥á⢮ ᨬ¢®«®¢ ¢ áâப¥ ¨«¨ -1, ¥á«¨ áâப  - § ¢¥àè ¥âáï ­ã«¥¬ - color 梥â ⥪áâ  0x00RRGGBB - params ¯ à ¬¥âàë-ä« £¨: - 1 ¦¨à­ë© - 2 ªãàᨢ - 4 ¯®¤ç¥àª­ãâë© - 8 ¯¥à¥ç¥àª­ãâë© - 16 ¯à¨¬¥­¨âì ᣫ ¦¨¢ ­¨¥ - 32 ¢ë¢®¤ ¢ 32-¡¨â­ë© ¡ãä¥à - ¢®§¬®¦­® ¨á¯®«ì§®¢ ­¨¥ ä« £®¢ ¢ «î¡ëå á®ç¥â ­¨ïå ------------------------------------------------------------------------------- -MODULE RasterWorks - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ Rasterworks.obj ------------------------------------------------------------------------------- -MODULE libimg - ®¡¥à⪠ ¡¨¡«¨®â¥ª¨ libimg.obj ------------------------------------------------------------------------------- -MODULE NetDevices - ®¡¥à⪠ ¤«ï ä.74 (à ¡®â  á á¥â¥¢ë¬¨ ãáâனá⢠¬¨) ------------------------------------------------------------------------------- \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/KOSLib1251.txt b/programs/develop/oberon07/Docs/KOSLib1251.txt new file mode 100644 index 0000000000..0f8175a68e --- /dev/null +++ b/programs/develop/oberon07/Docs/KOSLib1251.txt @@ -0,0 +1,563 @@ +============================================================================== + + Áèáëèîòåêà (KolibriOS) + +------------------------------------------------------------------------------ +MODULE Out - êîíñîëüíûé âûâîä + + PROCEDURE Open + ôîðìàëüíî îòêðûâàåò êîíñîëüíûé âûâîä + + PROCEDURE Int(x, width: INTEGER) + âûâîä öåëîãî ÷èñëà x; + width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà + + PROCEDURE Real(x: REAL; width: INTEGER) + âûâîä âåùåñòâåííîãî ÷èñëà x â ïëàâàþùåì ôîðìàòå; + width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà + + PROCEDURE Char(x: CHAR) + âûâîä ñèìâîëà x + + PROCEDURE FixReal(x: REAL; width, p: INTEGER) + âûâîä âåùåñòâåííîãî ÷èñëà x â ôèêñèðîâàííîì ôîðìàòå; + width - êîëè÷åñòâî çíàêîìåñò, èñïîëüçóåìûõ äëÿ âûâîäà; + p - êîëè÷åñòâî çíàêîâ ïîñëå äåñÿòè÷íîé òî÷êè + + PROCEDURE Ln + ïåðåõîä íà ñëåäóþùóþ ñòðîêó + + PROCEDURE String(s: ARRAY OF CHAR) + âûâîä ñòðîêè s + +------------------------------------------------------------------------------ +MODULE In - êîíñîëüíûé ââîä + + VAR Done: BOOLEAN + ïðèíèìàåò çíà÷åíèå TRUE â ñëó÷àå óñïåøíîãî âûïîëíåíèÿ + îïåðàöèè ââîäà, èíà÷å FALSE + + PROCEDURE Open + ôîðìàëüíî îòêðûâàåò êîíñîëüíûé ââîä, + òàêæå ïðèñâàèâàåò ïåðåìåííîé Done çíà÷åíèå TRUE + + PROCEDURE Int(VAR x: INTEGER) + ââîä ÷èñëà òèïà INTEGER + + PROCEDURE Char(VAR x: CHAR) + ââîä ñèìâîëà + + PROCEDURE Real(VAR x: REAL) + ââîä ÷èñëà òèïà REAL + + PROCEDURE String(VAR s: ARRAY OF CHAR) + ââîä ñòðîêè + + PROCEDURE Ln + îæèäàíèå íàæàòèÿ ENTER + +------------------------------------------------------------------------------ +MODULE Console - äîïîëíèòåëüíûå ïðîöåäóðû êîíñîëüíîãî âûâîäà + + CONST + + Ñëåäóþùèå êîíñòàíòû îïðåäåëÿþò öâåò êîíñîëüíîãî âûâîäà + + Black = 0 Blue = 1 Green = 2 + Cyan = 3 Red = 4 Magenta = 5 + Brown = 6 LightGray = 7 DarkGray = 8 + LightBlue = 9 LightGreen = 10 LightCyan = 11 + LightRed = 12 LightMagenta = 13 Yellow = 14 + White = 15 + + PROCEDURE Cls + î÷èñòêà îêíà êîíñîëè + + PROCEDURE SetColor(FColor, BColor: INTEGER) + óñòàíîâêà öâåòà êîíñîëüíîãî âûâîäà: FColor - öâåò òåêñòà, + BColor - öâåò ôîíà, âîçìîæíûå çíà÷åíèÿ - âûøåïåðå÷èñëåííûå + êîíñòàíòû + + PROCEDURE SetCursor(x, y: INTEGER) + óñòàíîâêà êóðñîðà êîíñîëè â ïîçèöèþ (x, y) + + PROCEDURE GetCursor(VAR x, y: INTEGER) + çàïèñûâàåò â ïàðàìåòðû òåêóùèå êîîðäèíàòû êóðñîðà êîíñîëè + + PROCEDURE GetCursorX(): INTEGER + âîçâðàùàåò òåêóùóþ x-êîîðäèíàòó êóðñîðà êîíñîëè + + PROCEDURE GetCursorY(): INTEGER + âîçâðàùàåò òåêóùóþ y-êîîðäèíàòó êóðñîðà êîíñîëè + +------------------------------------------------------------------------------ +MODULE ConsoleLib - îáåðòêà áèáëèîòåêè console.obj + +------------------------------------------------------------------------------ +MODULE Math - ìàòåìàòè÷åñêèå ôóíêöèè + + CONST + + pi = 3.141592653589793D+00 + e = 2.718281828459045D+00 + + + PROCEDURE IsNan(x: REAL): BOOLEAN + âîçâðàùàåò TRUE, åñëè x - íå ÷èñëî + + PROCEDURE IsInf(x: REAL): BOOLEAN + âîçâðàùàåò TRUE, åñëè x - áåñêîíå÷íîñòü + + PROCEDURE sqrt(x: REAL): REAL + êâàäðàòíûé êîðåíü x + + PROCEDURE exp(x: REAL): REAL + ýêñïîíåíòà x + + PROCEDURE ln(x: REAL): REAL + íàòóðàëüíûé ëîãàðèôì x + + PROCEDURE sin(x: REAL): REAL + ñèíóñ x + + PROCEDURE cos(x: REAL): REAL + êîñèíóñ x + + PROCEDURE tan(x: REAL): REAL + òàíãåíñ x + + PROCEDURE arcsin(x: REAL): REAL + àðêñèíóñ x + + PROCEDURE arccos(x: REAL): REAL + àðêêîñèíóñ x + + PROCEDURE arctan(x: REAL): REAL + àðêòàíãåíñ x + + PROCEDURE arctan2(y, x: REAL): REAL + àðêòàíãåíñ y/x + + PROCEDURE power(base, exponent: REAL): REAL + âîçâåäåíèå ÷èñëà base â ñòåïåíü exponent + + PROCEDURE log(base, x: REAL): REAL + ëîãàðèôì x ïî îñíîâàíèþ base + + PROCEDURE sinh(x: REAL): REAL + ãèïåðáîëè÷åñêèé ñèíóñ x + + PROCEDURE cosh(x: REAL): REAL + ãèïåðáîëè÷åñêèé êîñèíóñ x + + PROCEDURE tanh(x: REAL): REAL + ãèïåðáîëè÷åñêèé òàíãåíñ x + + PROCEDURE arcsinh(x: REAL): REAL + îáðàòíûé ãèïåðáîëè÷åñêèé ñèíóñ x + + PROCEDURE arccosh(x: REAL): REAL + îáðàòíûé ãèïåðáîëè÷åñêèé êîñèíóñ x + + PROCEDURE arctanh(x: REAL): REAL + îáðàòíûé ãèïåðáîëè÷åñêèé òàíãåíñ x + + PROCEDURE round(x: REAL): REAL + îêðóãëåíèå x äî áëèæàéøåãî öåëîãî + + PROCEDURE frac(x: REAL): REAL; + äðîáíàÿ ÷àñòü ÷èñëà x + + PROCEDURE floor(x: REAL): REAL + íàèáîëüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL), + íå áîëüøå x: floor(1.2) = 1.0 + + PROCEDURE ceil(x: REAL): REAL + íàèìåíüøåå öåëîå ÷èñëî (ïðåäñòàâëåíèå êàê REAL), + íå ìåíüøå x: ceil(1.2) = 2.0 + + PROCEDURE sgn(x: REAL): INTEGER + åñëè x > 0 âîçâðàùàåò 1 + åñëè x < 0 âîçâðàùàåò -1 + åñëè x = 0 âîçâðàùàåò 0 + +------------------------------------------------------------------------------ +MODULE Debug - âûâîä íà äîñêó îòëàäêè + Èíòåðôåéñ êàê ìîäóëü Out + + PROCEDURE Open + îòêðûâàåò äîñêó îòëàäêè + +------------------------------------------------------------------------------ +MODULE File - ðàáîòà ñ ôàéëîâîé ñèñòåìîé + + TYPE + + FNAME = ARRAY 520 OF CHAR + + FS = POINTER TO rFS + + rFS = RECORD (* èíôîðìàöèîííàÿ ñòðóêòóðà ôàéëà *) + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END + + FD = POINTER TO rFD + + rFD = RECORD (* ñòðóêòóðà áëîêà äàííûõ âõîäà êàòàëîãà *) + attr: INTEGER; + ntyp: CHAR; + reserved: ARRAY 3 OF CHAR; + time_create, date_create, + time_access, date_access, + time_modif, date_modif, + size, hsize: INTEGER; + name: FNAME + END + + CONST + + SEEK_BEG = 0 + SEEK_CUR = 1 + SEEK_END = 2 + + PROCEDURE Load(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; + Çàãðóæàåò â ïàìÿòü ôàéë ñ èìåíåì FName, çàïèñûâàåò â ïàðàìåòð + size ðàçìåð ôàéëà, âîçâðàùàåò àäðåñ çàãðóæåííîãî ôàéëà + èëè 0 (îøèáêà). Ïðè íåîáõîäèìîñòè, ðàñïàêîâûâàåò + ôàéë (kunpack). + + PROCEDURE GetFileInfo(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN + Çàïèñûâàåò ñòðóêòóðó áëîêà äàííûõ âõîäà êàòàëîãà äëÿ ôàéëà + èëè ïàïêè ñ èìåíåì FName â ïàðàìåòð Info. + Ïðè îøèáêå âîçâðàùàåò FALSE. + + PROCEDURE Exists(FName: ARRAY OF CHAR): BOOLEAN + âîçâðàùàåò TRUE, åñëè ôàéë ñ èìåíåì FName ñóùåñòâóåò + + PROCEDURE Close(VAR F: FS) + îñâîáîæäàåò ïàìÿòü, âûäåëåííóþ äëÿ èíôîðìàöèîííîé ñòðóêòóðû + ôàéëà F è ïðèñâàèâàåò F çíà÷åíèå NIL + + PROCEDURE Open(FName: ARRAY OF CHAR): FS + âîçâðàùàåò óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà ñ + èìåíåì FName, ïðè îøèáêå âîçâðàùàåò NIL + + PROCEDURE Delete(FName: ARRAY OF CHAR): BOOLEAN + óäàëÿåò ôàéë ñ èìåíåì FName, ïðè îøèáêå âîçâðàùàåò FALSE + + PROCEDURE Seek(F: FS; Offset, Origin: INTEGER): INTEGER + óñòàíàâëèâàåò ïîçèöèþ ÷òåíèÿ-çàïèñè ôàéëà F íà Offset, + îòíîñèòåëüíî Origin = (SEEK_BEG - íà÷àëî ôàéëà, + SEEK_CUR - òåêóùàÿ ïîçèöèÿ, SEEK_END - êîíåö ôàéëà), + âîçâðàùàåò ïîçèöèþ îòíîñèòåëüíî íà÷àëà ôàéëà, íàïðèìåð: + Seek(F, 0, SEEK_END) + óñòàíàâëèâàåò ïîçèöèþ íà êîíåö ôàéëà è âîçâðàùàåò äëèíó + ôàéëà; ïðè îøèáêå âîçâðàùàåò -1 + + PROCEDURE Read(F: FS; Buffer, Count: INTEGER): INTEGER + ×èòàåò äàííûå èç ôàéëà â ïàìÿòü. F - óêàçàòåëü íà + èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè + ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ ïðî÷èòàòü + èç ôàéëà; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî ïðî÷èòàíî + è ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â + èíôîðìàöèîííîé ñòðóêòóðå F. + + PROCEDURE Write(F: FS; Buffer, Count: INTEGER): INTEGER + Çàïèñûâàåò äàííûå èç ïàìÿòè â ôàéë. F - óêàçàòåëü íà + èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, Buffer - àäðåñ îáëàñòè + ïàìÿòè, Count - êîëè÷åñòâî áàéò, êîòîðîå òðåáóåòñÿ çàïèñàòü + â ôàéë; âîçâðàùàåò êîëè÷åñòâî áàéò, êîòîðîå áûëî çàïèñàíî è + ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿåò ïîçèöèþ ÷òåíèÿ/çàïèñè â + èíôîðìàöèîííîé ñòðóêòóðå F. + + PROCEDURE Create(FName: ARRAY OF CHAR): FS + ñîçäàåò íîâûé ôàéë ñ èìåíåì FName (ïîëíîå èìÿ), âîçâðàùàåò + óêàçàòåëü íà èíôîðìàöèîííóþ ñòðóêòóðó ôàéëà, + ïðè îøèáêå âîçâðàùàåò NIL + + PROCEDURE CreateDir(DirName: ARRAY OF CHAR): BOOLEAN + ñîçäàåò ïàïêó ñ èìåíåì DirName, âñå ïðîìåæóòî÷íûå ïàïêè + äîëæíû ñóùåñòâîâàòü, ïðè îøèáêå âîçâðàùàåò FALSE + + PROCEDURE DeleteDir(DirName: ARRAY OF CHAR): BOOLEAN + óäàëÿåò ïóñòóþ ïàïêó ñ èìåíåì DirName, + ïðè îøèáêå âîçâðàùàåò FALSE + + PROCEDURE DirExists(DirName: ARRAY OF CHAR): BOOLEAN + âîçâðàùàåò TRUE, åñëè ïàïêà ñ èìåíåì DirName ñóùåñòâóåò + +------------------------------------------------------------------------------ +MODULE Read - ÷òåíèå îñíîâíûõ òèïîâ äàííûõ èç ôàéëà F + + Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè ÷òåíèÿ è + ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â + èíôîðìàöèîííîé ñòðóêòóðå F + + PROCEDURE Char(F: File.FS; VAR x: CHAR): BOOLEAN + + PROCEDURE Int(F: File.FS; VAR x: INTEGER): BOOLEAN + + PROCEDURE Real(F: File.FS; VAR x: REAL): BOOLEAN + + PROCEDURE Boolean(F: File.FS; VAR x: BOOLEAN): BOOLEAN + + PROCEDURE Set(F: File.FS; VAR x: SET): BOOLEAN + + PROCEDURE Card16(F: File.FS; VAR x: SYSTEM.CARD16): BOOLEAN + +------------------------------------------------------------------------------ +MODULE Write - çàïèñü îñíîâíûõ òèïîâ äàííûõ â ôàéë F + + Ïðîöåäóðû âîçâðàùàþò TRUE â ñëó÷àå óñïåøíîé îïåðàöèè çàïèñè è + ñîîòâåòñòâóþùèì îáðàçîì èçìåíÿþò ïîçèöèþ ÷òåíèÿ/çàïèñè â + èíôîðìàöèîííîé ñòðóêòóðå F + + PROCEDURE Char(F: File.FS; x: CHAR): BOOLEAN + + PROCEDURE Int(F: File.FS; x: INTEGER): BOOLEAN + + PROCEDURE Real(F: File.FS; x: REAL): BOOLEAN + + PROCEDURE Boolean(F: File.FS; x: BOOLEAN): BOOLEAN + + PROCEDURE Set(F: File.FS; x: SET): BOOLEAN + + PROCEDURE Card16(F: File.FS; x: SYSTEM.CARD16): BOOLEAN + +------------------------------------------------------------------------------ +MODULE DateTime - äàòà, âðåìÿ + + CONST ERR = -7.0E5 + + PROCEDURE Now(VAR Year, Month, Day, Hour, Min, Sec: INTEGER) + çàïèñûâàåò â ïàðàìåòðû êîìïîíåíòû òåêóùåé ñèñòåìíîé äàòû è + âðåìåíè + + PROCEDURE Encode(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL + âîçâðàùàåò äàòó, ïîëó÷åííóþ èç êîìïîíåíòîâ + Year, Month, Day, Hour, Min, Sec; + ïðè îøèáêå âîçâðàùàåò êîíñòàíòó ERR = -7.0D5 + + PROCEDURE Decode(Date: REAL; VAR Year, Month, Day, + Hour, Min, Sec: INTEGER): BOOLEAN + èçâëåêàåò êîìïîíåíòû + Year, Month, Day, Hour, Min, Sec èç äàòû Date; + ïðè îøèáêå âîçâðàùàåò FALSE + +------------------------------------------------------------------------------ +MODULE Args - ïàðàìåòðû ïðîãðàììû + + VAR argc: INTEGER + êîëè÷åñòâî ïàðàìåòðîâ ïðîãðàììû, âêëþ÷àÿ èìÿ + èñïîëíÿåìîãî ôàéëà + + PROCEDURE GetArg(n: INTEGER; VAR s: ARRAY OF CHAR) + çàïèñûâàåò â ñòðîêó s n-é ïàðàìåòð ïðîãðàììû, + íóìåðàöèÿ ïàðàìåòðîâ îò 0 äî argc - 1, + íóëåâîé ïàðàìåòð -- èìÿ èñïîëíÿåìîãî ôàéëà + +------------------------------------------------------------------------------ +MODULE KOSAPI + + PROCEDURE sysfunc1(arg1: INTEGER): INTEGER + PROCEDURE sysfunc2(arg1, arg2: INTEGER): INTEGER + ... + PROCEDURE sysfunc7(arg1, arg2, ..., arg7: INTEGER): INTEGER + Îáåðòêè äëÿ ôóíêöèé API ÿäðà KolibriOS. + arg1 .. arg7 ñîîòâåòñòâóþò ðåãèñòðàì + eax, ebx, ecx, edx, esi, edi, ebp; + âîçâðàùàþò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. + + PROCEDURE sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER + Îáåðòêà äëÿ ôóíêöèé API ÿäðà KolibriOS. + arg1 - ðåãèñòð eax, arg2 - ðåãèñòð ebx, + res2 - çíà÷åíèå ðåãèñòðà ebx ïîñëå ñèñòåìíîãî âûçîâà; + âîçâðàùàåò çíà÷åíèå ðåãèñòðà eax ïîñëå ñèñòåìíîãî âûçîâà. + + PROCEDURE malloc(size: INTEGER): INTEGER + Âûäåëÿåò áëîê ïàìÿòè. + size - ðàçìåð áëîêà â áàéòàõ, + âîçâðàùàåò àäðåñ âûäåëåííîãî áëîêà + + PROCEDURE free(ptr: INTEGER): INTEGER + Îñâîáîæäàåò ðàíåå âûäåëåííûé áëîê ïàìÿòè ñ àäðåñîì ptr, + âîçâðàùàåò 0 + + PROCEDURE realloc(ptr, size: INTEGER): INTEGER + Ïåðåðàñïðåäåëÿåò áëîê ïàìÿòè, + ptr - àäðåñ ðàíåå âûäåëåííîãî áëîêà, + size - íîâûé ðàçìåð, + âîçâðàùàåò óêàçàòåëü íà ïåðåðàñïðåäåëåííûé áëîê, + 0 ïðè îøèáêå + + PROCEDURE GetCommandLine(): INTEGER + Âîçâðàùàåò àäðåñ ñòðîêè ïàðàìåòðîâ + + PROCEDURE GetName(): INTEGER + Âîçâðàùàåò àäðåñ ñòðîêè ñ èìåíåì ïðîãðàììû + + PROCEDURE LoadLib(name: ARRAY OF CHAR): INTEGER + Çàãðóæàåò DLL ñ ïîëíûì èìåíåì name. Âîçâðàùàåò àäðåñ òàáëèöû + ýêñïîðòà. Ïðè îøèáêå âîçâðàùàåò 0. + + PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER + name - èìÿ ïðîöåäóðû + lib - àäðåñ òàáëèöû ýêñïîðòà DLL + Âîçâðàùàåò àäðåñ ïðîöåäóðû. Ïðè îøèáêå âîçâðàùàåò 0. + +------------------------------------------------------------------------------ +MODULE ColorDlg - ðàáîòà ñ äèàëîãîì "Color Dialog" + + TYPE + + Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) + status: INTEGER (* ñîñòîÿíèå äèàëîãà: + 0 - ïîëüçîâàòåëü íàæàë Cancel + 1 - ïîëüçîâàòåëü íàæàë OK + 2 - äèàëîã îòêðûò *) + + color: INTEGER (* âûáðàííûé öâåò *) + END + + PROCEDURE Create(draw_window: DRAW_WINDOW): Dialog + ñîçäàòü äèàëîã + draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà + (TYPE DRAW_WINDOW = PROCEDURE); + ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà + + PROCEDURE Show(cd: Dialog) + ïîêàçàòü äèàëîã + cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå + ïðîöåäóðîé Create + + PROCEDURE Destroy(VAR cd: Dialog) + óíè÷òîæèòü äèàëîã + cd - óêàçàòåëü íà ñòðóêòóðó äèàëîãà + +------------------------------------------------------------------------------ +MODULE OpenDlg - ðàáîòà ñ äèàëîãîì "Open Dialog" + + TYPE + + Dialog = POINTER TO RECORD (* ñòðóêòóðà äèàëîãà *) + status: INTEGER (* ñîñòîÿíèå äèàëîãà: + 0 - ïîëüçîâàòåëü íàæàë Cancel + 1 - ïîëüçîâàòåëü íàæàë OK + 2 - äèàëîã îòêðûò *) + + FileName: ARRAY 4096 OF CHAR (* èìÿ âûáðàííîãî ôàéëà *) + FilePath: ARRAY 4096 OF CHAR (* ïîëíîå èìÿ âûáðàííîãî + ôàéëà *) + END + + PROCEDURE Create(draw_window: DRAW_WINDOW; type: INTEGER; def_path, + filter: ARRAY OF CHAR): Dialog + ñîçäàòü äèàëîã + draw_window - ïðîöåäóðà ïåðåðèñîâêè îñíîâíîãî îêíà + (TYPE DRAW_WINDOW = PROCEDURE) + type - òèï äèàëîãà + 0 - îòêðûòü + 1 - ñîõðàíèòü + 2 - âûáðàòü ïàïêó + def_path - ïóòü ïî óìîë÷àíèþ, ïàïêà def_path áóäåò îòêðûòà + ïðè ïåðâîì çàïóñêå äèàëîãà + filter - â ñòðîêå çàïèñàíî ïåðå÷èñëåíèå ðàñøèðåíèé ôàéëîâ, + êîòîðûå áóäóò ïîêàçàíû â äèàëîãîâîì îêíå, ðàñøèðåíèÿ + ðàçäåëÿþòñÿ ñèìâîëîì "|", íàïðèìåð: "ASM|TXT|INI" + ïðîöåäóðà âîçâðàùàåò óêàçàòåëü íà ñòðóêòóðó äèàëîãà + + PROCEDURE Show(od: Dialog; Width, Height: INTEGER) + ïîêàçàòü äèàëîã + od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà, êîòîðûé áûë ñîçäàí ðàíåå + ïðîöåäóðîé Create + Width è Height - øèðèíà è âûñîòà äèàëîãîâîãî îêíà + + PROCEDURE Destroy(VAR od: Dialog) + óíè÷òîæèòü äèàëîã + od - óêàçàòåëü íà ñòðóêòóðó äèàëîãà + +------------------------------------------------------------------------------ +MODULE kfonts - ðàáîòà ñ kf-øðèôòàìè + + CONST + + bold = 1 + italic = 2 + underline = 4 + strike_through = 8 + smoothing = 16 + bpp32 = 32 + + TYPE + + TFont = POINTER TO TFont_desc (* óêàçàòåëü íà øðèôò *) + + PROCEDURE LoadFont(file_name: ARRAY OF CHAR): TFont + çàãðóçèòü øðèôò èç ôàéëà + file_name èìÿ kf-ôàéëà + ðåç-ò: óêàçàòåëü íà øðèôò/NIL (îøèáêà) + + PROCEDURE SetSize(Font: TFont; font_size: INTEGER): BOOLEAN + óñòàíîâèòü ðàçìåð øðèôòà + Font óêàçàòåëü íà øðèôò + font_size ðàçìåð øðèôòà + ðåç-ò: TRUE/FALSE (îøèáêà) + + PROCEDURE Enabled(Font: TFont; font_size: INTEGER): BOOLEAN + ïðîâåðèòü, åñòü ëè øðèôò, çàäàííîãî ðàçìåðà + Font óêàçàòåëü íà øðèôò + font_size ðàçìåð øðèôòà + ðåç-ò: TRUE/FALSE (øðèôòà íåò) + + PROCEDURE Destroy(VAR Font: TFont) + âûãðóçèòü øðèôò, îñâîáîäèòü äèíàìè÷åñêóþ ïàìÿòü + Font óêàçàòåëü íà øðèôò + Ïðèñâàèâàåò ïåðåìåííîé Font çíà÷åíèå NIL + + PROCEDURE TextHeight(Font: TFont): INTEGER + ïîëó÷èòü âûñîòó ñòðîêè òåêñòà + Font óêàçàòåëü íà øðèôò + ðåç-ò: âûñîòà ñòðîêè òåêñòà â ïèêñåëÿõ + + PROCEDURE TextWidth(Font: TFont; + str, length, params: INTEGER): INTEGER + ïîëó÷èòü øèðèíó ñòðîêè òåêñòà + Font óêàçàòåëü íà øðèôò + str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 + length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà + çàâåðøàåòñÿ íóëåì + params ïàðàìåòðû-ôëàãè ñì. íèæå + ðåç-ò: øèðèíà ñòðîêè òåêñòà â ïèêñåëÿõ + + PROCEDURE TextOut(Font: TFont; + canvas, x, y, str, length, color, params: INTEGER) + âûâåñòè òåêñò â áóôåð + äëÿ âûâîäà áóôåðà â îêíî, èñïîëüçîâàòü ô.65 èëè + ô.7 (åñëè áóôåð 24-áèòíûé) + Font óêàçàòåëü íà øðèôò + canvas àäðåñ ãðàôè÷åñêîãî áóôåðà + ñòðóêòóðà áóôåðà: + Xsize dd + Ysize dd + picture rb Xsize * Ysize * 4 (32 áèòà) + èëè Xsize * Ysize * 3 (24 áèòà) + x, y êîîðäèíàòû òåêñòà îòíîñèòåëüíî ëåâîãî âåðõíåãî + óãëà áóôåðà + str àäðåñ ñòðîêè òåêñòà â êîäèðîâêå Win-1251 + length êîëè÷åñòâî ñèìâîëîâ â ñòðîêå èëè -1, åñëè ñòðîêà + çàâåðøàåòñÿ íóëåì + color öâåò òåêñòà 0x00RRGGBB + params ïàðàìåòðû-ôëàãè: + 1 æèðíûé + 2 êóðñèâ + 4 ïîä÷åðêíóòûé + 8 ïåðå÷åðêíóòûé + 16 ïðèìåíèòü ñãëàæèâàíèå + 32 âûâîä â 32-áèòíûé áóôåð + âîçìîæíî èñïîëüçîâàíèå ôëàãîâ â ëþáûõ ñî÷åòàíèÿõ +------------------------------------------------------------------------------ +MODULE RasterWorks - îáåðòêà áèáëèîòåêè Rasterworks.obj +------------------------------------------------------------------------------ +MODULE libimg - îáåðòêà áèáëèîòåêè libimg.obj +------------------------------------------------------------------------------ \ No newline at end of file diff --git a/programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf b/programs/develop/oberon07/Docs/Oberon07.Report_2016_05_03.pdf new file mode 100644 index 0000000000000000000000000000000000000000..2bcb834137ac7b95c4031fc5239d6dc67dd09140 GIT binary patch literal 70214 zcmce-1z23mmMDz7yVJNsOe9*Dfk$i5E<)%pAy6>l)3#7f3M@<{Cgb_@896Dv$FI2M|kY)oPY1f$@4cp*m>CgMl(AP z??1qEb~LuK0XZTgJZVSmNgDueE*51+kn6MD*|}I$?d_cb&wK+^S!C?Y?EzfCUu6kB z0TYlJ8wUrkxj7rB35d(wm;+?YVGJ||nVE8%@v?H53kd*$CO{J&Gj3iG4+zB0VayBS z0vVf`v$L_W^0I<>&4mn}6pP^GZ0zX#OMyUS1S%>?r5DHu|D@(8%|5B)4;zvP*;zPS z0@$7iePLze402?7VPotJk^q_7n}ME8h@FF%MGe5l%OND>ZfCh9IdCWu4kv)pUO6i+TmW)ujTzh4XjjksNHQQWpVt4)X+*~AZcNo zR0+nJjUfTz@Ma}oF=+A!mSCr%d0CZ+A*yUJ2*4tDXAx}wYxzNdfuG1RA=)Jo8Xg;P z5jtfEasnDk2&p-O;WH6QKd+715?LHD78DEv*)_22F~V#ETcx8YBF}01@_GZJia4Yc z90Cap-pAlGGQyKb{UM+~eCwy4e>tkMu?5Hp!1-iQPl{LfZ~(E08#^1@*junXx5yit zfNY+cIes=PfSirZo>~FVHVIJu?WBbK7)FK=lIkBc=m-S zRI2vQPr3vESrkBKR>orX?t0Jm#>L78;O1pBU=eq;clcYSD#*#+#nJSMUap_O|ABz# z=U)W8cp~7*#MRZ=09=1?rOp9(_S9zv)w!PR{f{CKfa?!Fo*cp6R1M^;$MQ6zv8aRG zoefwd-JPY>o@smnCZ)y-;QlECp{LKEGt^J;zmWbE+%sktNxLWOw6e2c(Xz4=wR5ui z>sid$3G}mvx|J=+NfG3xYHw?7r>v%+{$$;bPR`<%#*P4XHWqo~Kgt|jENU($&d(}Q zcXR>$g+c=4Wa?<;;B4>sG>QIXMa#;}+0sdmjq~~OKl?tlK0D!`7Vs>O|32-aj#kDt z|0%_+oWOri@^g$(eUi>ElDT=F{F~<~P;de`e;VPF4Ls@UY1RO+Kh4ZPFCJb1ClAN3 zeouAJ{hzPr{{J`EU;Uq8Ji~duo`v*`=lSA(nmM1ZpU+?g{+oF@KEb<#;l+Kj3mb!TJT``IqCTtpR^i4E$YwZvT@Lwr9*w7w1#^^Zgm` zpKX8MpQZA%{m*eveV=K2uKV+1XMd8|(;WVM|C8fCO@s9*2>ukofA#x>>>usrSr-38 zdtnl@w=w(AjfRc&-y6-ZxbzQ3^Pf}xOXPow>fhb}8O~1yKMC^B`=2K9-0K(I=P8Qy zr&69o{x418m&rUE!mrXlV|b?L8Nxr_pVj$X_uF88VdHr+{6Fjeyg$YCpJV?V^9=nD z9{*8W&-2>DEtN|0&n!=l@)9zs5du`CAKr z!u#!t&pP{8`g$JsUpw!gu>Pdx7nc8y!~Sx+|Bk!^UwnaXy7HCUzh{iHpUiCPZ<-7nls2&6Trjv6y_bI zK~@%)Pgx%)7mM~EWgv^Flj(Dq=HX>!c}DzPW@2OIV)WR4a1ADR1W3jJpepB4=N>nw8rlm32Z>;JX>I9a)W>5mo2!v^5x z<@pLR@DuVfjTY= zk`1bq4wryoCHd-;4(ONR)Tf)Yf5WkUEdCD9d0}Qr^j^U&xLOGB^lTK#tA56si$4M) z#qXN&y^K5h2l@3bq@H(IkH(q%6DyQ#r`ART!;mSmehS7}AX418O@J@Kb)sciNoZMH&zS|LGdafCG;ZcDZh9b9UpLS%U$v*Mu&cqHc>|? zt;etRjnPFedM)-m>_9>NHhKOxNZr|4=jyPZJs-)jecr9{nD;|z&I=6W3 zv;%tlxf?q0@nC$4wJS-#HsY0rddKIqgXUBWnbebU;lU_n><16l7j-XGaJ?zH;y-?$Ldng2O5oZfD}OrAF0b zv_EmVISJm=yIeAEK(#-L;^mT$`muD)Q2$f`JWTU->`0CVTQ~|r6)<5vX?AoUm(Ar) zD#*)uqFt0DZvBH-k=qVT1f76j^DXpOR~Hot+*ltQ95gx{G`Z7UIznN8HP7)ZdiO%Y z4!CQ*(8@!l3gC$m(oS#0aS9qXrsD)&Li%+Y9+2GYYpVM??7R3*V!^haG+Ipy+N6=z%9}x)<8G1uQ$Npdv{)B7}Z#mUWVG7!==sd2tF~>Gd20*5l(bQ z3mAqd4G96dev-8u0ft-1honAQ5mCW;<}4F^QQiZ|Cnm$@-|T}qp>MupSLLvJcLr1E z+2Qcw28X9NfoV2mc?o35YfZDf!&u0Te$B0xFXH#(&>pQ{`_T)Q0opU%CD4%dB@qNi z3b=*RWX4VUjuB6`T=5&cUYBWYEmIoaeo#99fXw#W!|S5_bYgVE6dF8V2)1u8`8HPj zty+AUmiLB_70(Muk?jOoA8t~lkak~2a7c$kK49Q=Aih^eF)hkrbh_v8_c?cR7qVs; zR$CFsCV)@yeHgD_XV~*Q^_M)dQr3G5ZkYj>4E1_znwXgG)x6VW+yaF$02I=4~2>L$n8YT*pb=NKhF2i=ImpAf98EqIzRu_&RWEyQ(%cBXq%3uyYPG zHQ|jv_DRSgN)7Y?h~6{Ozz4?%=*gEAsyx6USX+w!C{m*Gwfb8y0iJ}1kJfj4s7UEl z#v zQ=YRdb0w3qF!~HiyXy>TV8XOZy8fyI}$L2)7(N zC1iD@V1gaok6~|PJ*`{$GRt~%Q&kaeLuN{MuaM@>1-{_q$(=G#@4eJD;Li%HHia{Y zN5K|U@Nwd98zBJCGh5$h2*|r2R%2j1!s(n$Zn*$Qr+Ba7Km`-2iN&jHwTvR#jF}I^ zfnp*>iu8__Q!qp7P;8FygwMZ&LVE(;ihavOp_`pu9)g^n{fkn2?Rn2jTXG!h2Qa;0 zblzw~^x14wjCca-mLs4f&cvS2N-u>R0q9ee922h0*n9q`um z2vZC^EhAg}YWwU`Aq1y8nf~+YXuK#HbiRApv0%}d-7guMWT_VC$_!k37R3#83r~4@ z_CxGg6Z!`ICr3!;#YucHiJAEWQcLjC_WWGdK6CoZO7%1**(eP)y5jH!Rub(K6SBv# z!P8GwK$V^xkvr_t7%~FaGV#VKj#2j*>R_%Q3RrI1z6vsm zrQ})4HtqT)mD0N`2#G*}M+#p35dTIN5pC6qcF;~p-!2{^@TNse+LGz_9TdwH~rmo-@p%m_d zzJ#6$G@J+Da47RZYqAH>Z{uSLj(4toS-3!k$JZ(hHB0TCV*?rVz@K$vzbQ7*#;$ZF z>ybwgj@^7LcI=Gk3-^7vLzqIurt)dW3{QdSK!X+K7)_i5(1qz)1l_3L00WY!na>wL zk;y7L*%egLQItBd0FoYOuraP%sVAM}dr0icdpdU-V23-e>ns%`Y4hHnRTA$X0jVH! z@d$Vo5D~YK7+BvH@$~S#No}NxYTlT{9~2nL4ZH~e0d?IH{Y{kK>DlDI){f)RRo=J{ zbEhg)9HDdGT4X!1pooGr}gE1o9=NPb%lj_MV9^9I<)Mahr}&2&TTa z;PQz(_bC}zHWc=^-8H;r|TFwUX5bkv=5p)&{lyy z`{MZ;0*v|d_UYSLnk^O7#yoFu+41>Z_gJa}6rMD`9@t~OF{ZM@#c`+yV7+_OR*30` zhQ?$R;>Z-4v?UwpCiOWB^h;7Y#M-XxHA5 zr{Ef2zqmj`kaGVZ>~#k}MCojri1h&=6y4iM-}~u~cuM@9tD~25;~2%(cv}|!3j~tJ zyBrUALaluyGCC$rN)ZYZ%m=f^stzXUgDCJyHiog8RQTaUM56bqA7}8g^=P=j4BQ~4 z=6cS8f^ucICKAY4|F%xn}yJWmvBa!LCDbece zMy^*)rFa@nL#&zNZ2hnpCr1FinG8WpFn0OX$pA5 z-Z>L-8xmpBx!V@0H54^3g4TSjb#0jkRhe9S>X9fc!nLBDoKP zjwZn3aPO$7tV|Vq^7>UNN9Ncg0yutYmrw*P1k%ie1~HytF(_qAmP376JrZAI16I$M zeRNS>vsJKz7bWa-JKnwT<)xG&Fj;=u;Iu+)(9&}%2#e;uF;rnAQ=tNKceUIcwH{lFY7hpX3L zgxi7}7ub)EyiRPjg>O6yV3sV1P#PzuR)z?srbsRHS0e5b`B109yJT;*lKunG>lUO0 ze!l#2EZRhO6oJxl9fjnRS!_XMN(*7$OJt5Y%}aQ%9kfrC?ScS{duuek)<` zLqh@&f$X%iM{RSji8C7q*^l1pj=eVVhpw78G!0W21HL(J0P280eHxF-m^aafIZwx& zUi{kgS=}svbrIq{V&Dkuj5lq?qXPW`7~DTIHq$?$t=|JR-XCGdC~X3vmx+%G5puo z6({$0RYUl@j;?JFF53pS-3Aa|1=2EWI^7kAeP$T;t99WhmfD_0Pf2mj$ zFQ#hw-S%kd=#s;rFE)64{aUZ_LU}Hyl3w<(=sU3Rgc{6+z&boWB-=6>JPbfRd8}p*8*OyA}HjJb) z!V}b=d)M4IeB?_ZmuZne>#yqbfN-Z0+P>@IUXRT0sfKU&3DEo!|2H}t z@FfYPja$6EE|uNKuu2I)pz|vhpV%Ge(PTsJ^Px9qvR^9vIu$jq*S`+E4ZSdn@@u7( z|AajQ#;3^DKIo6k!)GZ~r(!5Fmm?CDk)NR62%~Rp`JE-Q?+^pZG~RZLZ{2FmWJIsxFm+3;Dbo%SKPKKoV=1I+VXU&*I#R#C9KN*%@kWGBvw~wz>U2Yt zYF^UtTOMVN<#p?aSlI;uD3mfn{}^e0&2ezmT0|h8TCV}e46A9JM}ve5W1xz4m|?GX zjCm3K*Opz{^fG-i)W#f~B?6sreYr)5)6agb7b&J=o?pTVA;!4M&xO9OH zJ*%i=o8DukJ>Z8kc(3M_dr{oPyKO@F5Xt>GJeI1{*S%5h$M>u4o;&YG`wS?K*p>n; zN@SN+r<;Tw5IRwb?YnJ>OxZp6WpF)D*AaH`^&BMH0`fl&2xxNT|3?>&^{>4Fa(=`TO zk(^r6o&g@vTe3YqIW;XQRwc?$+)j{p_b9Ev`TDJzSA(~2qX~mr6O0?jkSAEX04@Fm zVXaDiULRV+=W25bak1m$IkS^qyfK0x>@H6_7;eqDRB=$FYuDqutu z_WoOaR{AWA)yxvJNG|Cy8YD+8kIa$P`|*^3_tA{u#rlcF9B|t$7&!w`+w9I-S-Lf^XJ`spJynCw!?Are$7;v#5vncGMk7f;4JM;Z86JK$EQsO+$uJni)ZBqDy~lY$1hFx-{wXH6SawsC(_2@Bf=@y0Bu$PNP&Iy zLQ`!CGwpy0-EyWj<5Z9s#w}~@V>{SsA}hiDSC4RU$lYX;&lZEE$rGw%8751$W*JGdeVGmY*JxaO66{#O(lwai+WX4?m}xnrH;Lqxw+}gpnG)C{W_=vMVNRMwm^Aq z$%U-zLIU;6fT2N+6Y0S*rv5>yHL*<(mOocdmi}24Fh#DB!~}Y5P2R07#de*X#cFzc z9fy^iyDb}s)fdR3r;=zpOC$Vn*+7F{D8IaKSf>Cc$LKv8ZauR54kY`2D3#`OuRJI_ zkAUAwucsI0tZ_4Krn7n4b^u@r?VR(u_X4A)sgVf5T%CG6D?@Nw!YX~4S+#1muJ%6X z5KYf%%e2&aiW0q{0Ums4*F~tA7k&!=dO67M^CowPZ6D(XSh?-1mua5PCjNG{*=A{l zTUCYpjk;W=ZCbK#A-pyzx(E{#Z6|(!m1U93XkTB4@}w)Gu7K+l!BWE4_H2AGQp#s< zy#yo83Amm<+`8Trs`G#qiUgyiAcoGqvnS|I{eHi9-E#_0rbsZ}64)n$5tBK$sYm2k zDMv$E;cy)iBWNsWyes4-Rri8U^5Hsxs*hDaU125S_~QTza^7PN;y(B7i5ibu%1`e;MgIEZfsukoR5MkeKB==KxAAPt@CL;bJCaRKpy9_Ub zPsJ8iv6NE@nxe<5n=Fps-4h*?1m|XK(qg#0$O%xJR0)rNZR*q6PRm5|4eCJYKB`fDN(@ zJZkHdj<2)v8}W13N&)L`rY7lP+olBhWN=OVLfPlzGB{lavr_}rl}XC_0)uDVQ*Wvz z3Bu#m=WT9QQw45TJGv>SBTDEcC7Z@j=icB4Bw$ams)k0n>`%m!qE}r|y2ev;;ZFf8 zZypTaVvW(+Y4#qRt{pBHFXLoZ1zv&Frj6#70hK#g`99&NulznZsxO4XQ)RM$TZqJ;}=-yl)M~Bn8OiGuI4$H>y6cN(tB3le8qY*%tZ4eOOV+HzRdg|nh z&4x-xV~_hv;_-SDNzg}SaGZHz1U@h;#=yHHh*fR$>I&^&N@{#8yW4NAs$819gy{UF zIafK2)w3M6TbdYs;m?LzCAW32^KE`xlxtg$@AHzI;KTCX?A={mWn0;!Q{81}{r6Vu{b<*H%J=iL&8-s#1;v>c7Mj5Z z=jh)ZYtvAyy%{gOG}5G0dNi3~*l{yA0(Clj!!iux@c3bO_GVNpC@BC_x^*EdS$saZ zTn4#^k`i^hm$6%KvN0`;1>Td7{0_3KjQ7`Eq~)$ zGxw@Tdf!4+n04Xrd^OpX^Weau&&Z+U8cHL!yfx3>eZ3ooJDo_&T#WAs+73&ER*^{g=ZPhIvcpu z$9^s>4%*J2k|j?Yx~V&+&1(q#xLHwY`o4?%ebH>pfrfmcWcRkDApS$(u2D(z^nMXJ zti+6NU8Oe@y^m5+M}hSEaTNY44aNSFwt*;qf;Mv17b1@KZT{B@qhk$gn~c2jxD<&W zNrr}0aFKh)V20x!NI=L*IrG~r*4N|by0(Oi*+x6H*4Bb%OdX}9tt0a~Ie1&NaD%8y zRU`GD-}?v@UkZ2>lEeZHIzU0{d1%(&JB#CEEoE|f*d#FLrajdMF!8cV>f}FYKV{a6 zN*^tl57n=5V$*vbA*6{UHM5#gI4hiR8UXL?bO=J-((9Nzks0m2)Xn>LkG5UAF}kSV z5!z#}RI_z$Wf^+A&&Olj;SA~FBdIwwVA8I71y3zMCONjffbL|y>BT4DCJQHRX~pTN zOB*b0{UTBu1xd+`k-L!oZPgt54*HFqu;8%{9MI`s3$aHs|6P;nO%#b23!7NkX4M8@;iIkiC$mrd(fYf&w zkVgAT7C_+l3c#w@A>gik@K~(9Bxn&v13N41Y+XSKc0ad<`x=OL&F! ziD5{7!3sbkmKL|>_llvK3j(+#rSY1{@4cL z&gnO#MId2%hl0ssPn2miKbFH$Fc;^|-q9i|c%C%6Vgj+Q(M7}pg-buyErd}D@%DI# z@F#be3fK;U&zVP*9H^Z1ZSQBgJJKLNQc>`S=D+94Q=EkLU(%$$%W>FtbE{anCl|dPpLH)>0lZnQ<|?HB$HU~SwWjV)qe#q zvm#)rh@uu`#!G;Z0(L!@JRkVo-+D0Jhc@?4Fyu#{(2Dw%NLqU_tw$dk=@-p)kuL&z zlMbo+P~b%_-xbV7u7#YJ(Ow}z9HRDs$tDC??a{b&aTS{GT$d!X7uXpmd&Dm~#}Sea zZslg3#PqLI$ekIPLqT0}_mM`mJ$|S`t7x#w3@Vb!Pagm+;br+`fte)`g3L|S;)WR#7J2RHD@KwT+Wo)Acy?lIt-)GMJc{FT`pV9c z)Nq@mLZQdzDyB8&p4uwT@V|(HH;;Ky7CWp&E+E|zG%0hfhsU4ITX}%rClLso7Dd(C z=8)6L zTFH?Bp=8{ZZFnFg)r?dmFJSfW z@ok(V+)|fI%yK|eBvrat&g(4^h`bmHs=UevRl!qFyPJqlb<)zvXgJ-cdD+K(iiyY( z#G5>?X1?_5$wOw8cTW{|1j}_$grHVRlkHi&01Q*CkcYSWfE$O{1m-}!ugMT`7kvpY z!|IK|Gk*9{k&aw8bxtJ=e8f2`LHEWjSW$}U!`Zi}kf2TEZc`4%RkK%&Rsv}aQ~Ax@ z(@cmJh#V(kZRm% z)_Ukk6{g%0sOQ39uUcsH8ui`FjjxD-qKk#F(vI({AZ0HY^I)!6w0NU#Tdam&h3*R5 znm;61&`JEb%lPimQ>wA+RaFtk)Rt()@u z@Mc~?fJcG=G>&V{ZO!{7b(R_3D%V1>m63H1)fc(0UA-i%^;>R)+vjModo39NEDqf& z8NE(ZeWNXd`V|vT{}(#Na_l*I)%0e8_BmYFoDsuFLoT!2rTFjIzjNkFMBEKQ&{#x zX-T6Z4S*(b{17H6Hc5c1iDT;toF=Iy)A!^EW3pm`VO5Cte!DV!D8}H35kTx}zC8M- zTxdurmAx6$6ns162IpO$?iDp!pR-K%1a5VK2L-I`MK@OSM><22D2%a)VQv0db~_3y zVZ1tZYnl7^S1*{h5^)Nql1Wa_91D)#9)MTXEvRCJ)O1tU38%dcUM~_q+J<|1a^fH% zI;XPGKdKQ-F(rOM$KhKkm;+lVwEv>D`lk3x+2ZkQC8wknjAg6)H5nS2w|jK%uw`(B zE2s<)Jf~|}zEG_gZ7Q>A_Li1X)iQv>N{5tMc7jpm!)sV{D9%ToQyk{#crBErOI}$F zqE+&!IJV1)LbX$}S-o{D!mM3GLFD9chEIu*#EAJ+zL7DQ>}@E6F^69QHFJ2&G8D;e zB4OYQ#_%H~5vaZ2$K9zo(VIriPj-AE-)a_zSB?qfLHNY zR#wN>;ku*C?8w(ky<6vnyQaNRnW!uI&N{JXhS{OpJGByp)X~nMasFc(yQPY@dxQ@> zW2DTRv1*&g98K$oyst*i&>ZH)=~Z$iOXe;u;qgq`fb+rTIhbwh7T~*V61P3K|$ehBzgAx5HYf*W4LX z?^ec$wiJJa_o*a!TIJ=>x>89ue~HE_4e|%^z?DL-oRy+_hjq3iy1XwMzasy>5l~}{ zWzC{^FVRz(WZoN7gwA#C-OlP>8H$OpIod#9T;@Pg@LH-jJR{9hbmdE1BL8IXSaW|$ zM7iBk|J3NFZbPN0&8T3T+cEvs!8!M!_#3|AxD3MF9-fHqR<3g^w0!Qj#ot{{6%7=r zlin4#7cNBa?+Yi{?aMEdY9oK8?;}w?gt_Tm8-0rgf&r(SwzGg^dtL0=@uA|IuF_O~ z3>9t%^eCceyay4%aG$&Eo3p{%?LO{Ve*+m>i{2t@g@sMl7%$TL=|$qeLT#-XY|y7E zxZ17Me9C4u$8MXvD`x# zKU!7+XYS6Hq)cr%DhmWJ$n1w2_7_$514pY%VjHXJ<}-8^>f<&^|oq`ylel@&pN@I@zQpziCG7)`MZBc85(8RZc7jYVgH-6=o z>2l0l{Ze=9D;nR|!a-c1qIyj2Z)c zm{>HN{QB2$uz=3ibKpK3d7t`hDO`1RG(Hkiw1g=~qKx0Cv8)Jes5q!67QF2_w%tk+ z$6PlL<;!MqyigVzI8IDGwO~%e6Br{*Bh<3JEnk!1-Sy=AZik8qGr&Jr8*CfR#)|PR zjTV!F)XrWwn#I2GP1P4=mJX9yn&!TSrIKeZSM|5kgi{!&M@_r#Yo~jUAo3gR`+2SH-=E3-@9UcCn+1v9s(yyDa7wZ z8o81kczqPec(pkwh#4+(7xCohBGR`OCvv4yOu3&eK_%N4o?T#pZTP~U5H4DvGUw`o z78pZ=@dNIVy3J=7YCeBn1rJZp9Q5d*mQteCILa88v?mTO&E0kHCO(BW?*mO`U67H4 zFk+-)@gHT)x5*NV5@jGc#On+tVN=`33#)OOiR5~vmPQ<+Od)fwvuMZ#Dp|^+^Y9O& z?s4TcF}`~lq`BatL6eN%3xEUhkw{{%OCT1HfRO}xGoBhemc~TLE zni8?gUun%miIk{|)hi^cT`jej@pii+_-jLoXa(7yViMA)$vYz-#Wc(5C9&x#wQa3wM->>TrR6ZySX0-1j2fe{Fzm0@A_6kLI%qz2I z)}MCWAWiGltYrFDe3km>Z9HmJEXiu5Lp>_#&+aLiz;RGtE8SQg8L5TfuyNMhGJ!jI zCg757*E+H2vn~RiFE|MEVrn;%Aj_(5I0CIuVPU#fK)f46e9NyyM@^u?IgpMDIZgb7 z;gn$A{&5fS9wHQQgk*JVn#QxuwIgz%pMmSWwd?2}yk?>3Ep< z1%C_+8;a|N@O*7>e)mJ9oz`iI3%C8Y&|_?Q$NeYZwYOO0=xib`hxKh3MwKrBqJ}3Q z#PTJG2@R%xZD`YWh{nS406$x^0&()e=%g;{G)A zwXty*B~9;1f07ZB824^u4u|&PbMVLo;|v$D;qL?^@8~H@^lq^8M$SEI}n{AoU z`wBuzzfDJffZ2Pwe7wGA)f``vU%`4;t?GkYANSqUoPW@@c`GP_R*fjoFd-m?r_sq1 z%Vytu`J_LyG}GfKX$UlN`1Sn?U>==R@WH~6=;HucIo`^0AOT-OU?G=z+)bF^CWgIf zPeDsBx=uD_nu%hP-s_N1s?svEj-zxrELeO)ASxm*vmy`A>Ai#n`IT>FIQb8lHar zF04FMI?)`h=8({1N!wBa_UzUNEl&i%6BkK!XC)u<0c z@7WO3S$d50N*uR)v^aZnUfY!!VGx!NfFFpXk$oq|4@z~%KE1CU(b^L8F6BF(MkhH$ zURbV+Wt&-uB8M&uw;t`3IW5<|mWLqN6X9qP7S?&V`zRljk1US~zAwMQ^YRMQH-0~N zbR`2dQETiY3(=q*>TJRYG&}+NHr@dkn-$;V#Uhnd(}hsG7JgluDU>f&u9CCb!ieBk z`F1RM4CftsZ=3y~+pjwMh5oJ^C6HJ8SIKVc)0ShDDm<%!4m+cn5EpnSf(%#};b}Zy z*f`ly;>CPQzy#V0E70bHNdegep2XiOUH8KDSn3#(47KfVpvz{;Z11EENz`F|#Ay$j zZ>Y6RnMXJ4$RT}?Wxp?+M&#qC>}FXMjJVdtopRM+w!TX)tGjQ$Zw8Jv~4C0SVT(Ko$J2 z@@m%SV`;y37XC`CpH4|XpRfD>=S8ZglZa2if2Ycot_TJJRG$_kaj2rP{2VzP3;A9oEl6u%#&z2WsKhNiOZ>XqbM{|VoUw-a>E6a z46P!zV5_8j1jA{vUwLyk#quNJQ10F7>{gG`5U7(<&yLxw)8rbKlnZyJicvw*?(6q8 za&x2AAC7_VGMRb8-~R|KN3;!`wz(NFQc0<(GfAW1nnac|s z-}qW^sd&ik6UN7v&*F4~H{i{gu+T0%{ZZxtD3^J{trGO+{^34Zzk zw79DM9Am(l9*(a(LC&fb?ra@G+%{j|BjJo(*TcCnk&qlz^}&$|A`TcsJ|-TCq*`Lq zCSO3Sk&o79Y)VAaUT3^xOv^qj1BwmJg4}0u2{Dj*(wbAF(5a8ST>EA<5>8P%(Rf+3 z#9P|J@ys#&p=})czcva-4kDz;ZD<@0- zJye{j8q^{B2pa-7lyL%qXzF3aH!d=vxUNgt5E40R@EQx7Mrb4nk_1AeLHom4D&ovK z!Z|0q9dXCw1jNi;pQDCtv4+a*ozB)F)UcY5a+KJbB0DET3elBfO*wwHJ92^a%_m?{ zNOlJ5v3M*>LGZUMn(Sd3n#@GlYnnrPNY%_@V>yjEbx=#tqf9oSV1Y2(i68nE*IX+d zNe+@`hyDf4xyXtAQ#{Hm;50)UTc*Zl zHcC!`B@8Yo#61B9sBc8kF_?C~?Yc%NVQrjC2u*)3IEGohL@t5Re6-j4!Y&Pw*xlP~ z%$+h43hh>HTwixa$mdyjvu%UE@z=409|_*Qt!=*F z`aV;NMjCotNPTpYr1iniCF7fq>nYAm{XOPq=JMqRYrwHCAQ2?qTL?SqDZBe7Q zWnnPF?HyWAGt^N_%fpF%K8EW9``vXtYW+JQ%rl8kqN!%vr8Eq!?GUjmy~Mm#_hz9o z$={WIDxiYsV&Qn;EyJRy!LPqa*1sFGV-dc;4I+XNiO?#MnRYHVl1)G_ddY1YcnOI> z3f^OdvSmRdwuhLooAM?3X;Y*P+dyM+R+$@E21V~YcNmL915O?f?IO^pk3l6cRjt^T zV!VxJAa!gVv8J_9Iv~M7@u7pF%L%i;b#?*%iiCJ?3w-mg(cSfS{ar?qO zpw-KPAw81cw`wmd(;gsp+%1tVgD=0iL#CTm4npPcgp837fJs_PlJ1XE^>MFFbn*$3 z=x!)ru(4Vhff%cVnsg$XUPpI2Iw1FOYb6I-YlBvFW7AQB=rLp0-}I!K?yX z(5>L*Eim8%kYnWmjLneC%W-rrZswlA*o-3G-WesGt8XZm5WzeWycwL^HXeT4>Snwr zYs2A6LA7pXh}WK)_SsuRAItY97-jnvVa{G0_o7V3eto)qpEKjxu*Jz8*GR0bsT&sgj>K6E2b43=eR#4fXCR@M#y3ftexW;ZW3LSQ;#JA zsu2YXFISEyJ&7o3O5K6W0eJ+MD39U5ZXLU9gDO=+Z0ai zKr&JbYCUKr5U_N3@Z=%r7)%c2-;+JDj}=HivxkaVO%TevnezGk^_O(1b!$sK?!402 z_?>lNis{NK7vw;`qGNVR_R)xqd(C_yH|co9z!1&Fr|fcYd!}@%KIfn!KW5BR+2zk^ zXT@UNsf+O2Q+|`KYtJrhi;~P zf$F2Xr*f%+5Y7y(U^bjX`euUFTS}1?kuDMY>wF(RdX$PL>Kfjjp}?qVd{)-M0%WUF zu$nKmQ*wZiGUs+`QJpuT9*4TOEn!$S77fcTR85^s?2qOAkJ491u|c3fN5FWmq=YW(e#4`F-dAr1o4N91_Jv@&2K$)T3{KHB1q z_r)|L)PbA>={-h?aGWGvQ8UA6$dn=9{YJaAdX&r7Fb|OyMC$Th3GCKmlwU#$ZL(lH z*rABiWTZhQw))(>kU|uBzwDWNYKM=PQ?Wr#!@m0+rOP~j6weFaUFA+Q(6``rk_TO6 zvcTSH!$viJWbzEcjz*l}$h-=e&sd*Gs+9rf3&})`I6{lI|GxOf;e5WVBe}iIQ~?;g ziNPLSI4)4_|JeV9ZNPfG!q0rB7yU=7HxEY7NRuPvV`X*;gMa{FQFxSipIs0*^6jn!#I6_0C89N!0CPv{yUk}V}_Jse$A@Qsl8+`_Q>szrfQO>YYGMa#?!(k~lzSm6RLm7#KE>E^@vT2p`@(jyaDZx!$3u#!G z^Cx)n>)Jv$O0(+j&Aw1y+cKdap8GM1*?hU89YP#;6PX#=mBA)sBK-ynCVh=ryGM3H zP-3P7Z&7w<#m~0CWw6`RIY+U1>Lx;-ES(8iDJ_JxAG~hqsU8o6L4XRFuA#wWfyt9$ zePQ=jWm}Pz*JgWR7>?WaTdFJjM2SwNBZCW&2 z*F_;Q!ldv;0FZbwi4 z=Pm5Ryv>!Xw3G`-dG$#|*6t>De*QB-{Qz=j-t}vd#EkZ4Cll!eSHXmeH5Zi4#JhSj|_(;r_eEmSWm8N?w`RFh?7?J49&^vB$ zmy!wEd&*6w(A!pXk8A&8+(GsdJxWZhUeti-<$;}pPs%r$8Bsyrv|vM@HBa(NctBpc zpX~CT7AU5mC5JXkt0A-_txTpuxnSw86AM={sjNrq%$c~%(Jc~?EvT@_mW(lLw`t|f z>MX`eiaulEQ9stywrAk22jqSYE@-uA(tdFsGYOKerX(YArC};ifxSO`4BiET-l{b@ zg4rlS`NGsPGbR{|LWbRhW24guGsDGFd`kAW;c}7F7NIY--oS2hOw7Ay&dz#>rKCll zG#pqxg{XPGL`hN*&KTUg#V5IttakE$XnUt1OZX*UyUVt1ciFaW+qPZRW!tuG+qSJP z+f`rh_d93aJ#lu#j+vObTr1Yi|6)aC{_@EuNk9rB3_LF6%&*$|8H6atHWQ+Z)+$Gwn+B;~|6Osoo1nH&r$pANp{lM6w%c6Sj=>hk6& z@X1~E(l!QUfKUS06H2y%FoIAV)33a{Tz~3UN>0Lcvc*UNJ>iv`ElStR)urbi9K=kX zQSbwsI#BrJw=GLlycgmC$dv-p zjfbsdPy-EMDz(!(ForjCQ5<9GAtp$h&m8lf2yitbf+c`Tyb)zL$rf-WBGDBmCImt96C0^&{3f&6|Fy z?e)lj?0`HBaqMN@EWitrk6dA^LS$=UvNs0o6mBxf3c}WA@CJW_%K$h-j=~?d zy(^75bDLY8eRf_?Xq4gf4F56@_yiy0P=q;5BLYn`OkU4-*D%DJrDR}VEZF5 z`acQ7e^0wc|2N+Gf97sXbd2=>CK@PIwT#&qM)|zbrC*gbB9LZ->(+W0SY9iH4QO43 zBoEid$`!Im@fV^bHohjj^u6|mrU*~m#|+vdVJ5!b9BDhre!Uv;CBI$lem(y^Nn~3^HpdlGQPK;33#1J)T@l6UZd*j>G$E&;T*01{s*)l;FCr+-i(}99CK@1L3 zy*|farMCs@550-&gr-4MC84Mfgt5<~^9%21RlGd*AYr&syhT)T@(n*c`h&kslYlI4 z=S3C#7ehc+GUZa(;`Zg|=VgyxAm2;e^B$PJuj_lm4R5uNKunSnOO!0=KwqxJ+AbPh z=&->m*F}`@ejr@ijnB=V_IXwsqfvC_P$2WcCXnQCX==B+MJNh(XOHJ|UrgcMRbTOK zcgU2{McCB6CU21P?UilIvv2or`*2S)F->eZO=1dAnn6$(AX>{tboY^RPb#mLvv*w; zSKjTdhP9=fQC)JTRfc);1UAinQ%%<%FJJ1>UpS!yt2d&x6Xg_;K6v3c+9HaD0JzDs zzf6$(%u5SX#O$9P%)*x&J!T2L+XM*qo@L)WCWK^H6P`PRLW!-9M$#&6HyikP(ZI?RydOKca z5?%_MS%b|C?J@+gnY*X%ntD`!(uwjD?lym#QaiVMWVal*>Jm&5*ygx38;HeG!sP{g zembwueLJe*IRK?Ln$%)w@zZd`I@=3{e-CN@4dQw-Bk!WVZDpku-a6ArwCa9v^{XzWr z0q$&t7Ny3SU??~xY$-x=getv=j=sRuh)ZFr0z{&Mtl4ZfDZqP{7|9SAlh%=U5c0ga z?F4MIpG{RU017k=MtzcR@>avHkRW123d|0U2f2XE1|WgW98V`8l-jEH+HJ-n=J15e zVmxydz?9uYzbI4)z%G_0HfS=LgWHXSx|qNFQm^O@@$J)jfKR-6#Mt3Tn^^~_8pNMc zV^b4DyF4?ErbM?_*Xc5sKW`3EFOGl~;>38ZgXuEeEcG2uN2k%xjqX9o-e2)pX7b5B zU9gNWRgUb6k$VS=m4(>Dn`-v(54|GAlG)6tmBeRi{#`&+J@o=2e>{u&V=f;-y3Tl) zMS4s&hi$<>QYleOZ?CsC->?Dy(khjvO$&-2Sd7Y&@}OD`+zwvMaDYp?3)Jx`vQciN^?A~OAy zrbV>tjDp(l_-ug0{0>oH0Jca`!!WJ%BlG3cRU2bb0KxI*M;ldNec25IRV)0@Wc@HZ z|84RXC9Pid7_fCe17CbQ`b?-d8rMqs8s8(3c_lh0p|B{ja2%)r?r04mLY6)Ig}&KX zZ*rRu`kBZP*?ol%A1dq*cM&70Ep2`*`W9B{r*^*Y3iBRHA|#wNgg`S#h0_)|S3ELA zNMt1QQVPJnoNhRWMfO_n=S*jK3PICrqEYQuMKV9efK_!I9C(|VXHcLxoP<6m6nyXB zsC-Ak#rMj&-6I>1-dFIx zRH~G<_x5UCz@taK^^?hhYgY?!W1EnMvq^dgyyBMVufm(e2h}Na+U5x{f0Z@n5?n2{ zH%H~96yM{LhbJ;+LQ;qkb%s#)^KcawY={D7r~C-wO#$MgC7P^L%_)BDRXcH14kF^o zQ$H0e+O@v53)sjH)XkolYS?9V?K~p@6r3bB`6)`?ReXIx?h-ydBdYwlm#e6`+c z+0-{;{>^p*6&<185yJmQUBp)7f?Qm^u_K$IrQNtGMU91&4uy?@!CaW&$wF%ULlKbi z^x<hs5M@(697Ei|RJuo*d~4e^n^ zRuHh`=*o)gqBbJI-Y-_8hwsXz6-)&f_WA^kHJza~fSt|6Sqqk<&l`=c{WuNuqrHlug_6sMG7q=hd{W>f84n30A_~9r zPAIaIU^nC|XFyDTk6D3M&QV@2*|;B-`~#P89f$(10vlNvH^DJVSa?*xrj-7aj*#tY z<;Wt}R$32D@QTlVJr7QLb0N!3h|oXNWlO@EiXdE!bpRZL#J#5cWgVG*)k&Mc_>s}N z*_to;(Yaj~Dhhf)Fi*H!nqmApmXaQ)Y;onrn5ZAgQ&hZ_JaY-v(je85i=Od!-P9EW&`l&?G?~Txa9u; zTz+LU>@*yKoD)m>HAnIW(^OE82&cqn=oC+Rh7J5-51EvW`tXbxCagi$K=5VV7b3V* z+L)pQK2t)J%*Kz}H?Riaf%WUxK6+l+=^iGW(>hR6;8#Ploo1vTZ-EMlDV_AZk&n+? z`#U$vBiLw4G<%7~M7piVZ5CRF_VEjOPbeXXz{&if=F~J4B|2+&eF^eB*nPq%hUOk#S*chEs6FERb@24h4;L8Ro88yEnA_Z2MXXqtb$f;cvlc8fanQ@}uCTLU4;% zfL-9xRgouA&0XvQ9HdyjE*)_XU$a+ZoGNAqd19FH!{y%F%%Na4#0*1}b846x;5CX~cK6xa-ONZ%wN(^+*1* zh1CTm2CYm`QZqFqdCkwTZtJBX^U?N}3bUkRJ>r5Ru{HWJl35vys zC-M;84avFyRDilsGJ8L_0-aPxBI_ztItqxW>v9k(cppZNtTGwHCev^rpQ?-qUv(-} zJRv}$rwgzch@PA$Au^KsD}`lFc{S6PR`P4o5e$UfYjN!CU{Pq%rwVZu?#dS)g`|`_ zj0Sg@6&&i!0rnKibSwflC8P2o<4SE-ABDTNXCI+Z*;f>Ya^Uv`T%ipRsm*^!6^G?Y?#zDEtu1Eu&hM58}a0{p@G!; zj^I8Pe=K;YFQWfK7XW5$sW`IYP^5!T^sY<51uq4QocB|?Ljy;Dp-B>Pr8|dgk6ZyL zZgPuv(?<-c5x_lZv6iv6l<*NL=spv1;D;GS0pOH`cBmeT(VV&MtEYZYQ&fdMTW=eZ z1du0jf3Z<^C5t!~?%2-+aD27KGx&`473_21oS61dyieWpjx!t2xDLcWFy$y>x$;K0TJG&Qr zIju53*02A$6+>Re%e%Rkl6gA<8_>pXU)4q=>+=HzFd&XhCtE)D`5`>Vc>KxpTGuf% zXfc8J5R1`NERaj)lAp8TtgG2${fX^&H}kRc^^4`sgaW6Hha0e0UZ(LPjoAE2@u6=$ zsg6nY3JjG_=}a^2&j1Dz6>>9&K>K_trPu7l$bGa{gJ)S9U%Km{dCKjqQPY14SY+$W}gBJ=gda0_}bxS+b(kHDyo z1-n8k0$tj6UB3e30g&FEXwV`CA;?ITb&8-St>9Nxl+#eDdn;i7_CWViAYB}LX3~eZ zv zvSgo(#23jotU_j=3Jqe!@!TZv1Z?29!3-mt4axkCi08Zq@ojE=xR(dSOgSNu>smj7 z6Ur zX9d5=(&WpBY^ni0?0IbL(PXxqB@@foBMSs=EQ>iKa-+w*v50z$?KtlS1wfgtDWFXa6o*B=#Z5O*7QXO(&v z=ut{O`aEN?e3xKiJma8umpS3#M*P<<3}&)cPkGErUvHNWOA&^6NgY40d|!QkIBju{ z|H~BQ?|sX^Q;@%y;Qy@@qs5P3k6gJghQI(MoG*gGgT)Q zSVOoDO%VBy{Ky-Txetv?nsii|FL;y9S;xe>uDUlXbrhJ=h31C{8qo`ALC;(XXIN$& zCq$CH&Mrn0+s6hJ`<(*M>+vPnTdNBhv9P}<=O@`~Y0|AUAL%CB%8-TPv2C}_@6J5O z^*Y@ktnyiY#@&F#LfGD^Q!N_N>Jq|}jZhGSp9)w|Rq>;&=upU8BTpc2$6Z{Zn8TzG z3hblPhDJ~Jq3i?&nr8PNAkQiHuS=vg4KCXE31CAMsb+XU)*phdhqaPl^H>i42n!rh zb4KBZ>|m#>PO?Mxh#wdWpFBa?amew(RIc&4cQMFQwNO0k{=>z=kxzlK2t%|_3?Fhv zu@y7{AONfo3OE!wmAXcZ;RBzZU*?+osuvdn4Wo4C{(_>o!Dml`I8UMX?{e??=bz1+ z6TNC_p|!$w9>aAWGCXwSr+{%cZQyN?{lD@}ZLO3*!(C>~_e!YW6uyga7%~yn>=bgUS{IQ8z zmgI%weExRm?T)d^|Ea`jPFBW7;X}zoHiE6EF*fh#1u-xvm_b{(N>BYv)H*idm843& z88d7axXHEIf2#jbz~$x*T1omIo)HRb*sl~n{nh%*Z+OV}A;PxyE$Mfc@UHMGj?I!j zL*tqDeEz9}NGW|Za7P4Vd88qpz9YdUC~+$5YS=bPl=p!O;W|o;y#8;pLltb|KynB4 z+i~Ey(oCOefG8RE&u1z*37ZPAUjj`w_aax=gQHx%+@MlXc{2$ zmDV8*Q{%rItt~|a2um;uka`NnNG2nO1aOysF*^y_nDN~z3zGuN02$FHVeAv43;>qw z6Qyl7zGCxSwu7q~vH_ZJqNPa}!74&2I<)go`bF4nD?(`%6R=TLUd_*$A^%> zmdt_z>>QgSqXA<`rWr?hvu%HO%R2d0xv&9`B4TAl5^)uPBPHrjJ!h_aMqAIhMPT`vw=f+`u4@i*y*y!%oOB@rrvFs$0;92TQMBI2Rw?ssR&SmJS|-e5Dglb7 zN41uWSjwtMY)N3>I2#dGFtnORXGi&TySf(Owne{o$8Cj#&>dU88s9D`z{>v?e5hx( zNQ4Bj`=Sbom}}#LcOe-iO18yEeG~dal$850*i@LI;bm|FKKL* z&xVQ@J!kUA2sXejXPT8k%!^tQt+lqn8TUE^yU-?K#wKcGUcfPbZE|!#mc(rLS|a!e zb7yV2C@rv2GD2Q*`c>99gN=#5#&Qd&p#WJ*P`3NEi{XH^AOpt@1 zd3ysh=bZT|lA*OQXEGDZXnMlw$aJY%Z*X~u!57^yMHtOa6zaiCJE4LeF1mYbAik@ zBbx;u2U5!d9s zDa#0ELtD`&F49sE8W-eJ@$ zI2)(aek{cASa(AqQZ8^K3lXBUzPRIO=#dLNls%lV$&6}^B2i*&U-$cNvM6D<8Eo+ zPC#Le37#rB3VA4B#p)dkalm`K+5zaQ<1$xeRq8PF7VhuBSaaugmTVb}E2^ajKKxXg zV-EE(6B*xqa?i9sndTOEWfFVVD|9(UR=h{4{?%>8vG^$G9YDqBUCuJpb*yITUAdGx z3;jL@hi=TW>1%ec0nSFbR_}&`lHNGwA;aGHiaDg?#WnTG6YCFis7gTMr~aeWvw47> zlCdaR$4W|Kp4-iye@J%#YE>QgUdYFxzd1A;oj7R4y<>+p)M{z|@SDRVpXgAyPnHe| z2V@*dYyr;!Nrw~;Goy7wF#*7HMKsyVDxL}2Xp@=#J{X# z|6U^dk2;p&ukqObQXR|i51ja)rg?vT{_oPg{{toMUyuFIpf4Q*+rKGkGyjNFutX96 zAx=Tmn@b?!TyV?@vg&ndRHue^CqU?ci^mf&lEe#b#L zsh%h+S5)Tx@+ungcD(a(xjV2z1*bM~CF6kS`Pw6!P)-hG3RlVwU3(iudw$`~Sje#@ zQ*djbZOt4`8#kbTALE8lOnR-$Etxx|M;4Otukk7gtl1}5iko&sc%>xeW+(t!5UU`5 zRE#60oCx$2+VjLC(+f~>PaH8CX|l>*ZplarnJFxtDmR;uCh44M@XgMg+Lf8qdBJdx zBXK&YV7mE)$IID_yAMGH;ZU*1SJ*6?zW1&vfk!3LkZKCg*Lp54de};&5wx~O+K+A7R9;YfeFwAR-6}pk56PcPmYBh1t#ifIZ-s_ z;1)MFK2X8OlE147N}UjFJNQ0jVjM0Jwib_vu2)-o{kwjD$I~;Lazs*JQvbRv6myT{ z&Z&PGgpYg{!lH0s6g9tz$__oNJ8d?t1t}aDqwvV3!vpbBq*0Qnd~1D?gn=mD@rQr~ zM6?MZ&&RZs0b%vD2~u*jZF5Gw!8vG57UUC~ ztgfJkrY*WQSb_S@R<(;oQWE(5)X%dwmWlv^p-+GOMxszr#NbN)eAX>@(RDutnY)!N zw0!dj$g5(9xlm4}4cC}_Ap@2E%E@)5s@2V~;|`(&z80VItOtY@o-0;ZT?BF>BoXLY zlrxW&#{K13LYl_=h_$sDQyo%TGN4(asZ#!`0-~v@ykqon&?&Y#PTLNF5;y=A?H)&t zUer_6Zrqh7W{%$|Iul^Ez~g{U1SX=ZWIl~4Zh>#rH{h=zrnCoNe65-pofJo{d52(g zlih~sH!eE(3T;|dlLE-1twxmKbGo85aK-X!U zj<9=Mgo;89ddKSF$k9a^GPMOm2@>KulY4{Bt<@W|>YxVb!H>L^8=aE31iuSGiBBr> zMUI`F8Slw}E)zD1U>5_)xVXiDo9cxu|-giX%bxm20|`lCxtV%b{1c zT8hk5xKz<4vc;Ak5-+HZsYPIzf`?w56}RuHd+W;5=8&;Fr)~KvWpVtxh$>*jlJ)~K zW98)O;#)dYvpIE&}K?G&Yk#&o3dni1XYzvlkT z1Pk&c_J88|b1H02mEKsWBFNP-xf&azT9h(2))=C4OGH|_KdDu=q>8OM{rGA<5*Ush z#J~tdxuE`0Ifdgvw_evrQ0>j5uHtkzpb+*j{GP$Q7jzpL;$tVhoYXemfE+@w>71jb zvo7BZHT>o0EhJd%3k}gr4l9-oCQx=&Iq<+ws3ecAPy%jDSNrVSp^diw< zpJ)W2PPpTnp9YLbOThLBl=-s*alC{4T#GD(`VqPR zqa{R}`RQKO@)F7xffYCA+Nf*TBQ5$?tkTm%>|u7Aok*#cFud%AIV04I(CLLUC>hj& zS3Yz2dZq%6H z0r_LjEY=y|UY7f?+RG5B~f&{BS09uu)su)h!tqM?PI zd*Mmr5eg=m{FLlAxH>kXduj+@koR1;q?LVi2p^m9c2eOfVk_Uw;Ij!?B8*maEY+~? zV_^(jb09kX;hKvs3;}UWkLChj!L6xUbAJ#n`0Z(ESO(Rl7e6&GJE0B@7q(yDWFM5# z0=~OfHo4*_5eeQmaKoa>%vFMMK@Ns|=_y^Dr{-Z?uAs5YA-0KsrPVv zDe+qE0y@4UuFX|prbFSy>O6v~JZ%j!hv+%cH3%|gAM9w$pJ&eOT3NePg9rocaPZ62M|9EtXj=lZfDZUG`}D(Vedx z?-J9@aoT;^}x%}bXIsRdDDVbxh{QoHvD?Cl*3kXoMCX~ zisv(TdKnugk;c?Hyh2T-&U%Fm!hF{Zp| zEmX7nvRSRLjVi@nfIqL`H?@l5Z$+ez5xvy+=AS2$>+Xh&k>r}tw0O z1*=zDa&>x*7xYqSk2Xi~e#lHuL6Tf^tE!pEM(dmSXdMVxUP(oBx1rpal&~+dp{xOa zZb;NNIQv=KS_^8e={4=M-qv_9w!oq72E*wAb8+>Yb3$D4AV;-flJ(gxlUt`m6%cb~ zj#nS~CLfJ!IoC2m2#k_A)R@(9VPa{B9lE80T3}wU z6hUN^bx`iOYVFau<4Xu0+xs0*!R6YO)J$`{VIPQDUrPTNxM4)D%p3=_LulVjwE=hX z1j7muKIx^p^8Ok9#G%RSAN7oo(~HllxAs|c+9D%~)6!_Ba_sA^+F>z3hrIQULYe?n zMd1?*f4Z6{Sz-9KW6-f2>|(75iSz7HtnRMRS&JQc*E;s%WAEPh<2L`fG2`14M*Vpx zX2M|l_ldYr#L|^9h*tU2+%Sjs9<~Exs~iy6)ft4Gc`O*upEId9Dob zDshCE^5g;s_R;d6gO;2wx{}+Wv;c_va<(x0_WaaoXNZ%|7FhA;ev^boWE~? z#?@ zWW(lY>wW9-5W9yl!+OxboqtGkE zUq8$$&Y9b}{P(4AH}LOr-nZws(@PJWa=t3sm;kxgmw^?^m5QYCeYKM^4cizm=b&$A zal97MY>mpEJ%_Z)2TJ*K-3#%=v!onyjwsU+Ie1Nw?x!l)Zi#)d5&rCo)fI@dTL%w) z3^ER>0->TZog;m*{A9PjXP{>OclYdA0@Llc_0l~b(?!C^bxG#k<;_b}x1Dp;3AvH% zy^QV})H0dQY%!ZJ_W%lTgci&#~^L63HWhlq1tDqbhVHX5$it$pqid@sK&g@Eg&UvT{u~dsjK&^cIJfG?%7nu#1W9q=^SD;btd5k#pMNb)vLt|YT zX(ZEo)sVVq9XWNdNZ$>MUum_fG9$sF1p02q3lxe^-`^x z`wB={w%tUxh4a;)HG_6k>pqDR`OGlauR?rO80^S+@915Lr3!-0z~9(8 zW~e!447|0imG8;5u!Xch0BC%M8HmyGqr>xWD|?$8=skD5)nbO?Wa9I0O_z=HB(_yK^LIK;PD^` zfpM)59;TcFM}sA@X-X9UB&7*wK z%G0L2N8=JUSOn>3s<{I)$Uw+_vB>&#Q?+t!B95TQ826aCp_}S8V}EA*065wti>Cj8 z&5nab5YvjqP23K#tYYBd(v>?!y3SHVIwMAlG`_W9Fdz5SqbgLm-cH~`?&fv;^*T=f zFbPKkU>lO6RJ2`Ti&PR~AKwXF%jt2lB75#w>Qw+39DyE{Z#s0o@^oZX&ybMPlMt5c zQHS!XNAdKw@fra5JaOi${KBWeAU?i!Ct06wQ`4Wex2%jz<@1h!TXCvJGD69z!teKe zdSXbX?#4qO_*lnQ(H$S_cx{6~;A(sI3iZ^5JCl5{=3llLK3>Kj*Z7B(LQkWAzHpPu zD)S%|C)CT2>75_BRDTTCf$H3?psA^Xhaam*P$dKflBEQinI|Ci>RpEubUV(=Fn<(X zNj4Ew&QVx;U;O05ao&oFza%FKLMVcp+Y^iv+=Fmdpo05p@Qa22uItR^LW@`$jD+G4 zSfj=!9KiW~SNn4i{V)cSh&77-8S84-Ntk=80muK1)soDFd;@d~9G_awHmJNJn-g*I z8mfGJ@x6n6G%7&d0I9<<%Bf?w)t;!Ut2#D+Uk_jD^Q)gj_Fz~J<{e-YPVmnKJV>bU zhVF;NI&1NDwX)Mr7G*Hq_UQ*Er)s`ZEGg+wa*iA04Qqb$? z1LqN*SDYOx*=3`2ZP*)mFSbe3=^vZlbmOqO@QlbRsE~_+3=r0o_iEIlpL`a2^8GJ6 z_ZecDp=NFjjctSCGV|KhKVJ7b;Y14vnt>y#8qu5m`bBYK$-2OMJLn&|Wsh)h5^xzIq)maD&zW=8?7m(1jd_q<6r!^>s&?DLya;F8Vw5!pw{aTuBAPF-nmC!Ggvz_NzSWj_ zIS`OF**_wQxZjyYlOSChiQ1pABNtk`WlZMf9%TiV2l)XNuzmoI>SP~fjw38lqanB^ z&3baq?9Hp+#LAMT3V{_R+EE;7NnAW+!_j(N5eya!-r_itzkz@EK195+t0aklb%5H0?=R*MUCop{rCJD#Cs!u&K_pF?1upU&IK#Km z^czzY#kvtPqg{~x(x!kcE-V8fod*=>)yRbcl3vDk)vWV_t2Z@Aw#2pekD;Up)goiB zL|i66S`;JDPv3D?fcy+-&d7d3p$LCuX3pWH5Yd!|!z*g0sxnXKtW=&+mQMvmEg%A4 zvf(jN()wA2-(8SpDwVDT=4?n2p)ejrMyuxd^T8ZJAmg|IfLLn89#vrN5oJ~_kf54; zC!U>+CIO6EZ;(^fW#p)Ht#}x2@#Fp%T*o#~@Q9VJdo!g?&1)=ZP4Ur$X8Q9>c}jR} zT1ClN&5#t^ZMF8&OMdBlvTFL^J%|&>EK|xP>%c1}%f^7!7NrmiBtzkV%yQN%A5p0X zEsP+-``C*P{fW!(i^9Y}fCJ3p<@_(hW#iM38rjQYS(bj$inDu1^)cWi0;I)?_Y|~g zvgHt7={k06P%FDeAnF0)N%HvmNrG&f@{Bax5&0WGk0F=1m!4`&=m=UiShdIjG_sb4ohpZRZGSm zf2?VO?S2o{H;~;(-cTm0)f90nUYvtyqNfzmv zC0^R1vg8pXFM1Xj`XKo(RlA5I5cKU2tH=45)3#qtgRee9O{gGJnHm6 zj3>3-5|=6l(p*%gP_1W_@6V2a*#QUqUj|15i_(HVY{9cbiD4bU-)?Ug&`Q*Awj~op?|+%-Wb+^)|02wuhVOY%T&&U6 zJW(x7LQR{b;0~;gvCwCZkerCzn2ay?a-c*gDGlw$bwiQvy`}{p2`3uJR-)aN?GS&Z68}K)3^j~iS{wF3Rf0IW40sYYbJLo4< zRnu{U1@#}df=}~+T&REj=*viOB6VJ5;mjr`vaE5zH4AHQD-sqh#Pp2+c+Q5xmru+z zcVUR;Lu7lt_XeBs;a=G<=6-W`d9Y$(6o^=RjAJ4E<$IHGL^&a3Q8kW4-@yqv1oJU< z{IXL*L=mv|t;ZhCm^5VYwB8k_kQ7wc+tU1uiL6$FuavjIUx6;GrZ0$+fQk~VA8t_y zdwYluEjB=mAf8{piJr(_tQ{OF&k;kd;Y6^b712!9epjvK!e1O|CG3eeC^6xnqs<$B z)m%u1KnAShY496)3gAdaYa;hUn~TKqW|%=I|hks(z&tnbHKXtNLDy)uJQn^mK_tc=21u zg+*ikU<^8|%+b5O?C#0{aMvd4)T#av1h;sjICRS*>+JeHj&LGW-yVasdp&IbG88k( z!#fe=4ZC>Iui1SXdfMOVveYk{EAmO`A+! zm*VS**Y6I}?^`lc0Ouhw(_b@ps>G6#Zo;x-@(vNth^mzhq=pe<=5U6^TQ%pH0~mQ=hC!J=3>|**Y$el3f~530t5ySxbeU}gFQ}s6sFJ&(V{O6Z zt&z{Dxv$mu@O*HhMelrXI6MJSk`dE^F|&~W_ZKRrJ$*TOdBeWpT|Tp(eKG*IQ=rEurx(PDLm z5gC<5QDV&=W{h!Fm8K>&JxPd)2?NZf*YP9ATa7T3*FLC25fNkpz%S5Bt_~a_4JL(yNpH0Wzy$ zrQTXM+2eiduwbvBZqk)LrwN2(5`7otAB)@=mwtZvb`_4Q$(U8k%^0G8ZxYW=kzXQW z=NlF?yD|LXDZ1s}(qE2GvL~~XFSIbRx3Q8vk0?@EH&dwJ>$yImH6)RVO1((!zN8;W zB=m?|n_l+r8Tvan?n0t~cssC~*k#sP10KDpn~@I@2}X|KU=e%CXddCuF8D5+F$A4Z ziAzcV;tYc0NWhQJA%{H;Knzg1xm#dwVG~LDyz9bQ8#5S~=q|l;KX83e850L>nlrSw z#$6Ch$R`%6+`>hoggDj*6#00K)dT9r55K+U-9n_4A4VVocLoqVbhiMYjVME9>Xf&V zO%|N-Tq9gK>xcX-3(K$(=}xcJK#BOc0lRkWNG8-^y-N%+UWal1`Fiw_r8FQ?5iA8G zt5jPQvPf+nu57|55NiNdyj$~z3y7;zZS%W%$4Qnn+gcIrfIIq3zadq+t+=IFRIzO8 z#LJ&=cZ9+w%=+v#0QVGH5kCB}6wmU<=YY%TlaKvhAaxp3ec6T@?Qv!WpWWaNKsTfY z)=BA%mg&CVsb7vSt?tf^BowHjB^Mp{A6iuP@{<+}0Rmx!Oj+rwS~VRHIqX5w)Lo9G z+bmdt^ize`>~i(0VCk`NG32m_8=QfLVZvjKwWCj3He0A_Cbr& zmdCSfuF84G-{utKrjy1LIz)xJ{B9ir(cn!YgkS;=-EFrc1R!3xr}Y_D?jBHPiH^#h z->Gl~@ini(4XL9@Rcr?NZFpk3Bb#^ld~{b-=^+$eQRgwoR<<4JU}{k>SXiRL4xqpm zA5oLylB;q~M^G_=^6Qyj0qvh6TeOoN)rAMRiS3*i5U1rU^Sl^uGY?983%)u(a!(=W zh=7sKU$7{)@vkvHQFTm%IRfo72a-xnw=ryTXBPUE1u1w2q~gZpbNez6;&Qnalh4O< zKg!=oFNMr=0MsF#FevNf##yBTNx1#!IimG!&eoI<5bWs{EQrlM`zSI$PZzBsMq3HX zvuNk~gj#J7bb*r@t${+u5Fu!Jt0UU`^?`x9`8i5AC$Cg*o?#W&ow=8;uf;y;E(Q9Y z%)42IQmbt9?xpo&@u%4s!4a}&txxzfd$IYGp7FnqRbpPSE|nt14Os=B3cV2C{E%fI z*%i4LDP06&BIh#E^i*Du;P8A%{mvCu4Ogqc>N=>yM9~(0)qrr{y->;cA{_g*@q!*e zXKmSIN*KAZa2!&0y1C$Mc^~pH*+;#LU!e)Z9hqyzG2&zDh0nuTT!~otXF790muG?m zhLUnjzTH3g3>|>aWzlXDX;6uAN7g&+h4ERU&+dblH@(mm3B2GCuhz}H) z@f2#NsvuJRPkL{pCyd~^8q#Gy`QzXArHJJ#LM}6KC->bVt6LkDEtpNWGK%5^qWf9B zggv){VWnBNmSDE!4}CE`2=Lv_?)^j_8O)^uB z=f2hR#F5{+-!N&UD6TAp*LIdj+utOmyt73O-<>(36uPgy6=%TJT_xAWHNy6UAK0P0 zcOMY&zayL?B@)dWGlTa@v~kEv0OH3vFH*#0&i0xz?rF9dH?3;ah~%^g)v2!^+A%n~ z>^`^pOA=Ix-=SLsrk}RnNb#+hGP;iwnMVpKjHlvOGC8JB64ny2yXkZKlfT zzg{gUuVe?`Pn0J1d@yWf&3O15Cb*@kzXol*o=>{1{bUBa+5zuSIDlEUVXT_DQ=q5M zrq~M%eCal^a9X+F^KMV*`0TXbv2mg9A3524TGYy3bM}4C*0}$;0&3~^Uo?|aDulv( zw^W+QkoTLEJOt7vqrb3!fDNz2{L7;CZ&3R`idM$I$eVvrwEq9tx`M5fzLPON9j&yn zk-5Hrt()dQe$VnpgvZLxpiL|2U~BjPe5qjUXzT1?XzYm3@Rw`*pNiJMxuXAi(aOW~ z-`mXp>xKV0yJlkjcSn#4RnKiUL{Pu3OVFMChv1vkrlD)ZadOwlwP^uMYLlo@U3_Qf z#q=rTs>RruQQtA&J3VO_iJk2iToBXQAhOS!q<*}B2v9%Ox>Q`ry=)UAaTjWb4?=AdmgArp&rW<+A-r&2l}l- zg!Ye)<(2@;4iZN9|0?_?k8DgXLK#Fxmdl4)R3^4SN832eN!Cb3Vk}VPpmeJ8^-`yy ziBMR7IX-O@z@#+4tSu=C$KvOC$d#H(m$Y;zZgm-WSzc}NTTY8cSbXPPFJFKtN2mc= z`)1(+&y)kOj{VO}QoQ=kfpH*!SL3!FBAzaJYCV~GyrGB3ikiB~AAnl}exT;%QKs7E zK?PJ#g0cnb%LOg8WW0JylWtC*U?>v0ZJ3paS87HW>`tsHYz4+i#Xjy4(_&e!M7|Gm zI)l0_;ijt1D>vm2t;5V+B^M_I>4IZh<6I^xhpMK48OT#07Y6T<+^HY)FUfzx)d4D*biUb&$|yLdOJD?Z(b(lvACqGt6S?+hMBBbi-|sMbN+4eOyPcOoS-RVx zR`~sq9^LK&s*(%CM3HM`ZLu2G>!GN7;wo3xr<5$u><*y`fh4jswy9Mq#?&)`x9hWx zjENSWOvFNe7Er{fquLIoQlf-tL_;Up;pf)be41Q{LbT8LY5G!O+i!%03f3;yyV)OH zwVqB6p@_ih3%V0i1MAJS=w=lHv~zw3f@&O^S4>Wv}Q%3B3fOyvz%r;3`w}2V#G_=xxwFr z)igT*-5)4B{W%z*mq?YWwQnRD!Cuk(f(aaS6sd!1q}r{`6Ib6YLNGK+7FJ^-odWWZ zl<>~mY;!l=2;V`>@z|FTI01W1C(u;{nOL0#!=a0Im;xPZ9l0;kRe1$Pn{yr|XL2NC zj0zESP(#cDP>0oVI0NjE&cYdj^bRcoD8W8s+w|rRo4$#H_1EAHt$9wsd%$5z{Q1th z$D1Sd(d3KSvD>-U>M_1N6ZKUAi#bJB#T}j+*K)}fb*$9q7#ojZa+B2aL5(;5# z?ZHHjHYu|{;Hr$kq2-V0SHEyjmg&ozXVEokLuW1gKY!r~?_l#GXkh4L2Fm?^yuDM9 zr0uq@UFfoH+qP}nwq0GeZ5v&-ZQEV8ZSS7n+-rX;cFg$aj`hb{CmHePNoF2o#5JDh z8u!fzM9|%hoB3#2ZH~=CI)Dw z2Uf?Xlp7K{ytM`-Wqe+V`w+SF%mW~>5yzbI*VYv3N3rnQFavFaEg=XGHSFvSnD!Po z$ebS;yi-TAJ_8L6Z@I1!847}}c|RK(Qk#jZUGtn&36*k4I%S}R*>V7i)9OdcE-$pEd--=9iJNRD@iv(65im4TN~jO;fz5AJw@Q? z?b30$?$z&21GKF?i<1R@Lof1-&UtF5cJTDgyRp6tD^5DSxbqv-G;Zi;9 z;ux?)K*56sp9hH#Sapq=Vf3E$NZxoILS)kgrt7%5n~LP+yE7coT4!VuySEPIi1Btt z;(4#&C3AJ}4AILub>GG7E}mfC%C%cBeR!Jdx(31cMRWgBF7$Ds1NOQpz$5Sh$f*+? zL@F7hupjF_^MQNa^=7n%RpDrkt0MaR05Fx$@jxt}&MX7V!*SMecbiqNKU2Kpi&NUI zB4pC$}y0V@it`| zDN*9bYX)aLekM*#H8Hv-3E=sxNM8b%wM%1hPz2UgyNoxQ`(Eijud$w`PO22)fsGj+ zJ<0iS19mX=NKl6Q^d2^QJE#b`-9+=|Tuk&KY@h`cWCal+8vs*ag{0pZQfmx0J*l4G z;9jT=Q)r|?v*dxT)lmQR$|341D|3pFpd03Z3U;st+^(%DgMw}?JZh~GD9AIDuTcV6 zfjbUGP6}}{s^*awJ?~;nYkP7G8N!ZC43;7ljbI{$(`Xg}4%#B)Y<28|@q~!V!U80V zIPtLt8-F)=u23tpKM#DTH{Dy*utKE(M2iyj-YJ{2Whi)ZRZpK;5A=xRKmi>{*Tz(rx~}Xp!pJG>37vQ|=frP7T#wgT|mNp&qm> ze0dZrO;-pBJ#qxYP`TiPOW;yCeXxptK$_L5G{??tZjdP*63>v+ji2C&#hN>|1C=z1 z7cSJIX`Cm4LuG+E_O!x11l4TXTd=6=!vvHkt4bXq(?*+8ZfGlbbnk@DD!9>H{p?i* zjbWbUKaQnd&UxAPj>mV|)HKhJAS9{3YS$f;_HR#C_0Br|k)&iWlOG~25+yo(5V!om zLdMN52->`mu^Ts*21pxaYq`q4q8~VFequ8sONe`u^i`bKpUWe!WGKBIEC$OBn^3d| zmf}kSM;#K$L_Ny^5arEeEvm2jR8w|@kTI^p&4B=rBA=Dpjgl0T-S8A%N*(#@ris>{8eb&d)5H+P#ZFA;K&Br4( zna+pLHrRC*WIh<)GOdf^Sw?7xF_m{=N-Ob9B68$-&e)Z>cbY;Fs#RA?d$UMLays5q zP@s&!$L!M%*(wnsH>%-Ou5D}JWySHS&Xi$!1AKm`QJ%FL@4RB+VKtQpKdWQ0TyL@Y z26`uDN|}arWuGRq610***R*<)hZ7^TYXOg=w0RI{O4?tvOxjI^;hAPGo(js+yT zV4GfFxEm2KQ7Rsq(kBml&zmH{gQ_J#%)|qdc}e3%m{={k9s_FcadF zcGHNGn?6{=+Ebw@ES4U^yJj!kJSZ09I+Z;tTHVg5Dm68QPO9Ic5gCOE_R`rXoTseX z1z_#b4dvDt&APw=rnM+6lH4ZSrs(*Z!8m1(QABTi9E`Sv0t1{F?d~WscH0PyUCU_v zMT8)ZXN_f*N>%*W29Cq9ld=*EJ|khVrAp6N1eZtPxRU_*USp?unqde?+3C9#s0KN{ z6o&B$1C#`!LH@GiqUycpoxVNY-E4@y>rgXcb2e^Nr_#HU{%YENd7U>16A5Y{uXB0% zc?ee~g0tho@260ltc`n#A>XyQ(F)g$rf4u=qOAMKR1B_5s-Jxd;UB~@LQv5RY}Ntl z_&!I(G=t;-?8L)X;a_Uuy!~ENGN1-4_tF^xZ;4q=+McmVT|O{eH?QqsW7Xp&b0DL? zS!!}9w8GO=n}lj|uyTsYXH}in$zI|~%y6s*&tkb$GuCCh`zsvXcF;ufaB%o~yAdy0 zEQ{7y&EM}f#{33qn-*NQ9IOvYF`jo=LaatbBe_&a!NpEYA_TG%DLKuT54O5(m}M9o zmNQtGXZ9cLJl0PxvC)aRr<&`wzrR)S-Yqat5WC1fB_y_^4aRk%x1{Og461xo4r)6r z&3xlhQXBM)LkTkve)`VlmY2kT9_894p*YT7|B_&vgyYB!-oPXbEcq>_X7x?mx{b`(d5p1Wokxwfm_D-4UBmzB*%63C=gP@+s-< zD`x`yB&t~iB`G%58E+2c`u(}bXmU7RK(LnEzxyjr(7<1u=p3%XcXPA+nrasNz`RZx zKD&-x_$?4vJqL}0Oc8YjiC%Oh#BHLcXVRi$L;frd~*N*hoxdOt=maRMz>?Mr^P{p zcwIK$nr_8_tg)AgL*VAEyPzRhK#pcOXa_|5D~bP%Yzp%hrCAma<%CiUM`p4-P_I2Qy9z+T($PV-HU5QR0arwLJAmJy6sbCdJm2*>2y@S>|Bk1ycWhZ(CQ5KbQ-@&NmX7z(<_O5 zL%MSc#Z0oRPDAG&6t#ghVy@EBQ*dBh?;pf~0IA3Ln{9tCPfk-sZkc2+0L5iOFH_VM z$NWSiOHx{+48+{q%v(E4e=<(7o^FLZUr!FNxCFeaD^%9mvg)_;#l6n<1Bf)A5bhjU9@}RYL6Bh!I1$(-0R{2ZS z=**5P2tWPuAnjFPaXLKofiES)QsxBNLdCoN6|mwDj$cPv{)m4(`9Ng&15v^=y(4Oi zb$j@6uzZgg<+Ny)m8n)4YPrSI^MZ8}9-@h$LY7A!+h=d>YuXcdX`swJAF|(gs{^=~RFB13}T&jh*YaZW}3Il`be4DI^ z;mtycF0Qfoc2x!RGrCQVkIcxhr=o03R5z{?8jKgHE=6yYVBz^I3bIYO6#;GJl;Yh* zDFF<5mnC<%sVNB$ZH^EeIl*7Kd^TmsXZrmTidVwx$`I=EQWlgNf-RZ@^Aa?$;Usk9nV29&Iu~AY4CYS&66Qb|MmTi> zS&$hCI_LTXxs z`Yj?B;bWXooTFv3V;MeJAlV`!!y-Bh`FO|kwkbnMbLt@L&g+Vu#t&eYT%Y&p5F6~q z0dU@42oEr%;%RRnUR(afI&{XVJ}gi-;76#CQXrmf-ghJcZZCu&0)1|OQC080*+uN$ zLyfse{E#_6IzD7v1{~eO&NV|rid~{sHAasNys@!{8D3<2A;TVicwfw3JC>aCt?S&J zE8kx=3vdzvetxU!LHspeyzs&nxLln4gdzv?AkqtwW^Zo+4OVKa8EXs(R;o-)0AjHV ziX0n=>_r+>yp=+hH_pUrHyFS=FC~DG2&{RLsE9!=ire;jMTH_j|Fxh3M=6G7`oXWG{1(BB(D*% zAYnW{ca2SLHGWDoM?f5UDRxD+U09*s>^nTaSlrNw_~{SM0(MGIAv z8TgJR+hT?xYmt}Rt``_2Y!xflcO|czbvEINmmfYn(p$fBY7v3y{bD>dWHfvfg+)UJ+ewoK#-D^vJu5i&po0n~y@VDqeW@|=EGH?4@J4ie zw@WK7{lj5H2Pzg>8BLb4;)j5UAQ_a4YEho3!S7=*ET!K;!CM{;I*wy~2~ms91af9Y zym48YKePf9H8KvDDQ?Jz{BvgvN6A$hfAOm--UcRd2=}!m5Qy4Y?k4Dd*tHV#GhbEw zFqozVpJ!j<>gM8f#!s;oL`MctKalmC94Ki5kGy7UwofqYE)&<`Hmy){ZGhMX-jc5_ zDz<7WA}c~H;9vU6w!laXEw8%>gIRVx7?phqEEF&dA6YN_d2^%MdBsY91KM_YS`RJUesn|X+ms3Cy#l*DQRB_3hs1A^$ zj5ZDO#DPWF7$V=EGhIx`5(|=Su_Ex1*wY&`PBUHi6QNXk8>wK|reHmjrjjp)u5LS2 zySsQk&S#c13G~hj>XY3#?t8f3W>9bUpZt(!PjuX{gqLUHlcIl$Rkbfg0#pZ<8Iglj z{f|9V!T3a+36b-UMJtCMx#%x;Tpq?)Ji4eCjqY`%+dJXDAFH9d@^LG zhhY!K;*narKe%xsEm(Va^i)>vo(X)@Ie`yL6s_e3Uk|N647j^oWrOcsp49F@+xwZ< zPWjPYIg{oHvi$KV@b*dw(L}?T_~VF$vm-!ws9yba)HxB%@In`=U-C%09r_w*JF$G( zdx-n&B;@gf-NtFPrBblRLRY3tFur87BHEX~Zf`#fsjCkOMtZrBdkFa@yNmUS6{&Hv zMqv({h`tELkwC6@hjIoU;I}Di!?W0D5haX9F2b7F#sh0BI=@J2;vNgNJN;9_k%SJN z4}xr|B`n0dcWL4S(YD=hX9<|N(FG9FOji-bA)$Q__hUjy(AVJDfLGjz^hTDOZx6-U zt(UhhDuzkuPTCurAb{fTWRW{T8OF;AWl)1-LipY%&zF<0N%JYFjrdnbF9Uc?YNj}2idnvL;&*Fx2a=E>3E!bz3%MYo~E0rHi^Oa?#{~A+o@Pn!9r*Q zOe@D@*?j4n{bhq59o?#w*z;%Y*1>~jjWNdPgeP)cPlq{R#l&iVTZH_^P>3b1<-z$X20FW=v`uEnl#onMIWrvkOW}SQ^!AffI$In zjo4h0j0jqsOCeJ47@xU|)`?Q~URMrGD7~G`KXh!nO$^_$4yV@pymQN2cL6s+cN#$S zsh+(Pu2CkWRJS6w$r|eVdw$|jD*%2 zW)`Fx^w+N2r1W4!ftL<&F@QJU6#WgnGrbxgRvRC5B9gFzBxc>W&cssq=I)cJcv04D zTvLH1{Ixl9CT)j|>U7zSRb4v-;34Z#=?-O6aqu|ftde#p!YfA_LZvsVQYToR8?Rr_ za`1#%dNfQ8(^FL_C>L%RPo`eNFErM~=3z2IBtE+7k%U|)>@o?d)<}b0g)fU#QY_6R z4W%7GOdc#@DyJf)HxhyLs_O}lL0f7kC#IRU-)wjK;I2iWHA-yAkntgrFW6DrGTZD) zJxO`)M@9~vD!9P}!XPSywsjK`u&OL+#xE$Sj-(WL_yisCnIQQIrRuto&PSqFB3>hW z?Oy33$nlSJgf*trT1fVE!rI(3&|b6HHqa3!F3`b;Ve9s2)|Lmc5dW+WQLl(nYnP#f zr6+?r?PzEFZjSkOFg=ake3~}>x?=$ahVk0Vsz_SZ5+$X4HoV z|A2dth(>0ZV}Ef7qDLJNs;hFNlzJ2~!8!tcv?=i2Q2J%(aHz2Qel!4$+pt?ig>c6{ zHvimK2)!@rn7B*wrJ5+UPXrrx78@>X3+-*6@!ffCKgR*$XDa6KJO2-wyZ6wu)~l$R zw#YgXfMiNq(8R~q!#ejV6D@a2kUSQXshkI!kzCm{Sx(ttAIaidBv~7gy6PhoF9SOF zEmXFdyphaKO1*^5yea8+i=R{6h7fk5Ag%heGKWY4z+KULkf8zUN9QP7?k)RSi?hje z6G&vq-(X4L;Gfud<>W5k)Hns0=jz=(Y0|9=O63Tc8xlVeGh;&0HuA~i*q4dfAPn7g zD%o7XoRItA5(hKTx@$Czk%N4g2wt&g0EWt3s=Q5GYy4v*mC%KL3&A=eFR&+Un^sWP zllF}lRA1(_m)N7LRqH!|LDSvthj~tM2aOXz|B}0 zvgvmG1w1(wPr?$8r8_n$+2@_lWyA`jwU(Ca?Rl|$1p zo5YHaX>z=pP((;Y;lOa%p8iK}O@FN$NdzNQRnu&5nGYb(lf3sI^-c_R^lxZA9;Lzw zv}2cp79IEHXL7fLwV*e@|2DqXAN@>pH_H7`Yxk|{t!;_Fu#$5#e-jf_%a*e9jH-8< zF!wS&0*6{B2Y-qn?F&S61znaUGBYcM@w026iUql9sq+mLVW(AxQv$jO1_|Ra#Y6rq z>ms(5yAXUiU!_k;fK$VUJ_)Pv4p{cd>xfe)b=1Zk%kdqF4P=0{0g}p! z66|J9uK>X#eru1L0A}?`Z_DOh{W&Zo)7xyR*_zh7$BP1q*k&( zZu?naTA`NHKJvYm_2uPToXqr&Qj^H;)Sy1KwU$ip!bGRqh#8$ifL{;9z0$z=LQ{ei zAHmILN>P3MlOlZ1N0^K({`$=)t&G^AfgAi}8p1buPVM82tY{w1o8!}~5YG<#P`ZC~ zW|P0>y#7qOu)Va&fsiePHF0ppkZo?rQDY`@`qxMg#qs&YjB(U;NxVAI^A)i$;qJvk z>FMKz=yp9k-y`?N!_(Q>z{5pCb&OK06k3bR0#3!9?B}`b^_9L`OX@Xk?BQLk8Qk~BJrLXcx#5?Ljfw(|a&eaMz%*u$+x!Q)oZI|- zcB699r`M~4oMy@o+g7sZ>pP+qsXgr5H@FzQ)26az5YLRI22Bl`Q(pEdnLTPAd)C@n zJt>6}D>FFJO&dxwS8txsAMS-z=aQed14}5VyIANu0G4mV4y1s=&t=RLA{Crj+NfT& zZEPRbmmo!nZD6DaTfhBBu_vCR0WlB4x+*=%S6j5yoZ&Xv;p!d8*C4pkf>;wO^#iE# z@U!AAwxh=;!hH(8tc8OH$icnxj(4=Q@$T8!Z$)K*&Rgnktl??B}7ZALyhABVi7xk&uAT(WnJ{)Uy_h@i<7>eaf#5YMr#bD z1!-eg4%A@#DQA`k@|LCGr(d>LyRVNHDz)yVhxkdum)`nEtOKKT*%#&GL1Suew_1+Y zk-4{6C%@V#@e1ZbZv|L6bp`oA=7CtsZSBlhq13X1iw`#r(K+~uzy7R7;am(pYO%L4CVJDOvzQh3b3$0j<% zK?H8}`(@T%tu4}OZrrd*4HzfwCd;3z{5*q$%dePW`W-r;F`+~FgB3x1pgd$&oQ*0) zgLDuE=%<(gp(w;{RW}JjBm3(g_>XV{1iukOnf_bBg z_H4-1;`g^=gsvx+bcLUnI%jf~%=h&gSyp>^8eL)OQlQ z(n~(BaNUO@^q+6ft9T4F)sl|fBQ-vkb(3Kh%z~IY6Qtnt5sRr1b<*@xjTnK zHcObQDuJZ3*8+l0%t|Oo#(k{V(FwRKT-u7#Dh%Bmm6A81mMpc+26R$1_fYw{HgH}w z((>Wl3m1o$I&%4>*IM#*;c0NQaVZ`Ty_!Tl@AIuYYR+)%VR|6qW|a`i`Q~JL;zuX| zi|h+Qxz#Ld_-+fckKYU#Z}$Pvg9clsgLc@xeSOM!8A9@=$mCnfRtXUL!C$+-%1ctO zl_|#C#TMf&p7VS}6;2Wl=sf6yZ6Opqvmj2;LOSz75Pf`ZZ_hkRB){Z8_fK9%yT22= zc4P8-IT+nJwlItvgo5&y4~(_pjVX{rb451k#K`Po4nEKG$302-nt!C4y;dIxQTZ_^ z`jF1byJ`rc&bKR7S*QQ}sfOtzvI)@c6df3FB|VFCV)E@Tzwiv!W>XUd zz--EJM~NfKr3@~~=N6Kj_=c2&TdqDt4B-3bBl($g^%!(JM^8XV4g_S!;#!|xQE^F_VYJL! zO^_P8RjOji1E;7#zY4wu9AR~Oy*ElRFYo)>(ou7=tCCBBTe0q%Pi)JCpQiDg8oS=PeK<_Tf~0o~1!G3CRf0&le1yazuBQ&+zmr zzBNz7YA+F%icn1`*l`&!Nl7^Z6|U7@-lj3wTxTv(w#Zd&c~tDm?!FEme-1hFiK=35 z<__kRYM5J|WXr~Q2eM~U;dA0X4=iq?EK<{?w*rhp0$Pd5P`^uS5phO`<2gW*Z!9>s zd#Eqr&wJhJF?HDYdn*@tRi|a`4C1{OtvMtT`)%hz;oT<(1UjyLc722 z5qN?2guA4@smq!6_XWeFC~`b>Ko#%s96@78cqJZw9F4w*WY^K0ePB=lV~rYB(krq? z=T29%oxmFwTwca?N&jiHdR6LCP-#VyDH&$j%MhF)W|`nBPK;S~gRQ4bqaOdn zQVEyJllQYS_@kA48dIH&Y*8`jE$>foEGGwGcyyCj@ZGT;u$j9s4gA5&aK+rrdZv*l z%r6Js{N>yA(1;Y^Pt4W2uUa)FfPH4)Vdaw}KsyPqQ|vOQ;`xhXiY8AcAx&Eg*8#-@ zqwBL}<_DCwfHP-qjX~zIuj;Qwyov0dES-uOGRu(kd>1~Wbe(}8;7A#_*&M)^n_IWB zD{6c)+X^|PZ^!3loUOZ$(K&oszjD8vU1{_-**je%yCEKP#`h3Jb=$4{297C_P!MDS z&GJ~0M2}yhI%Z%(I<-@$gO1oVSlBYq`0y%Tfr~WYZ&1HSbU=w}~NISxV6}AL)*nDeHqXK!#JeteO2*e`)s zxKAa{PkE;~LK07#epJyi4hrJ)IeW9KVM=X@40hd(t)-=bONeo{E5j2-V@9zC6NXP< zb<^Jgh|(vD)RlZJn^k8DLb5YsL51~1M2#!VG!F~85*W|{*2@S~_D=<+s#aNzf0}4+ z;k!D?b^~7H{J=hPOW|-H_WUD+#ljNsp+?m8(n8XGcdY7wW7RGYsGoSEU(LnOFA^Bl z6q*LaUDM^fX}m@K7nID6a)QhA)3E_-%W^i!vh{!#Q}jS7i}Vxk08Oo0|xdUhLEl#lx+0+7WVxy2X z9rnPIUWmm>9)AYHo4K73ERQtVr^A=qL-cIhE_j8jv*TF8-j(nC2!6mB`<}w2DSve8 zsm~rmB%wavUh0jylX7s7?CJ$pf|@9-{YAKcwxE$A>j&OMJ}}qU++WN5Ejlv>I7=rj zuQ}QD)6@YMSRrq}zY?F0VdX^mR)rsAs@i92#NcF(p~o`hNHi9xNM65i78Hu|qK(ms#NRe?dpYUOuOx-ut){3FmmR;k%;}ibUTa?0 zt(Axv`h@~@R-kbC%h${oj2=w=ZagqiEsDgsTngo|Ryqti_OINycUR>`M(@M=D#$(|E4jO`LAT$zsJ(PYav-`pd7a%_t1_r86H)Y2Qo$oFhd;W3+oP$0Z8q_KSh`Z(^@ zX5O8;*(AL2Y^G1BaswQ?FP(~tc~7nIO}NC zh!{MX*wX)6lrfUK{oSC>JTf2t#c(dNj2Ultz9q3C-n?GU7>xf+;T|j38CvMpT+8hT zq1|QS+J)3n#(Y^dYH6ik0?Zbs#Gq6SIsalVR)>>Z#F{kR7z=x$Y6|NWKN@1oX;z{` zVxx*Lk{`6lzp7PN1gB|sWVFTD{>}!XWb94)2CPMI4NF+G4ikJhP)I+|%3?(BDkrm? zDn$)+KokcycSQ*t$x>tm^>kYAO<5O_X*yx|VnJZdTV7cLcCOQ00_9_u$k^x>3AFPqgl4qdRVc1*mxbN5JrHQz$)(8p!`Z$>JB&Ri(QMtYholvrQH5WE-i~W<# zWhoFL*%7fBq(n=KKPi~FXp`5`R6gN(9q5h_7oB{Os%&-^ES#=j)yaE3*7&joOdVsQ zjY%p$$SsC!o2h%|O?rgjY0dZ(xuqL&bwkdOV5uL$DdKoeUpw4-h_}Ku?gakr*F`NS zN*6trket;Z5I*@p(6luTBHQ8^N|0tL=$6%l zcXLo)#{cK(JfI5ITPVF-o%avjyu$>?5eACkBzEdJ<6@D-QAESH^DiZe~~6psAD;G)Rl3WpUS9p->cpX|~<3=rLC4+RE5l@{i&x?tL}_SB@<8QJuwQgwn7 zz;Jn1Mk)EHsG3w14!rraJ#g5Ogxb}FVX6x77!We6@GU&$9966c`ZgkXxGk*egT2kJ zD7<{@1lvUsy6ELnMksEaUzonH!=2X{isM7kfwOPdL4Jq?cIoLLsY%2kegtRj_l5aQ z*Xnd(CAnmW1qlHK2wa4Lt5!P5XMhrhPe$dX6r$H__4vuUD*)eJ1r9SuIiB8KDiuCV z>$KfaHSI~0MTO89?~1DbEhm?2SjV+heLIi}7)6Slb*1h$qdNZ`DfLg_%NR+gg1qO_ z{#7Riq%8#|Jqg4^a*X0h`sH@q5)^l}Kw}h7{FomDdJMfyVTLQtrZV$0Uji zZ+l%2SG36ZSB+Z+ehZ8ZyyD-@jL=j)3h@%fX&&lmhQ?VK&)#b<9=EYO9$joa^`cVW zWFpl;3TBg;PVF^1&A4#`)86sm@Dx6o3Zc#p&2(^zX@aMPAg_uPr)CyD@_K8_y98SJmrni?L4`e{y8mzD zS_pZTfl4vovovLs#5eoznU3JBh5`O!_dUQ+RwV&QFjALOlrUy|(zN{6x4>1W zp8yimGi%=;HOnY{H<4a0e0rl7s*4ws3%HwI@M8D8;$Y-^6|s2Rn_VA%dL$6#ktF87 zF`ru*GU?W?(QdH$4+5=WVv$02jU;ZBI&3bY47fEz?4}%8KQK65m?^MNg|H_Bwejsi z;X7*62CV{mfTTH5Yk*k`@r4(0v`D)6_5H$g0B*ESpbW{M*!tKkHmUU8Jx5RsKVA(2 z6bZ4Q9uimAe*of`TYvE9xo_3 zZ-WW~XcEdd+7?F41o&>qwaXmfnD?JgirK%$1>tONcaSFL3|H>~WB2FkW_h}e!FvwV zr3r@1ob;sheGuM8aDNqfof%8SArQSe6f%6qUXa&T_8Ve zT0%Y1-1p4W*@Kt8>Xx&7*Fm=gspzF{62HmbBBb0ISinfcoh-u+9 zcS}sroren%u@&kWnFTCQ?4tX`=)R6=L;eQhJbu0SZX0#<)Fpl!_MO|nnP<2fkO}jQ zdriR~IwS4P-VOr!f!p7y5H&`#ykqhDDv*}9SlAW&0KVOU#x=78e7fC%{#;Q46Z$$i zDjJcAfPUbaSpz2hL_O3uJ8O8PLf-76Q!(?X$ph!X8&R$*m_nemq|YpX1Uchh2y zHlFY`a@;bom`JS6=3eeDdkb(&ENE(nfg3dMtP{88V3-iZp#1)`4bToCU5-&^aY)eO z-IIkISV^8Vv7ntHovKL?al+LrhVJq@wJ~7 z%ijH=oZfw$gsVU* zF9&P=zhMD>-U_+?OG5s8U*!K>6*^9r-w$%UR~?a2LA z881&p!tI?gsoB1CNxa51ABP>1)vfSbGaYLuRJSdXnMetrFaiEo9K`c{ARlP; z0nOB6+MpNwAZ+nEG+8p$J0jlC*qmp^FSY5O{cXRo)9pQp(4LrUd|lDSNzX}N_0&eBJGkU zstTB@7zH&%Mnemblu9Wc!6(Zyr)Ar_d&BN$>*+p|3$?v7`tPTtDm5vxALo<^Oev%~ z9B2!OY2f!8(;*D0C{Eu!3Lm!S#o4>EfuIT5R*`VkOK&b`G4+y#y3~QsgDIVMy1FSDf77bY3;Tgdk` zfP%4}VlSla)sQe9ytR~C8@M))KU5f+Ae}V5|!O0((?QJlg)Y>SQ0>v5kP1 z(m%YwdMV5a1?lzZL(I`oZQ&Dlz={s!>YF^=x%`?i!MWY)teBg06Sl{YAYi)%1IESa z@2ri8R+W2T&0c$OxuDHh;$OI&x{uJ$_Q1q z@G?pLa%UKzy&@P;_HykiYAF{_r#Gs>FCS{jB&Y$e+U#vC%j&%`&}LY1Zu+ThH8I(i zhT!`BpT4NOeTNRYfBLwHn60o{exO;SHia3Tm#?muUXvWi#NGxD z<;R=Gbt3?zOvqTK1T&vharNp>v4aorAleC?GI3i7s%#CV$)Sw13H}=5Uq}&9peG}Q z?eq(2vftgY+vmM$a`b_cSynz<0DDMBRQ;-AzE1%ex$EPlu~}1VJ(TTeE8P;8tZ+Mi z?izz+*g5R%=FLp~+ktyCboV zN=wU&Ygp>{rK}5czMpC}tx#b=e?|n$JQPlkQz*L%T7#h}R$zgGTaABkuQyX6WP|#a zJ*)P;NV<$)^DeGERXD7vo@)GPp-pxbX6!p4Jf)hS9ypI!L<+tI;>7udD)^h;w$&md z0wyNAMaX1W19Oll%w$O*kRBo<$$g_hS*3^mQ4^UZgDl%FxLZLJ)L-U7K6kM1VjPvy z*iX~vZ6J&`q=g$YLaln1yzF%=lH#OLZQBc@-p>gmX zK*7rT*{#BvwLe6x-u^Di;3gQ&Tcs^z6Fn$2iLw=QO>2(4>*X7u3fU9qUt-kXQt;mx z_0QNG<)8K@bn*sf|9EjUv3160`RDup|KfC*{|cD=PX~>E3pxK^81-Lfr@wWZ|IJPe zOsuT`)_l=$`YjIcbFAikYSGvv?Tpuv47NTRt~4l*PxfbrkDUItKDZCGt)8Oacl#=5 z&fmYvT035pNfA%a*ZbyZb2T{B=9uxibIb`&d$h+z8xH$pKr3PVAC0cYm;zs`4m*I~ z$4u>B*Wk7HJq~LyNa;aw&yz8D6N3=`u7S&}l;BZ7Vw|F2HG*%1e!cMoR`D_WgGHjP z4Bl%n+^2aQ3dD(v_u|H>y8Sd>Wx77s(t|2>O&$IZLG>Ng(nGD(l8?VsNqV)o;Q`dp z_MsQ~F#p?HWCP6sUUfDlG_Q^PU?g+ZHlb z=Jmz`DX$%S-X;&O$43pN%=++S;{_%Qb@(dbUk7%RjcYq+%_R6 zz`7F8-jiha4kpa^H*H3P@T%z^_GAyq`HHR5s1|$7+AC}**7@hw(y&D?0n_H_z5G(A zJqp{TXe8ac*NZHke<_I0pS=Kh`S>cC(OdaYuYCPkj3Qts9~%4&XJq6&wg}Ow2WXM{ zIKsA~iDDS^8=awu;M~BXnu=#6mR_lxz2#s~Q#O*!Tq3A;HrWPtmfFYizUka!-eu!p zb+|~PGz`hBC`VbL*$G@f38o=3%Rg_!SqP&*L6)f4z;MqBN{d@G?aJ0^Fuh9%3V566 zRL8KhLdbuo2we6s2yL8Mm|QD<>1<&bA`yJ$e98dhCVmTGB@lsLihg&p#Dps?wo(x* z3=qP*$7IJL17qC~Qu|K1_8Am(?s#~Z5_YGwiPb{It3 z+)@R!DtR`&%(^l=DUZ@8k4^-KN#$cHi0G)OPW3S#Juz!(ku`upotQr_Xc5E4LWpN& z1SA_3QDJCdpUQFvmWjLwdqmw@V^j=U6>EJiqS?TVm2e>K?33#l|IyyPWeNvvL(Vw4w|NBV!6l(Y>>JmI}@TKMc2u z!l1F!eev7eMa<*cedmEMQB83$UACm3@uD$V{KJ=}DsfR8D*~Jh>hP$zvdo4F+i*;) zhkQB6qGB^3E}D)1tGzFQrs{hemLi1A^KfMz@4dL!JP#Q%WX#NUFK*_0uQ^I&p2tE& zNXQUH5+XwgAqfdd#*mQtJ@}3Kz3>0~ukTy$THjj#yB2Go=RDJX_Otid&pyxDJ5;7U z29@bKxRO^~t0Qj})5k|wzhmS=*J}DvB6Z_NXA-!YJ@stR4KTZ)XwiEC{QHRTU1h$& znEk9}@F3$QhaF|H7!%SIo71iEM5dYj1@gT*V~^B8p)?hlHuJWJN<0b}g9Q33CVpq` zd4)PJL{~sk!|Y)L?FCCyr{=~lUzYT`$!0M|*f5NnN;<=omThyXQ9+9BZWpk-6s?$e zYzP!4930MJ{mqZnH|x-zKeR;xZ9!9eIqX;V%$n$z#F^%b-UB-+SA|R>x0?^p)-QI#G%{R-pO&e1l*RL(( zt#Dt${o}Lem#jp%6#Spw{D6;#ZYT%}g+N8+<*_&n%FdOHL?d#{l-S77l&Qhb?1t)7 zp4k|K7mAmIDXbOs;m$;-a#|dyC?0uTY7SAYO57ZdB8iN;_s)Rc@?p`VB3rfSt{<0J zWzFdYXlkP3Mmr?m)fp|A5a7OrT<#mXgPqB`Bjz|Rvsu4+u(@-v^Ks|k`aXRVJ{~Dv z!40yu){=-<(Q3lUi8GRT7cLhIaN)-H7T`aE20N!?FfN~Z21K!Sn$kbt||l4GGr{H7}dfVMQvxnZ+#X$F}TQjRnJUDQ`rE(#G=AS(nTGF#ehNB)Tgz99AMK z-)3clL3vVe@9_59{T!9`mJSEA+*TSP6;O#|EOzyyAv4sdYeHo5vxWvh@q+u72oy<) zt8_2Wehz*?9Tb>GNKI^9-G+qS#@>sn{=$soGBOvc#?i2iM3ZZ2-qH*eiqp6-n4Eh_ z#5DgQ?J7djfSy8%siBTg9+%)e?Idf-6cyhFY}yc+*xv`4Q+Rc-M>hO^QvpjyU$GSZ z_L-@zw~Qoru+MtctCv*IH+9F$%wJmTz1RF|yyVB)-i+^aH)#6%c+rl8K+ZE#r=7I~ z{_9R#`&ZLf6VNs-QuJ({WgILaLiz(c+w6VLg>|E9(Gt5LC z$mdNO=ZBHnVcM=h71J#fp=%jmc6(Zq^)Bx}y+;}B7hEp;J}dpx#@wZjEYr7H`qp#T zFN*ISfFlpdSF(6!QkZ8>P&@}2tD9h%&C2QrZV=2Cy{i*0)T z7es1yr;_`+rJyURtt#B;nX&1%z7c!N&`oZx zpWk4Uxcg^3Gw1wGE0IrCz$kcE@-B0>d4I94>!@IyGkvx2xWv*{cK_43;x;Oq3q38q zSB*~#+7G;R=U%wamg4ey?AlOz{f3>@WSv5`cFaH{z3lS)v9zZEY;U%mcbiIsKP;G;*-Tfg#x zH;c|9`;7I=hVnYQi?8xS2kb@JwyRlK*jN|YN9s1_bK1D~``om;8;3&OF<@6=bbPkq z8dB|^c*nxr<+n@GWD>wTwouzuma)mljAWZk@U~`1eBPqK+F00Axzd{McRI01x9e>T zT261uv$iuiX~MJvPP6?K<(#HVj;x*|W#Tk4dpw698ykxDGru3)pA0AIM9J|>5wdf~ zHm#=fzmCYYn@pTcH1s&Tuy-IyjK*jC5?&|s}bo+ha1@7Vnk5!}|9+){(wTPl42 z@@pZ&OyD4r8&YHZo%!8NUxeU;_3OmTJmXi(=PxuGM@|IwRGw#JtIA0GB)#7nr+7`r zX{J=p!g2d+sau`-%IVFKcvj>1nsY(Vx7Kd^4V5TZ6c+Y8tres__o63>K98e@(>ufy zm6F+H<2(A5xt8nu=_Si=(8iZmo%7rC`NdUG{yUX%Q!*lxjL+9~JfmXY_UqhT5|kc@ zkEn5xW=I&>w*6qWQ85)@ec9srcp5z2xqsY>ONbp?)-oC^-Nd~4r6WYbB5j84L(U85 zkdaLprJm9pdK%+F$F&-rYa^~}a{>VeDcr^ObEc5c|~xz1xGfzj>=b z%)*R2xTTEos8s)99I*qrBq=n6?EzVairEAO+IXM-aNCey@vSm(}X7> zirds3lHvWOoUQuyJvRw6Zu-&Oyqu8dO33OeG-c>F!k8ZyR;@;gmLuLFpDeH`wC;Cd zVtpg7I+)?qubP3Dq=FJpaAwe)PSEnG)@W$69dwE%O*Vb8?uvJHmTx~3&h)0jL-WK#-WZ7#HEs)`1WRD|~4GmJ=i#aF~ueq&C6;F6AFd1!Gv zYocNY>MDV1p4KC->G}NE`l)OZN*tytUIO;bz50B_KiUNf*t0csg3(%cEOk0)JIJLp zO!A8;T^)#(3$|s}jM?Z~6I*SJy?Q6^<$>62t7$3qTgcgb@2SR3CK#>6I6K2460_ zaf6Yj!bX%IFdro;oW=f`(R?t$8s}}@nOScnWjY959fF>S4|5S5*sb;Ux zv9Nf-_{FDXR^z4U1!C`pXv_L*eRO8=iJfd`ZkB}CJYTTLq}8quq|qwq3n$TB!FggvSO*-kDw`U0tHG(hgKs6mN*iYFJ-EQtVXwYptGXJz6V!gB4Sz|Q_u;#DneA-(Xuhp6))Tbs_jz$JJ zM^Vr+(zx)ew%UvAuFX-^iEOR-2;7A};7qrD(xTUhjo-+BI0nnCJlbPjS|%nW44jw9VN z&~6{Rkwce8#TxgM>=3ChW80Zz33I!s_s{OMH%gI`r_AD#mHpT@9!dwpZ7FmmhCJNsZmg%GgO$(AKSS*dHT`fm$l7!qw{CE zxm3i@gplMZ-tgFs4gQ%#Jij{Pf*Ax-`MA=}2T z0aYPEvSKryLC;DbcMNY_j{HdUV5OpNESgytB~;Vf<(G0DH6DKs9@OAA7?~3lSNVSb zYgFEHtBo_-`zQZkz4Tn_`{E@|T|d$~i~_Ik!hCPoB5R|;c1y+O*B_{N*)vgunK4>g z_r^*QHCyWMt{eXRkP#4<(m;=(tHSm7G=c-}KHlsahN25D<_Ly=^Bbz;z7Ks~>o6w$ zB5gw^Q5*jOZQWa}NKVi-KIZ|IOc|zfx%Z~Ld^VX+kZ@g>Kid$yFlrRnyg7?xPuHX)K+~*smh&}Js zTQ7CxYW9^<%S`f1A8S?}^WyI`Cohr^1skO4l- zAWvnJBP{fUPs`=eCA#=tot>Z$JrDE-JzG_@&oUIaHi(O0uWnall$;Okp4oV4cIvf{ zdsJJ242g>v2LDpcNBN(Z%G_-p2i2R-;HBI2URkc(+8$8v9TG-)j^wG=3Uaag;x#1X zgy{@?vw6zi{BU2fZ7r1QVd!^*Ss%Y5gb}1sWtL(~n2A?Z=VJO`aX`-Zu9s0h;g!De z4l+#)iuF4i4dtu!>}w@2Rjah>QH9|ljn@KvY?N$C1e@^b6oqlX2N%Tkll8u2%C^LN z6yxptvXTT}C&?w1`Sc+d9)cp&DhPO*35U;DNpV(EjZNmpv5|%oL&A#`@xv%i?Q{rx z5J+UT5N2^OBUS@AHX1=yE5xT5h1%cwG_gsZy&lYNOVi^-tTVe!KV>>`gO>Y@!G!qO z=#|J&Wj7d}tr1klC7f3}shBc(9Y0c|0QANtT0+{BsA7uL|Kkq<(Oa zqKddmD<$Yw<&{aE`+*HtR)67wKaBSTu!{!Nn}I}*Bfc?7C7%?kP6Ozi9!zDPv$G*vCDrPQYI`C(8qvh^&v9siv|iY>&6=O*LSs(N|YL>yIc(NL3l3UbR>cEzFR5@T<%G>h%g8t+AC79Qldr+eAMz8kozGnr#=Uh=@Xs42ERtGC1vwE=ZgjRHkJKr zT%>^kcj_$HLiL=}#JQqylA^_&9j<6n4%!t)v^|UA0AXF|d_PapODk@N+2Chqep-&X zUROW&iSzy3rN_5#B@}en5EApAsz{G@I6I8*G+`f+|kk9j_6y3b5Bg`NEx^IfVm zxjqk7L4}!{?=g6rLrTakr5bPhD*vTr#YD`#$etNpYQw8aB?ax8w8L85F7V9z_ro8l zEV5-h9DK{Uw8Fgej&AIgSJ*+-^AW2qct7u||P)#r7R zUsFiyK<2LxJ+3q?oYVeP*YC5xvvnYsF87>xRc=h7#=||9sC-InQe-RnJE=(x-#&hz zuG0BuyA`C?60M<|5{J?epfF`<}P0ba@LtQFU2QMT7uh&ME0b~JeO zH1K(PmpMLdq;Ztw{i1oBg%+nVkNeJYUO!}4r1Sz`8``XL(aoREsYwhI?;Iz-Dt>W; z{9je$Q$N`E41^Gns){tSFr^76L`21Bhl#gc+ z$mm3S;}Kk%(KPP{sde!mZ<*0Twg02m(c4c_gvngIKW^h28q{TIJ{l(N@%U=#i$o!b%QZ%W1#iCP zYSqeP8aF)aZorzL>wS;e8hZ1x3yUK%iI!jrtxf-a&DQ~AA)c{+#)H6#eb@C7&*i=j zw=Ui$vj$z0A*PXZznRsFFv14a6uch(p<(+DJwN97uV)(JuDKc>KW&NH;gkzk+a`UU z{XApSF$W35ml0#JO5%@^no)G$cy*iNYuYW8cB`A4RF#VvalCVFQu)*tf&R^D=xCF4- z_L+&aHoGg?w_Gv2F7&<1^dst&*3~aU;S$^IB7NzhJ=fUQWhmJ>m?$aFsKsy~BCI0Z zIl^w~`ciwIvJaHaHe9`+D&@XSmXf*AM6L0tpS41}CRf+H$s0%mE-Go=wb0>)MAVPs zNIFxQ*pd$fJD(#Zws%>bCGns1kM;#uek{c5M?P^^u?T<2wmrRfdl_zoP*6xdP$s|d z5lxau{+(S5w0~-ctyNkVwA~s&(LBtWboOba%<8_|4bz|eXA;8ttb?6WgF-i_gM~ZR zwnr1=Iqs_FD8;Pb3uKOa!0yaSr4SaVky-gEaB6viaO;$%`nJfn0{_QwvS~xk^7siC zyY2x=6Hpff+?7u-r$Dj!PENmkEEuwJuqaAf(|k(a+qYSduI79VY@!0QI*r8Ee__mN{-4pjza=El)=y26*= z6c=|E=aUE&eR;O4^RY$Z`ZJeF)ihs0#(K30;ZL(axhNt8Cf>7-g2HZj^#H6_PGRI}qQA%uOQ(PZPzcW4U^bzq0HOW}j95{#8VpM4XP(?rB2k3Il4B(>(6> zsuHSyo2V*`Lw3Y5r1SHOr`FDTW{%fapgQ$^{%lt8-g!Y;+?185)(&<^ml!VU4Q&hbqe|1H!J-Zxa>cK z-GR+D)MUA_F?9?#ZrZ{m#>uepdd<(T>aJlPu$JZjWw_D266=O9Pd5Y3z>Bc|pq&@GGtr#9L zm?`$q-01yA;-6$Xv_a5lb#Sn!cYRm1WiHhx#T_hHaHBkBolkg`>bn?$wfcU$6Tw5G zg76iGVBU(zZaUvnLy4d0d@0wL>3oT|0tl?bbZ&b6c!ir+yl^M4eBf;)4eM=bSuYx6 zamf1Ek3nqY{ba-NxgWVmYBHWUo`$A}cYM@24a4I+-%!?lhO|BL_I~PHiFVH0R|%hO zq)WMzec7OtBE>w*+$b$$YG!Ko>+}Ow%R8AVIiHzt=5$ds>%Z1-O6W`=T-@Y2jV1_7 zRb**SIOVV-IxRMR%9GeA6+c8Q!SoC=q(k+dFVB@*`1)LDi)_w!U`|Ez8aO4%kD*9N zUn<^V2{Wk8K-{~{n-Dha*kMZ?N=RC#pGJ9Qkg|yLtj5_>>-ncY>f;a5o)Ir+h=^wB zyunq0BE&u73}FwUrf@#J^bpyB(!d{`Iake|FU{)YPTm)&c4pAv!a2>mXK#2{-ZbQ- z4#Dd?AXgl+FbS$4(#U=o%(30+lH(hcSjU{hnY7{Z}~>M*4Dktq{_&H9^^%3`y!j8pi4E{lVwoHfN{T za#ML-kYL?j*38@BARPVv;em{W_4e27Yxr9|FUfD)exGJ|Us0)6JGDs6MAkEk!@)*d zRTJ*WE;=_CJm6OxCD}?0cb;PX*0wsQ1RVEjAHIn0>A1hY+u2dk`ZMI50X~7%S#n+u zFqo$ygFwk-ie2&>rPBKbsp^mx7*n*1le$ytRU;oduFdN~kIRzx;6gpFkC;D3)(1}9 zGIguls$j-Gy>h->J&HijcSnb`vM80J5uX%qwCt+;KN{!H?f8!}Vh*!Zz-n&x?ntzo zBUlp&WX7Oze!?1HWjieD=%%`=lCH9@prM~D!rev32yEzuz#Zn&9Fjx8swk{I$_;7f zhC4*YTELDz>$3tIxf{Eo0j?;}QF9plnIdz9ar}jxsRa~n0TY+B0`L!69?AQcf>ktC z4-pS3M8Uv?p&u59a@BNmaF>+@>tT>63{Vxm->bq8Hb6O|fp@Had`d`n1d1Q1fQN?* z%Jnb@2m&PH9P&D>1qSVbbH{*S$7d6$nu4GZ2ymYas2!j!*%AC$?LTz=lkA9#I@$## z3KBowf9H^`^6^1j!lI%O;AJmV?2skQ>IhfY&K0Qd3Dc^(*g0ZB;$TCdJ|@5kUn+JU z8Yr}*6QC$q>Cn!&BM!eA9S0H?g-U@nads|fdnGqVm%~HB4#le5xuRYC_>NnQ{|ICV zyko}MJArlGF|KwlMR#FFrvqRe9?EdItS9C7@nI0gk;Ok*$ z?~KBM5P(Cw$?+~fZ{!7`k#fAIFdc}FhYHFGt>KSB8T#uQ+50=&OCfm`<+zN z*w@ZO*a7W=Lt(HWz}e+4s2E&Qzn~ybMk4Dg?d$5{3djcey1KYwrG4dik7%TU@*x<^ z3pzrI5}P~FEmmbB?(6$;1DTc2|F=K zVR11DNntxNgo7~B4j~SKp%C^cN#yVHJpQ8R-vk0T0EuFNC4iE&KE@sCWskzh@haJ4 z+!1y-kSZ|1pj}*07!X_p0^&1817n5{mY-K%7JR7BU-bLkIDY~CU#SeV>p$BFxN&SG z5Kxj<0a8qGC{^H3j#m@{g$qMq!cd42L`oV4krsstLPVt@5Woz-qq<{^fL4~{)i*pE z7hxhu7Z;ET;5>&WhKY!Zh#n*B0M88vzkkK|f5i+sI{&jFTwM|+JjNY4<{_pd{97Tq`kDm;iwHbv>ou^LfhNnfJOiVjtICHaMS*4!1;II=)yV$uo%JKRNBT)`^ zUM@IZc^x$1^H_HW9LUrig9HhK^bjbFyBkD8!~o^tj=_l_-R)1vJmPsM^EWyF)F+N$ zz=&~ZWAGm%5^x3jU-?rGTZr$qdSK0zn?AhA0Cu_6g2StbIf4*d(dFX&kt7e!Z`u# zjwf*Ze+H_)7?cAU$>Cw&!2dsfAUF&r1_K@5Ir>RJrGUWo@CS1H112U4gs&%H;)g-( z-(XOPC>#i7Pr$^afQb483=(O;0(&_9B3D96;ul&; zz}rsplN3E%Ncfw6Vo)*BlXez^iXSevoWO%goUDf!&}_fpi33WXq!ow5f1#Ct9xhe< zU513H#4r3Ler - - - - - - - - - diff --git a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 index 84520b27d8..1c4d680f79 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/API.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/API.ob07 @@ -1,23 +1,13 @@ -(* - Copyright 2016, 2017, 2018 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, Anton Krotov + All rights reserved. *) MODULE API; -IMPORT sys := SYSTEM; +IMPORT SYSTEM, K := KOSAPI; CONST @@ -41,10 +31,23 @@ VAR CriticalSection: CRITICAL_SECTION; + import*, multi: BOOLEAN; -PROCEDURE [stdcall] zeromem* (size, adr: INTEGER); + eol*: ARRAY 3 OF CHAR; + base*: INTEGER; + + +PROCEDURE [stdcall] zeromem* (dwords: INTEGER; adr: INTEGER); BEGIN - sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F") + SYSTEM.CODE( + 0FCH, (* cld *) + 031H, 0C0H, (* xor eax, eax *) + 057H, (* push edi *) + 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) + 0F3H, 0ABH, (* rep stosd *) + 05FH (* pop edi *) + ) END zeromem; @@ -53,128 +56,31 @@ VAR tmp: INTEGER; BEGIN FOR tmp := adr TO adr + size - 1 BY 4096 DO - sys.PUT(tmp, 0) + SYSTEM.PUT(tmp, 0) END END mem_commit; -PROCEDURE strncmp* (a, b, n: INTEGER): INTEGER; -VAR - A, B: CHAR; - Res: INTEGER; -BEGIN - Res := 0; - WHILE n > 0 DO - sys.GET(a, A); INC(a); - sys.GET(b, B); INC(b); - DEC(n); - IF A # B THEN - Res := ORD(A) - ORD(B); - n := 0 - ELSIF A = 0X THEN - n := 0 - END - END - RETURN Res -END strncmp; - - -PROCEDURE [stdcall] sysfunc1* (arg1: INTEGER): INTEGER; -BEGIN - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20400"); (* ret 04h *) - RETURN 0 -END sysfunc1; - - -PROCEDURE [stdcall] sysfunc2* (arg1, arg2: INTEGER): INTEGER; -BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20800"); (* ret 08h *) - RETURN 0 -END sysfunc2; - - -PROCEDURE [stdcall] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER; -BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20C00"); (* ret 0Ch *) - RETURN 0 -END sysfunc3; - - -PROCEDURE [stdcall] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER; -BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21000"); (* ret 10h *) - RETURN 0 -END sysfunc4; - - -PROCEDURE [stdcall] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER; -BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("56"); (* push esi *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("8B7518"); (* mov esi, [ebp + 18h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5E"); (* pop esi *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21400"); (* ret 14h *) - RETURN 0 -END sysfunc5; - - PROCEDURE switch_task; -VAR - res: INTEGER; BEGIN - res := sysfunc2(68, 1) + K.sysfunc2(68, 1) END switch_task; PROCEDURE futex_create (ptr: INTEGER): INTEGER; - RETURN sysfunc3(77, 0, ptr) + RETURN K.sysfunc3(77, 0, ptr) END futex_create; PROCEDURE futex_wait (futex, value, timeout: INTEGER); -VAR - res: INTEGER; BEGIN - res := sysfunc5(77, 2, futex, value, timeout) + K.sysfunc5(77, 2, futex, value, timeout) END futex_wait; PROCEDURE futex_wake (futex, number: INTEGER); -VAR - res: INTEGER; BEGIN - res := sysfunc4(77, 3, futex, number) + K.sysfunc4(77, 3, futex, number) END futex_wake; @@ -195,7 +101,7 @@ END LeaveCriticalSection; PROCEDURE InitializeCriticalSection* (VAR CriticalSection: CRITICAL_SECTION); BEGIN - CriticalSection[0] := futex_create(sys.ADR(CriticalSection[1])); + CriticalSection[0] := futex_create(SYSTEM.ADR(CriticalSection[1])); CriticalSection[1] := 0 END InitializeCriticalSection; @@ -208,14 +114,14 @@ BEGIN idx := ASR(size, 5); res := pockets[idx]; IF res # 0 THEN - sys.GET(res, pockets[idx]); - sys.PUT(res, size); + SYSTEM.GET(res, pockets[idx]); + SYSTEM.PUT(res, size); INC(res, 4) ELSE temp := 0; IF heap + size >= endheap THEN - IF sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN - temp := sysfunc3(68, 12, HEAP_SIZE) + IF K.sysfunc2(18, 16) > ASR(HEAP_SIZE, 10) THEN + temp := K.sysfunc3(68, 12, HEAP_SIZE) ELSE temp := 0 END; @@ -228,7 +134,7 @@ BEGIN END END; IF (heap # 0) & (temp # -1) THEN - sys.PUT(heap, size); + SYSTEM.PUT(heap, size); res := heap + 4; heap := heap + size ELSE @@ -236,11 +142,11 @@ BEGIN END END ELSE - IF sysfunc2(18, 16) > ASR(size, 10) THEN - res := sysfunc3(68, 12, size); + IF K.sysfunc2(18, 16) > ASR(size, 10) THEN + res := K.sysfunc3(68, 12, size); IF res # 0 THEN mem_commit(res, size); - sys.PUT(res, size); + SYSTEM.PUT(res, size); INC(res, 4) END ELSE @@ -259,13 +165,13 @@ VAR size, idx: INTEGER; BEGIN DEC(ptr, 4); - sys.GET(ptr, size); + SYSTEM.GET(ptr, size); IF size <= MAX_SIZE THEN idx := ASR(size, 5); - sys.PUT(ptr, pockets[idx]); + SYSTEM.PUT(ptr, pockets[idx]); pockets[idx] := ptr ELSE - size := sysfunc3(68, 13, ptr) + size := K.sysfunc3(68, 13, ptr) END RETURN 0 END __DISPOSE; @@ -274,8 +180,11 @@ END __DISPOSE; PROCEDURE NEW_DISPOSE (func, arg: INTEGER): INTEGER; VAR res: INTEGER; + BEGIN - EnterCriticalSection(CriticalSection); + IF multi THEN + EnterCriticalSection(CriticalSection) + END; IF func = _new THEN res := __NEW(arg) @@ -283,7 +192,10 @@ BEGIN res := __DISPOSE(arg) END; - LeaveCriticalSection(CriticalSection) + IF multi THEN + LeaveCriticalSection(CriticalSection) + END + RETURN res END NEW_DISPOSE; @@ -298,63 +210,110 @@ PROCEDURE _DISPOSE* (ptr: INTEGER): INTEGER; END _DISPOSE; -PROCEDURE ExitProcess* (p1: INTEGER); +PROCEDURE exit* (p1: INTEGER); BEGIN - p1 := sysfunc1(-1) -END ExitProcess; + K.sysfunc1(-1) +END exit; -PROCEDURE ExitThread* (p1: INTEGER); +PROCEDURE exit_thread* (p1: INTEGER); BEGIN - p1 := sysfunc1(-1) -END ExitThread; + K.sysfunc1(-1) +END exit_thread; PROCEDURE OutChar (c: CHAR); -VAR - res: INTEGER; BEGIN - res := sysfunc3(63, 1, ORD(c)) + K.sysfunc3(63, 1, ORD(c)) END OutChar; -PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); +PROCEDURE OutLn; +BEGIN + OutChar(0DX); + OutChar(0AX) +END OutLn; + + +PROCEDURE OutStr (pchar: INTEGER); VAR c: CHAR; BEGIN - IF lpCaption # 0 THEN - OutChar(0DX); - OutChar(0AX); + IF pchar # 0 THEN REPEAT - sys.GET(lpCaption, c); + SYSTEM.GET(pchar, c); IF c # 0X THEN OutChar(c) END; - INC(lpCaption) - UNTIL c = 0X; - OutChar(":"); - OutChar(0DX); - OutChar(0AX) - END; - REPEAT - sys.GET(lpText, c); - IF c # 0X THEN - OutChar(c) - END; - INC(lpText) - UNTIL c = 0X; + INC(pchar) + UNTIL c = 0X + END +END OutStr; + + +PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); +BEGIN IF lpCaption # 0 THEN - OutChar(0DX); - OutChar(0AX) + OutLn; + OutStr(lpCaption); + OutChar(":"); + OutLn + END; + OutStr(lpText); + IF lpCaption # 0 THEN + OutLn END END DebugMsg; -PROCEDURE init* (p1: INTEGER); +PROCEDURE OutString (s: ARRAY OF CHAR); +VAR + i: INTEGER; BEGIN - p1 := sysfunc2(68, 11); - InitializeCriticalSection(CriticalSection) + i := 0; + WHILE (i < LEN(s)) & (s[i] # 0X) DO + OutChar(s[i]); + INC(i) + END +END OutString; + + +PROCEDURE imp_error; +BEGIN + OutString("import error: "); + IF K.imp_error.error = 1 THEN + OutString("can't load "); OutString(K.imp_error.lib) + ELSIF K.imp_error.error = 2 THEN + OutString("not found "); OutString(K.imp_error.proc); OutString(" in "); OutString(K.imp_error.lib) + END; + OutLn +END imp_error; + + +PROCEDURE init* (_import, code: INTEGER); +BEGIN + multi := FALSE; + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + base := code - 36; + K.sysfunc2(68, 11); + InitializeCriticalSection(CriticalSection); + K._init; + import := (K.dll_Load(_import) = 0) & (K.imp_error.error = 0); + IF ~import THEN + imp_error + END END init; +PROCEDURE SetMultiThr* (value: BOOLEAN); +BEGIN + multi := value +END SetMultiThr; + + +PROCEDURE GetTickCount* (): INTEGER; + RETURN K.sysfunc2(26, 9) * 10 +END GetTickCount; + + END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 index e7cf4bab2a..889059d0a4 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Args.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -38,7 +38,7 @@ END GetChar; PROCEDURE ParamParse; VAR p, count, name: INTEGER; c: CHAR; cond: INTEGER; - PROCEDURE ChangeCond(A, B, C: INTEGER); + PROCEDURE ChangeCond(A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER); BEGIN IF (c <= 20X) & (c # 0X) THEN cond := A @@ -64,11 +64,11 @@ BEGIN WHILE (argc < MAX_PARAM) & (cond # 6) DO c := GetChar(p); CASE cond OF - |0: ChangeCond(0, 4, 1); IF cond = 1 THEN Params[count, 0] := p END - |1: ChangeCond(0, 3, 1); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END - |3: ChangeCond(3, 1, 3); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END - |4: ChangeCond(5, 0, 5); IF cond = 5 THEN Params[count, 0] := p END - |5: ChangeCond(5, 1, 5); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END + |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END + |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END + |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END ELSE END; INC(p) @@ -86,8 +86,8 @@ BEGIN WHILE (j < len) & (i <= Params[n, 1]) DO c := GetChar(i); IF c # 22X THEN - s[j] := c; - INC(j) + s[j] := c; + INC(j) END; INC(i); END; diff --git a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 index 763ef55cd4..e993d375cb 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/ColorDlg.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -65,7 +65,7 @@ BEGIN res.color_type := 0; res.procinfo := sys.ADR(res.procinf[0]); res.com_area_name := sys.ADR(res.s_com_area_name[0]); - res.start_path := sys.ADR("/rd/1/colrdial"); + res.start_path := sys.SADR("/rd/1/colrdial"); res.draw_window := draw_window; res.status := 0; res.X := 0; @@ -86,7 +86,7 @@ END Destroy; PROCEDURE Load; VAR Lib: INTEGER; - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); + PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR); VAR a: INTEGER; BEGIN a := KOSAPI.GetProcAdr(name, Lib); @@ -96,8 +96,8 @@ VAR Lib: INTEGER; BEGIN Lib := KOSAPI.LoadLib("/rd/1/Lib/Proc_lib.obj"); - GetProc(sys.ADR(Dialog_init), "ColorDialog_init"); - GetProc(sys.ADR(Dialog_start), "ColorDialog_start"); + GetProc(Lib, sys.ADR(Dialog_init), "ColorDialog_init"); + GetProc(Lib, sys.ADR(Dialog_start), "ColorDialog_start"); END Load; BEGIN diff --git a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 index 140800c739..7d80c4fb01 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Console.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -17,50 +17,78 @@ MODULE Console; -IMPORT ConsoleLib; +IMPORT ConsoleLib, In, Out; + CONST - Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; - Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; - DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; - LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; + Black* = 0; Blue* = 1; Green* = 2; Cyan* = 3; + Red* = 4; Magenta* = 5; Brown* = 6; LightGray* = 7; + DarkGray* = 8; LightBlue* = 9; LightGreen* = 10; LightCyan* = 11; + LightRed* = 12; LightMagenta* = 13; Yellow* = 14; White* = 15; -PROCEDURE SetCursor*(X, Y: INTEGER); + +PROCEDURE SetCursor* (X, Y: INTEGER); BEGIN - ConsoleLib.set_cursor_pos(X, Y) + ConsoleLib.set_cursor_pos(X, Y) END SetCursor; -PROCEDURE GetCursor*(VAR X, Y: INTEGER); + +PROCEDURE GetCursor* (VAR X, Y: INTEGER); BEGIN - ConsoleLib.get_cursor_pos(X, Y) + ConsoleLib.get_cursor_pos(X, Y) END GetCursor; + PROCEDURE Cls*; BEGIN - ConsoleLib.cls + ConsoleLib.cls END Cls; -PROCEDURE SetColor*(FColor, BColor: INTEGER); -VAR res: INTEGER; + +PROCEDURE SetColor* (FColor, BColor: INTEGER); +VAR + res: INTEGER; + BEGIN - IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN - res := ConsoleLib.set_flags(LSL(BColor, 4) + FColor) - END + IF (FColor IN {0..15}) & (BColor IN {0..15}) THEN + res := ConsoleLib.set_flags(LSL(BColor, 4) + FColor) + END END SetColor; -PROCEDURE GetCursorX*(): INTEGER; -VAR x, y: INTEGER; + +PROCEDURE GetCursorX* (): INTEGER; +VAR + x, y: INTEGER; + BEGIN - ConsoleLib.get_cursor_pos(x, y) - RETURN x + ConsoleLib.get_cursor_pos(x, y) + RETURN x END GetCursorX; -PROCEDURE GetCursorY*(): INTEGER; -VAR x, y: INTEGER; + +PROCEDURE GetCursorY* (): INTEGER; +VAR + x, y: INTEGER; + BEGIN - ConsoleLib.get_cursor_pos(x, y) - RETURN y + ConsoleLib.get_cursor_pos(x, y) + RETURN y END GetCursorY; + +PROCEDURE open*; +BEGIN + ConsoleLib.open(-1, -1, -1, -1, ""); + In.Open; + Out.Open +END open; + + +PROCEDURE exit* (bCloseWindow: BOOLEAN); +BEGIN + ConsoleLib.exit(bCloseWindow) +END exit; + + END Console. diff --git a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 index 85ac6def5e..74346a692c 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/ConsoleLib.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -23,11 +23,11 @@ CONST COLOR_BLUE* = 001H; COLOR_GREEN* = 002H; - COLOR_RED* = 004H; + COLOR_RED* = 004H; COLOR_BRIGHT* = 008H; - BGR_BLUE* = 010H; - BGR_GREEN* = 020H; - BGR_RED* = 040H; + BGR_BLUE* = 010H; + BGR_GREEN* = 020H; + BGR_RED* = 040H; BGR_BRIGHT* = 080H; IGNORE_SPECIALS* = 100H; WINDOW_CLOSED* = 200H; @@ -38,25 +38,25 @@ TYPE VAR - version* : INTEGER; - init* : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); - exit* : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); + version* : INTEGER; + init* : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); + exit* : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); write_asciiz* : PROCEDURE [stdcall] (string: INTEGER); write_string* : PROCEDURE [stdcall] (string, length: INTEGER); - get_flags* : PROCEDURE [stdcall] (): INTEGER; - set_flags* : PROCEDURE [stdcall] (new_flags: INTEGER): INTEGER; + get_flags* : PROCEDURE [stdcall] (): INTEGER; + set_flags* : PROCEDURE [stdcall] (new_flags: INTEGER): INTEGER; get_font_height* : PROCEDURE [stdcall] (): INTEGER; get_cursor_height* : PROCEDURE [stdcall] (): INTEGER; set_cursor_height* : PROCEDURE [stdcall] (new_height: INTEGER): INTEGER; - getch* : PROCEDURE [stdcall] (): INTEGER; - getch2* : PROCEDURE [stdcall] (): INTEGER; - kbhit* : PROCEDURE [stdcall] (): INTEGER; - gets* : PROCEDURE [stdcall] (str, n: INTEGER): INTEGER; - gets2* : PROCEDURE [stdcall] (callback: gets2_callback; str, n: INTEGER): INTEGER; - cls* : PROCEDURE [stdcall] (); + getch* : PROCEDURE [stdcall] (): INTEGER; + getch2* : PROCEDURE [stdcall] (): INTEGER; + kbhit* : PROCEDURE [stdcall] (): INTEGER; + gets* : PROCEDURE [stdcall] (str, n: INTEGER): INTEGER; + gets2* : PROCEDURE [stdcall] (callback: gets2_callback; str, n: INTEGER): INTEGER; + cls* : PROCEDURE [stdcall] (); get_cursor_pos* : PROCEDURE [stdcall] (VAR x, y: INTEGER); set_cursor_pos* : PROCEDURE [stdcall] (x, y: INTEGER); - set_title* : PROCEDURE [stdcall] (title: INTEGER); + set_title* : PROCEDURE [stdcall] (title: INTEGER); PROCEDURE open*(wnd_width, wnd_height, scr_width, scr_height: INTEGER; title: ARRAY OF CHAR); BEGIN @@ -66,7 +66,7 @@ END open; PROCEDURE main; VAR Lib: INTEGER; - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); + PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR); VAR a: INTEGER; BEGIN a := KOSAPI.GetProcAdr(name, Lib); @@ -77,25 +77,25 @@ VAR Lib: INTEGER; BEGIN Lib := KOSAPI.LoadLib("/rd/1/lib/Console.obj"); ASSERT(Lib # 0); - GetProc(sys.ADR(version), "version"); - GetProc(sys.ADR(init), "con_init"); - GetProc(sys.ADR(exit), "con_exit"); - GetProc(sys.ADR(write_asciiz), "con_write_asciiz"); - GetProc(sys.ADR(write_string), "con_write_string"); - GetProc(sys.ADR(get_flags), "con_get_flags"); - GetProc(sys.ADR(set_flags), "con_set_flags"); - GetProc(sys.ADR(get_font_height), "con_get_font_height"); - GetProc(sys.ADR(get_cursor_height), "con_get_cursor_height"); - GetProc(sys.ADR(set_cursor_height), "con_set_cursor_height"); - GetProc(sys.ADR(getch), "con_getch"); - GetProc(sys.ADR(getch2), "con_getch2"); - GetProc(sys.ADR(kbhit), "con_kbhit"); - GetProc(sys.ADR(gets), "con_gets"); - GetProc(sys.ADR(gets2), "con_gets2"); - GetProc(sys.ADR(cls), "con_cls"); - GetProc(sys.ADR(get_cursor_pos), "con_get_cursor_pos"); - GetProc(sys.ADR(set_cursor_pos), "con_set_cursor_pos"); - GetProc(sys.ADR(set_title), "con_set_title"); + GetProc(Lib, sys.ADR(version), "version"); + GetProc(Lib, sys.ADR(init), "con_init"); + GetProc(Lib, sys.ADR(exit), "con_exit"); + GetProc(Lib, sys.ADR(write_asciiz), "con_write_asciiz"); + GetProc(Lib, sys.ADR(write_string), "con_write_string"); + GetProc(Lib, sys.ADR(get_flags), "con_get_flags"); + GetProc(Lib, sys.ADR(set_flags), "con_set_flags"); + GetProc(Lib, sys.ADR(get_font_height), "con_get_font_height"); + GetProc(Lib, sys.ADR(get_cursor_height), "con_get_cursor_height"); + GetProc(Lib, sys.ADR(set_cursor_height), "con_set_cursor_height"); + GetProc(Lib, sys.ADR(getch), "con_getch"); + GetProc(Lib, sys.ADR(getch2), "con_getch2"); + GetProc(Lib, sys.ADR(kbhit), "con_kbhit"); + GetProc(Lib, sys.ADR(gets), "con_gets"); + GetProc(Lib, sys.ADR(gets2), "con_gets2"); + GetProc(Lib, sys.ADR(cls), "con_cls"); + GetProc(Lib, sys.ADR(get_cursor_pos), "con_get_cursor_pos"); + GetProc(Lib, sys.ADR(set_cursor_pos), "con_set_cursor_pos"); + GetProc(Lib, sys.ADR(set_title), "con_set_title"); END main; BEGIN diff --git a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 b/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 index e87e132ed3..12291065f6 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/DateTime.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -19,10 +19,10 @@ MODULE DateTime; IMPORT KOSAPI; -CONST ERR* = -7.0D5; +CONST ERR* = -7.0E5; -PROCEDURE Encode*(Year, Month, Day, Hour, Min, Sec: INTEGER): LONGREAL; -VAR d, i: INTEGER; M: ARRAY 13 OF CHAR; Res: LONGREAL; +PROCEDURE Encode*(Year, Month, Day, Hour, Min, Sec: INTEGER): REAL; +VAR d, i: INTEGER; M: ARRAY 14 OF CHAR; Res: REAL; BEGIN Res := ERR; IF (Year >= 1) & (Year <= 9999) & (Month >= 1) & (Month <= 12) & @@ -36,18 +36,18 @@ BEGIN DEC(Year); d := Year * 365 + (Year DIV 4) - (Year DIV 100) + (Year DIV 400) + Day - 693594; FOR i := 1 TO Month - 1 DO - d := d + ORD(M[i]) - ORD("0") + 28 + d := d + ORD(M[i]) - ORD("0") + 28 END; - Res := LONG(FLT(d)) + LONG(FLT(Hour * 3600000 + Min * 60000 + Sec * 1000)) / 86400000.0D0 + Res := FLT(d) + FLT(Hour * 3600000 + Min * 60000 + Sec * 1000) / 86400000.0 END END RETURN Res END Encode; -PROCEDURE Decode*(Date: LONGREAL; VAR Year, Month, Day, Hour, Min, Sec: INTEGER): BOOLEAN; -VAR Res, flag: BOOLEAN; d, t, i: INTEGER; M: ARRAY 13 OF CHAR; +PROCEDURE Decode*(Date: REAL; VAR Year, Month, Day, Hour, Min, Sec: INTEGER): BOOLEAN; +VAR Res, flag: BOOLEAN; d, t, i: INTEGER; M: ARRAY 14 OF CHAR; - PROCEDURE MonthDay(n: INTEGER): BOOLEAN; + PROCEDURE MonthDay(n: INTEGER; VAR d, Month: INTEGER; M: ARRAY OF CHAR): BOOLEAN; VAR Res: BOOLEAN; BEGIN Res := FALSE; @@ -60,9 +60,9 @@ VAR Res, flag: BOOLEAN; d, t, i: INTEGER; M: ARRAY 13 OF CHAR; END MonthDay; BEGIN - IF (Date >= -693593.0D0) & (Date < 2958466.0D0) THEN + IF (Date >= -693593.0) & (Date < 2958466.0) THEN d := FLOOR(Date); - t := FLOOR((Date - LONG(FLT(d))) * 86400000.0D0); + t := FLOOR((Date - FLT(d)) * 86400000.0); d := d + 693593; Year := 1; Month := 1; @@ -82,7 +82,7 @@ BEGIN i := 1; flag := TRUE; WHILE flag & (i <= 12) DO - flag := MonthDay(i); + flag := MonthDay(i, d, Month, M); INC(i) END; Day := d; @@ -98,43 +98,44 @@ BEGIN RETURN Res END Decode; -PROCEDURE Now*(VAR Year, Month, Day, Hour, Min, Sec: INTEGER); +PROCEDURE Now*(VAR Year, Month, Day, Hour, Min, Sec, Msec: INTEGER); VAR date, time: INTEGER; BEGIN - date := KOSAPI.sysfunc1(29); - time := KOSAPI.sysfunc1(3); + date := KOSAPI.sysfunc1(29); + time := KOSAPI.sysfunc1(3); - Year := date MOD 16; - date := date DIV 16; - Year := (date MOD 16) * 10 + Year; - date := date DIV 16; + Year := date MOD 16; + date := date DIV 16; + Year := (date MOD 16) * 10 + Year; + date := date DIV 16; Month := date MOD 16; - date := date DIV 16; + date := date DIV 16; Month := (date MOD 16) * 10 + Month; - date := date DIV 16; + date := date DIV 16; Day := date MOD 16; - date := date DIV 16; + date := date DIV 16; Day := (date MOD 16) * 10 + Day; - date := date DIV 16; + date := date DIV 16; - Hour := time MOD 16; - time := time DIV 16; - Hour := (time MOD 16) * 10 + Hour; - time := time DIV 16; + Hour := time MOD 16; + time := time DIV 16; + Hour := (time MOD 16) * 10 + Hour; + time := time DIV 16; Min := time MOD 16; - time := time DIV 16; + time := time DIV 16; Min := (time MOD 16) * 10 + Min; - time := time DIV 16; + time := time DIV 16; Sec := time MOD 16; - time := time DIV 16; + time := time DIV 16; Sec := (time MOD 16) * 10 + Sec; - time := time DIV 16; + time := time DIV 16; - Year := Year + 2000 + Year := Year + 2000; + Msec := 0 END Now; END DateTime. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 index dded894dd9..daaf40ece1 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Debug.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -21,11 +21,11 @@ IMPORT KOSAPI, sys := SYSTEM; CONST - d = 1.0D0 - 5.0D-12; + d = 1.0 - 5.0E-12; VAR - Realp: PROCEDURE (x: LONGREAL; width: INTEGER); + Realp: PROCEDURE (x: REAL; width: INTEGER); PROCEDURE Char*(c: CHAR); VAR res: INTEGER; @@ -72,7 +72,7 @@ BEGIN UNTIL i = 0 END WriteInt; -PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN; +PROCEDURE IsNan(AValue: REAL): BOOLEAN; VAR h, l: SET; BEGIN sys.GET(sys.ADR(AValue), l); @@ -80,8 +80,8 @@ BEGIN RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) END IsNan; -PROCEDURE IsInf(x: LONGREAL): BOOLEAN; - RETURN ABS(x) = sys.INF(LONGREAL) +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() END IsInf; PROCEDURE Int*(x, width: INTEGER); @@ -97,15 +97,15 @@ BEGIN END END Int; -PROCEDURE OutInf(x: LONGREAL; width: INTEGER); -VAR s: ARRAY 4 OF CHAR; i: INTEGER; +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; BEGIN IF IsNan(x) THEN s := "Nan"; INC(width) - ELSIF IsInf(x) & (x > 0.0D0) THEN + ELSIF IsInf(x) & (x > 0.0) THEN s := "+Inf" - ELSIF IsInf(x) & (x < 0.0D0) THEN + ELSIF IsInf(x) & (x < 0.0) THEN s := "-Inf" END; FOR i := 1 TO width - 4 DO @@ -120,8 +120,8 @@ BEGIN Char(0AX) END Ln; -PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER); -VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN; +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; BEGIN IF IsNan(x) OR IsInf(x) THEN OutInf(x, width) @@ -130,23 +130,23 @@ BEGIN ELSE len := 0; minus := FALSE; - IF x < 0.0D0 THEN + IF x < 0.0 THEN minus := TRUE; INC(len); x := ABS(x) END; e := 0; - WHILE x >= 10.0D0 DO - x := x / 10.0D0; + WHILE x >= 10.0 DO + x := x / 10.0; INC(e) END; IF e >= 0 THEN len := len + e + p + 1; - IF x > 9.0D0 + d THEN - INC(len) + IF x > 9.0 + d THEN + INC(len) END; IF p > 0 THEN - INC(len) + INC(len) END ELSE len := len + p + 2 @@ -158,51 +158,51 @@ BEGIN Char("-") END; y := x; - WHILE (y < 1.0D0) & (y # 0.0D0) DO - y := y * 10.0D0; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; DEC(e) END; IF e < 0 THEN - IF x - LONG(FLT(FLOOR(x))) > d THEN - Char("1"); - x := 0.0D0 + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 ELSE - Char("0"); - x := x * 10.0D0 + Char("0"); + x := x * 10.0 END ELSE WHILE e >= 0 DO - IF x - LONG(FLT(FLOOR(x))) > d THEN - IF x > 9.0D0 THEN - String("10") - ELSE - Char(CHR(FLOOR(x) + ORD("0") + 1)) - END; - x := 0.0D0 - ELSE - Char(CHR(FLOOR(x) + ORD("0"))); - x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 - END; - DEC(e) + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) END END; IF p > 0 THEN Char(".") END; WHILE p > 0 DO - IF x - LONG(FLT(FLOOR(x))) > d THEN - Char(CHR(FLOOR(x) + ORD("0") + 1)); - x := 0.0D0 + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 ELSE - Char(CHR(FLOOR(x) + ORD("0"))); - x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 END; DEC(p) END END END _FixReal; -PROCEDURE Real*(x: LONGREAL; width: INTEGER); +PROCEDURE Real*(x: REAL; width: INTEGER); VAR e, n, i: INTEGER; minus: BOOLEAN; BEGIN IF IsNan(x) OR IsInf(x) THEN @@ -217,22 +217,22 @@ BEGIN width := 9 END; width := width - 5; - IF x < 0.0D0 THEN + IF x < 0.0 THEN x := -x; minus := TRUE ELSE minus := FALSE END; - WHILE x >= 10.0D0 DO - x := x / 10.0D0; + WHILE x >= 10.0 DO + x := x / 10.0; INC(e) END; - WHILE (x < 1.0D0) & (x # 0.0D0) DO - x := x * 10.0D0; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; DEC(e) END; - IF x > 9.0D0 + d THEN - x := 1.0D0; + IF x > 9.0 + d THEN + x := 1.0; INC(e) END; FOR i := 1 TO n DO @@ -260,7 +260,7 @@ BEGIN END END Real; -PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER); +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); BEGIN Realp := Real; _FixReal(x, width, p) @@ -282,7 +282,7 @@ VAR info: info_struct; res: INTEGER; BEGIN info.subfunc := 7; info.flags := 0; - info.param := sys.ADR(" "); + info.param := sys.SADR(" "); info.rsrvd1 := 0; info.rsrvd2 := 0; info.fname := "/rd/1/develop/board"; diff --git a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 index 684853b6db..729c365a9f 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/File.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/File.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -17,239 +17,300 @@ MODULE File; -IMPORT sys := SYSTEM, KOSAPI; +IMPORT sys := SYSTEM, KOSAPI; + CONST - SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2; + SEEK_BEG* = 0; SEEK_CUR* = 1; SEEK_END* = 2; + TYPE - FNAME* = ARRAY 520 OF CHAR; + FNAME* = ARRAY 520 OF CHAR; - FS* = POINTER TO rFS; + FS* = POINTER TO rFS; - rFS* = RECORD - subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER; - name*: FNAME - END; + rFS* = RECORD + subfunc*, pos*, hpos*, bytes*, buffer*: INTEGER; + name*: FNAME + END; - FD* = POINTER TO rFD; + FD* = POINTER TO rFD; - rFD* = RECORD - attr*: INTEGER; - ntyp*: CHAR; - reserved: ARRAY 3 OF CHAR; - time_create*, date_create*, - time_access*, date_access*, - time_modif*, date_modif*, - size*, hsize*: INTEGER; - name*: FNAME - END; + rFD* = RECORD + attr*: INTEGER; + ntyp*: CHAR; + reserved: ARRAY 3 OF CHAR; + time_create*, date_create*, + time_access*, date_access*, + time_modif*, date_modif*, + size*, hsize*: INTEGER; + name*: FNAME + END; -PROCEDURE [stdcall] f_68_27(file_name: INTEGER; VAR size: INTEGER): INTEGER; + +PROCEDURE [stdcall] f_68_27 (file_name: INTEGER; VAR size: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("6A44"); (* push 68 *) - sys.CODE("58"); (* pop eax *) - sys.CODE("6A1B"); (* push 27 *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("8B4D08"); (* mov ecx, [ebp + 08h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("8B4D0C"); (* mov ecx, [ebp + 0Ch] *) - sys.CODE("8911"); (* mov [ecx], edx *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20800"); (* ret 08h *) - RETURN 0 -END f_68_27; + sys.CODE( + 053H, (* push ebx *) + 06AH, 044H, (* push 68 *) + 058H, (* pop eax *) + 06AH, 01BH, (* push 27 *) + 05BH, (* pop ebx *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 8] *) + 0CDH, 040H, (* int 64 *) + 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 089H, 011H, (* mov dword [ecx], edx *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 8 *) + ) + RETURN 0 +END f_68_27; -PROCEDURE Load*(FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; - RETURN f_68_27(sys.ADR(FName[0]), size) + +PROCEDURE Load* (FName: ARRAY OF CHAR; VAR size: INTEGER): INTEGER; + RETURN f_68_27(sys.ADR(FName[0]), size) END Load; -PROCEDURE GetFileInfo*(FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; -VAR res2: INTEGER; fs: rFS; -BEGIN - fs.subfunc := 5; - fs.pos := 0; - fs.hpos := 0; - fs.bytes := 0; - fs.buffer := sys.ADR(Info); - COPY(FName, fs.name) - RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0 -END GetFileInfo; -PROCEDURE Exists*(FName: ARRAY OF CHAR): BOOLEAN; -VAR fd: rFD; +PROCEDURE GetFileInfo* (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; +VAR + res2: INTEGER; fs: rFS; + BEGIN - RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) + fs.subfunc := 5; + fs.pos := 0; + fs.hpos := 0; + fs.bytes := 0; + fs.buffer := sys.ADR(Info); + COPY(FName, fs.name) + + RETURN KOSAPI.sysfunc22(70, sys.ADR(fs), res2) = 0 +END GetFileInfo; + + +PROCEDURE Exists* (FName: ARRAY OF CHAR): BOOLEAN; +VAR + fd: rFD; +BEGIN + RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) END Exists; + -PROCEDURE Close*(VAR F: FS); +PROCEDURE Close* (VAR F: FS); BEGIN - IF F # NIL THEN - DISPOSE(F) - END + IF F # NIL THEN + DISPOSE(F) + END END Close; -PROCEDURE Open*(FName: ARRAY OF CHAR): FS; -VAR F: FS; -BEGIN - IF Exists(FName) THEN - NEW(F); - IF F # NIL THEN - F.subfunc := 0; - F.pos := 0; - F.hpos := 0; - F.bytes := 0; - F.buffer := 0; - COPY(FName, F.name) - END - ELSE - F := NIL - END - RETURN F -END Open; -PROCEDURE Delete*(FName: ARRAY OF CHAR): BOOLEAN; -VAR F: FS; res, res2: INTEGER; -BEGIN - IF Exists(FName) THEN - NEW(F); - IF F # NIL THEN - F.subfunc := 8; - F.pos := 0; - F.hpos := 0; - F.bytes := 0; - F.buffer := 0; - COPY(FName, F.name); - res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); - DISPOSE(F) +PROCEDURE Open* (FName: ARRAY OF CHAR): FS; +VAR + F: FS; + +BEGIN + + IF Exists(FName) THEN + NEW(F); + IF F # NIL THEN + F.subfunc := 0; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(FName, F.name) + END ELSE - res := -1 + F := NIL END - ELSE - res := -1 - END - RETURN res = 0 + + RETURN F +END Open; + + +PROCEDURE Delete* (FName: ARRAY OF CHAR): BOOLEAN; +VAR + F: FS; + res, res2: INTEGER; + +BEGIN + + IF Exists(FName) THEN + NEW(F); + IF F # NIL THEN + F.subfunc := 8; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(FName, F.name); + res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); + DISPOSE(F) + ELSE + res := -1 + END + ELSE + res := -1 + END + + RETURN res = 0 END Delete; + + +PROCEDURE Seek* (F: FS; Offset, Origin: INTEGER): INTEGER; +VAR + res: INTEGER; + fd: rFD; -PROCEDURE Seek*(F: FS; Offset, Origin: INTEGER): INTEGER; -VAR res: INTEGER; fd: rFD; BEGIN - IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN - CASE Origin OF - |SEEK_BEG: F.pos := Offset - |SEEK_CUR: F.pos := F.pos + Offset - |SEEK_END: F.pos := fd.size + Offset + + IF (F # NIL) & GetFileInfo(F.name, fd) & (BITS(fd.attr) * {4} = {}) THEN + CASE Origin OF + |SEEK_BEG: F.pos := Offset + |SEEK_CUR: F.pos := F.pos + Offset + |SEEK_END: F.pos := fd.size + Offset + ELSE + END; + res := F.pos ELSE - END; - res := F.pos - ELSE - res := -1 - END - RETURN res + res := -1 + END + + RETURN res END Seek; -PROCEDURE Read*(F: FS; Buffer, Count: INTEGER): INTEGER; -VAR res, res2: INTEGER; -BEGIN - IF F # NIL THEN - F.subfunc := 0; - F.bytes := Count; - F.buffer := Buffer; - res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); - IF res2 > 0 THEN - F.pos := F.pos + res2 - END - ELSE - res2 := 0 - END - RETURN res2 -END Read; -PROCEDURE Write*(F: FS; Buffer, Count: INTEGER): INTEGER; -VAR res, res2: INTEGER; -BEGIN - IF F # NIL THEN - F.subfunc := 3; - F.bytes := Count; - F.buffer := Buffer; - res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); - IF res2 > 0 THEN - F.pos := F.pos + res2 - END - ELSE - res2 := 0 - END - RETURN res2 -END Write; +PROCEDURE Read* (F: FS; Buffer, Count: INTEGER): INTEGER; +VAR + res, res2: INTEGER; -PROCEDURE Create*(FName: ARRAY OF CHAR): FS; -VAR F: FS; res2: INTEGER; BEGIN - NEW(F); - IF F # NIL THEN - F.subfunc := 2; - F.pos := 0; - F.hpos := 0; - F.bytes := 0; - F.buffer := 0; - COPY(FName, F.name); - IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN - DISPOSE(F) - END - END - RETURN F -END Create; -PROCEDURE DirExists*(FName: ARRAY OF CHAR): BOOLEAN; -VAR fd: rFD; -BEGIN - RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr)) -END DirExists; - -PROCEDURE CreateDir*(DirName: ARRAY OF CHAR): BOOLEAN; -VAR F: FS; res, res2: INTEGER; -BEGIN - NEW(F); - IF F # NIL THEN - F.subfunc := 9; - F.pos := 0; - F.hpos := 0; - F.bytes := 0; - F.buffer := 0; - COPY(DirName, F.name); - res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); - DISPOSE(F) - ELSE - res := -1 - END - RETURN res = 0 -END CreateDir; - -PROCEDURE DeleteDir*(DirName: ARRAY OF CHAR): BOOLEAN; -VAR F: FS; res, res2: INTEGER; -BEGIN - IF DirExists(DirName) THEN - NEW(F); IF F # NIL THEN - F.subfunc := 8; - F.pos := 0; - F.hpos := 0; - F.bytes := 0; - F.buffer := 0; - COPY(DirName, F.name); - res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); - DISPOSE(F) + F.subfunc := 0; + F.bytes := Count; + F.buffer := Buffer; + res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); + IF res2 > 0 THEN + F.pos := F.pos + res2 + END ELSE - res := -1 + res2 := 0 END - ELSE - res := -1 - END - RETURN res = 0 + + RETURN res2 +END Read; + + +PROCEDURE Write* (F: FS; Buffer, Count: INTEGER): INTEGER; +VAR + res, res2: INTEGER; + +BEGIN + + IF F # NIL THEN + F.subfunc := 3; + F.bytes := Count; + F.buffer := Buffer; + res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); + IF res2 > 0 THEN + F.pos := F.pos + res2 + END + ELSE + res2 := 0 + END + + RETURN res2 +END Write; + + +PROCEDURE Create* (FName: ARRAY OF CHAR): FS; +VAR + F: FS; + res2: INTEGER; + +BEGIN + NEW(F); + + IF F # NIL THEN + F.subfunc := 2; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(FName, F.name); + IF KOSAPI.sysfunc22(70, sys.ADR(F^), res2) # 0 THEN + DISPOSE(F) + END + END + + RETURN F +END Create; + + +PROCEDURE DirExists* (FName: ARRAY OF CHAR): BOOLEAN; +VAR + fd: rFD; +BEGIN + RETURN GetFileInfo(FName, fd) & (4 IN BITS(fd.attr)) +END DirExists; + + +PROCEDURE CreateDir* (DirName: ARRAY OF CHAR): BOOLEAN; +VAR + F: FS; + res, res2: INTEGER; + +BEGIN + NEW(F); + + IF F # NIL THEN + F.subfunc := 9; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(DirName, F.name); + res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); + DISPOSE(F) + ELSE + res := -1 + END + + RETURN res = 0 +END CreateDir; + + +PROCEDURE DeleteDir* (DirName: ARRAY OF CHAR): BOOLEAN; +VAR + F: FS; + res, res2: INTEGER; + +BEGIN + + IF DirExists(DirName) THEN + NEW(F); + IF F # NIL THEN + F.subfunc := 8; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(DirName, F.name); + res := KOSAPI.sysfunc22(70, sys.ADR(F^), res2); + DISPOSE(F) + ELSE + res := -1 + END + ELSE + res := -1 + END + + RETURN res = 0 END DeleteDir; + END File. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 index bc232050b5..3a43347bc0 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/HOST.ob07 @@ -1,246 +1,471 @@ -(* - Copyright 2016, 2017 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE HOST; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, K := KOSAPI, API, RTL; + CONST - OS* = "KOS"; - Slash* = "/"; + slash* = "/"; + OS* = "KOS"; + + bit_depth* = RTL.bit_depth; + maxint* = RTL.maxint; + minint* = RTL.minint; + + MAX_PARAM = 1024; + TYPE - FILENAME = ARRAY 2048 OF CHAR; + FNAME = ARRAY 520 OF CHAR; + + FS = POINTER TO rFS; + + rFS = RECORD + subfunc, pos, hpos, bytes, buffer: INTEGER; + name: FNAME + END; + + FD = POINTER TO rFD; + + rFD = RECORD + attr: INTEGER; + ntyp: CHAR; + reserved: ARRAY 3 OF CHAR; + time_create, date_create, + time_access, date_access, + time_modif, date_modif, + size, hsize: INTEGER; + name: FNAME + END; - OFSTRUCT = RECORD - subfunc, pos, hpos, bytes, buf: INTEGER; - name: FILENAME - END; VAR - con_init : PROCEDURE [stdcall] (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); - con_exit : PROCEDURE [stdcall] (bCloseWindow: BOOLEAN); - con_write_asciiz : PROCEDURE [stdcall] (string: INTEGER); - fsize, sec*, dsec*: INTEGER; + Console: BOOLEAN; -PROCEDURE [stdcall] sysfunc22(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER; + Params: ARRAY MAX_PARAM, 2 OF INTEGER; + argc*: INTEGER; + + eol*: ARRAY 3 OF CHAR; + + +PROCEDURE [stdcall, "Console.obj", "con_init"] con_init (wnd_width, wnd_height, scr_width, scr_height, title: INTEGER); + +PROCEDURE [stdcall, "Console.obj", "con_exit"] con_exit (bCloseWindow: BOOLEAN); + +PROCEDURE [stdcall, "Console.obj", "con_write_string"] con_write_string (string, length: INTEGER); + + +PROCEDURE ExitProcess* (p1: INTEGER); BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8919"); (* mov [ecx], ebx *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20C00"); (* ret 0Ch *) - RETURN 0 -END sysfunc22; - -PROCEDURE GetProcAdr(name: ARRAY OF CHAR; lib: INTEGER): INTEGER; -VAR cur, procname, adr: INTEGER; - - PROCEDURE streq(str1, str2: INTEGER): BOOLEAN; - VAR c1, c2: CHAR; - BEGIN - REPEAT - sys.GET(str1, c1); - sys.GET(str2, c2); - INC(str1); - INC(str2) - UNTIL (c1 # c2) OR (c1 = 0X) - RETURN c1 = c2 - END streq; - -BEGIN - adr := 0; - IF (lib # 0) & (name # "") THEN - cur := lib; - REPEAT - sys.GET(cur, procname); - INC(cur, 8) - UNTIL (procname = 0) OR streq(procname, sys.ADR(name[0])); - IF procname # 0 THEN - sys.GET(cur - 4, adr) - END - END - RETURN adr -END GetProcAdr; - -PROCEDURE Time*(VAR sec, dsec: INTEGER); -VAR t: INTEGER; -BEGIN - t := API.sysfunc2(26, 9); - sec := t DIV 100; - dsec := t MOD 100 -END Time; - -PROCEDURE init*; -VAR Lib: INTEGER; - - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); - VAR a: INTEGER; - BEGIN - a := GetProcAdr(name, Lib); - sys.PUT(v, a) - END GetProc; - -BEGIN - Time(sec, dsec); - Lib := API.sysfunc3(68, 19, sys.ADR("/rd/1/lib/console.obj")); - IF Lib # 0 THEN - GetProc(sys.ADR(con_init), "con_init"); - GetProc(sys.ADR(con_exit), "con_exit"); - GetProc(sys.ADR(con_write_asciiz), "con_write_asciiz"); - IF con_init # NIL THEN - con_init(-1, -1, -1, -1, sys.ADR("Oberon-07/11 for KolibriOS")) - END - END -END init; - -PROCEDURE ExitProcess* (n: INTEGER); -BEGIN - IF con_exit # NIL THEN - con_exit(FALSE) - END; - API.ExitProcess(0) + IF Console THEN + con_exit(FALSE) + END; + K.sysfunc1(-1) END ExitProcess; -PROCEDURE AppAdr(): INTEGER; + +PROCEDURE OutChar* (c: CHAR); +BEGIN + IF Console THEN + con_write_string(SYSTEM.ADR(c), 1) + ELSE + K.sysfunc3(63, 1, ORD(c)) + END +END OutChar; + + +PROCEDURE GetFileInfo (FName: ARRAY OF CHAR; VAR Info: rFD): BOOLEAN; +VAR + res2: INTEGER; + fs: rFS; + +BEGIN + fs.subfunc := 5; + fs.pos := 0; + fs.hpos := 0; + fs.bytes := 0; + fs.buffer := SYSTEM.ADR(Info); + COPY(FName, fs.name) + RETURN K.sysfunc22(70, SYSTEM.ADR(fs), res2) = 0 +END GetFileInfo; + + +PROCEDURE Exists (FName: ARRAY OF CHAR): BOOLEAN; +VAR + fd: rFD; + +BEGIN + RETURN GetFileInfo(FName, fd) & ~(4 IN BITS(fd.attr)) +END Exists; + + +PROCEDURE Close (VAR F: FS); +BEGIN + IF F # NIL THEN + DISPOSE(F) + END +END Close; + + +PROCEDURE Open (FName: ARRAY OF CHAR): FS; +VAR + F: FS; + +BEGIN + IF Exists(FName) THEN + NEW(F); + IF F # NIL THEN + F.subfunc := 0; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(FName, F.name) + END + ELSE + F := NIL + END + + RETURN F +END Open; + + +PROCEDURE Read (F: FS; Buffer, Count: INTEGER): INTEGER; +VAR + res, res2: INTEGER; + +BEGIN + IF F # NIL THEN + F.subfunc := 0; + F.bytes := Count; + F.buffer := Buffer; + res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); + IF res2 > 0 THEN + F.pos := F.pos + res2 + END + ELSE + res2 := 0 + END + + RETURN res2 +END Read; + + +PROCEDURE Write (F: FS; Buffer, Count: INTEGER): INTEGER; +VAR + res, res2: INTEGER; + +BEGIN + IF F # NIL THEN + F.subfunc := 3; + F.bytes := Count; + F.buffer := Buffer; + res := K.sysfunc22(70, SYSTEM.ADR(F^), res2); + IF res2 > 0 THEN + F.pos := F.pos + res2 + END + ELSE + res2 := 0 + END + + RETURN res2 +END Write; + + +PROCEDURE Create (FName: ARRAY OF CHAR): FS; +VAR + F: FS; + res2: INTEGER; + +BEGIN + NEW(F); + IF F # NIL THEN + F.subfunc := 2; + F.pos := 0; + F.hpos := 0; + F.bytes := 0; + F.buffer := 0; + COPY(FName, F.name); + IF K.sysfunc22(70, SYSTEM.ADR(F^), res2) # 0 THEN + DISPOSE(F) + END + END + + RETURN F +END Create; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + n: INTEGER; + fs: FS; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(F), fs); + n := Read(fs, SYSTEM.ADR(Buffer[0]), bytes); + IF n = 0 THEN + n := -1 + END + + RETURN n +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + n: INTEGER; + fs: FS; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(F), fs); + n := Write(fs, SYSTEM.ADR(Buffer[0]), bytes); + IF n = 0 THEN + n := -1 + END + + RETURN n +END FileWrite; + + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; +VAR + fs: FS; + res: INTEGER; + +BEGIN + fs := Create(FName); + SYSTEM.GET(SYSTEM.ADR(fs), res) + RETURN res +END FileCreate; + + +PROCEDURE FileClose* (F: INTEGER); +VAR + fs: FS; + +BEGIN + SYSTEM.GET(SYSTEM.ADR(F), fs); + Close(fs) +END FileClose; + + +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; +VAR + fs: FS; + res: INTEGER; + +BEGIN + fs := Open(FName); + SYSTEM.GET(SYSTEM.ADR(fs), res) + RETURN res +END FileOpen; + + +PROCEDURE GetTickCount* (): INTEGER; + RETURN K.sysfunc2(26, 9) +END GetTickCount; + + +PROCEDURE AppAdr (): INTEGER; VAR buf: ARRAY 1024 OF CHAR; a: INTEGER; + BEGIN - a := API.sysfunc3(9, sys.ADR(buf), -1); - sys.GET(sys.ADR(buf) + 22, a) + a := K.sysfunc3(9, SYSTEM.ADR(buf), -1); + SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) RETURN a END AppAdr; -PROCEDURE GetCommandLine*(): INTEGER; -VAR param: INTEGER; + +PROCEDURE GetCommandLine (): INTEGER; +VAR + param: INTEGER; + BEGIN - sys.GET(28 + AppAdr(), param) - RETURN param + SYSTEM.GET(28 + AppAdr(), param) + RETURN param END GetCommandLine; -PROCEDURE GetName*(): INTEGER; -VAR name: INTEGER; + +PROCEDURE GetName (): INTEGER; +VAR + name: INTEGER; + BEGIN - sys.GET(32 + AppAdr(), name) - RETURN name + SYSTEM.GET(32 + AppAdr(), name) + RETURN name END GetName; -PROCEDURE malloc*(size: INTEGER): INTEGER; - RETURN API.sysfunc3(68, 12, size) -END malloc; -PROCEDURE CloseFile*(hObject: INTEGER); -VAR pFS: POINTER TO OFSTRUCT; +PROCEDURE GetChar (adr: INTEGER): CHAR; +VAR + res: CHAR; + BEGIN - sys.PUT(sys.ADR(pFS), hObject); - DISPOSE(pFS) -END CloseFile; + SYSTEM.GET(adr, res) + RETURN res +END GetChar; + + +PROCEDURE ParamParse; +VAR + p, count, name, cond: INTEGER; + c: CHAR; + + + PROCEDURE ChangeCond (A, B, C: INTEGER; c: CHAR; VAR cond: INTEGER); + BEGIN + IF (c <= 20X) & (c # 0X) THEN + cond := A + ELSIF c = 22X THEN + cond := B + ELSIF c = 0X THEN + cond := 6 + ELSE + cond := C + END + END ChangeCond; + -PROCEDURE _OCFile(FileName: ARRAY OF CHAR; VAR FS: OFSTRUCT; mode: INTEGER; VAR fsize: INTEGER): INTEGER; -VAR buf: ARRAY 40 OF CHAR; res: INTEGER; BEGIN - FS.subfunc := mode; - FS.pos := 0; - FS.hpos := 0; - FS.bytes := 0; - FS.buf := sys.ADR(buf); - COPY(FileName, FS.name); - IF sysfunc22(70, sys.ADR(FS), res) = 0 THEN - res := sys.ADR(FS); - sys.GET(sys.ADR(buf) + 32, fsize) - ELSE - res := 0 - END - RETURN res -END _OCFile; + p := GetCommandLine(); + name := GetName(); + Params[0, 0] := name; + WHILE GetChar(name) # 0X DO + INC(name) + END; + Params[0, 1] := name - 1; + cond := 0; + count := 1; + WHILE (argc < MAX_PARAM) & (cond # 6) DO + c := GetChar(p); + CASE cond OF + |0: ChangeCond(0, 4, 1, c, cond); IF cond = 1 THEN Params[count, 0] := p END + |1: ChangeCond(0, 3, 1, c, cond); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END + |3: ChangeCond(3, 1, 3, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |4: ChangeCond(5, 0, 5, c, cond); IF cond = 5 THEN Params[count, 0] := p END + |5: ChangeCond(5, 1, 5, c, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |6: + END; + INC(p) + END; + argc := count +END ParamParse; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, j, len: INTEGER; + c: CHAR; -PROCEDURE IOFile(VAR FS: OFSTRUCT; Buffer, bytes, io: INTEGER): INTEGER; -VAR res1, res: INTEGER; BEGIN - FS.subfunc := io; - FS.bytes := bytes; - FS.buf := Buffer; - res1 := sysfunc22(70, sys.ADR(FS), res); - IF res = -1 THEN - res := 0 - END; - FS.pos := FS.pos + res - RETURN res -END IOFile; + j := 0; + IF n < argc THEN + len := LEN(s) - 1; + i := Params[n, 0]; + WHILE (j < len) & (i <= Params[n, 1]) DO + c := GetChar(i); + IF c # 22X THEN + s[j] := c; + INC(j) + END; + INC(i); + END; + END; + s[j] := 0X +END GetArg; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +VAR + n: INTEGER; -PROCEDURE OCFile(FName: ARRAY OF CHAR; mode: INTEGER): INTEGER; -VAR FS: OFSTRUCT; pFS: POINTER TO OFSTRUCT; res: INTEGER; BEGIN - IF _OCFile(FName, FS, mode, fsize) # 0 THEN - NEW(pFS); - IF pFS = NIL THEN - res := 0 - ELSE - sys.GET(sys.ADR(pFS), res); - pFS^ := FS - END - ELSE - res := 0 - END - RETURN res -END OCFile; + GetArg(0, path); + n := LENGTH(path) - 1; + WHILE path[n] # slash DO + DEC(n) + END; + path[n + 1] := 0X +END GetCurrentDirectory; -PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER; - RETURN OCFile(FName, 2) -END CreateFile; -PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER; - RETURN OCFile(FName, 5) -END OpenFile; +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN path[0] # slash +END isRelative; -PROCEDURE FileSize* (F: INTEGER): INTEGER; - RETURN fsize -END FileSize; -PROCEDURE FileRW* (hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER; -VAR pFS: POINTER TO OFSTRUCT; res: INTEGER; +PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); +VAR + date, time: INTEGER; + BEGIN - IF hFile # 0 THEN - sys.PUT(sys.ADR(pFS), hFile); - res := IOFile(pFS^, Buffer, nNumberOfBytes, 3 * ORD(write)) - ELSE - res := 0 - END - RETURN res -END FileRW; + date := K.sysfunc1(29); + time := K.sysfunc1(3); -PROCEDURE OutString* (str: ARRAY OF CHAR); -VAR n: INTEGER; + year := date MOD 16; + date := date DIV 16; + year := (date MOD 16) * 10 + year; + date := date DIV 16; + + month := date MOD 16; + date := date DIV 16; + month := (date MOD 16) * 10 + month; + date := date DIV 16; + + day := date MOD 16; + date := date DIV 16; + day := (date MOD 16) * 10 + day; + date := date DIV 16; + + hour := time MOD 16; + time := time DIV 16; + hour := (time MOD 16) * 10 + hour; + time := time DIV 16; + + min := time MOD 16; + time := time DIV 16; + min := (time MOD 16) * 10 + min; + time := time DIV 16; + + sec := time MOD 16; + time := time DIV 16; + sec := (time MOD 16) * 10 + sec; + time := time DIV 16; + + year := year + 2000 +END now; + + +PROCEDURE UnixTime* (): INTEGER; + RETURN 0 +END UnixTime; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; BEGIN - n := ORD(str[0] = 3X); - IF con_write_asciiz # NIL THEN - con_write_asciiz(sys.ADR(str[n])) - ELSE - API.DebugMsg(sys.ADR(str[n]), 0) - END -END OutString; + SYSTEM.GET(SYSTEM.ADR(x), a); + SYSTEM.GET(SYSTEM.ADR(x) + 4, b) + RETURN a +END splitf; + +BEGIN + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + Console := API.import; + IF Console THEN + con_init(-1, -1, -1, -1, SYSTEM.SADR("Oberon-07 for KolibriOS")) + END; + ParamParse END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 b/programs/develop/oberon07/Lib/KolibriOS/In.ob07 index e2c740decc..50af0cb957 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/In.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/In.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -84,12 +84,12 @@ BEGIN ELSE res := res * 10; IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN - err := TRUE; - flag := FALSE; - res := 0 + err := TRUE; + flag := FALSE; + res := 0 ELSE - res := res + (ORD(str[i]) - ORD("0")); - INC(i) + res := res + (ORD(str[i]) - ORD("0")); + INC(i) END END END; @@ -117,108 +117,108 @@ BEGIN IF s[i] = "." THEN INC(i); WHILE digit(s[i]) DO - INC(i) + INC(i) END; IF (s[i] = "D") OR (s[i] = "E") OR (s[i] = "d") OR (s[i] = "e") THEN - INC(i); - IF (s[i] = "+") OR (s[i] = "-") THEN - INC(i) - END; - Res := digit(s[i]); - WHILE digit(s[i]) DO - INC(i) - END + INC(i); + IF (s[i] = "+") OR (s[i] = "-") THEN + INC(i) + END; + Res := digit(s[i]); + WHILE digit(s[i]) DO + INC(i) + END END END END RETURN Res & (s[i] <= 20X) END CheckReal; -PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): LONGREAL; -CONST maxDBL = 1.69D308; maxINT = 7FFFFFFFH; -VAR i, scale: INTEGER; res, m, d: LONGREAL; minus, neg: BOOLEAN; +PROCEDURE StrToFloat(str: STRING; VAR err: BOOLEAN): REAL; +CONST maxDBL = 1.69E308; maxINT = 7FFFFFFFH; +VAR i, scale: INTEGER; res, m, d: REAL; minus, neg: BOOLEAN; - PROCEDURE part1(): BOOLEAN; + PROCEDURE part1 (str: STRING; VAR res, d: REAL; VAR i: INTEGER): BOOLEAN; BEGIN - res := 0.0D0; - d := 1.0D0; + res := 0.0; + d := 1.0; WHILE digit(str[i]) DO - res := res * 10.0D0 + LONG(FLT(ORD(str[i]) - ORD("0"))); + res := res * 10.0 + FLT(ORD(str[i]) - ORD("0")); INC(i) END; IF str[i] = "." THEN INC(i); WHILE digit(str[i]) DO - d := d / 10.0D0; - res := res + LONG(FLT(ORD(str[i]) - ORD("0"))) * d; - INC(i) + d := d / 10.0; + res := res + FLT(ORD(str[i]) - ORD("0")) * d; + INC(i) END END RETURN str[i] # 0X END part1; - PROCEDURE part2(): BOOLEAN; + PROCEDURE part2 (str: STRING; VAR i, scale: INTEGER; VAR minus, err: BOOLEAN; VAR m, res: REAL): BOOLEAN; BEGIN INC(i); - m := 10.0D0; + m := 10.0; minus := FALSE; IF str[i] = "+" THEN INC(i) ELSIF str[i] = "-" THEN minus := TRUE; INC(i); - m := 0.1D0 + m := 0.1 END; scale := 0; err := FALSE; WHILE ~err & digit(str[i]) DO IF scale > maxINT DIV 10 THEN - err := TRUE; - res := 0.0D0 + err := TRUE; + res := 0.0 ELSE - scale := scale * 10; - IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN - err := TRUE; - res := 0.0D0 - ELSE - scale := scale + (ORD(str[i]) - ORD("0")); - INC(i) - END + scale := scale * 10; + IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN + err := TRUE; + res := 0.0 + ELSE + scale := scale + (ORD(str[i]) - ORD("0")); + INC(i) + END END END RETURN ~err END part2; - PROCEDURE part3; + PROCEDURE part3 (VAR err, minus: BOOLEAN; VAR res, m: REAL; VAR scale: INTEGER); VAR i: INTEGER; BEGIN err := FALSE; IF scale = maxINT THEN err := TRUE; - res := 0.0D0 + res := 0.0 END; i := 1; WHILE ~err & (i <= scale) DO IF ~minus & (res > maxDBL / m) THEN - err := TRUE; - res := 0.0D0 + err := TRUE; + res := 0.0 ELSE - res := res * m; - INC(i) + res := res * m; + INC(i) END END END part3; BEGIN IF CheckReal(str, i, neg) THEN - IF part1() & part2() THEN - part3 + IF part1(str, res, d, i) & part2(str, i, scale, minus, err, m, res) THEN + part3(err, minus, res, m, scale) END; IF neg THEN res := -res END ELSE - res := 0.0D0; + res := 0.0; err := TRUE END RETURN res @@ -251,7 +251,7 @@ BEGIN Done := TRUE END Ln; -PROCEDURE LongReal*(VAR x: LONGREAL); +PROCEDURE Real* (VAR x: REAL); VAR str: STRING; err: BOOLEAN; BEGIN err := FALSE; @@ -260,23 +260,9 @@ BEGIN UNTIL ~Space(str); x := StrToFloat(str, err); Done := ~err -END LongReal; - -PROCEDURE Real*(VAR x: REAL); -CONST maxREAL = 3.39E38; -VAR y: LONGREAL; -BEGIN - LongReal(y); - IF Done THEN - IF ABS(y) > LONG(maxREAL) THEN - x := 0.0; - Done := FALSE - ELSE - x := SHORT(y) - END - END END Real; + PROCEDURE Int*(VAR x: INTEGER); VAR str: STRING; err: BOOLEAN; BEGIN diff --git a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 index 632033ef17..4cf92fc861 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/KOSAPI.ob07 @@ -1,348 +1,430 @@ -(* - Copyright 2016, 2018 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE KOSAPI; -IMPORT sys := SYSTEM; +IMPORT SYSTEM; -TYPE STRING = ARRAY 1024 OF CHAR; -VAR DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER); +TYPE -PROCEDURE [stdcall] sysfunc1*(arg1: INTEGER): INTEGER; + STRING = ARRAY 1024 OF CHAR; + + +VAR + + DLL_INIT: PROCEDURE [stdcall] (entry: INTEGER); + + imp_error*: RECORD + + proc*, lib*: STRING; + error*: INTEGER + + END; + + +PROCEDURE [stdcall-] sysfunc1* (arg1: INTEGER): INTEGER; BEGIN - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20400"); (* ret 04h *) - RETURN 0 + SYSTEM.CODE( + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 0CDH, 040H, (* int 64 *) + 0C9H, (* leave *) + 0C2H, 004H, 000H (* ret 4 *) + ) + RETURN 0 END sysfunc1; -PROCEDURE [stdcall] sysfunc2*(arg1, arg2: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc2* (arg1, arg2: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20800"); (* ret 08h *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 0CDH, 040H, (* int 64 *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 8 *) + ) + RETURN 0 END sysfunc2; -PROCEDURE [stdcall] sysfunc3*(arg1, arg2, arg3: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc3* (arg1, arg2, arg3: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20C00"); (* ret 0Ch *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 0CDH, 040H, (* int 64 *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END sysfunc3; -PROCEDURE [stdcall] sysfunc4*(arg1, arg2, arg3, arg4: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc4* (arg1, arg2, arg3, arg4: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21000"); (* ret 10h *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 0CDH, 040H, (* int 64 *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 16 *) + ) + RETURN 0 END sysfunc4; -PROCEDURE [stdcall] sysfunc5*(arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc5* (arg1, arg2, arg3, arg4, arg5: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("56"); (* push esi *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("8B7518"); (* mov esi, [ebp + 18h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5E"); (* pop esi *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21400"); (* ret 14h *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 056H, (* push esi *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *) + 0CDH, 040H, (* int 64 *) + 05EH, (* pop esi *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 014H, 000H (* ret 20 *) + ) + RETURN 0 END sysfunc5; -PROCEDURE [stdcall] sysfunc6*(arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc6* (arg1, arg2, arg3, arg4, arg5, arg6: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("56"); (* push esi *) - sys.CODE("57"); (* push edi *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("8B7518"); (* mov esi, [ebp + 18h] *) - sys.CODE("8B7D1C"); (* mov edi, [ebp + 1Ch] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5F"); (* pop edi *) - sys.CODE("5E"); (* pop esi *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21800"); (* ret 18h *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 056H, (* push esi *) + 057H, (* push edi *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *) + 08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *) + 0CDH, 040H, (* int 64 *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 END sysfunc6; -PROCEDURE [stdcall] sysfunc7*(arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc7* (arg1, arg2, arg3, arg4, arg5, arg6, arg7: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("56"); (* push esi *) - sys.CODE("57"); (* push edi *) - sys.CODE("55"); (* push ebp *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("8B7518"); (* mov esi, [ebp + 18h] *) - sys.CODE("8B7D1C"); (* mov edi, [ebp + 1Ch] *) - sys.CODE("8B6D20"); (* mov ebp, [ebp + 20h] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("5D"); (* pop ebp *) - sys.CODE("5F"); (* pop edi *) - sys.CODE("5E"); (* pop esi *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21C00"); (* ret 1Ch *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 056H, (* push esi *) + 057H, (* push edi *) + 055H, (* push ebp *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *) + 08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *) + 08BH, 06DH, 020H, (* mov ebp, dword [ebp + 32] *) + 0CDH, 040H, (* int 64 *) + 05DH, (* pop ebp *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 01CH, 000H (* ret 28 *) + ) + RETURN 0 END sysfunc7; -PROCEDURE [stdcall] sysfunc22*(arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER; + +PROCEDURE [stdcall-] sysfunc22* (arg1, arg2: INTEGER; VAR res2: INTEGER): INTEGER; BEGIN - sys.CODE("53"); (* push ebx *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("CD40"); (* int 40h *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8919"); (* mov [ecx], ebx *) - sys.CODE("5B"); (* pop ebx *) - sys.CODE("C9"); (* leave *) - sys.CODE("C20C00"); (* ret 0Ch *) - RETURN 0 + SYSTEM.CODE( + 053H, (* push ebx *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 0CDH, 040H, (* int 64 *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 089H, 019H, (* mov dword [ecx], ebx *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + RETURN 0 END sysfunc22; -PROCEDURE mem_commit(adr, size: INTEGER); -VAR tmp: INTEGER; + +PROCEDURE mem_commit (adr, size: INTEGER); +VAR + tmp: INTEGER; + BEGIN - FOR tmp := adr TO adr + size - 1 BY 4096 DO - sys.PUT(tmp, 0) - END + FOR tmp := adr TO adr + size - 1 BY 4096 DO + SYSTEM.PUT(tmp, 0) + END END mem_commit; -PROCEDURE [stdcall] malloc*(size: INTEGER): INTEGER; -VAR ptr: INTEGER; + +PROCEDURE [stdcall] malloc* (size: INTEGER): INTEGER; +VAR + ptr: INTEGER; + BEGIN - sys.CODE("60"); (* pusha *) - IF sysfunc2(18, 16) > ASR(size, 10) THEN - ptr := sysfunc3(68, 12, size); - IF ptr # 0 THEN - mem_commit(ptr, size) - END - ELSE - ptr := 0 - END; - sys.CODE("61") (* popa *) - RETURN ptr + SYSTEM.CODE(060H); (* pusha *) + IF sysfunc2(18, 16) > ASR(size, 10) THEN + ptr := sysfunc3(68, 12, size); + IF ptr # 0 THEN + mem_commit(ptr, size) + END + ELSE + ptr := 0 + END; + SYSTEM.CODE(061H) (* popa *) + RETURN ptr END malloc; -PROCEDURE [stdcall] free*(ptr: INTEGER): INTEGER; + +PROCEDURE [stdcall] free* (ptr: INTEGER): INTEGER; BEGIN - sys.CODE("60"); (* pusha *) - IF ptr # 0 THEN - ptr := sysfunc3(68, 13, ptr) - END; - sys.CODE("61") (* popa *) - RETURN 0 + SYSTEM.CODE(060H); (* pusha *) + IF ptr # 0 THEN + ptr := sysfunc3(68, 13, ptr) + END; + SYSTEM.CODE(061H) (* popa *) + RETURN 0 END free; -PROCEDURE [stdcall] realloc*(ptr, size: INTEGER): INTEGER; + +PROCEDURE [stdcall] realloc* (ptr, size: INTEGER): INTEGER; BEGIN - sys.CODE("60"); (* pusha *) - ptr := sysfunc4(68, 20, size, ptr); - sys.CODE("61") (* popa *) - RETURN ptr + SYSTEM.CODE(060H); (* pusha *) + ptr := sysfunc4(68, 20, size, ptr); + SYSTEM.CODE(061H) (* popa *) + RETURN ptr END realloc; -PROCEDURE AppAdr(): INTEGER; + +PROCEDURE AppAdr (): INTEGER; VAR buf: ARRAY 1024 OF CHAR; a: INTEGER; + BEGIN - a := sysfunc3(9, sys.ADR(buf), -1); - sys.GET(sys.ADR(buf) + 22, a) + a := sysfunc3(9, SYSTEM.ADR(buf), -1); + SYSTEM.GET(SYSTEM.ADR(buf) + 22, a) RETURN a END AppAdr; -PROCEDURE GetCommandLine*(): INTEGER; -VAR param: INTEGER; + +PROCEDURE GetCommandLine* (): INTEGER; +VAR + param: INTEGER; + BEGIN - sys.GET(28 + AppAdr(), param) - RETURN param + SYSTEM.GET(28 + AppAdr(), param) + RETURN param END GetCommandLine; -PROCEDURE GetName*(): INTEGER; -VAR name: INTEGER; + +PROCEDURE GetName* (): INTEGER; +VAR + name: INTEGER; + BEGIN - sys.GET(32 + AppAdr(), name) - RETURN name + SYSTEM.GET(32 + AppAdr(), name) + RETURN name END GetName; -PROCEDURE [stdcall] dll_init2(arg1, arg2, arg3, arg4, arg5: INTEGER); + +PROCEDURE [stdcall] dll_init2 (arg1, arg2, arg3, arg4, arg5: INTEGER); BEGIN - sys.CODE("60"); (* pusha *) - sys.CODE("8B4508"); (* mov eax, [ebp + 08h] *) - sys.CODE("8B5D0C"); (* mov ebx, [ebp + 0Ch] *) - sys.CODE("8B4D10"); (* mov ecx, [ebp + 10h] *) - sys.CODE("8B5514"); (* mov edx, [ebp + 14h] *) - sys.CODE("8B7518"); (* mov esi, [ebp + 18h] *) - sys.CODE("FFD6"); (* call esi *) - sys.CODE("61"); (* popa *) - sys.CODE("C9"); (* leave *) - sys.CODE("C21400"); (* ret 14h *) + SYSTEM.CODE( + 060H, (* pusha *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *) + 0FFH, 0D6H, (* call esi *) + 061H, (* popa *) + 0C9H, (* leave *) + 0C2H, 014H, 000H (* ret 20 *) + ) END dll_init2; -PROCEDURE GetProcAdr*(name: ARRAY OF CHAR; lib: INTEGER): INTEGER; -VAR cur, procname, adr: INTEGER; - PROCEDURE streq(str1, str2: INTEGER): BOOLEAN; - VAR c1, c2: CHAR; - BEGIN - REPEAT - sys.GET(str1, c1); - sys.GET(str2, c2); - INC(str1); - INC(str2) - UNTIL (c1 # c2) OR (c1 = 0X) - RETURN c1 = c2 - END streq; +PROCEDURE GetProcAdr* (name: ARRAY OF CHAR; lib: INTEGER): INTEGER; +VAR + cur, procname, adr: INTEGER; + + + PROCEDURE streq (str1, str2: INTEGER): BOOLEAN; + VAR + c1, c2: CHAR; + + BEGIN + REPEAT + SYSTEM.GET(str1, c1); + SYSTEM.GET(str2, c2); + INC(str1); + INC(str2) + UNTIL (c1 # c2) OR (c1 = 0X) + + RETURN c1 = c2 + END streq; + BEGIN - adr := 0; - IF (lib # 0) & (name # "") THEN - cur := lib; - REPEAT - sys.GET(cur, procname); - INC(cur, 8) - UNTIL (procname = 0) OR streq(procname, sys.ADR(name[0])); - IF procname # 0 THEN - sys.GET(cur - 4, adr) + adr := 0; + IF (lib # 0) & (name # "") THEN + cur := lib; + REPEAT + SYSTEM.GET(cur, procname); + INC(cur, 8) + UNTIL (procname = 0) OR streq(procname, SYSTEM.ADR(name[0])); + IF procname # 0 THEN + SYSTEM.GET(cur - 4, adr) + END END - END - RETURN adr + + RETURN adr END GetProcAdr; -PROCEDURE init(dll: INTEGER); -VAR lib_init: INTEGER; + +PROCEDURE init (dll: INTEGER); +VAR + lib_init: INTEGER; + BEGIN - lib_init := GetProcAdr("lib_init", dll); - IF lib_init # 0 THEN - DLL_INIT(lib_init) - END; - lib_init := GetProcAdr("START", dll); - IF lib_init # 0 THEN - DLL_INIT(lib_init) - END; + lib_init := GetProcAdr("lib_init", dll); + IF lib_init # 0 THEN + DLL_INIT(lib_init) + END; + lib_init := GetProcAdr("START", dll); + IF lib_init # 0 THEN + DLL_INIT(lib_init) + END END init; -PROCEDURE [stdcall] dll_Load(import_table: INTEGER): INTEGER; -VAR imp, lib, exp, proc, res: INTEGER; + +PROCEDURE GetStr (adr, i: INTEGER; VAR str: STRING); +VAR + c: CHAR; +BEGIN + REPEAT + SYSTEM.GET(adr, c); INC(adr); + str[i] := c; INC(i) + UNTIL c = 0X +END GetStr; + + +PROCEDURE [stdcall] dll_Load* (import_table: INTEGER): INTEGER; +VAR + imp, lib, exp, proc, res: INTEGER; fail, done: BOOLEAN; procname, libname: STRING; - PROCEDURE GetStr(adr, i: INTEGER; VAR str: STRING); - VAR c: CHAR; - BEGIN - REPEAT - sys.GET(adr, c); INC(adr); - str[i] := c; INC(i) - UNTIL c = 0X - END GetStr; - BEGIN - sys.CODE("60"); (* pusha *) - fail := FALSE; - done := FALSE; - res := 0; - libname := "/rd/1/lib/"; - REPEAT - sys.GET(import_table, imp); - IF imp # 0 THEN - sys.GET(import_table + 4, lib); - GetStr(lib, 10, libname); - exp := sysfunc3(68, 19, sys.ADR(libname[0])); - fail := exp = 0; - ELSE - done := TRUE - END; + SYSTEM.CODE(060H); (* pusha *) + fail := FALSE; + done := FALSE; + res := 0; + libname := "/rd/1/lib/"; + REPEAT + SYSTEM.GET(import_table, imp); + IF imp # 0 THEN + SYSTEM.GET(import_table + 4, lib); + GetStr(lib, 10, libname); + exp := sysfunc3(68, 19, SYSTEM.ADR(libname[0])); + fail := exp = 0; + ELSE + done := TRUE + END; + IF fail THEN + done := TRUE; + imp_error.proc := ""; + imp_error.lib := libname; + imp_error.error := 1 + END; + IF (imp # 0) & ~fail THEN + REPEAT + SYSTEM.GET(imp, proc); + IF proc # 0 THEN + GetStr(proc, 0, procname); + proc := GetProcAdr(procname, exp); + IF proc # 0 THEN + SYSTEM.PUT(imp, proc); + INC(imp, 4) + ELSE + imp_error.proc := procname; + imp_error.lib := libname; + imp_error.error := 2 + END + END + UNTIL proc = 0; + init(exp); + INC(import_table, 8) + END + UNTIL done; IF fail THEN - done := TRUE + res := 1 END; - IF (imp # 0) & ~fail THEN - REPEAT - sys.GET(imp, proc); - IF proc # 0 THEN - GetStr(proc, 0, procname); - proc := GetProcAdr(procname, exp); - IF proc # 0 THEN - sys.PUT(imp, proc); - INC(imp, 4); - END - END - UNTIL proc = 0; - init(exp); - INC(import_table, 8) - END - UNTIL done; - IF fail THEN - res := 1 - END; - import_table := res; - sys.CODE("61") (* popa *) - RETURN import_table + import_table := res; + SYSTEM.CODE(061H) (* popa *) + RETURN import_table END dll_Load; -PROCEDURE [stdcall] dll_Init(entry: INTEGER); + +PROCEDURE [stdcall] dll_Init (entry: INTEGER); BEGIN - sys.CODE("60"); (* pusha *) - IF entry # 0 THEN - dll_init2(sys.ADR(malloc), sys.ADR(free), sys.ADR(realloc), sys.ADR(dll_Load), entry) - END; - sys.CODE("61"); (* popa *) + SYSTEM.CODE(060H); (* pusha *) + IF entry # 0 THEN + dll_init2(SYSTEM.ADR(malloc), SYSTEM.ADR(free), SYSTEM.ADR(realloc), SYSTEM.ADR(dll_Load), entry) + END; + SYSTEM.CODE(061H); (* popa *) END dll_Init; -PROCEDURE LoadLib*(name: ARRAY OF CHAR): INTEGER; -VAR Lib: INTEGER; + +PROCEDURE LoadLib* (name: ARRAY OF CHAR): INTEGER; +VAR + Lib: INTEGER; + BEGIN - DLL_INIT := dll_Init; - Lib := sysfunc3(68, 19, sys.ADR(name[0])); - IF Lib # 0 THEN - init(Lib) - END - RETURN Lib + DLL_INIT := dll_Init; + Lib := sysfunc3(68, 19, SYSTEM.ADR(name[0])); + IF Lib # 0 THEN + init(Lib) + END + RETURN Lib END LoadLib; + +PROCEDURE _init*; +BEGIN + DLL_INIT := dll_Init; + imp_error.lib := ""; + imp_error.proc := ""; + imp_error.error := 0 +END _init; + + END KOSAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 index 6c41800886..6031e758ee 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2013, 2014, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -17,238 +17,365 @@ MODULE Math; -IMPORT sys := SYSTEM; +IMPORT SYSTEM; -CONST pi* = 3.141592653589793D+00; - e* = 2.718281828459045D+00; -VAR Inf*, nInf*: LONGREAL; +CONST + + pi* = 3.141592653589793; + e* = 2.718281828459045; + + +PROCEDURE IsNan* (x: REAL): BOOLEAN; +VAR + h, l: SET; -PROCEDURE IsNan*(x: LONGREAL): BOOLEAN; -VAR h, l: SET; BEGIN - sys.GET(sys.ADR(x), l); - sys.GET(sys.ADR(x) + 4, h); - RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) + SYSTEM.GET(SYSTEM.ADR(x), l); + SYSTEM.GET(SYSTEM.ADR(x) + 4, h) + RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) END IsNan; -PROCEDURE IsInf*(x: LONGREAL): BOOLEAN; - RETURN ABS(x) = sys.INF(LONGREAL) + +PROCEDURE IsInf* (x: REAL): BOOLEAN; + RETURN ABS(x) = SYSTEM.INF() END IsInf; -PROCEDURE Max(A, B: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE Max (a, b: REAL): REAL; +VAR + res: REAL; + BEGIN - IF A > B THEN - Res := A - ELSE - Res := B - END - RETURN Res + IF a > b THEN + res := a + ELSE + res := b + END + RETURN res END Max; -PROCEDURE Min(A, B: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE Min (a, b: REAL): REAL; +VAR + res: REAL; + BEGIN - IF A < B THEN - Res := A - ELSE - Res := B - END - RETURN Res + IF a < b THEN + res := a + ELSE + res := b + END + RETURN res END Min; -PROCEDURE SameValue(A, B: LONGREAL): BOOLEAN; -VAR Epsilon: LONGREAL; Res: BOOLEAN; + +PROCEDURE SameValue (a, b: REAL): BOOLEAN; +VAR + eps: REAL; + res: BOOLEAN; + BEGIN - Epsilon := Max(Min(ABS(A), ABS(B)) * 1.0D-12, 1.0D-12); - IF A > B THEN - Res := (A - B) <= Epsilon - ELSE - Res := (B - A) <= Epsilon - END - RETURN Res + eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12); + IF a > b THEN + res := (a - b) <= eps + ELSE + res := (b - a) <= eps + END + RETURN res END SameValue; -PROCEDURE IsZero(x: LONGREAL): BOOLEAN; - RETURN ABS(x) <= 1.0D-12 + +PROCEDURE IsZero (x: REAL): BOOLEAN; + RETURN ABS(x) <= 1.0E-12 END IsZero; -PROCEDURE [stdcall] sqrt*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] sqrt* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D9FAC9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FAH, (* fsqrt *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END sqrt; -PROCEDURE [stdcall] sin*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] sin* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D9FEC9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FEH, (* fsin *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END sin; -PROCEDURE [stdcall] cos*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] cos* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D9FFC9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FFH, (* fcos *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END cos; -PROCEDURE [stdcall] tan*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] tan* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D9F2DEC9C9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0FBH, (* fsincos *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END tan; -PROCEDURE [stdcall] arctan2*(y, x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL; BEGIN - sys.CODE("DD4508DD4510D9F3C9C21000") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F3H, (* fpatan *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 END arctan2; -PROCEDURE [stdcall] ln*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] ln* (x: REAL): REAL; BEGIN - sys.CODE("D9EDDD4508D9F1C9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0D9H, 0EDH, (* fldln2 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END ln; -PROCEDURE [stdcall] log*(base, x: LONGREAL): LONGREAL; -BEGIN - sys.CODE("D9E8DD4510D9F1D9E8DD4508D9F1DEF9C9C21000") - RETURN 0.0D0 + +PROCEDURE [stdcall] log* (base, x: REAL): REAL; +BEGIN + SYSTEM.CODE( + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 010H, (* fld qword [ebp + 10h] *) + 0D9H, 0F1H, (* fyl2x *) + 0D9H, 0E8H, (* fld1 *) + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0F1H, (* fyl2x *) + 0DEH, 0F9H, (* fdivp st1, st *) + 0C9H, (* leave *) + 0C2H, 010H, 000H (* ret 10h *) + ) + RETURN 0.0 END log; -PROCEDURE [stdcall] exp*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] exp* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D9EADEC9D9C0D9FCDCE9D9C9D9F0D9E8DEC1D9FDDDD9C9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0EAH, (* fldl2e *) + 0DEH, 0C9H, 0D9H, 0C0H, + 0D9H, 0FCH, 0DCH, 0E9H, + 0D9H, 0C9H, 0D9H, 0F0H, + 0D9H, 0E8H, 0DEH, 0C1H, + 0D9H, 0FDH, 0DDH, 0D9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END exp; -PROCEDURE [stdcall] round*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] round* (x: REAL): REAL; BEGIN - sys.CODE("DD4508D97DF4D97DF666814DF60003D96DF6D9FCD96DF4C9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 07DH, 0F4H, 0D9H, + 07DH, 0F6H, 066H, 081H, + 04DH, 0F6H, 000H, 003H, + 0D9H, 06DH, 0F6H, 0D9H, + 0FCH, 0D9H, 06DH, 0F4H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END round; -PROCEDURE [stdcall] frac*(x: LONGREAL): LONGREAL; + +PROCEDURE [stdcall] frac* (x: REAL): REAL; BEGIN - sys.CODE("50DD4508D9C0D93C24D97C240266814C2402000FD96C2402D9FCD92C24DEE9C9C20800") - RETURN 0.0D0 + SYSTEM.CODE( + 050H, + 0DDH, 045H, 008H, (* fld qword [ebp + 08h] *) + 0D9H, 0C0H, 0D9H, 03CH, + 024H, 0D9H, 07CH, 024H, + 002H, 066H, 081H, 04CH, + 024H, 002H, 000H, 00FH, + 0D9H, 06CH, 024H, 002H, + 0D9H, 0FCH, 0D9H, 02CH, + 024H, 0DEH, 0E9H, + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + RETURN 0.0 END frac; -PROCEDURE arcsin*(x: LONGREAL): LONGREAL; - RETURN arctan2(x, sqrt(1.0D0 - x * x)) + +PROCEDURE arcsin* (x: REAL): REAL; + RETURN arctan2(x, sqrt(1.0 - x * x)) END arcsin; -PROCEDURE arccos*(x: LONGREAL): LONGREAL; - RETURN arctan2(sqrt(1.0D0 - x * x), x) + +PROCEDURE arccos* (x: REAL): REAL; + RETURN arctan2(sqrt(1.0 - x * x), x) END arccos; -PROCEDURE arctan*(x: LONGREAL): LONGREAL; - RETURN arctan2(x, 1.0D0) + +PROCEDURE arctan* (x: REAL): REAL; + RETURN arctan2(x, 1.0) END arctan; -PROCEDURE sinh*(x: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE sinh* (x: REAL): REAL; +VAR + res: REAL; + BEGIN - IF IsZero(x) THEN - Res := 0.0D0 - ELSE - Res := (exp(x) - exp(-x)) / 2.0D0 - END - RETURN Res + IF IsZero(x) THEN + res := 0.0 + ELSE + res := (exp(x) - exp(-x)) / 2.0 + END + RETURN res END sinh; -PROCEDURE cosh*(x: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE cosh* (x: REAL): REAL; +VAR + res: REAL; + BEGIN - IF IsZero(x) THEN - Res := 1.0D0 - ELSE - Res := (exp(x) + exp(-x)) / 2.0D0 - END - RETURN Res + IF IsZero(x) THEN + res := 1.0 + ELSE + res := (exp(x) + exp(-x)) / 2.0 + END + RETURN res END cosh; -PROCEDURE tanh*(x: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE tanh* (x: REAL): REAL; +VAR + res: REAL; + BEGIN - IF IsZero(x) THEN - Res := 0.0D0 - ELSE - Res := sinh(x) / cosh(x) - END - RETURN Res + IF IsZero(x) THEN + res := 0.0 + ELSE + res := sinh(x) / cosh(x) + END + RETURN res END tanh; -PROCEDURE arcsinh*(x: LONGREAL): LONGREAL; - RETURN ln(x + sqrt((x * x) + 1.0D0)) + +PROCEDURE arcsinh* (x: REAL): REAL; + RETURN ln(x + sqrt((x * x) + 1.0)) END arcsinh; -PROCEDURE arccosh*(x: LONGREAL): LONGREAL; - RETURN ln(x + sqrt((x - 1.0D0) / (x + 1.0D0)) * (x + 1.0D0)) + +PROCEDURE arccosh* (x: REAL): REAL; + RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0)) END arccosh; -PROCEDURE arctanh*(x: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE arctanh* (x: REAL): REAL; +VAR + res: REAL; + BEGIN - IF SameValue(x, 1.0D0) THEN - Res := Inf - ELSIF SameValue(x, -1.0D0) THEN - Res := nInf - ELSE - Res := 0.5D0 * ln((1.0D0 + x) / (1.0D0 - x)) - END - RETURN Res + IF SameValue(x, 1.0) THEN + res := SYSTEM.INF() + ELSIF SameValue(x, -1.0) THEN + res := -SYSTEM.INF() + ELSE + res := 0.5 * ln((1.0 + x) / (1.0 - x)) + END + RETURN res END arctanh; -PROCEDURE floor*(x: LONGREAL): LONGREAL; -VAR f: LONGREAL; + +PROCEDURE floor* (x: REAL): REAL; +VAR + f: REAL; + BEGIN - f := frac(x); - x := x - f; - IF f < 0.0D0 THEN - x := x - 1.0D0 - END - RETURN x + f := frac(x); + x := x - f; + IF f < 0.0 THEN + x := x - 1.0 + END + RETURN x END floor; -PROCEDURE ceil*(x: LONGREAL): LONGREAL; -VAR f: LONGREAL; + +PROCEDURE ceil* (x: REAL): REAL; +VAR + f: REAL; + BEGIN - f := frac(x); - x := x - f; - IF f > 0.0D0 THEN - x := x + 1.0D0 - END - RETURN x + f := frac(x); + x := x - f; + IF f > 0.0 THEN + x := x + 1.0 + END + RETURN x END ceil; -PROCEDURE power*(base, exponent: LONGREAL): LONGREAL; -VAR Res: LONGREAL; + +PROCEDURE power* (base, exponent: REAL): REAL; +VAR + res: REAL; + BEGIN - IF exponent = 0.0D0 THEN - Res := 1.0D0 - ELSIF (base = 0.0D0) & (exponent > 0.0D0) THEN - Res := 0.0D0 - ELSE - Res := exp(exponent * ln(base)) - END - RETURN Res + IF exponent = 0.0 THEN + res := 1.0 + ELSIF (base = 0.0) & (exponent > 0.0) THEN + res := 0.0 + ELSE + res := exp(exponent * ln(base)) + END + RETURN res END power; -PROCEDURE sgn*(x: LONGREAL): INTEGER; -VAR Res: INTEGER; -BEGIN - IF x > 0.0D0 THEN - Res := 1 - ELSIF x < 0.0D0 THEN - Res := -1 - ELSE - Res := 0 - END - RETURN Res -END sgn; + +PROCEDURE sgn* (x: REAL): INTEGER; +VAR + res: INTEGER; BEGIN - Inf := sys.INF(LONGREAL); - nInf := -sys.INF(LONGREAL) + IF x > 0.0 THEN + res := 1 + ELSIF x < 0.0 THEN + res := -1 + ELSE + res := 0 + END + RETURN res +END sgn; + + END Math. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 index 78ca879fcf..9bffd20f21 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/OpenDlg.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -108,7 +108,7 @@ BEGIN res.filter_area.size := LENGTH(res.filter_area.filter); res.procinfo := sys.ADR(res.procinf[0]); res.com_area_name := sys.ADR(res.s_com_area_name[0]); - res.start_path := sys.ADR("/rd/1/File managers/opendial"); + res.start_path := sys.SADR("/rd/1/File managers/opendial"); res.opendir_path := sys.ADR(res.s_opendir_path[0]); res.dir_default_path := sys.ADR(res.s_dir_default_path[0]); res.openfile_path := sys.ADR(res.FilePath[0]); @@ -134,7 +134,7 @@ END Destroy; PROCEDURE Load; VAR Lib: INTEGER; - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); + PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR); VAR a: INTEGER; BEGIN a := KOSAPI.GetProcAdr(name, Lib); @@ -144,8 +144,8 @@ VAR Lib: INTEGER; BEGIN Lib := KOSAPI.LoadLib("/rd/1/Lib/Proc_lib.obj"); - GetProc(sys.ADR(Dialog_init), "OpenDialog_init"); - GetProc(sys.ADR(Dialog_start), "OpenDialog_start"); + GetProc(Lib, sys.ADR(Dialog_init), "OpenDialog_init"); + GetProc(Lib, sys.ADR(Dialog_start), "OpenDialog_start"); END Load; BEGIN diff --git a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 index e136c01e70..02cc14e017 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Out.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -21,11 +21,11 @@ IMPORT ConsoleLib, sys := SYSTEM; CONST - d = 1.0D0 - 5.0D-12; + d = 1.0 - 5.0E-12; VAR - Realp: PROCEDURE (x: LONGREAL; width: INTEGER); + Realp: PROCEDURE (x: REAL; width: INTEGER); PROCEDURE Char*(c: CHAR); BEGIN @@ -67,7 +67,7 @@ BEGIN UNTIL i = 0 END WriteInt; -PROCEDURE IsNan(AValue: LONGREAL): BOOLEAN; +PROCEDURE IsNan(AValue: REAL): BOOLEAN; VAR h, l: SET; BEGIN sys.GET(sys.ADR(AValue), l); @@ -75,8 +75,8 @@ BEGIN RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {})) END IsNan; -PROCEDURE IsInf(x: LONGREAL): BOOLEAN; - RETURN ABS(x) = sys.INF(LONGREAL) +PROCEDURE IsInf(x: REAL): BOOLEAN; + RETURN ABS(x) = sys.INF() END IsInf; PROCEDURE Int*(x, width: INTEGER); @@ -92,15 +92,15 @@ BEGIN END END Int; -PROCEDURE OutInf(x: LONGREAL; width: INTEGER); -VAR s: ARRAY 4 OF CHAR; i: INTEGER; +PROCEDURE OutInf(x: REAL; width: INTEGER); +VAR s: ARRAY 5 OF CHAR; i: INTEGER; BEGIN IF IsNan(x) THEN s := "Nan"; INC(width) - ELSIF IsInf(x) & (x > 0.0D0) THEN + ELSIF IsInf(x) & (x > 0.0) THEN s := "+Inf" - ELSIF IsInf(x) & (x < 0.0D0) THEN + ELSIF IsInf(x) & (x < 0.0) THEN s := "-Inf" END; FOR i := 1 TO width - 4 DO @@ -115,8 +115,8 @@ BEGIN Char(0AX) END Ln; -PROCEDURE _FixReal(x: LONGREAL; width, p: INTEGER); -VAR e, len, i: INTEGER; y: LONGREAL; minus: BOOLEAN; +PROCEDURE _FixReal(x: REAL; width, p: INTEGER); +VAR e, len, i: INTEGER; y: REAL; minus: BOOLEAN; BEGIN IF IsNan(x) OR IsInf(x) THEN OutInf(x, width) @@ -125,23 +125,23 @@ BEGIN ELSE len := 0; minus := FALSE; - IF x < 0.0D0 THEN + IF x < 0.0 THEN minus := TRUE; INC(len); x := ABS(x) END; e := 0; - WHILE x >= 10.0D0 DO - x := x / 10.0D0; + WHILE x >= 10.0 DO + x := x / 10.0; INC(e) END; IF e >= 0 THEN len := len + e + p + 1; - IF x > 9.0D0 + d THEN - INC(len) + IF x > 9.0 + d THEN + INC(len) END; IF p > 0 THEN - INC(len) + INC(len) END ELSE len := len + p + 2 @@ -153,51 +153,51 @@ BEGIN Char("-") END; y := x; - WHILE (y < 1.0D0) & (y # 0.0D0) DO - y := y * 10.0D0; + WHILE (y < 1.0) & (y # 0.0) DO + y := y * 10.0; DEC(e) END; IF e < 0 THEN - IF x - LONG(FLT(FLOOR(x))) > d THEN - Char("1"); - x := 0.0D0 + IF x - FLT(FLOOR(x)) > d THEN + Char("1"); + x := 0.0 ELSE - Char("0"); - x := x * 10.0D0 + Char("0"); + x := x * 10.0 END ELSE WHILE e >= 0 DO - IF x - LONG(FLT(FLOOR(x))) > d THEN - IF x > 9.0D0 THEN - String("10") - ELSE - Char(CHR(FLOOR(x) + ORD("0") + 1)) - END; - x := 0.0D0 - ELSE - Char(CHR(FLOOR(x) + ORD("0"))); - x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 - END; - DEC(e) + IF x - FLT(FLOOR(x)) > d THEN + IF x > 9.0 THEN + String("10") + ELSE + Char(CHR(FLOOR(x) + ORD("0") + 1)) + END; + x := 0.0 + ELSE + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 + END; + DEC(e) END END; IF p > 0 THEN Char(".") END; WHILE p > 0 DO - IF x - LONG(FLT(FLOOR(x))) > d THEN - Char(CHR(FLOOR(x) + ORD("0") + 1)); - x := 0.0D0 + IF x - FLT(FLOOR(x)) > d THEN + Char(CHR(FLOOR(x) + ORD("0") + 1)); + x := 0.0 ELSE - Char(CHR(FLOOR(x) + ORD("0"))); - x := (x - LONG(FLT(FLOOR(x)))) * 10.0D0 + Char(CHR(FLOOR(x) + ORD("0"))); + x := (x - FLT(FLOOR(x))) * 10.0 END; DEC(p) END END END _FixReal; -PROCEDURE Real*(x: LONGREAL; width: INTEGER); +PROCEDURE Real*(x: REAL; width: INTEGER); VAR e, n, i: INTEGER; minus: BOOLEAN; BEGIN IF IsNan(x) OR IsInf(x) THEN @@ -212,22 +212,22 @@ BEGIN width := 9 END; width := width - 5; - IF x < 0.0D0 THEN + IF x < 0.0 THEN x := -x; minus := TRUE ELSE minus := FALSE END; - WHILE x >= 10.0D0 DO - x := x / 10.0D0; + WHILE x >= 10.0 DO + x := x / 10.0; INC(e) END; - WHILE (x < 1.0D0) & (x # 0.0D0) DO - x := x * 10.0D0; + WHILE (x < 1.0) & (x # 0.0) DO + x := x * 10.0; DEC(e) END; - IF x > 9.0D0 + d THEN - x := 1.0D0; + IF x > 9.0 + d THEN + x := 1.0; INC(e) END; FOR i := 1 TO n DO @@ -255,7 +255,7 @@ BEGIN END END Real; -PROCEDURE FixReal*(x: LONGREAL; width, p: INTEGER); +PROCEDURE FixReal*(x: REAL; width, p: INTEGER); BEGIN Realp := Real; _FixReal(x, width, p) diff --git a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 index 1a2a314fd7..2758c1e417 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RTL.ob07 @@ -1,276 +1,630 @@ -(* - Copyright 2016, 2017 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE RTL; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, API; + + +CONST + + bit_depth* = 32; + maxint* = 7FFFFFFFH; + minint* = 80000000H; + + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + SIZE_OF_DWORD = 4; + TYPE - IntArray = ARRAY 2048 OF INTEGER; - STRING = ARRAY 2048 OF CHAR; - PROC = PROCEDURE; + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR - SelfName, rtab: INTEGER; CloseProc: PROC; - init: BOOLEAN; + name: INTEGER; + types: INTEGER; -PROCEDURE [stdcall] _halt*(n: INTEGER); -BEGIN - API.ExitProcess(n) -END _halt; - -PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER); -BEGIN - ptr := API._NEW(size); - IF ptr # 0 THEN - sys.PUT(ptr, t); - INC(ptr, 4) - END -END _newrec; - -PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER); -BEGIN - IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - 4) - END -END _disprec; - -PROCEDURE [stdcall] _rset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800") -END _rset; - -PROCEDURE [stdcall] _inset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800") -END _inset; - -PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER); -BEGIN - table := rtab; - sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00") -END _checktype; - -PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER); -BEGIN - sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D") -END _savearr; - -PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN; -VAR res: BOOLEAN; -BEGIN - res := dyn = stat; - IF res THEN - _savearr(size, source, dest) - END - RETURN res -END _saverec; - -PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER); -VAR i, m: INTEGER; -BEGIN - m := bsize * idx; - FOR i := 4 TO Dim + 2 DO - m := m * Arr[i] - END; - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := c + m - ELSE - Arr[3] := 0 - END -END _arrayidx; - -PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER); -BEGIN - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := bsize * idx + c - ELSE - Arr[3] := 0 - END -END _arrayidx1; - -PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray); -VAR i, j, t: INTEGER; -BEGIN - FOR i := 1 TO n DO - t := Arr[0]; - FOR j := 0 TO m + n - 1 DO - Arr[j] := Arr[j + 1] + dll: RECORD + process_detach, + thread_detach, + thread_attach: DLL_ENTRY END; - Arr[m + n] := t - END -END _arrayrot; -PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; + +PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN - sys.CODE("8B4508"); // mov eax, [ebp + 08h] - sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] - sys.CODE("48"); // dec eax - // L1: - sys.CODE("40"); // inc eax - sys.CODE("803800"); // cmp byte ptr [eax], 0 - sys.CODE("7403"); // jz L2 - sys.CODE("E2F8"); // loop L1 - sys.CODE("40"); // inc eax - // L2: - sys.CODE("2B4508"); // sub eax, [ebp + 08h] - sys.CODE("C9"); // leave - sys.CODE("C20800"); // ret 08h - RETURN 0 + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) + 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *) + 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move2; + + +PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, src, dst); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy; + + +PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy2; + + +PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); +VAR + i, n, k: INTEGER; + +BEGIN + + k := LEN(A) - 1; + n := A[0]; + i := 0; + WHILE i < k DO + A[i] := A[i + 1]; + INC(i) + END; + A[k] := n + +END _rot; + + +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF (a <= b) & (a <= 31) & (b >= 0) THEN + IF b > 31 THEN + b := 31 + END; + IF a < 0 THEN + a := 0 + END; + res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + ELSE + res := 0 + END + + RETURN res +END _set2; + + +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; + RETURN _set2(a, b) +END _set; + + +PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 031H, 0D2H, (* xor edx, edx *) + 085H, 0C0H, (* test eax, eax *) + 07DH, 002H, (* jge L1 *) + 0F7H, 0D2H, (* not edx *) + (* L1: *) + 0F7H, 0F9H, (* idiv ecx *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 089H, 011H, (* mov dword [ecx], edx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + + RETURN 0 +END divmod; + + +PROCEDURE div_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + DEC(div) + END + + RETURN div +END div_; + + +PROCEDURE mod_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + INC(mod, y) + END + + RETURN mod +END mod_; + + +PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; + RETURN div_(a, b) +END _div; + + +PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; + RETURN div_(a, b) +END _div2; + + +PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod; + + +PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod2; + + +PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, SIZE_OF_DWORD) + END +END _new; + + +PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + END +END _dispose; + + +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmpw; + + +PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 080H, 038H, 000H, (* cmp byte [eax], 0 *) + 074H, 003H, (* jz L2 *) + 0E2H, 0F8H, (* loop L1 *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 END _length; -PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); -BEGIN - _savearr(MIN(alen, blen), a, b); - IF blen > alen THEN - sys.PUT(b + alen, 0X) - END -END _strcopy; -PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; -VAR i: INTEGER; Res: BOOLEAN; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; BEGIN - i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); - IF i = 0 THEN - i := _length(a) - _length(b) - END; - CASE op OF - |0: Res := i = 0 - |1: Res := i # 0 - |2: Res := i < 0 - |3: Res := i > 0 - |4: Res := i <= 0 - |5: Res := i >= 0 - ELSE - END - RETURN Res + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 040H, (* inc eax *) + 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *) + 074H, 004H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 040H, (* inc eax *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0D1H, 0E8H, (* shr eax, 1 *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 +END _lengthw; + + +PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + +BEGIN + + res := strncmp(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _length(len1, str1) - _length(len2, str2) + END; + + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes END _strcmp; -PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; + +PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmp(op, len2, str2, len1, str1) +END _strcmp2; + + +PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + BEGIN - s[0] := b; - s[1] := 0X; - RETURN _strcmp(op, s, a) -END _lstrcmp; -PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; -BEGIN - s[0] := a; - s[1] := 0X; - RETURN _strcmp(op, b, s) -END _rstrcmp; + res := strncmpw(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _lengthw(len1, str1) - _lengthw(len2, str2) + END; -PROCEDURE Int(x: INTEGER; VAR str: STRING); -VAR i, a, b: INTEGER; c: CHAR; -BEGIN - i := 0; - a := 0; - REPEAT - str[i] := CHR(x MOD 10 + ORD("0")); - x := x DIV 10; - INC(i) - UNTIL x = 0; - b := i - 1; - WHILE a < b DO - c := str[a]; - str[a] := str[b]; - str[b] := c; - INC(a); - DEC(b) - END; - str[i] := 0X -END Int; - -PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER); -VAR msg, int: STRING; pos, n: INTEGER; - - PROCEDURE StrAppend(s: STRING); - VAR i, n: INTEGER; - BEGIN - n := LEN(s); - i := 0; - WHILE (i < n) & (s[i] # 0X) DO - msg[pos] := s[i]; - INC(pos); - INC(i) + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 END - END StrAppend; + + RETURN bRes +END _strcmpw; + + +PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmpw(op, len2, str2, len1, str1) +END _strcmpw2; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; BEGIN - pos := 0; - n := line MOD 16; - line := line DIV 16; - CASE n OF - |1: StrAppend("assertion failure") - |2: StrAppend("variable of a procedure type has NIL as value") - |3: StrAppend("typeguard error") - |4: StrAppend("inadmissible dynamic type") - |5: StrAppend("index check error") - |6: StrAppend("NIL pointer dereference") - |7: StrAppend("invalid value in case statement") - |8: StrAppend("division by zero") - ELSE - END; - StrAppend(0DX); - StrAppend(0AX); - StrAppend("module "); - StrAppend(modname); - StrAppend(0DX); - StrAppend(0AX); - StrAppend("line "); - Int(line, int); - StrAppend(int); - IF m = 2 THEN - StrAppend(0DX); - StrAppend(0AX); - StrAppend("code "); - Int(code, int); - StrAppend(int) - END; - API.DebugMsg(sys.ADR(msg), SelfName); - API.ExitThread(0) -END _assrt; + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; -PROCEDURE [stdcall] _close*; -BEGIN - IF CloseProc # NIL THEN - CloseProc - END -END _close; -PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a, b: INTEGER; + c: CHAR; + BEGIN - IF ~init THEN - API.zeromem(gsize, gadr); - init := TRUE; - API.init(esp); - SelfName := self; - rtab := rec; - CloseProc := NIL - END + + i := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + a := 0; + b := i - 1; + WHILE a < b DO + c := str[a]; + str[a] := str[b]; + str[b] := c; + INC(a); + DEC(b) + END; + str[i] := 0X +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X + +END append; + + +PROCEDURE [stdcall] _error* (module, err: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + + s := ""; + CASE err MOD 16 OF + | 1: append(s, "assertion failure") + | 2: append(s, "NIL dereference") + | 3: append(s, "division by zero") + | 4: append(s, "NIL procedure call") + | 5: append(s, "type guard error") + | 6: append(s, "index out of range") + | 7: append(s, "invalid CASE") + | 8: append(s, "array assignment error") + | 9: append(s, "CHR out of range") + |10: append(s, "WCHR out of range") + |11: append(s, "BYTE out of range") + END; + + append(s, API.eol); + + append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); + append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +BEGIN + (* r IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _isrec; + + +PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := -1 + END + + RETURN t1 = t0 +END _is; + + +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +BEGIN + (* r:t1 IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _guardrec; + + +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + SYSTEM.GET(p, p); + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # t0) & (t1 # 0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := t0 + END + + RETURN t1 = t0 +END _guard; + + +PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + res := 0; + IF dll.thread_attach # NIL THEN + dll.thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + res := 0; + IF dll.thread_detach # NIL THEN + dll.thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + res := 0; + IF dll.process_detach # NIL THEN + dll.process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + res := 0 + END + + RETURN res +END _dllentry; + + +PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + dll.process_detach := process_detach; + dll.thread_detach := thread_detach; + dll.thread_attach := thread_attach +END SetDll; + + +PROCEDURE [stdcall] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +BEGIN + SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) + API.init(param, code); + + types := _types; + name := modname; + + dll.process_detach := NIL; + dll.thread_detach := NIL; + dll.thread_attach := NIL; END _init; -PROCEDURE SetClose*(proc: PROC); -BEGIN - CloseProc := proc -END SetClose; END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 b/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 index 421a01185f..5c804aa180 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/RasterWorks.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 KolibriOS team +(* + Copyright 2016, 2018 KolibriOS team This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -24,21 +24,21 @@ CONST (* flags *) - bold *= 1; - italic *= 2; - underline *= 4; + bold *= 1; + italic *= 2; + underline *= 4; strike_through *= 8; - align_right *= 16; - align_center *= 32; + align_right *= 16; + align_center *= 32; - bpp32 *= 128; + bpp32 *= 128; (* encoding *) - cp866 *= 1; - utf16le *= 2; - utf8 *= 3; + cp866 *= 1; + utf16le *= 2; + utf8 *= 3; VAR @@ -48,19 +48,19 @@ VAR drawText *: PROCEDURE (canvas, x, y, string, charQuantity, fontColor, params: INTEGER): INTEGER; (* [canvas]: - xSize dd ? - ySize dd ? - picture rb xSize * ySize * bpp + xSize dd ? + ySize dd ? + picture rb xSize * ySize * bpp - fontColor dd AARRGGBB - AA = alpha channel ; 0 = transparent, FF = non transparent + fontColor dd AARRGGBB + AA = alpha channel ; 0 = transparent, FF = non transparent - params dd ffeewwhh + params dd ffeewwhh hh = char height - ww = char width ; 0 = auto (proportional) - ee = encoding ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8 - ff = flags ; 0001 = bold, 0010 = italic - ; 0100 = underline, 1000 = strike-through + ww = char width ; 0 = auto (proportional) + ee = encoding ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8 + ff = flags ; 0001 = bold, 0010 = italic + ; 0100 = underline, 1000 = strike-through 00010000 = align right, 00100000 = align center 01000000 = set text area between higher and lower halfs of 'x' 10000000 = 32bpp canvas insted of 24bpp @@ -85,10 +85,10 @@ VAR PROCEDURE params* (charHeight, charWidth, encoding, flags: INTEGER): INTEGER; (* hh = char height - ww = char width ; 0 = auto (proportional) - ee = encoding ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8 - ff = flags ; 0001 = bold, 0010 = italic - ; 0100 = underline, 1000 = strike-through + ww = char width ; 0 = auto (proportional) + ee = encoding ; 1 = cp866, 2 = UTF-16LE, 3 = UTF-8 + ff = flags ; 0001 = bold, 0010 = italic + ; 0100 = underline, 1000 = strike-through 00010000 = align right, 00100000 = align center 01000000 = set text area between higher and lower halfs of 'x' 10000000 = 32bpp canvas insted of 24bpp @@ -101,7 +101,7 @@ END params; PROCEDURE main; VAR Lib: INTEGER; - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); + PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR); VAR a: INTEGER; BEGIN a := KOSAPI.GetProcAdr(name, Lib); @@ -112,10 +112,10 @@ VAR Lib: INTEGER; BEGIN Lib := KOSAPI.LoadLib("/rd/1/lib/RasterWorks.obj"); ASSERT(Lib # 0); - GetProc(sys.ADR(drawText), "drawText"); - GetProc(sys.ADR(cntUTF_8), "cntUTF-8"); - GetProc(sys.ADR(charsFit), "charsFit"); - GetProc(sys.ADR(strWidth), "strWidth"); + GetProc(Lib, sys.ADR(drawText), "drawText"); + GetProc(Lib, sys.ADR(cntUTF_8), "cntUTF-8"); + GetProc(Lib, sys.ADR(charsFit), "charsFit"); + GetProc(Lib, sys.ADR(strWidth), "strWidth"); END main; diff --git a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 index edcda5d186..c9df9d2c4f 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Read.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -31,10 +31,6 @@ PROCEDURE Real*(F: File.FS; VAR x: REAL): BOOLEAN; RETURN File.Read(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL) END Real; -PROCEDURE LongReal*(F: File.FS; VAR x: LONGREAL): BOOLEAN; - RETURN File.Read(F, sys.ADR(x), sys.SIZE(LONGREAL)) = sys.SIZE(LONGREAL) -END LongReal; - PROCEDURE Boolean*(F: File.FS; VAR x: BOOLEAN): BOOLEAN; RETURN File.Read(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN) END Boolean; diff --git a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 b/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 index ece6fac831..153b2bb930 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/Write.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -31,10 +31,6 @@ PROCEDURE Real*(F: File.FS; x: REAL): BOOLEAN; RETURN File.Write(F, sys.ADR(x), sys.SIZE(REAL)) = sys.SIZE(REAL) END Real; -PROCEDURE LongReal*(F: File.FS; x: LONGREAL): BOOLEAN; - RETURN File.Write(F, sys.ADR(x), sys.SIZE(LONGREAL)) = sys.SIZE(LONGREAL) -END LongReal; - PROCEDURE Boolean*(F: File.FS; x: BOOLEAN): BOOLEAN; RETURN File.Write(F, sys.ADR(x), sys.SIZE(BOOLEAN)) = sys.SIZE(BOOLEAN) END Boolean; diff --git a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 index e699b741bc..8ef267a004 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/kfonts.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 Anton Krotov +(* + Copyright 2016, 2018 Anton Krotov This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -24,12 +24,12 @@ CONST MIN_FONT_SIZE = 8; MAX_FONT_SIZE = 46; - bold *= 1; - italic *= 2; - underline *= 4; + bold *= 1; + italic *= 2; + underline *= 4; strike_through *= 8; - smoothing *= 16; - bpp32 *= 32; + smoothing *= 16; + bpp32 *= 32; TYPE @@ -51,7 +51,7 @@ TYPE PROCEDURE [stdcall] zeromem(size, adr: INTEGER); BEGIN - sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F") + sys.CODE(057H, 08BH, 07DH, 00CH, 08BH, 04DH, 008H, 033H, 0C0H, 09CH, 0FCH, 0F3H, 0ABH, 09DH, 05FH) END zeromem; PROCEDURE pset(buf, x, y, color: INTEGER; bpp32: BOOLEAN); @@ -97,7 +97,6 @@ PROCEDURE rgb(r, g, b: INTEGER): INTEGER; END rgb; PROCEDURE create_glyph(VAR Font: TFont_desc; VAR glyph: Glyph; xsize, ysize: INTEGER); -VAR res: INTEGER; BEGIN glyph.base := Font.mempos; glyph.xsize := xsize; @@ -123,14 +122,14 @@ BEGIN FOR y := 1 TO ysize - 1 DO FOR x := 1 TO xsize - 1 DO IF (getpix(Font, n, x, y, xsize) = 1X) & (getpix(Font, n, x - 1, y - 1, xsize) = 1X) & - (getpix(Font, n, x - 1, y, xsize) = 0X) & (getpix(Font, n, x, y - 1, xsize) = 0X) THEN - setpix(Font, n, x - 1, y, xsize, 2X); - setpix(Font, n, x, y - 1, xsize, 2X) + (getpix(Font, n, x - 1, y, xsize) = 0X) & (getpix(Font, n, x, y - 1, xsize) = 0X) THEN + setpix(Font, n, x - 1, y, xsize, 2X); + setpix(Font, n, x, y - 1, xsize, 2X) END; IF (getpix(Font, n, x, y, xsize) = 0X) & (getpix(Font, n, x - 1, y - 1, xsize) = 0X) & - (getpix(Font, n, x - 1, y, xsize) = 1X) & (getpix(Font, n, x, y - 1, xsize) = 1X) THEN - setpix(Font, n, x, y, xsize, 2X); - setpix(Font, n, x - 1, y - 1, xsize, 2X) + (getpix(Font, n, x - 1, y, xsize) = 1X) & (getpix(Font, n, x, y - 1, xsize) = 1X) THEN + setpix(Font, n, x, y, xsize, 2X); + setpix(Font, n, x - 1, y - 1, xsize, 2X) END END END @@ -143,9 +142,9 @@ BEGIN FOR j := 0 TO Font.height - 1 DO pix := getpix(Font, src, i, j, src_xsize); IF pix = 1X THEN - FOR k := 0 TO n DO - setpix(Font, dst, i + k, j, dst_xsize, pix) - END + FOR k := 0 TO n DO + setpix(Font, dst, i + k, j, dst_xsize, pix) + END END END END @@ -166,20 +165,20 @@ BEGIN INC(ptr, 4); FOR i := 0 TO 31 DO IF ~eoc THEN - IF i IN s THEN - setpix(Font, glyph.base, x, y, Font.width, 1X); - IF x > max THEN - max := x - END - ELSE - setpix(Font, glyph.base, x, y, Font.width, 0X) - END + IF i IN s THEN + setpix(Font, glyph.base, x, y, Font.width, 1X); + IF x > max THEN + max := x + END + ELSE + setpix(Font, glyph.base, x, y, Font.width, 0X) + END END; INC(x); IF x = Font.width THEN - x := 0; - INC(y); - eoc := eoc OR (y = Font.height) + x := 0; + INC(y); + eoc := eoc OR (y = Font.height) END END UNTIL eoc; @@ -204,7 +203,7 @@ BEGIN FOR j := 0 TO Font.height - 1 DO pix := getpix(Font, Font.glyphs[0, c].base, i, j, Font.glyphs[0, c].xsize); IF pix = 1X THEN - setpix(Font, glyph.base, i + (Font.height - 1 - j) DIV 3, j, glyph.xsize, pix) + setpix(Font, glyph.base, i + (Font.height - 1 - j) DIV 3, j, glyph.xsize, pix) END END END; @@ -270,10 +269,10 @@ BEGIN INC(str); res := res + Font.glyphs[params, ORD(c)].width; IF length > 0 THEN - DEC(length) + DEC(length) END; IF length # 0 THEN - sys.GET(str, c) + sys.GET(str, c) END END END @@ -318,7 +317,7 @@ PROCEDURE TextOut*(Font: TFont; canvas, x, y, str, length, color, params: INTEGE VAR width, xsize, ysize, str1, n: INTEGER; c: CHAR; bpp32, smoothing, underline, strike: BOOLEAN; BEGIN IF Font # NIL THEN - sys.GET(canvas, xsize); + sys.GET(canvas, xsize); sys.GET(canvas + 4, ysize); IF (y <= -TextHeight(Font)) OR (y >= ysize) THEN length := 0 @@ -332,7 +331,7 @@ BEGIN n := str1 - str; str := str1; IF length >= n THEN - length := length - n + length := length - n END; sys.GET(str, c) END; @@ -340,20 +339,20 @@ BEGIN INC(str); width := OutChar(Font^, ORD(c), x, y, canvas, bpp32, smoothing, color, params); IF strike THEN - hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width + 2, color, bpp32) + hline(canvas, x + ORD(1 IN BITS(params)) * ((Font.height DIV 2) DIV 3), y + Font.height DIV 2, width + 2, color, bpp32) END; IF underline THEN - hline(canvas, x, y + Font.height - 1, width + 2, color, bpp32) + hline(canvas, x, y + Font.height - 1, width + 2, color, bpp32) END; x := x + width; IF x > xsize THEN - length := 0 + length := 0 END; IF length > 0 THEN - DEC(length) + DEC(length) END; IF length # 0 THEN - sys.GET(str, c) + sys.GET(str, c) END END END @@ -371,61 +370,61 @@ BEGIN IF (Font.data <= temp) & (temp <= Font.size + Font.data - 4) THEN sys.GET(temp, offset); IF offset # -1 THEN - Font.font_size := font_size; - INC(offset, 156); - offset := offset + Font.data; - IF (Font.data <= offset) & (offset <= Font.size + Font.data - 4) THEN - sys.GET(offset, fsize); - IF fsize > 256 + 6 THEN - temp := offset + fsize - 1; - IF (Font.data <= temp) & (temp <= Font.size + Font.data - 1) THEN - sys.GET(temp, c); - IF c # 0X THEN - Font.height := ORD(c); - DEC(temp); - sys.GET(temp, c); - IF c # 0X THEN - Font.width := ORD(c); - DEC(fsize, 6); - Font.char_size := fsize DIV 256; - IF fsize MOD 256 # 0 THEN - INC(Font.char_size) - END; - IF Font.char_size > 0 THEN - Font.font := offset + 4; - Font.mempos := 0; - memsize := (Font.width + 10) * Font.height * 1024; - mem := Font.mem; - Font.mem := KOSAPI.sysfunc3(68, 12, memsize); - IF Font.mem # 0 THEN - IF mem # 0 THEN - mem := KOSAPI.sysfunc3(68, 13, mem) - END; - zeromem(memsize DIV 4, Font.mem); - FOR i := 0 TO 255 DO - make_glyph(Font, i) - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END - ELSE - offset := -1 - END + Font.font_size := font_size; + INC(offset, 156); + offset := offset + Font.data; + IF (Font.data <= offset) & (offset <= Font.size + Font.data - 4) THEN + sys.GET(offset, fsize); + IF fsize > 256 + 6 THEN + temp := offset + fsize - 1; + IF (Font.data <= temp) & (temp <= Font.size + Font.data - 1) THEN + sys.GET(temp, c); + IF c # 0X THEN + Font.height := ORD(c); + DEC(temp); + sys.GET(temp, c); + IF c # 0X THEN + Font.width := ORD(c); + DEC(fsize, 6); + Font.char_size := fsize DIV 256; + IF fsize MOD 256 # 0 THEN + INC(Font.char_size) + END; + IF Font.char_size > 0 THEN + Font.font := offset + 4; + Font.mempos := 0; + memsize := (Font.width + 10) * Font.height * 1024; + mem := Font.mem; + Font.mem := KOSAPI.sysfunc3(68, 12, memsize); + IF Font.mem # 0 THEN + IF mem # 0 THEN + mem := KOSAPI.sysfunc3(68, 13, mem) + END; + zeromem(memsize DIV 4, Font.mem); + FOR i := 0 TO 255 DO + make_glyph(Font, i) + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END + ELSE + offset := -1 + END END; ELSE offset := -1 diff --git a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 b/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 index d927d8aea2..425f74034a 100644 --- a/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 +++ b/programs/develop/oberon07/Lib/KolibriOS/libimg.ob07 @@ -1,5 +1,5 @@ -(* - Copyright 2016 KolibriOS team +(* + Copyright 2016, 2018 KolibriOS team This program is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by @@ -26,51 +26,51 @@ CONST FLIP_HORIZONTAL *= 2; - ROTATE_90_CW *= 1; - ROTATE_180 *= 2; + ROTATE_90_CW *= 1; + ROTATE_180 *= 2; ROTATE_270_CW *= 3; ROTATE_90_CCW *= ROTATE_270_CW; ROTATE_270_CCW *= ROTATE_90_CW; - // scale type corresponding img_scale params - LIBIMG_SCALE_INTEGER *= 1; // scale factor ; reserved 0 - LIBIMG_SCALE_TILE *= 2; // new width ; new height - LIBIMG_SCALE_STRETCH *= 3; // new width ; new height + // scale type corresponding img_scale params + LIBIMG_SCALE_INTEGER *= 1; // scale factor ; reserved 0 + LIBIMG_SCALE_TILE *= 2; // new width ; new height + LIBIMG_SCALE_STRETCH *= 3; // new width ; new height LIBIMG_SCALE_FIT_RECT *= 4; // new width ; new height LIBIMG_SCALE_FIT_WIDTH *= 5; // new width ; new height LIBIMG_SCALE_FIT_HEIGHT *= 6; // new width ; new height - LIBIMG_SCALE_FIT_MAX *= 7; // new width ; new height + LIBIMG_SCALE_FIT_MAX *= 7; // new width ; new height // interpolation algorithm - LIBIMG_INTER_NONE *= 0; // use it with LIBIMG_SCALE_INTEGER, LIBIMG_SCALE_TILE, etc + LIBIMG_INTER_NONE *= 0; // use it with LIBIMG_SCALE_INTEGER, LIBIMG_SCALE_TILE, etc LIBIMG_INTER_BILINEAR *= 1; - LIBIMG_INTER_DEFAULT *= LIBIMG_INTER_BILINEAR; + LIBIMG_INTER_DEFAULT *= LIBIMG_INTER_BILINEAR; // list of format id's - LIBIMG_FORMAT_BMP *= 1; - LIBIMG_FORMAT_ICO *= 2; - LIBIMG_FORMAT_CUR *= 3; - LIBIMG_FORMAT_GIF *= 4; - LIBIMG_FORMAT_PNG *= 5; - LIBIMG_FORMAT_JPEG *= 6; - LIBIMG_FORMAT_TGA *= 7; - LIBIMG_FORMAT_PCX *= 8; - LIBIMG_FORMAT_XCF *= 9; - LIBIMG_FORMAT_TIFF *= 10; - LIBIMG_FORMAT_PNM *= 11; - LIBIMG_FORMAT_WBMP *= 12; - LIBIMG_FORMAT_XBM *= 13; - LIBIMG_FORMAT_Z80 *= 14; + LIBIMG_FORMAT_BMP *= 1; + LIBIMG_FORMAT_ICO *= 2; + LIBIMG_FORMAT_CUR *= 3; + LIBIMG_FORMAT_GIF *= 4; + LIBIMG_FORMAT_PNG *= 5; + LIBIMG_FORMAT_JPEG *= 6; + LIBIMG_FORMAT_TGA *= 7; + LIBIMG_FORMAT_PCX *= 8; + LIBIMG_FORMAT_XCF *= 9; + LIBIMG_FORMAT_TIFF *= 10; + LIBIMG_FORMAT_PNM *= 11; + LIBIMG_FORMAT_WBMP *= 12; + LIBIMG_FORMAT_XBM *= 13; + LIBIMG_FORMAT_Z80 *= 14; // encode flags (byte 0x02 of common option) LIBIMG_ENCODE_STRICT_SPECIFIC *= 01H; LIBIMG_ENCODE_STRICT_BIT_DEPTH *= 02H; - LIBIMG_ENCODE_DELETE_ALPHA *= 08H; - LIBIMG_ENCODE_FLUSH_ALPHA *= 10H; + LIBIMG_ENCODE_DELETE_ALPHA *= 08H; + LIBIMG_ENCODE_FLUSH_ALPHA *= 10H; // values for Image.Type @@ -80,7 +80,7 @@ CONST bpp32 *= 3; bpp15 *= 4; bpp16 *= 5; - bpp1 *= 6; + bpp1 *= 6; bpp8g *= 7; // grayscale bpp2i *= 8; bpp4i *= 9; @@ -112,7 +112,7 @@ TYPE ImageDecodeOptions* = RECORD - UsedSize *: INTEGER; // if >=8, the field BackgroundColor is valid, and so on + UsedSize *: INTEGER; // if >=8, the field BackgroundColor is valid, and so on BackgroundColor *: INTEGER // used for transparent images as background END; @@ -120,10 +120,10 @@ TYPE FormatsTableEntry* = RECORD - Format_id *: INTEGER; - Is *: INTEGER; - Decode *: INTEGER; - Encode *: INTEGER; + Format_id *: INTEGER; + Is *: INTEGER; + Decode *: INTEGER; + Encode *: INTEGER; Capabilities *: INTEGER END; @@ -131,7 +131,7 @@ TYPE VAR - img_is_img *: PROCEDURE (data, length: INTEGER): INTEGER; + img_is_img *: PROCEDURE (data, length: INTEGER): INTEGER; @@ -147,7 +147,7 @@ VAR - img_to_rgb *: PROCEDURE (img: INTEGER): INTEGER; + img_to_rgb *: PROCEDURE (img: INTEGER): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? decodes image data into RGB triplets and returns pointer to memory area containing them ;; @@ -160,7 +160,7 @@ VAR - img_decode *: PROCEDURE (data, length, options: INTEGER): INTEGER; + img_decode *: PROCEDURE (data, length, options: INTEGER): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? decodes loaded into memory graphic file ;; @@ -175,7 +175,7 @@ VAR - img_encode *: PROCEDURE (img: INTEGER; common, specific: INTEGER): INTEGER; + img_encode *: PROCEDURE (img: INTEGER; common, specific: INTEGER): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? encode image to some format ;; @@ -203,7 +203,7 @@ VAR - img_create *: PROCEDURE (width, height, type: INTEGER): INTEGER; + img_create *: PROCEDURE (width, height, type: INTEGER): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? creates an Image structure and initializes some its fields ;; @@ -246,7 +246,7 @@ VAR - img_count *: PROCEDURE (img: INTEGER): INTEGER; + img_count *: PROCEDURE (img: INTEGER): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? Get number of images in the list (e.g. in animated GIF file) ;; @@ -259,7 +259,7 @@ VAR - img_flip *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN; + img_flip *: PROCEDURE (img: INTEGER; flip_kind: INTEGER): BOOLEAN; (* ;;------------------------------------------------------------------------------------------------;; ;? Flip all layers of image ;; @@ -287,7 +287,7 @@ VAR - img_rotate *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN; + img_rotate *: PROCEDURE (img: INTEGER; rotate_kind: INTEGER): BOOLEAN; (* ;;------------------------------------------------------------------------------------------------;; ;? Rotate all layers of image ;; @@ -315,7 +315,7 @@ VAR - img_draw *: PROCEDURE (img: INTEGER; x, y, width, height, xpos, ypos: INTEGER); + img_draw *: PROCEDURE (img: INTEGER; x, y, width, height, xpos, ypos: INTEGER); (* ;;------------------------------------------------------------------------------------------------;; ;? Draw image in the window ;; @@ -332,7 +332,7 @@ VAR - img_scale *: PROCEDURE (src: INTEGER; crop_x, crop_y, crop_width, crop_height: INTEGER; dst: INTEGER; scale, inter, param1, param2: INTEGER ): INTEGER; + img_scale *: PROCEDURE (src: INTEGER; crop_x, crop_y, crop_width, crop_height: INTEGER; dst: INTEGER; scale, inter, param1, param2: INTEGER ): INTEGER; (* ;;------------------------------------------------------------------------------------------------;; ;? scale _image ;; @@ -398,7 +398,7 @@ END GetFormatsTable; PROCEDURE main; VAR Lib, formats_table_ptr: INTEGER; - PROCEDURE GetProc(v: INTEGER; name: ARRAY OF CHAR); + PROCEDURE GetProc(Lib, v: INTEGER; name: ARRAY OF CHAR); VAR a: INTEGER; BEGIN a := KOSAPI.GetProcAdr(name, Lib); @@ -409,23 +409,23 @@ VAR Lib, formats_table_ptr: INTEGER; BEGIN Lib := KOSAPI.LoadLib("/rd/1/lib/libimg.obj"); ASSERT(Lib # 0); - GetProc(sys.ADR(img_is_img) , "img_is_img"); - GetProc(sys.ADR(img_to_rgb) , "img_to_rgb"); - GetProc(sys.ADR(img_to_rgb2) , "img_to_rgb2"); - GetProc(sys.ADR(img_decode) , "img_decode"); - GetProc(sys.ADR(img_encode) , "img_encode"); - GetProc(sys.ADR(img_create) , "img_create"); - GetProc(sys.ADR(img_destroy) , "img_destroy"); - GetProc(sys.ADR(img_destroy_layer) , "img_destroy_layer"); - GetProc(sys.ADR(img_count) , "img_count"); - GetProc(sys.ADR(img_flip) , "img_flip"); - GetProc(sys.ADR(img_flip_layer) , "img_flip_layer"); - GetProc(sys.ADR(img_rotate) , "img_rotate"); - GetProc(sys.ADR(img_rotate_layer) , "img_rotate_layer"); - GetProc(sys.ADR(img_draw) , "img_draw"); - GetProc(sys.ADR(img_scale) , "img_scale"); - GetProc(sys.ADR(img_convert) , "img_convert"); - GetProc(sys.ADR(formats_table_ptr) , "img_formats_table"); + GetProc(Lib, sys.ADR(img_is_img) , "img_is_img"); + GetProc(Lib, sys.ADR(img_to_rgb) , "img_to_rgb"); + GetProc(Lib, sys.ADR(img_to_rgb2) , "img_to_rgb2"); + GetProc(Lib, sys.ADR(img_decode) , "img_decode"); + GetProc(Lib, sys.ADR(img_encode) , "img_encode"); + GetProc(Lib, sys.ADR(img_create) , "img_create"); + GetProc(Lib, sys.ADR(img_destroy) , "img_destroy"); + GetProc(Lib, sys.ADR(img_destroy_layer) , "img_destroy_layer"); + GetProc(Lib, sys.ADR(img_count) , "img_count"); + GetProc(Lib, sys.ADR(img_flip) , "img_flip"); + GetProc(Lib, sys.ADR(img_flip_layer) , "img_flip_layer"); + GetProc(Lib, sys.ADR(img_rotate) , "img_rotate"); + GetProc(Lib, sys.ADR(img_rotate_layer) , "img_rotate_layer"); + GetProc(Lib, sys.ADR(img_draw) , "img_draw"); + GetProc(Lib, sys.ADR(img_scale) , "img_scale"); + GetProc(Lib, sys.ADR(img_convert) , "img_convert"); + GetProc(Lib, sys.ADR(formats_table_ptr) , "img_formats_table"); GetFormatsTable(formats_table_ptr) END main; diff --git a/programs/develop/oberon07/Lib/Linux32/API.ob07 b/programs/develop/oberon07/Lib/Linux32/API.ob07 index f0ec129793..b461216a69 100644 --- a/programs/develop/oberon07/Lib/Linux32/API.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/API.ob07 @@ -1,148 +1,145 @@ (* - Copyright 2016 Anton Krotov + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2019, Anton Krotov + All rights reserved. *) MODULE API; -IMPORT sys := SYSTEM; +IMPORT SYSTEM; + + +CONST + + BASE_ADR = 08048000H; + TYPE - TP* = ARRAY 2 OF INTEGER; + TP* = ARRAY 2 OF INTEGER; + VAR - Param*: INTEGER; + eol*: ARRAY 2 OF CHAR; + base*, MainParam*: INTEGER; - sec* : INTEGER; - dsec* : INTEGER; - stdin* : INTEGER; - stdout* : INTEGER; - stderr* : INTEGER; - dlopen* : PROCEDURE [cdecl] (filename, flag: INTEGER): INTEGER; - dlsym* : PROCEDURE [cdecl] (handle, symbol: INTEGER): INTEGER; - _malloc* : PROCEDURE [cdecl] (size: INTEGER): INTEGER; - free* : PROCEDURE [cdecl] (ptr: INTEGER); - fopen* : PROCEDURE [cdecl] (fname, fmode: INTEGER): INTEGER; - fclose*, ftell* : PROCEDURE [cdecl] (file: INTEGER): INTEGER; - fwrite*, fread* : PROCEDURE [cdecl] (buffer, bytes, blocks, file: INTEGER): INTEGER; - fseek* : PROCEDURE [cdecl] (file, offset, origin: INTEGER): INTEGER; - exit* : PROCEDURE [cdecl] (code: INTEGER); - strncmp* : PROCEDURE [cdecl] (str1, str2, n: INTEGER): INTEGER; - strlen* : PROCEDURE [cdecl] (str: INTEGER): INTEGER; - clock_gettime* : PROCEDURE [cdecl] (clock_id: INTEGER; VAR tp: TP): INTEGER; + libc*, librt*: INTEGER; + + dlopen* : PROCEDURE [linux] (filename, flag: INTEGER): INTEGER; + dlsym* : PROCEDURE [linux] (handle, symbol: INTEGER): INTEGER; + + stdout*, + stdin*, + stderr* : INTEGER; + + malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; + free* : PROCEDURE [linux] (ptr: INTEGER); + _exit* : PROCEDURE [linux] (code: INTEGER); + puts* : PROCEDURE [linux] (pStr: INTEGER); + fwrite*, + fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; + fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; + fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; + + clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; + time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + + +PROCEDURE putc* (c: CHAR); +VAR + res: INTEGER; -PROCEDURE [stdcall] zeromem* (size, adr: INTEGER); BEGIN - sys.CODE("578B7D0C8B4D0833C09CFCF3AB9D5F") -END zeromem; + res := fwrite(SYSTEM.ADR(c), 1, 1, stdout) +END putc; -PROCEDURE Align(n, m: INTEGER): INTEGER; - RETURN n + (m - n MOD m) MOD m -END Align; - -PROCEDURE malloc* (Bytes: INTEGER): INTEGER; -VAR res: INTEGER; -BEGIN - Bytes := Align(Bytes, 4); - res := _malloc(Bytes); - IF res # 0 THEN - zeromem(ASR(Bytes, 2), res) - END - RETURN res -END malloc; - -PROCEDURE Free* (hMem: INTEGER): INTEGER; -BEGIN - free(hMem) - RETURN 0 -END Free; - -PROCEDURE _NEW*(size: INTEGER): INTEGER; - RETURN malloc(size) -END _NEW; - -PROCEDURE _DISPOSE*(p: INTEGER): INTEGER; - RETURN Free(p) -END _DISPOSE; - -PROCEDURE ConOut(str, length: INTEGER); -BEGIN - length := fwrite(str, length, 1, stdout) -END ConOut; PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); -VAR eol: ARRAY 3 OF CHAR; BEGIN - eol[0] := 0DX; - eol[1] := 0AX; - eol[2] := 00X; - ConOut(sys.ADR(eol), 2); - ConOut(lpCaption, strlen(lpCaption)); - ConOut(sys.ADR(":"), 1); - ConOut(sys.ADR(eol), 2); - ConOut(lpText, strlen(lpText)); - ConOut(sys.ADR(eol), 2); + puts(lpCaption); + puts(lpText) END DebugMsg; -PROCEDURE ExitProcess* (code: INTEGER); + +PROCEDURE _NEW* (size: INTEGER): INTEGER; +VAR + res, ptr, words: INTEGER; + BEGIN - exit(code) -END ExitProcess; + res := malloc(size); + IF res # 0 THEN + ptr := res; + words := size DIV SYSTEM.SIZE(INTEGER); + WHILE words > 0 DO + SYSTEM.PUT(ptr, 0); + INC(ptr, SYSTEM.SIZE(INTEGER)); + DEC(words) + END + END -PROCEDURE ExitThread* (code: INTEGER); + RETURN res +END _NEW; + + +PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; BEGIN - exit(code) -END ExitThread; + free(p) + RETURN 0 +END _DISPOSE; -PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); -VAR H: INTEGER; + +PROCEDURE GetProcAdr (lib: INTEGER; name: ARRAY OF CHAR; VarAdr: INTEGER); +VAR + sym: INTEGER; BEGIN - H := dlsym(hMOD, sys.ADR(name[0])); - ASSERT(H # 0); - sys.PUT(adr, H); -END GetProc; + sym := dlsym(lib, SYSTEM.ADR(name[0])); + ASSERT(sym # 0); + SYSTEM.PUT(VarAdr, sym) +END GetProcAdr; -PROCEDURE init* (esp: INTEGER); -VAR lib, proc: INTEGER; + +PROCEDURE init* (sp, code: INTEGER); BEGIN - Param := esp; - sys.MOVE(Param + 12, sys.ADR(dlopen), 4); - sys.MOVE(Param + 16, sys.ADR(dlsym), 4); - sys.MOVE(Param + 20, sys.ADR(exit), 4); - sys.MOVE(Param + 24, sys.ADR(stdin), 4); - sys.MOVE(Param + 28, sys.ADR(stdout), 4); - sys.MOVE(Param + 32, sys.ADR(stderr), 4); - sys.MOVE(Param + 36, sys.ADR(_malloc), 4); - sys.MOVE(Param + 40, sys.ADR(free), 4); - sys.MOVE(Param + 44, sys.ADR(fopen), 4); - sys.MOVE(Param + 48, sys.ADR(fclose), 4); - sys.MOVE(Param + 52, sys.ADR(fwrite), 4); - sys.MOVE(Param + 56, sys.ADR(fread), 4); - sys.MOVE(Param + 60, sys.ADR(fseek), 4); - sys.MOVE(Param + 64, sys.ADR(ftell), 4); + SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER) * 2, dlopen); + SYSTEM.GET(code - 1000H - SYSTEM.SIZE(INTEGER), dlsym); + MainParam := sp; + base := BASE_ADR; + eol := 0AX; - lib := dlopen(sys.ADR("libc.so.6"), 1); - ASSERT(lib # 0); - GetProc("strncmp", lib, sys.ADR(strncmp)); - GetProc("strlen", lib, sys.ADR(strlen)); + libc := dlopen(SYSTEM.SADR("libc.so.6"), 1); + GetProcAdr(libc, "malloc", SYSTEM.ADR(malloc)); + GetProcAdr(libc, "free", SYSTEM.ADR(free)); + GetProcAdr(libc, "exit", SYSTEM.ADR(_exit)); + GetProcAdr(libc, "stdout", SYSTEM.ADR(stdout)); + GetProcAdr(libc, "stdin", SYSTEM.ADR(stdin)); + GetProcAdr(libc, "stderr", SYSTEM.ADR(stderr)); + SYSTEM.GET(stdout - SYSTEM.SIZE(INTEGER), stdout); + SYSTEM.GET(stdin - SYSTEM.SIZE(INTEGER), stdin); + SYSTEM.GET(stderr - SYSTEM.SIZE(INTEGER), stderr); + GetProcAdr(libc, "puts", SYSTEM.ADR(puts)); + GetProcAdr(libc, "fwrite", SYSTEM.ADR(fwrite)); + GetProcAdr(libc, "fread", SYSTEM.ADR(fread)); + GetProcAdr(libc, "fopen", SYSTEM.ADR(fopen)); + GetProcAdr(libc, "fclose", SYSTEM.ADR(fclose)); + GetProcAdr(libc, "time", SYSTEM.ADR(time)); - lib := dlopen(sys.ADR("librt.so.1"), 1); - ASSERT(lib # 0); - GetProc("clock_gettime", lib, sys.ADR(clock_gettime)); + librt := dlopen(SYSTEM.SADR("librt.so.1"), 1); + GetProcAdr(librt, "clock_gettime", SYSTEM.ADR(clock_gettime)) END init; + +PROCEDURE exit* (code: INTEGER); +BEGIN + _exit(code) +END exit; + + +PROCEDURE exit_thread* (code: INTEGER); +BEGIN + _exit(code) +END exit_thread; + + END API. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 index 76913bcd41..967e2657bc 100644 --- a/programs/develop/oberon07/Lib/Linux32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/HOST.ob07 @@ -1,121 +1,178 @@ -(* - Copyright 2016 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2019, Anton Krotov + All rights reserved. *) MODULE HOST; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, API, RTL; + CONST - OS* = "LNX"; - Slash* = "/"; + slash* = "/"; + OS* = "LINUX"; + + bit_depth* = RTL.bit_depth; + maxint* = RTL.maxint; + minint* = RTL.minint; + VAR - fsize : INTEGER; + argc: INTEGER; - sec* : INTEGER; - dsec* : INTEGER; + eol*: ARRAY 2 OF CHAR; -PROCEDURE GetCommandLine* (): INTEGER; - RETURN API.Param -END GetCommandLine; - -PROCEDURE CloseFile* (File: INTEGER); -BEGIN - File := API.fclose(File) -END CloseFile; - -PROCEDURE FileRW* (hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER; -VAR res: INTEGER; -BEGIN - IF write THEN - res := API.fwrite(Buffer, nNumberOfBytes, 1, hFile) * nNumberOfBytes - ELSE - res := API.fread(Buffer, nNumberOfBytes, 1, hFile) * nNumberOfBytes - END - RETURN res -END FileRW; - -PROCEDURE OutString* (str: ARRAY OF CHAR); -VAR res: INTEGER; -BEGIN - res := FileRW(API.stdout, sys.ADR(str), LENGTH(str), TRUE) -END OutString; - -PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER; - RETURN API.fopen(sys.ADR(FName), sys.ADR("wb")) -END CreateFile; - -PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER; -VAR F, res: INTEGER; -BEGIN - F := API.fopen(sys.ADR(FName), sys.ADR("rb")); - IF F # 0 THEN - res := API.fseek(F, 0, 2); - fsize := API.ftell(F); - res := API.fseek(F, 0, 0) - END - RETURN F -END OpenFile; - -PROCEDURE FileSize* (F: INTEGER): INTEGER; - RETURN fsize -END FileSize; - -PROCEDURE Align(n, m: INTEGER): INTEGER; - RETURN n + (m - n MOD m) MOD m -END Align; - -PROCEDURE malloc* (Bytes: INTEGER): INTEGER; -VAR res: INTEGER; -BEGIN - Bytes := Align(Bytes, 4); - res := API.malloc(Bytes); - IF res # 0 THEN - API.zeromem(ASR(Bytes, 2), res) - END - RETURN res -END malloc; PROCEDURE ExitProcess* (code: INTEGER); BEGIN - API.exit(code) + API.exit(code) END ExitProcess; -PROCEDURE Time* (VAR sec, dsec: INTEGER); -VAR tp: API.TP; + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, len, ptr: INTEGER; + c: CHAR; + BEGIN - IF API.clock_gettime(0, tp) = 0 THEN - sec := tp[0]; - dsec := tp[1] DIV 10000000 - ELSE - sec := 0; - dsec := 0 - END -END Time; + i := 0; + len := LEN(s) - 1; + IF (n < argc) & (len > 0) THEN + SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); + REPEAT + SYSTEM.GET(ptr, c); + s[i] := c; + INC(i); + INC(ptr) + UNTIL (c = 0X) OR (i = len) + END; + s[i] := 0X +END GetArg; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +VAR + n: INTEGER; -PROCEDURE init*; BEGIN - Time(sec, dsec) -END init; + GetArg(0, path); + n := LENGTH(path) - 1; + WHILE path[n] # slash DO + DEC(n) + END; + path[n + 1] := 0X +END GetCurrentDirectory; -PROCEDURE GetName*(): INTEGER; - RETURN 0 -END GetName; +PROCEDURE ReadFile (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; + RETURN API.fread(SYSTEM.ADR(Buffer[0]), 1, bytes, F) +END ReadFile; + + +PROCEDURE WriteFile (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; + RETURN API.fwrite(SYSTEM.ADR(Buffer[0]), 1, bytes, F) +END WriteFile; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := ReadFile(F, Buffer, bytes); + IF res <= 0 THEN + res := -1 + END + + RETURN res +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := WriteFile(F, Buffer, bytes); + IF res <= 0 THEN + res := -1 + END + + RETURN res +END FileWrite; + + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; + RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("wb")) +END FileCreate; + + +PROCEDURE FileClose* (File: INTEGER); +BEGIN + File := API.fclose(File) +END FileClose; + + +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; + RETURN API.fopen(SYSTEM.ADR(FName[0]), SYSTEM.SADR("rb")) +END FileOpen; + + +PROCEDURE OutChar* (c: CHAR); +BEGIN + API.putc(c) +END OutChar; + + +PROCEDURE GetTickCount* (): INTEGER; +VAR + tp: API.TP; + res: INTEGER; + +BEGIN + IF API.clock_gettime(0, tp) = 0 THEN + res := tp[0] * 100 + tp[1] DIV 10000000 + ELSE + res := 0 + END + + RETURN res +END GetTickCount; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN path[0] # slash +END isRelative; + + +PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); +END now; + + +PROCEDURE UnixTime* (): INTEGER; + RETURN API.time(0) +END UnixTime; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + a := 0; + b := 0; + SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); + SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); + SYSTEM.GET(SYSTEM.ADR(x), res) + RETURN res +END splitf; + + +BEGIN + eol := 0AX; + SYSTEM.GET(API.MainParam, argc) END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 new file mode 100644 index 0000000000..339516e58e --- /dev/null +++ b/programs/develop/oberon07/Lib/Linux32/LINAPI.ob07 @@ -0,0 +1,141 @@ +(* + BSD 2-Clause License + + Copyright (c) 2019, Anton Krotov + All rights reserved. +*) + +MODULE LINAPI; + +IMPORT SYSTEM, API; + + +TYPE + + TP* = API.TP; + + +VAR + + argc*, envc*: INTEGER; + + libc*, librt*: INTEGER; + + stdout*, + stdin*, + stderr* : INTEGER; + + malloc* : PROCEDURE [linux] (size: INTEGER): INTEGER; + free* : PROCEDURE [linux] (ptr: INTEGER); + exit* : PROCEDURE [linux] (code: INTEGER); + puts* : PROCEDURE [linux] (pStr: INTEGER); + fwrite*, + fread* : PROCEDURE [linux] (buffer, bytes, blocks, file: INTEGER): INTEGER; + fopen* : PROCEDURE [linux] (fname, fmode: INTEGER): INTEGER; + fclose* : PROCEDURE [linux] (file: INTEGER): INTEGER; + time* : PROCEDURE [linux] (ptr: INTEGER): INTEGER; + + clock_gettime* : PROCEDURE [linux] (clock_id: INTEGER; VAR tp: TP): INTEGER; + + +PROCEDURE dlopen* (filename: ARRAY OF CHAR): INTEGER; + RETURN API.dlopen(SYSTEM.ADR(filename[0]), 1) +END dlopen; + + +PROCEDURE dlsym* (handle: INTEGER; symbol: ARRAY OF CHAR): INTEGER; + RETURN API.dlsym(handle, SYSTEM.ADR(symbol[0])) +END dlsym; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, len, ptr: INTEGER; + c: CHAR; + +BEGIN + i := 0; + len := LEN(s) - 1; + IF (0 <= n) & (n <= argc + envc) & (n # argc) & (len > 0) THEN + SYSTEM.GET(API.MainParam + (n + 1) * SYSTEM.SIZE(INTEGER), ptr); + REPEAT + SYSTEM.GET(ptr, c); + s[i] := c; + INC(i); + INC(ptr) + UNTIL (c = 0X) OR (i = len) + END; + s[i] := 0X +END GetArg; + + +PROCEDURE GetEnv* (n: INTEGER; VAR s: ARRAY OF CHAR); +BEGIN + IF (0 <= n) & (n < envc) THEN + GetArg(n + argc + 1, s) + ELSE + s[0] := 0X + END +END GetEnv; + + +PROCEDURE init; +VAR + ptr: INTEGER; + +BEGIN + envc := -1; + SYSTEM.GET(API.MainParam, argc); + REPEAT + SYSTEM.GET(API.MainParam + (envc + argc + 3) * SYSTEM.SIZE(INTEGER), ptr); + INC(envc) + UNTIL ptr = 0; + + libc := API.libc; + + stdout := API.stdout; + stdin := API.stdin; + stderr := API.stderr; + + malloc := API.malloc; + free := API.free; + exit := API._exit; + puts := API.puts; + fwrite := API.fwrite; + fread := API.fread; + fopen := API.fopen; + fclose := API.fclose; + time := API.time; + + librt := API.librt; + + clock_gettime := API.clock_gettime +END init; + + +PROCEDURE [stdcall-] syscall* (eax, ebx, ecx, edx, esi, edi: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + 053H, (* push ebx *) + 056H, (* push esi *) + 057H, (* push edi *) + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 05DH, 00CH, (* mov ebx, dword [ebp + 12] *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 08BH, 055H, 014H, (* mov edx, dword [ebp + 20] *) + 08BH, 075H, 018H, (* mov esi, dword [ebp + 24] *) + 08BH, 07DH, 01CH, (* mov edi, dword [ebp + 28] *) + 0CDH, 080H, (* int 128 *) + 05FH, (* pop edi *) + 05EH, (* pop esi *) + 05BH, (* pop ebx *) + 0C9H, (* leave *) + 0C2H, 018H, 000H (* ret 24 *) + ) + RETURN 0 +END syscall; + + +BEGIN + init +END LINAPI. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 index 96eb3f82b8..2758c1e417 100644 --- a/programs/develop/oberon07/Lib/Linux32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Linux32/RTL.ob07 @@ -1,276 +1,630 @@ (* - Copyright 2016, 2017 Anton Krotov + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE RTL; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, API; + + +CONST + + bit_depth* = 32; + maxint* = 7FFFFFFFH; + minint* = 80000000H; + + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + SIZE_OF_DWORD = 4; + TYPE - IntArray = ARRAY 2048 OF INTEGER; - STRING = ARRAY 2048 OF CHAR; - PROC = PROCEDURE; + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR - SelfName, rtab: INTEGER; CloseProc: PROC; - init: BOOLEAN; + name: INTEGER; + types: INTEGER; -PROCEDURE [stdcall] _halt*(n: INTEGER); -BEGIN - API.ExitProcess(n) -END _halt; - -PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER); -BEGIN - ptr := API._NEW(size); - IF ptr # 0 THEN - sys.PUT(ptr, t); - INC(ptr, 4) - END -END _newrec; - -PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER); -BEGIN - IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - 4) - END -END _disprec; - -PROCEDURE [stdcall] _rset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800") -END _rset; - -PROCEDURE [stdcall] _inset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800") -END _inset; - -PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER); -BEGIN - table := rtab; - sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00") -END _checktype; - -PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER); -BEGIN - sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D") -END _savearr; - -PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN; -VAR res: BOOLEAN; -BEGIN - res := dyn = stat; - IF res THEN - _savearr(size, source, dest) - END - RETURN res -END _saverec; - -PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER); -VAR i, m: INTEGER; -BEGIN - m := bsize * idx; - FOR i := 4 TO Dim + 2 DO - m := m * Arr[i] - END; - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := c + m - ELSE - Arr[3] := 0 - END -END _arrayidx; - -PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER); -BEGIN - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := bsize * idx + c - ELSE - Arr[3] := 0 - END -END _arrayidx1; - -PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray); -VAR i, j, t: INTEGER; -BEGIN - FOR i := 1 TO n DO - t := Arr[0]; - FOR j := 0 TO m + n - 1 DO - Arr[j] := Arr[j + 1] + dll: RECORD + process_detach, + thread_detach, + thread_attach: DLL_ENTRY END; - Arr[m + n] := t - END -END _arrayrot; -PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; + +PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN - sys.CODE("8B4508"); // mov eax, [ebp + 08h] - sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] - sys.CODE("48"); // dec eax - // L1: - sys.CODE("40"); // inc eax - sys.CODE("803800"); // cmp byte ptr [eax], 0 - sys.CODE("7403"); // jz L2 - sys.CODE("E2F8"); // loop L1 - sys.CODE("40"); // inc eax - // L2: - sys.CODE("2B4508"); // sub eax, [ebp + 08h] - sys.CODE("C9"); // leave - sys.CODE("C20800"); // ret 08h - RETURN 0 + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) + 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *) + 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move2; + + +PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, src, dst); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy; + + +PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy2; + + +PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); +VAR + i, n, k: INTEGER; + +BEGIN + + k := LEN(A) - 1; + n := A[0]; + i := 0; + WHILE i < k DO + A[i] := A[i + 1]; + INC(i) + END; + A[k] := n + +END _rot; + + +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF (a <= b) & (a <= 31) & (b >= 0) THEN + IF b > 31 THEN + b := 31 + END; + IF a < 0 THEN + a := 0 + END; + res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + ELSE + res := 0 + END + + RETURN res +END _set2; + + +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; + RETURN _set2(a, b) +END _set; + + +PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 031H, 0D2H, (* xor edx, edx *) + 085H, 0C0H, (* test eax, eax *) + 07DH, 002H, (* jge L1 *) + 0F7H, 0D2H, (* not edx *) + (* L1: *) + 0F7H, 0F9H, (* idiv ecx *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 089H, 011H, (* mov dword [ecx], edx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + + RETURN 0 +END divmod; + + +PROCEDURE div_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + DEC(div) + END + + RETURN div +END div_; + + +PROCEDURE mod_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + INC(mod, y) + END + + RETURN mod +END mod_; + + +PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; + RETURN div_(a, b) +END _div; + + +PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; + RETURN div_(a, b) +END _div2; + + +PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod; + + +PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod2; + + +PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, SIZE_OF_DWORD) + END +END _new; + + +PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + END +END _dispose; + + +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmpw; + + +PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 080H, 038H, 000H, (* cmp byte [eax], 0 *) + 074H, 003H, (* jz L2 *) + 0E2H, 0F8H, (* loop L1 *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 END _length; -PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); -BEGIN - _savearr(MIN(alen, blen), a, b); - IF blen > alen THEN - sys.PUT(b + alen, 0X) - END -END _strcopy; -PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; -VAR i: INTEGER; Res: BOOLEAN; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; BEGIN - i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); - IF i = 0 THEN - i := _length(a) - _length(b) - END; - CASE op OF - |0: Res := i = 0 - |1: Res := i # 0 - |2: Res := i < 0 - |3: Res := i > 0 - |4: Res := i <= 0 - |5: Res := i >= 0 - ELSE - END - RETURN Res + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 040H, (* inc eax *) + 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *) + 074H, 004H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 040H, (* inc eax *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0D1H, 0E8H, (* shr eax, 1 *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 +END _lengthw; + + +PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + +BEGIN + + res := strncmp(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _length(len1, str1) - _length(len2, str2) + END; + + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes END _strcmp; -PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; + +PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmp(op, len2, str2, len1, str1) +END _strcmp2; + + +PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + BEGIN - s[0] := b; - s[1] := 0X; - RETURN _strcmp(op, s, a) -END _lstrcmp; -PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; -BEGIN - s[0] := a; - s[1] := 0X; - RETURN _strcmp(op, b, s) -END _rstrcmp; + res := strncmpw(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _lengthw(len1, str1) - _lengthw(len2, str2) + END; -PROCEDURE Int(x: INTEGER; VAR str: STRING); -VAR i, a, b: INTEGER; c: CHAR; -BEGIN - i := 0; - a := 0; - REPEAT - str[i] := CHR(x MOD 10 + ORD("0")); - x := x DIV 10; - INC(i) - UNTIL x = 0; - b := i - 1; - WHILE a < b DO - c := str[a]; - str[a] := str[b]; - str[b] := c; - INC(a); - DEC(b) - END; - str[i] := 0X -END Int; - -PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER); -VAR msg, int: STRING; pos, n: INTEGER; - - PROCEDURE StrAppend(s: STRING); - VAR i, n: INTEGER; - BEGIN - n := LEN(s); - i := 0; - WHILE (i < n) & (s[i] # 0X) DO - msg[pos] := s[i]; - INC(pos); - INC(i) + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 END - END StrAppend; + + RETURN bRes +END _strcmpw; + + +PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmpw(op, len2, str2, len1, str1) +END _strcmpw2; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; BEGIN - pos := 0; - n := line MOD 16; - line := line DIV 16; - CASE n OF - |1: StrAppend("assertion failure") - |2: StrAppend("variable of a procedure type has NIL as value") - |3: StrAppend("typeguard error") - |4: StrAppend("inadmissible dynamic type") - |5: StrAppend("index check error") - |6: StrAppend("NIL pointer dereference") - |7: StrAppend("invalid value in case statement") - |8: StrAppend("division by zero") - ELSE - END; - StrAppend(0DX); - StrAppend(0AX); - StrAppend("module "); - StrAppend(modname); - StrAppend(0DX); - StrAppend(0AX); - StrAppend("line "); - Int(line, int); - StrAppend(int); - IF m = 2 THEN - StrAppend(0DX); - StrAppend(0AX); - StrAppend("code "); - Int(code, int); - StrAppend(int) - END; - API.DebugMsg(sys.ADR(msg), SelfName); - API.ExitThread(0) -END _assrt; + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; -PROCEDURE [stdcall] _close*; -BEGIN - IF CloseProc # NIL THEN - CloseProc - END -END _close; -PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a, b: INTEGER; + c: CHAR; + BEGIN - IF ~init THEN - API.zeromem(gsize, gadr); - init := TRUE; - API.init(esp); - SelfName := self; - rtab := rec; - CloseProc := NIL - END + + i := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + a := 0; + b := i - 1; + WHILE a < b DO + c := str[a]; + str[a] := str[b]; + str[b] := c; + INC(a); + DEC(b) + END; + str[i] := 0X +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X + +END append; + + +PROCEDURE [stdcall] _error* (module, err: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + + s := ""; + CASE err MOD 16 OF + | 1: append(s, "assertion failure") + | 2: append(s, "NIL dereference") + | 3: append(s, "division by zero") + | 4: append(s, "NIL procedure call") + | 5: append(s, "type guard error") + | 6: append(s, "index out of range") + | 7: append(s, "invalid CASE") + | 8: append(s, "array assignment error") + | 9: append(s, "CHR out of range") + |10: append(s, "WCHR out of range") + |11: append(s, "BYTE out of range") + END; + + append(s, API.eol); + + append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); + append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +BEGIN + (* r IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _isrec; + + +PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := -1 + END + + RETURN t1 = t0 +END _is; + + +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +BEGIN + (* r:t1 IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _guardrec; + + +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + SYSTEM.GET(p, p); + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # t0) & (t1 # 0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := t0 + END + + RETURN t1 = t0 +END _guard; + + +PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + res := 0; + IF dll.thread_attach # NIL THEN + dll.thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + res := 0; + IF dll.thread_detach # NIL THEN + dll.thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + res := 0; + IF dll.process_detach # NIL THEN + dll.process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + res := 0 + END + + RETURN res +END _dllentry; + + +PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + dll.process_detach := process_detach; + dll.thread_detach := thread_detach; + dll.thread_attach := thread_attach +END SetDll; + + +PROCEDURE [stdcall] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +BEGIN + SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) + API.init(param, code); + + types := _types; + name := modname; + + dll.process_detach := NIL; + dll.thread_detach := NIL; + dll.thread_attach := NIL; END _init; -PROCEDURE SetClose*(proc: PROC); -BEGIN - CloseProc := proc -END SetClose; END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/API.ob07 b/programs/develop/oberon07/Lib/Windows32/API.ob07 index d06ecf3165..07b4226363 100644 --- a/programs/develop/oberon07/Lib/Windows32/API.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/API.ob07 @@ -1,79 +1,61 @@ (* - Copyright 2016, 2017 Anton Krotov + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE API; -IMPORT sys := SYSTEM; +IMPORT SYSTEM; VAR - Alloc*: PROCEDURE [winapi] (uFlags, dwBytes: INTEGER): INTEGER; - Free*: PROCEDURE [winapi] (hMem: INTEGER): INTEGER; - MessageBoxA*: PROCEDURE [winapi] (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; - ExitProcess*: PROCEDURE [winapi] (code: INTEGER); - ExitThread*: PROCEDURE [winapi] (code: INTEGER); - GetCurrentThreadId*: PROCEDURE [winapi] (): INTEGER; - strncmp*: PROCEDURE [cdecl] (a, b, n: INTEGER): INTEGER; + eol*: ARRAY 3 OF CHAR; + base*: INTEGER; - GetProcAddress*: PROCEDURE [winapi] (hModule, name: INTEGER): INTEGER; - LoadLibraryA*: PROCEDURE [winapi] (name: INTEGER): INTEGER; -PROCEDURE zeromem*(size, adr: INTEGER); -END zeromem; +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] ExitProcess (code: INTEGER); +PROCEDURE [windows-, "kernel32.dll", "ExitThread"] ExitThread (code: INTEGER); +PROCEDURE [windows-, "kernel32.dll", "GlobalAlloc"] Alloc (uFlags, dwBytes: INTEGER): INTEGER; +PROCEDURE [windows-, "kernel32.dll", "GlobalFree"] Free (hMem: INTEGER): INTEGER; -PROCEDURE DebugMsg*(lpText, lpCaption: INTEGER); +PROCEDURE [windows-, "user32.dll", "MessageBoxA"] MessageBoxA (hWnd, lpText, lpCaption, uType: INTEGER): INTEGER; + + +PROCEDURE DebugMsg* (lpText, lpCaption: INTEGER); BEGIN - MessageBoxA(0, lpText, lpCaption, 16) + MessageBoxA(0, lpText, lpCaption, 16) END DebugMsg; -PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); -VAR H: INTEGER; -BEGIN - H := GetProcAddress(hMOD, sys.ADR(name[0])); - ASSERT(H # 0); - sys.PUT(adr, H); -END GetProc; -PROCEDURE _NEW*(size: INTEGER): INTEGER; - RETURN Alloc(64, size) +PROCEDURE _NEW* (size: INTEGER): INTEGER; + RETURN Alloc(64, size) END _NEW; -PROCEDURE _DISPOSE*(p: INTEGER): INTEGER; - RETURN Free(p) + +PROCEDURE _DISPOSE* (p: INTEGER): INTEGER; + RETURN Free(p) END _DISPOSE; -PROCEDURE init* (esp: INTEGER); -VAR lib: INTEGER; + +PROCEDURE init* (reserved, code: INTEGER); BEGIN - sys.GET(esp, GetProcAddress); - sys.GET(esp + 4, LoadLibraryA); - - lib := LoadLibraryA(sys.ADR("kernel32.dll")); - GetProc("ExitProcess", lib, sys.ADR(ExitProcess)); - GetProc("ExitThread", lib, sys.ADR(ExitThread)); - GetProc("GetCurrentThreadId", lib, sys.ADR(GetCurrentThreadId)); - GetProc("GlobalAlloc", lib, sys.ADR(Alloc)); - GetProc("GlobalFree", lib, sys.ADR(Free)); - - lib := LoadLibraryA(sys.ADR("msvcrt.dll")); - GetProc("strncmp", lib, sys.ADR(strncmp)); - - lib := LoadLibraryA(sys.ADR("user32.dll")); - GetProc("MessageBoxA", lib, sys.ADR(MessageBoxA)); + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + base := code - 4096 END init; -END API. \ No newline at end of file + +PROCEDURE exit* (code: INTEGER); +BEGIN + ExitProcess(code) +END exit; + + +PROCEDURE exit_thread* (code: INTEGER); +BEGIN + ExitThread(code) +END exit_thread; + + +END API. diff --git a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 index 3bfd54cbb4..78c531b72b 100644 --- a/programs/develop/oberon07/Lib/Windows32/HOST.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/HOST.ob07 @@ -1,139 +1,331 @@ (* - Copyright 2016, 2017 Anton Krotov + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE HOST; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, RTL; + CONST - OS* = "WIN"; - Slash* = "\"; + slash* = "\"; + OS* = "WINDOWS"; + + bit_depth* = RTL.bit_depth; + maxint* = RTL.maxint; + minint* = RTL.minint; + + MAX_PARAM = 1024; + + OFS_MAXPATHNAME = 128; - OFS_MAXPATHNAME = 128; TYPE - OFSTRUCT = RECORD - cBytes: CHAR; - fFixedDisk: CHAR; - nErrCode: sys.CARD16; - Reserved1: sys.CARD16; - Reserved2: sys.CARD16; - szPathName: ARRAY OFS_MAXPATHNAME OF CHAR - END; + POverlapped = POINTER TO OVERLAPPED; + + OVERLAPPED = RECORD + + Internal: INTEGER; + InternalHigh: INTEGER; + Offset: INTEGER; + OffsetHigh: INTEGER; + hEvent: INTEGER + + END; + + OFSTRUCT = RECORD + + cBytes: CHAR; + fFixedDisk: CHAR; + nErrCode: SYSTEM.CARD16; + Reserved1: SYSTEM.CARD16; + Reserved2: SYSTEM.CARD16; + szPathName: ARRAY OFS_MAXPATHNAME OF CHAR + + END; + + PSecurityAttributes = POINTER TO TSecurityAttributes; + + TSecurityAttributes = RECORD + + nLength: INTEGER; + lpSecurityDescriptor: INTEGER; + bInheritHandle: INTEGER + + END; + + TSystemTime = RECORD + + Year, + Month, + DayOfWeek, + Day, + Hour, + Min, + Sec, + MSec: WCHAR + + END; + VAR - sec*, dsec*, hConsoleOutput: INTEGER; + hConsoleOutput: INTEGER; - GetStdHandle: PROCEDURE [winapi] (nStdHandle: INTEGER): INTEGER; - CloseFile*: PROCEDURE [winapi] (hObject: INTEGER): INTEGER; - _CreateFile*: PROCEDURE [winapi] (lpFileName, dwDesiredAccess, dwShareMode, lpSecurityAttributes, - dwCreationDisposition, dwFlagsAndAttributes, hTemplateFile: INTEGER): INTEGER; - _OpenFile*: PROCEDURE [winapi] (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; - ReadFile, WriteFile: PROCEDURE [winapi] (hFile, Buffer, nNumberOfBytesToRead, lpNumberOfBytesRead, lpOverlapped: INTEGER): INTEGER; - GetCommandLine*: PROCEDURE [winapi] (): INTEGER; - GetTickCount: PROCEDURE [winapi] (): INTEGER; - ExitProcess*: PROCEDURE [winapi] (code: INTEGER); - SetFilePointer: PROCEDURE [winapi] (hFile, lDistanceToMove, lpDistanceToMoveHigh, dwMoveMethod: INTEGER): INTEGER; + Params: ARRAY MAX_PARAM, 2 OF INTEGER; + argc: INTEGER; -PROCEDURE FileRW*(hFile, Buffer, nNumberOfBytes: INTEGER; write: BOOLEAN): INTEGER; -VAR res: INTEGER; + eol*: ARRAY 3 OF CHAR; + + +PROCEDURE [windows-, "kernel32.dll", "GetTickCount"] + _GetTickCount (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetStdHandle"] + _GetStdHandle (nStdHandle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCommandLineA"] + _GetCommandLine (): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "ReadFile"] + _ReadFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "WriteFile"] + _WriteFile (hFile, Buffer, nNumberOfBytesToRW: INTEGER; VAR NumberOfBytesRW: INTEGER; lpOverlapped: POverlapped): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CloseHandle"] + _CloseHandle (hObject: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "CreateFileA"] + _CreateFile ( + lpFileName, dwDesiredAccess, dwShareMode: INTEGER; + lpSecurityAttributes: PSecurityAttributes; + dwCreationDisposition, dwFlagsAndAttributes, + hTemplateFile: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "OpenFile"] + _OpenFile (lpFileName: INTEGER; lpReOpenBuff: OFSTRUCT; uStyle: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetCurrentDirectoryA"] + _GetCurrentDirectory (nBufferLength, lpBuffer: INTEGER): INTEGER; + +PROCEDURE [windows-, "kernel32.dll", "GetSystemTime"] + _GetSystemTime (T: TSystemTime); + +PROCEDURE [windows-, "kernel32.dll", "ExitProcess"] + _ExitProcess (code: INTEGER); + + +PROCEDURE ExitProcess* (code: INTEGER); BEGIN - IF write THEN - WriteFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0) - ELSE - ReadFile(hFile, Buffer, nNumberOfBytes, sys.ADR(res), 0) - END - RETURN res -END FileRW; + _ExitProcess(code) +END ExitProcess; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +VAR + n: INTEGER; -PROCEDURE OutString* (str: ARRAY OF CHAR); -VAR res: INTEGER; BEGIN - res := FileRW(hConsoleOutput, sys.ADR(str[0]), LENGTH(str), TRUE) -END OutString; + n := _GetCurrentDirectory(LEN(path), SYSTEM.ADR(path[0])); + path[n] := slash; + path[n + 1] := 0X +END GetCurrentDirectory; + + +PROCEDURE GetChar (adr: INTEGER): CHAR; +VAR + res: CHAR; -PROCEDURE CreateFile* (FName: ARRAY OF CHAR): INTEGER; -VAR res: INTEGER; BEGIN - res := _CreateFile(sys.ADR(FName[0]), 0C0000000H, 0, 0, 2, 80H, 0); - IF res = -1 THEN - res := 0 - END - RETURN res -END CreateFile; + SYSTEM.GET(adr, res) + RETURN res +END GetChar; + + +PROCEDURE ParamParse; +VAR + p, count, cond: INTEGER; + c: CHAR; + + + PROCEDURE ChangeCond (A, B, C: INTEGER; VAR cond: INTEGER; c: CHAR); + BEGIN + IF (c <= 20X) & (c # 0X) THEN + cond := A + ELSIF c = 22X THEN + cond := B + ELSIF c = 0X THEN + cond := 6 + ELSE + cond := C + END + END ChangeCond; + -PROCEDURE OpenFile* (FName: ARRAY OF CHAR): INTEGER; -VAR res: INTEGER; ofstr: OFSTRUCT; BEGIN - res := _OpenFile(sys.ADR(FName[0]), ofstr, 0); - IF res = -1 THEN - res := 0 - END - RETURN res -END OpenFile; + p := _GetCommandLine(); + cond := 0; + count := 0; + WHILE (count < MAX_PARAM) & (cond # 6) DO + c := GetChar(p); + CASE cond OF + |0: ChangeCond(0, 4, 1, cond, c); IF cond = 1 THEN Params[count, 0] := p END + |1: ChangeCond(0, 3, 1, cond, c); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END + |3: ChangeCond(3, 1, 3, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |4: ChangeCond(5, 0, 5, cond, c); IF cond = 5 THEN Params[count, 0] := p END + |5: ChangeCond(5, 1, 5, cond, c); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END + |6: + END; + INC(p) + END; + argc := count +END ParamParse; + + +PROCEDURE GetArg* (n: INTEGER; VAR s: ARRAY OF CHAR); +VAR + i, j, len: INTEGER; + c: CHAR; -PROCEDURE FileSize*(F: INTEGER): INTEGER; -VAR res: INTEGER; BEGIN - res := SetFilePointer(F, 0, 0, 2); - SetFilePointer(F, 0, 0, 0) - RETURN res -END FileSize; + j := 0; + IF n < argc THEN + len := LEN(s) - 1; + i := Params[n, 0]; + WHILE (j < len) & (i <= Params[n, 1]) DO + c := GetChar(i); + IF c # 22X THEN + s[j] := c; + INC(j) + END; + INC(i) + END + END; + s[j] := 0X +END GetArg; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res, n: INTEGER; -PROCEDURE GetProc(name: ARRAY OF CHAR; hMOD, adr: INTEGER); BEGIN - sys.PUT(adr, API.GetProcAddress(hMOD, sys.ADR(name[0]))) -END GetProc; + IF _ReadFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN + res := -1 + ELSE + res := n + END + + RETURN res +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res, n: INTEGER; -PROCEDURE Time*(VAR sec, dsec: INTEGER); -VAR t: INTEGER; BEGIN - t := GetTickCount() DIV 10; - sec := t DIV 100; - dsec := t MOD 100 -END Time; + IF _WriteFile(F, SYSTEM.ADR(Buffer[0]), bytes, n, NIL) = 0 THEN + res := -1 + ELSE + res := n + END -PROCEDURE malloc*(size: INTEGER): INTEGER; - RETURN API.Alloc(64, size) -END malloc; + RETURN res +END FileWrite; -PROCEDURE init*; -VAR lib: INTEGER; + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; + RETURN _CreateFile(SYSTEM.ADR(FName[0]), 0C0000000H, 0, NIL, 2, 80H, 0) +END FileCreate; + + +PROCEDURE FileClose* (F: INTEGER); BEGIN - lib := API.LoadLibraryA(sys.ADR("kernel32.dll")); - GetProc("GetTickCount", lib, sys.ADR(GetTickCount)); - Time(sec, dsec); - GetProc("GetStdHandle", lib, sys.ADR(GetStdHandle)); - GetProc("CreateFileA", lib, sys.ADR(_CreateFile)); - GetProc("CloseHandle", lib, sys.ADR(CloseFile)); - GetProc("OpenFile", lib, sys.ADR(_OpenFile)); - GetProc("ReadFile", lib, sys.ADR(ReadFile)); - GetProc("WriteFile", lib, sys.ADR(WriteFile)); - GetProc("GetCommandLineA", lib, sys.ADR(GetCommandLine)); - GetProc("SetFilePointer", lib, sys.ADR(SetFilePointer)); - ExitProcess := API.ExitProcess; - hConsoleOutput := GetStdHandle(-11) -END init; + _CloseHandle(F) +END FileClose; -PROCEDURE GetName*(): INTEGER; - RETURN 0 -END GetName; +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; +VAR + ofstr: OFSTRUCT; + res: INTEGER; + +BEGIN + res := _OpenFile(SYSTEM.ADR(FName[0]), ofstr, 0); + IF res = 0FFFFFFFFH THEN + res := -1 + END + + RETURN res +END FileOpen; + + +PROCEDURE OutChar* (c: CHAR); +VAR + count: INTEGER; +BEGIN + _WriteFile(hConsoleOutput, SYSTEM.ADR(c), 1, count, NIL) +END OutChar; + + +PROCEDURE GetTickCount* (): INTEGER; + RETURN _GetTickCount() DIV 10 +END GetTickCount; + + +PROCEDURE letter (c: CHAR): BOOLEAN; + RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") +END letter; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN ~(letter(path[0]) & (path[1] = ":")) +END isRelative; + + +PROCEDURE now* (VAR year, month, day, hour, min, sec: INTEGER); +VAR + T: TSystemTime; + +BEGIN + _GetSystemTime(T); + year := ORD(T.Year); + month := ORD(T.Month); + day := ORD(T.Day); + hour := ORD(T.Hour); + min := ORD(T.Min); + sec := ORD(T.Sec) +END now; + + +PROCEDURE UnixTime* (): INTEGER; + RETURN 0 +END UnixTime; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + a := 0; + b := 0; + SYSTEM.MOVE(SYSTEM.ADR(x), SYSTEM.ADR(a), 4); + SYSTEM.MOVE(SYSTEM.ADR(x) + 4, SYSTEM.ADR(b), 4); + SYSTEM.GET(SYSTEM.ADR(x), res) + RETURN res +END splitf; + + +BEGIN + eol[0] := 0DX; eol[1] := 0AX; eol[2] := 0X; + hConsoleOutput := _GetStdHandle(-11); + ParamParse END HOST. \ No newline at end of file diff --git a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 index 846a936bce..2758c1e417 100644 --- a/programs/develop/oberon07/Lib/Windows32/RTL.ob07 +++ b/programs/develop/oberon07/Lib/Windows32/RTL.ob07 @@ -1,282 +1,630 @@ -(* - Copyright 2016, 2017 Anton Krotov +(* + BSD 2-Clause License - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Lesser General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public License - along with this program. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE RTL; -IMPORT sys := SYSTEM, API; +IMPORT SYSTEM, API; + + +CONST + + bit_depth* = 32; + maxint* = 7FFFFFFFH; + minint* = 80000000H; + + DLL_PROCESS_ATTACH = 1; + DLL_THREAD_ATTACH = 2; + DLL_THREAD_DETACH = 3; + DLL_PROCESS_DETACH = 0; + + SIZE_OF_DWORD = 4; + TYPE - IntArray = ARRAY 2048 OF INTEGER; - STRING = ARRAY 2048 OF CHAR; - PROC = PROCEDURE; + DLL_ENTRY* = PROCEDURE (hinstDLL, fdwReason, lpvReserved: INTEGER); + VAR - SelfName, rtab: INTEGER; CloseProc: PROC; - init: BOOLEAN; - main_thread_id: INTEGER; + name: INTEGER; + types: INTEGER; -PROCEDURE [stdcall] _halt*(n: INTEGER); -BEGIN - API.ExitProcess(n) -END _halt; - -PROCEDURE [stdcall] _newrec*(size, t: INTEGER; VAR ptr: INTEGER); -BEGIN - ptr := API._NEW(size); - IF ptr # 0 THEN - sys.PUT(ptr, t); - INC(ptr, 4) - END -END _newrec; - -PROCEDURE [stdcall] _disprec*(VAR ptr: INTEGER); -BEGIN - IF ptr # 0 THEN - ptr := API._DISPOSE(ptr - 4) - END -END _disprec; - -PROCEDURE [stdcall] _rset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C3BC87F0A83F91F760B83F81F760633C0C9C2080083F9007D0233C983F81F7E05B81F000000BA000000802BC8F7D9D3FA83E81F8BC8F7D9D3EA8BC2C9C20800") -END _rset; - -PROCEDURE [stdcall] _inset*(y, x: INTEGER); -BEGIN - sys.CODE("8B45088B4D0C83F91F7709D3E883E001C9C20800C933C0C20800") -END _inset; - -PROCEDURE [stdcall] _checktype*(table, t, r: INTEGER); -BEGIN - table := rtab; - sys.CODE("8B450C8B4D1085C975076A0158C9C20C008B51FC8B4D083BD0740D85D27409C1E20203D18B12EBEF33C93BC20F94C18BC1C9C20C00") -END _checktype; - -PROCEDURE [stdcall] _savearr*(size, source, dest: INTEGER); -BEGIN - sys.CODE("9CFC8BD78BC68B7D108B750C8B4D08F3A48BFA8BF09D") -END _savearr; - -PROCEDURE [stdcall] _saverec*(dyn, stat, size, source, dest: INTEGER): BOOLEAN; -VAR res: BOOLEAN; -BEGIN - res := dyn = stat; - IF res THEN - _savearr(size, source, dest) - END - RETURN res -END _saverec; - -PROCEDURE [stdcall] _arrayidx*(Dim: INTEGER; VAR Arr: IntArray; bsize, idx, c: INTEGER); -VAR i, m: INTEGER; -BEGIN - m := bsize * idx; - FOR i := 4 TO Dim + 2 DO - m := m * Arr[i] - END; - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := c + m - ELSE - Arr[3] := 0 - END -END _arrayidx; - -PROCEDURE [stdcall] _arrayidx1*(VAR Arr: IntArray; bsize, idx, c: INTEGER); -BEGIN - IF (Arr[3] > idx) & (idx >= 0) THEN - Arr[3] := bsize * idx + c - ELSE - Arr[3] := 0 - END -END _arrayidx1; - -PROCEDURE [stdcall] _arrayrot*(m, n: INTEGER; VAR Arr: IntArray); -VAR i, j, t: INTEGER; -BEGIN - FOR i := 1 TO n DO - t := Arr[0]; - FOR j := 0 TO m + n - 1 DO - Arr[j] := Arr[j + 1] + dll: RECORD + process_detach, + thread_detach, + thread_attach: DLL_ENTRY END; - Arr[m + n] := t - END -END _arrayrot; -PROCEDURE [stdcall] _length*(s: ARRAY OF CHAR): INTEGER; + +PROCEDURE [stdcall] _move* (bytes, source, dest: INTEGER); BEGIN - sys.CODE("8B4508"); // mov eax, [ebp + 08h] - sys.CODE("8B4D0C"); // mov ecx, [ebp + 0Ch] - sys.CODE("48"); // dec eax - // L1: - sys.CODE("40"); // inc eax - sys.CODE("803800"); // cmp byte ptr [eax], 0 - sys.CODE("7403"); // jz L2 - sys.CODE("E2F8"); // loop L1 - sys.CODE("40"); // inc eax - // L2: - sys.CODE("2B4508"); // sub eax, [ebp + 08h] - sys.CODE("C9"); // leave - sys.CODE("C20800"); // ret 08h - RETURN 0 + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 00CH, (* mov esi, dword [ebp + 12] *) + 08BH, 07DH, 010H, (* mov edi, dword [ebp + 16] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move; + + +PROCEDURE [stdcall] _move2* (bytes, dest, source: INTEGER); +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 085H, 0C0H, (* test eax, eax *) + 07EH, 019H, (* jle L *) + 0FCH, (* cld *) + 057H, (* push edi *) + 056H, (* push esi *) + 08BH, 075H, 010H, (* mov esi, dword [ebp + 16] *) + 08BH, 07DH, 00CH, (* mov edi, dword [ebp + 12] *) + 089H, 0C1H, (* mov ecx, eax *) + 0C1H, 0E9H, 002H, (* shr ecx, 2 *) + 0F3H, 0A5H, (* rep movsd *) + 089H, 0C1H, (* mov ecx, eax *) + 083H, 0E1H, 003H, (* and ecx, 3 *) + 0F3H, 0A4H, (* rep movsb *) + 05EH, (* pop esi *) + 05FH (* pop edi *) + (* L: *) + ) +END _move2; + + +PROCEDURE [stdcall] _arrcpy* (base_size, len_dst, dst, len_src, src: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF len_src > len_dst THEN + res := FALSE + ELSE + _move(len_src * base_size, src, dst); + res := TRUE + END + + RETURN res +END _arrcpy; + + +PROCEDURE [stdcall] _strcpy* (chr_size, len_dst, dst, len_src, src: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy; + + +PROCEDURE [stdcall] _strcpy2* (chr_size, len_src, src, len_dst, dst: INTEGER); +BEGIN + _move(MIN(len_dst, len_src) * chr_size, src, dst) +END _strcpy2; + + +PROCEDURE [stdcall] _rot* (VAR A: ARRAY OF INTEGER); +VAR + i, n, k: INTEGER; + +BEGIN + + k := LEN(A) - 1; + n := A[0]; + i := 0; + WHILE i < k DO + A[i] := A[i + 1]; + INC(i) + END; + A[k] := n + +END _rot; + + +PROCEDURE [stdcall] _set2* (a, b: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF (a <= b) & (a <= 31) & (b >= 0) THEN + IF b > 31 THEN + b := 31 + END; + IF a < 0 THEN + a := 0 + END; + res := LSR(ASR(ROR(1, 1), b - a), 31 - b) + ELSE + res := 0 + END + + RETURN res +END _set2; + + +PROCEDURE [stdcall] _set* (b, a: INTEGER): INTEGER; + RETURN _set2(a, b) +END _set; + + +PROCEDURE [stdcall] divmod (a, b: INTEGER; VAR mod: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 008H, (* mov eax, dword [ebp + 8] *) + 08BH, 04DH, 00CH, (* mov ecx, dword [ebp + 12] *) + 031H, 0D2H, (* xor edx, edx *) + 085H, 0C0H, (* test eax, eax *) + 07DH, 002H, (* jge L1 *) + 0F7H, 0D2H, (* not edx *) + (* L1: *) + 0F7H, 0F9H, (* idiv ecx *) + 08BH, 04DH, 010H, (* mov ecx, dword [ebp + 16] *) + 089H, 011H, (* mov dword [ecx], edx *) + 0C9H, (* leave *) + 0C2H, 00CH, 000H (* ret 12 *) + ) + + RETURN 0 +END divmod; + + +PROCEDURE div_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + DEC(div) + END + + RETURN div +END div_; + + +PROCEDURE mod_ (x, y: INTEGER): INTEGER; +VAR + div, mod: INTEGER; + +BEGIN + div := divmod(x, y, mod); + IF (mod # 0) & ((x < 0) & (y > 0) OR (x > 0) & (y < 0)) THEN + INC(mod, y) + END + + RETURN mod +END mod_; + + +PROCEDURE [stdcall] _div* (b, a: INTEGER): INTEGER; + RETURN div_(a, b) +END _div; + + +PROCEDURE [stdcall] _div2* (a, b: INTEGER): INTEGER; + RETURN div_(a, b) +END _div2; + + +PROCEDURE [stdcall] _mod* (b, a: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod; + + +PROCEDURE [stdcall] _mod2* (a, b: INTEGER): INTEGER; + RETURN mod_(a, b) +END _mod2; + + +PROCEDURE [stdcall] _new* (t, size: INTEGER; VAR ptr: INTEGER); +BEGIN + ptr := API._NEW(size); + IF ptr # 0 THEN + SYSTEM.PUT(ptr, t); + INC(ptr, SIZE_OF_DWORD) + END +END _new; + + +PROCEDURE [stdcall] _dispose* (VAR ptr: INTEGER); +BEGIN + IF ptr # 0 THEN + ptr := API._DISPOSE(ptr - SIZE_OF_DWORD) + END +END _dispose; + + +PROCEDURE strncmp (a, b, n: INTEGER): INTEGER; +VAR + A, B: CHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a); + SYSTEM.GET(b, B); INC(b); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmp; + + +PROCEDURE strncmpw (a, b, n: INTEGER): INTEGER; +VAR + A, B: WCHAR; + res: INTEGER; + +BEGIN + res := 0; + WHILE n > 0 DO + SYSTEM.GET(a, A); INC(a, 2); + SYSTEM.GET(b, B); INC(b, 2); + DEC(n); + IF A # B THEN + res := ORD(A) - ORD(B); + n := 0 + ELSIF A = 0X THEN + n := 0 + END + END + RETURN res +END strncmpw; + + +PROCEDURE [stdcall] _length* (len, str: INTEGER): INTEGER; +BEGIN + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 080H, 038H, 000H, (* cmp byte [eax], 0 *) + 074H, 003H, (* jz L2 *) + 0E2H, 0F8H, (* loop L1 *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 END _length; -PROCEDURE [stdcall] _strcopy*(b, blen, a, alen: INTEGER); -BEGIN - _savearr(MIN(alen, blen), a, b); - IF blen > alen THEN - sys.PUT(b + alen, 0X) - END -END _strcopy; -PROCEDURE [stdcall] _strcmp*(op: INTEGER; b, a: ARRAY OF CHAR): BOOLEAN; -VAR i: INTEGER; Res: BOOLEAN; +PROCEDURE [stdcall] _lengthw* (len, str: INTEGER): INTEGER; BEGIN - i := API.strncmp(sys.ADR(a), sys.ADR(b), MIN(LEN(a), LEN(b))); - IF i = 0 THEN - i := _length(a) - _length(b) - END; - CASE op OF - |0: Res := i = 0 - |1: Res := i # 0 - |2: Res := i < 0 - |3: Res := i > 0 - |4: Res := i <= 0 - |5: Res := i >= 0 - ELSE - END - RETURN Res + SYSTEM.CODE( + + 08BH, 045H, 00CH, (* mov eax, dword [ebp + 0Ch] *) + 08BH, 04DH, 008H, (* mov ecx, dword [ebp + 08h] *) + 048H, (* dec eax *) + 048H, (* dec eax *) + (* L1: *) + 040H, (* inc eax *) + 040H, (* inc eax *) + 066H, 083H, 038H, 000H, (* cmp word [eax], 0 *) + 074H, 004H, (* jz L2 *) + 0E2H, 0F6H, (* loop L1 *) + 040H, (* inc eax *) + 040H, (* inc eax *) + (* L2: *) + 02BH, 045H, 00CH, (* sub eax, dword [ebp + 0Ch] *) + 0D1H, 0E8H, (* shr eax, 1 *) + 0C9H, (* leave *) + 0C2H, 008H, 000H (* ret 08h *) + ) + + RETURN 0 +END _lengthw; + + +PROCEDURE [stdcall] _strcmp* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + +BEGIN + + res := strncmp(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _length(len1, str1) - _length(len2, str2) + END; + + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 + END + + RETURN bRes END _strcmp; -PROCEDURE [stdcall] _lstrcmp*(op: INTEGER; b: CHAR; a: ARRAY OF CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; + +PROCEDURE [stdcall] _strcmp2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmp(op, len2, str2, len1, str1) +END _strcmp2; + + +PROCEDURE [stdcall] _strcmpw* (op, len2, str2, len1, str1: INTEGER): BOOLEAN; +VAR + res: INTEGER; + bRes: BOOLEAN; + BEGIN - s[0] := b; - s[1] := 0X; - RETURN _strcmp(op, s, a) -END _lstrcmp; -PROCEDURE [stdcall] _rstrcmp*(op: INTEGER; b: ARRAY OF CHAR; a: CHAR): BOOLEAN; -VAR s: ARRAY 2 OF CHAR; -BEGIN - s[0] := a; - s[1] := 0X; - RETURN _strcmp(op, b, s) -END _rstrcmp; + res := strncmpw(str1, str2, MIN(len1, len2)); + IF res = 0 THEN + res := _lengthw(len1, str1) - _lengthw(len2, str2) + END; -PROCEDURE Int(x: INTEGER; VAR str: STRING); -VAR i, a, b: INTEGER; c: CHAR; -BEGIN - i := 0; - a := 0; - REPEAT - str[i] := CHR(x MOD 10 + ORD("0")); - x := x DIV 10; - INC(i) - UNTIL x = 0; - b := i - 1; - WHILE a < b DO - c := str[a]; - str[a] := str[b]; - str[b] := c; - INC(a); - DEC(b) - END; - str[i] := 0X -END Int; - -PROCEDURE [stdcall] _assrt*(code, m: INTEGER; modname: STRING; line: INTEGER); -VAR msg, int: STRING; pos, n: INTEGER; - - PROCEDURE StrAppend(s: STRING); - VAR i, n: INTEGER; - BEGIN - n := LEN(s); - i := 0; - WHILE (i < n) & (s[i] # 0X) DO - msg[pos] := s[i]; - INC(pos); - INC(i) + CASE op OF + |0: bRes := res = 0 + |1: bRes := res # 0 + |2: bRes := res < 0 + |3: bRes := res <= 0 + |4: bRes := res > 0 + |5: bRes := res >= 0 END - END StrAppend; + + RETURN bRes +END _strcmpw; + + +PROCEDURE [stdcall] _strcmpw2* (op, len1, str1, len2, str2: INTEGER): BOOLEAN; + RETURN _strcmpw(op, len2, str2, len1, str1) +END _strcmpw2; + + +PROCEDURE PCharToStr (pchar: INTEGER; VAR s: ARRAY OF CHAR); +VAR + c: CHAR; + i: INTEGER; BEGIN - pos := 0; - n := line MOD 16; - line := line DIV 16; - CASE n OF - |1: StrAppend("assertion failure") - |2: StrAppend("variable of a procedure type has NIL as value") - |3: StrAppend("typeguard error") - |4: StrAppend("inadmissible dynamic type") - |5: StrAppend("index check error") - |6: StrAppend("NIL pointer dereference") - |7: StrAppend("invalid value in case statement") - |8: StrAppend("division by zero") - ELSE - END; - StrAppend(0DX); - StrAppend(0AX); - StrAppend("module "); - StrAppend(modname); - StrAppend(0DX); - StrAppend(0AX); - StrAppend("line "); - Int(line, int); - StrAppend(int); - IF m = 2 THEN - StrAppend(0DX); - StrAppend(0AX); - StrAppend("code "); - Int(code, int); - StrAppend(int) - END; - API.DebugMsg(sys.ADR(msg), SelfName); - IF API.GetCurrentThreadId() = main_thread_id THEN - API.ExitProcess(0) - ELSE - API.ExitThread(0) - END -END _assrt; + i := 0; + REPEAT + SYSTEM.GET(pchar, c); + s[i] := c; + INC(pchar); + INC(i) + UNTIL c = 0X +END PCharToStr; -PROCEDURE [stdcall] _close*; -BEGIN - IF CloseProc # NIL THEN - CloseProc - END -END _close; -PROCEDURE [stdcall] _init*(self, rec, gsize, gadr, esp: INTEGER); +PROCEDURE IntToStr (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a, b: INTEGER; + c: CHAR; + BEGIN - IF ~init THEN - API.zeromem(gsize, gadr); - init := TRUE; - API.init(esp); - main_thread_id := API.GetCurrentThreadId(); - SelfName := self; - rtab := rec; - CloseProc := NIL - END + + i := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + a := 0; + b := i - 1; + WHILE a < b DO + c := str[a]; + str[a] := str[b]; + str[b] := c; + INC(a); + DEC(b) + END; + str[i] := 0X +END IntToStr; + + +PROCEDURE append (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X + +END append; + + +PROCEDURE [stdcall] _error* (module, err: INTEGER); +VAR + s, temp: ARRAY 1024 OF CHAR; + +BEGIN + + s := ""; + CASE err MOD 16 OF + | 1: append(s, "assertion failure") + | 2: append(s, "NIL dereference") + | 3: append(s, "division by zero") + | 4: append(s, "NIL procedure call") + | 5: append(s, "type guard error") + | 6: append(s, "index out of range") + | 7: append(s, "invalid CASE") + | 8: append(s, "array assignment error") + | 9: append(s, "CHR out of range") + |10: append(s, "WCHR out of range") + |11: append(s, "BYTE out of range") + END; + + append(s, API.eol); + + append(s, "module: "); PCharToStr(module, temp); append(s, temp); append(s, API.eol); + append(s, "line: "); IntToStr(LSR(err, 4), temp); append(s, temp); + + API.DebugMsg(SYSTEM.ADR(s[0]), name); + + API.exit_thread(0) +END _error; + + +PROCEDURE [stdcall] _isrec* (t0, t1, r: INTEGER): BOOLEAN; +BEGIN + (* r IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _isrec; + + +PROCEDURE [stdcall] _is* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := -1 + END + + RETURN t1 = t0 +END _is; + + +PROCEDURE [stdcall] _guardrec* (t0, t1: INTEGER): BOOLEAN; +BEGIN + (* r:t1 IS t0 *) + + WHILE (t1 # 0) & (t1 # t0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + + RETURN t1 = t0 +END _guardrec; + + +PROCEDURE [stdcall] _guard* (t0, p: INTEGER): BOOLEAN; +VAR + t1: INTEGER; + +BEGIN + (* p IS t0 *) + SYSTEM.GET(p, p); + IF p # 0 THEN + DEC(p, SIZE_OF_DWORD); + SYSTEM.GET(p, t1); + WHILE (t1 # t0) & (t1 # 0) DO + SYSTEM.GET(types + t1 * SIZE_OF_DWORD, t1) + END + ELSE + t1 := t0 + END + + RETURN t1 = t0 +END _guard; + + +PROCEDURE [stdcall] _dllentry* (hinstDLL, fdwReason, lpvReserved: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE fdwReason OF + |DLL_PROCESS_ATTACH: + res := 1 + |DLL_THREAD_ATTACH: + res := 0; + IF dll.thread_attach # NIL THEN + dll.thread_attach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_THREAD_DETACH: + res := 0; + IF dll.thread_detach # NIL THEN + dll.thread_detach(hinstDLL, fdwReason, lpvReserved) + END + |DLL_PROCESS_DETACH: + res := 0; + IF dll.process_detach # NIL THEN + dll.process_detach(hinstDLL, fdwReason, lpvReserved) + END + ELSE + res := 0 + END + + RETURN res +END _dllentry; + + +PROCEDURE SetDll* (process_detach, thread_detach, thread_attach: DLL_ENTRY); +BEGIN + dll.process_detach := process_detach; + dll.thread_detach := thread_detach; + dll.thread_attach := thread_attach +END SetDll; + + +PROCEDURE [stdcall] _exit* (code: INTEGER); +BEGIN + API.exit(code) +END _exit; + + +PROCEDURE [stdcall] _init* (modname: INTEGER; typesc, _types: INTEGER; code, param: INTEGER); +BEGIN + SYSTEM.CODE(09BH, 0DBH, 0E3H); (* finit *) + API.init(param, code); + + types := _types; + name := modname; + + dll.process_detach := NIL; + dll.thread_detach := NIL; + dll.thread_attach := NIL; END _init; -PROCEDURE SetClose*(proc: PROC); -BEGIN - CloseProc := proc -END SetClose; END RTL. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/Dialogs.ob07 b/programs/develop/oberon07/Samples/Dialogs.ob07 index bb06cf5e83..a0630c7d5c 100644 --- a/programs/develop/oberon07/Samples/Dialogs.ob07 +++ b/programs/develop/oberon07/Samples/Dialogs.ob07 @@ -5,15 +5,13 @@ IMPORT KOSAPI, sys := SYSTEM, OpenDlg, ColorDlg; VAR header: ARRAY 1024 OF CHAR; back_color: INTEGER; PROCEDURE WindowRedrawStatus(p: INTEGER); -VAR aux: INTEGER; BEGIN - aux := KOSAPI.sysfunc2(12, p) + KOSAPI.sysfunc2(12, p) END WindowRedrawStatus; PROCEDURE DefineAndDrawWindow(x, y, w, h, color, style, hcolor, hstyle, htext: INTEGER); -VAR aux: INTEGER; BEGIN - aux := KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) + KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) END DefineAndDrawWindow; PROCEDURE WaitForEvent(): INTEGER; @@ -21,15 +19,13 @@ PROCEDURE WaitForEvent(): INTEGER; END WaitForEvent; PROCEDURE ExitApp; -VAR aux: INTEGER; BEGIN - aux := KOSAPI.sysfunc1(-1) + KOSAPI.sysfunc1(-1) END ExitApp; PROCEDURE pause(t: INTEGER); -VAR aux: INTEGER; BEGIN - aux := KOSAPI.sysfunc2(5, t) + KOSAPI.sysfunc2(5, t) END pause; PROCEDURE Buttons; diff --git a/programs/develop/oberon07/Samples/HW.ob07 b/programs/develop/oberon07/Samples/HW.ob07 index 93617db970..dd3d0ffe28 100644 --- a/programs/develop/oberon07/Samples/HW.ob07 +++ b/programs/develop/oberon07/Samples/HW.ob07 @@ -3,21 +3,18 @@ MODULE HW; IMPORT sys := SYSTEM, KOSAPI; PROCEDURE WindowRedrawStatus(p: INTEGER); -VAR res: INTEGER; BEGIN - res := KOSAPI.sysfunc2(12, p) + KOSAPI.sysfunc2(12, p) END WindowRedrawStatus; PROCEDURE DefineAndDrawWindow(x, y, w, h, color, style, hcolor, hstyle, htext: INTEGER); -VAR res: INTEGER; BEGIN - res := KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) + KOSAPI.sysfunc6(0, x * 65536 + w, y * 65536 + h, color + LSL(style, 24), hcolor + LSL(hstyle, 24), htext) END DefineAndDrawWindow; PROCEDURE WriteTextToWindow(x, y, color: INTEGER; text: ARRAY OF CHAR); -VAR res: INTEGER; BEGIN - res := KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(48, 24), sys.ADR(text[0]), LENGTH(text), 0) + KOSAPI.sysfunc6(4, x * 65536 + y, color + LSL(48, 24), sys.ADR(text[0]), LENGTH(text), 0) END WriteTextToWindow; PROCEDURE WaitForEvent(): INTEGER; @@ -25,9 +22,8 @@ PROCEDURE WaitForEvent(): INTEGER; END WaitForEvent; PROCEDURE ExitApp; -VAR res: INTEGER; BEGIN - res := KOSAPI.sysfunc1(-1) + KOSAPI.sysfunc1(-1) END ExitApp; PROCEDURE draw_window(header, text: ARRAY OF CHAR); diff --git a/programs/develop/oberon07/Samples/HW_con.ob07 b/programs/develop/oberon07/Samples/HW_con.ob07 index 3186eb3c31..6cab57e15d 100644 --- a/programs/develop/oberon07/Samples/HW_con.ob07 +++ b/programs/develop/oberon07/Samples/HW_con.ob07 @@ -1,53 +1,63 @@ -MODULE HW_con; +MODULE HW_con; + +IMPORT Out, In, Console, DateTime; -IMPORT Out, In, Console, DateTime, ConsoleLib; PROCEDURE OutInt2(n: INTEGER); BEGIN - ASSERT((0 <= n) & (n <= 99)); - IF n < 10 THEN - Out.Char("0") - END; - Out.Int(n, 0) -END OutInt2; + ASSERT((0 <= n) & (n <= 99)); + IF n < 10 THEN + Out.Char("0") + END; + Out.Int(n, 0) +END OutInt2; + PROCEDURE OutMonth(n: INTEGER); -VAR str: ARRAY 4 OF CHAR; -BEGIN - CASE n OF - | 1: str := "jan" - | 2: str := "feb" - | 3: str := "mar" - | 4: str := "apr" - | 5: str := "may" - | 6: str := "jun" - | 7: str := "jul" - | 8: str := "aug" - | 9: str := "sep" - |10: str := "oct" - |11: str := "nov" - |12: str := "dec" - END; - Out.String(str) -END OutMonth; +VAR + str: ARRAY 4 OF CHAR; + +BEGIN + + CASE n OF + | 1: str := "jan" + | 2: str := "feb" + | 3: str := "mar" + | 4: str := "apr" + | 5: str := "may" + | 6: str := "jun" + | 7: str := "jul" + | 8: str := "aug" + | 9: str := "sep" + |10: str := "oct" + |11: str := "nov" + |12: str := "dec" + END; + + Out.String(str) +END OutMonth; + PROCEDURE main; -VAR Year, Month, Day, Hour, Min, Sec: INTEGER; -BEGIN - ConsoleLib.open(-1, -1, -1, -1, "Hello!"); - Out.String("Hello, world!"); Out.Ln; - Console.SetColor(Console.Yellow, Console.Blue); - DateTime.Now(Year, Month, Day, Hour, Min, Sec); - Out.Int(Year, 0); Out.Char("-"); - OutMonth(Month); Out.Char("-"); - OutInt2(Day); Out.Char(" "); - OutInt2(Hour); Out.Char(":"); - OutInt2(Min); Out.Char(":"); - OutInt2(Sec); - In.Ln; - ConsoleLib.exit(TRUE) -END main; +VAR + Year, Month, Day, Hour, Min, Sec, Msec: INTEGER; BEGIN - main + Out.String("Hello, world!"); Out.Ln; + Console.SetColor(Console.White, Console.Red); + DateTime.Now(Year, Month, Day, Hour, Min, Sec, Msec); + Out.Int(Year, 0); Out.Char("-"); + OutMonth(Month); Out.Char("-"); + OutInt2(Day); Out.Char(" "); + OutInt2(Hour); Out.Char(":"); + OutInt2(Min); Out.Char(":"); + OutInt2(Sec) +END main; + + +BEGIN + Console.open; + main; + In.Ln; + Console.exit(TRUE) END HW_con. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/RasterW.ob07 b/programs/develop/oberon07/Samples/RasterW.ob07 deleted file mode 100644 index f53a856bd0..0000000000 --- a/programs/develop/oberon07/Samples/RasterW.ob07 +++ /dev/null @@ -1,159 +0,0 @@ -MODULE RasterW; - -IMPORT sys := SYSTEM, RW := RasterWorks, KOSAPI; - - -TYPE - - TWindow = RECORD - - Left, Top, Width, Height: INTEGER; - Color: INTEGER; - Header: ARRAY 256 OF CHAR - - END; - - -VAR - - canvas : INTEGER; - bpp32 : BOOLEAN; - - -PROCEDURE CreateCanvas(width, height: INTEGER; bpp32: BOOLEAN): INTEGER; -VAR canvas: INTEGER; -BEGIN - canvas := KOSAPI.malloc(width * height * (3 + ORD(bpp32)) + 8); - sys.PUT(canvas, width); - sys.PUT(canvas + 4, height) - RETURN canvas -END CreateCanvas; - - -PROCEDURE ClearCanvas(canvas, color: INTEGER; bpp32: BOOLEAN); -VAR data, width, height, i: INTEGER; -BEGIN - sys.GET(canvas, width); - sys.GET(canvas + 4, height); - data := canvas + 8; - IF bpp32 THEN - FOR i := 1 TO width * height DO - sys.PUT(data, color); INC(data, 4) - END - ELSE - FOR i := 1 TO width * height - 1 DO - sys.PUT(data, color); INC(data, 3) - END; - sys.MOVE(sys.ADR(color), data, 3) - END -END ClearCanvas; - - -PROCEDURE WindowRedrawStatus(p: INTEGER); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc2(12, p) -END WindowRedrawStatus; - - -PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0])) -END DefineAndDrawWindow; - - -PROCEDURE WaitForEvent(): INTEGER; - RETURN KOSAPI.sysfunc1(10) -END WaitForEvent; - - -PROCEDURE ExitApp; -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc1(-1) -END ExitApp; - - -PROCEDURE DrawCanvas(canvas: INTEGER; x, y: INTEGER; bpp32: BOOLEAN); -VAR xsize, ysize, aux: INTEGER; -BEGIN - sys.GET(canvas, xsize); - sys.GET(canvas + 4, ysize); - aux := KOSAPI.sysfunc7(65, canvas + 8, xsize * 65536 + ysize, x * 65536 + y, 24 + 8 * ORD(bpp32), 0, 0) -END DrawCanvas; - - -PROCEDURE TextOut(canvas, x, y: INTEGER; string: ARRAY OF CHAR; color, params: INTEGER); -VAR width: INTEGER; -BEGIN - width := RW.drawText(canvas, x, y, sys.ADR(string[0]), LENGTH(string), color + 0FF000000H, params) -END TextOut; - - -PROCEDURE DrawText; -VAR x, y: INTEGER; -BEGIN - ClearCanvas(canvas, 00FFFFFFH, bpp32); - - x := 0; y := 0; - - TextOut(canvas, x, y, "font size 16", 000000FFH, RW.params( 16, 0, RW.cp866, RW.bpp32 * ORD(bpp32) ) ); - y := y + 16; - x := x + 20; - TextOut(canvas, x, y, "font size 12", 00FF0000H, RW.params( 12, 0, RW.cp866, RW.bpp32 * ORD(bpp32) ) ); - y := y + 12; - x := x + 20; - TextOut(canvas, x, y, "italic", 00808080H, RW.params( 16, 0, RW.cp866, RW.bpp32 * ORD(bpp32) + RW.italic ) ); - y := y + 16; - x := x + 20; - TextOut(canvas, x, y, "bold", 00000000H, RW.params( 16, 0, RW.cp866, RW.bpp32 * ORD(bpp32) + RW.bold ) ); - y := y + 16; - x := x + 20; - TextOut(canvas, x, y, "underline", 00000000H, RW.params( 16, 0, RW.cp866, RW.bpp32 * ORD(bpp32) + RW.underline ) ); - y := y + 16; - x := x + 20; - TextOut(canvas, x, y, "strike-through", 00000000H, RW.params( 16, 0, RW.cp866, RW.bpp32 * ORD(bpp32) + RW.strike_through ) ); - y := y + 16; - x := x + 20; - - DrawCanvas(canvas, 10, 10, bpp32); -END DrawText; - - -PROCEDURE draw_window(Window: TWindow); -BEGIN - WindowRedrawStatus(1); - DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header); - DrawText; - WindowRedrawStatus(2); -END draw_window; - - -PROCEDURE main; -VAR Window: TWindow; -BEGIN - - Window.Left := 200; - Window.Top := 200; - Window.Width := 400; - Window.Height := 300; - Window.Color := 00C0C0C0H; - Window.Header := "RasterWorks"; - - bpp32 := FALSE; - canvas := CreateCanvas(Window.Width - 30, Window.Height - 50, bpp32); - - WHILE TRUE DO - CASE WaitForEvent() OF - |1: draw_window(Window) - |3: ExitApp - ELSE - END - END - -END main; - -BEGIN - main -END RasterW. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/kfont.ob07 b/programs/develop/oberon07/Samples/kfont.ob07 deleted file mode 100644 index 61bb5698dd..0000000000 --- a/programs/develop/oberon07/Samples/kfont.ob07 +++ /dev/null @@ -1,175 +0,0 @@ -MODULE kfont; - -IMPORT sys := SYSTEM, kfonts, KOSAPI; - - -CONST - - FileName = "/rd/1/fonts/tahoma.kf"; - - -TYPE - - TWindow = RECORD - - Left, Top, Width, Height: INTEGER; - Color: INTEGER; - Header: ARRAY 256 OF CHAR - - END; - - -VAR - - canvas : INTEGER; - bpp32 : BOOLEAN; - - Font12, Font16: kfonts.TFont; - - -PROCEDURE CreateCanvas(width, height: INTEGER; bpp32: BOOLEAN): INTEGER; -VAR canvas: INTEGER; -BEGIN - canvas := KOSAPI.malloc(width * height * (3 + ORD(bpp32)) + 8); - sys.PUT(canvas, width); - sys.PUT(canvas + 4, height) - RETURN canvas -END CreateCanvas; - - -PROCEDURE ClearCanvas(canvas, color: INTEGER; bpp32: BOOLEAN); -VAR data, width, height, i: INTEGER; -BEGIN - sys.GET(canvas, width); - sys.GET(canvas + 4, height); - data := canvas + 8; - IF bpp32 THEN - FOR i := 1 TO width * height DO - sys.PUT(data, color); INC(data, 4) - END - ELSE - FOR i := 1 TO width * height - 1 DO - sys.PUT(data, color); INC(data, 3) - END; - sys.MOVE(sys.ADR(color), data, 3) - END -END ClearCanvas; - - -PROCEDURE WindowRedrawStatus(p: INTEGER); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc2(12, p) -END WindowRedrawStatus; - - -PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0])) -END DefineAndDrawWindow; - - -PROCEDURE WaitForEvent(): INTEGER; - RETURN KOSAPI.sysfunc1(10) -END WaitForEvent; - - -PROCEDURE ExitApp; -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc1(-1) -END ExitApp; - - -PROCEDURE DrawCanvas(canvas: INTEGER; x, y: INTEGER; bpp32: BOOLEAN); -VAR xsize, ysize, aux: INTEGER; -BEGIN - sys.GET(canvas, xsize); - sys.GET(canvas + 4, ysize); - aux := KOSAPI.sysfunc7(65, canvas + 8, xsize * 65536 + ysize, x * 65536 + y, 24 + 8 * ORD(bpp32), 0, 0) -END DrawCanvas; - - -PROCEDURE DrawText; -VAR x, y: INTEGER; -BEGIN - ClearCanvas(canvas, 00FFFFFFH, bpp32); - - x := 0; y := 0; - - kfonts.TextOut(Font16, canvas, x, y, sys.ADR("font size 16"), -1, 000000FFH, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing ); - y := y + kfonts.TextHeight( Font16 ); - x := x + 20; - - kfonts.TextOut(Font12, canvas, x, y, sys.ADR("font size 12"), -1, 00FF0000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing ); - y := y + kfonts.TextHeight( Font12 ); - x := x + 20; - - kfonts.TextOut(Font16, canvas, x, y, sys.ADR("italic"), -1, 00808080H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.italic ); - y := y + kfonts.TextHeight( Font16 ); - x := x + 20; - - kfonts.TextOut(Font16, canvas, x, y, sys.ADR("bold"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.bold ); - y := y + kfonts.TextHeight( Font16 ); - x := x + 20; - - kfonts.TextOut(Font16, canvas, x, y, sys.ADR("underline"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.underline ); - y := y + kfonts.TextHeight( Font16 ); - x := x + 20; - - kfonts.TextOut(Font16, canvas, x, y, sys.ADR("strike-through"), -1, 00000000H, kfonts.bpp32 * ORD(bpp32) + kfonts.smoothing + kfonts.strike_through ); - y := y + kfonts.TextHeight( Font16 ); - x := x + 20; - - DrawCanvas(canvas, 10, 10, bpp32); -END DrawText; - - -PROCEDURE draw_window(Window: TWindow); -BEGIN - WindowRedrawStatus(1); - DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header); - DrawText; - WindowRedrawStatus(2); -END draw_window; - - -PROCEDURE main; -VAR Window: TWindow; - bool: BOOLEAN; -BEGIN - - Window.Left := 200; - Window.Top := 200; - Window.Width := 400; - Window.Height := 300; - Window.Color := 00C0C0C0H; - Window.Header := "kfonts"; - - bpp32 := TRUE; - canvas := CreateCanvas(Window.Width - 30, Window.Height - 50, bpp32); - - Font12 := kfonts.LoadFont(FileName); - IF kfonts.Enabled(Font12, 12) THEN - bool := kfonts.SetSize(Font12, 12) - END; - - Font16 := kfonts.LoadFont(FileName); - IF kfonts.Enabled(Font16, 16) THEN - bool := kfonts.SetSize(Font16, 16) - END; - - WHILE TRUE DO - CASE WaitForEvent() OF - |1: draw_window(Window) - |3: ExitApp - ELSE - END - END - -END main; - -BEGIN - main -END kfont. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/lib_img.ob07 b/programs/develop/oberon07/Samples/lib_img.ob07 deleted file mode 100644 index 104c83fb6e..0000000000 --- a/programs/develop/oberon07/Samples/lib_img.ob07 +++ /dev/null @@ -1,97 +0,0 @@ -MODULE lib_img; - -IMPORT sys := SYSTEM, KOSAPI, libimg, File; - - -TYPE - - TWindow = RECORD - - Left, Top, Width, Height: INTEGER; - Color: INTEGER; - Header: ARRAY 256 OF CHAR - - END; - -VAR - - img, rgb, width, height: INTEGER; - - -PROCEDURE WindowRedrawStatus(p: INTEGER); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc2(12, p) -END WindowRedrawStatus; - - -PROCEDURE DefineAndDrawWindow(x, y, width, height, color, style, hcolor, hstyle: INTEGER; htext: ARRAY OF CHAR); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc6(0, x * 65536 + width, y * 65536 + height, color + LSL(style, 24), hcolor + LSL(hstyle, 24), sys.ADR(htext[0])) -END DefineAndDrawWindow; - - -PROCEDURE WaitForEvent(): INTEGER; - RETURN KOSAPI.sysfunc1(10) -END WaitForEvent; - - -PROCEDURE PutImage(x, y, rgb, width, height: INTEGER); -VAR aux: INTEGER; -BEGIN - aux := KOSAPI.sysfunc7(65, rgb + 8, width * 65536 + height, x * 65536 + y, 24, 0, 0) -END PutImage; - - -PROCEDURE draw_window(Window: TWindow); -BEGIN - WindowRedrawStatus(1); - DefineAndDrawWindow(Window.Left, Window.Top, Window.Width, Window.Height, Window.Color, 51, 0, 0, Window.Header); - PutImage(10, 10, rgb, width, height); - WindowRedrawStatus(2) -END draw_window; - - -PROCEDURE LoadImage(FName: ARRAY OF CHAR); -VAR data, size: INTEGER; -BEGIN - data := File.Load(FName, size); - IF data # 0 THEN - img := libimg.img_decode(data, size, 0); - data := KOSAPI.free(data); - IF img # 0 THEN - rgb := libimg.img_to_rgb(img); - IF rgb # 0 THEN - sys.GET(img + 4, width); - sys.GET(img + 8, height) - END - END - END -END LoadImage; - - -PROCEDURE main; -VAR Window: TWindow; - exit: BOOLEAN; -BEGIN - Window.Left := 200; - Window.Top := 200; - Window.Width := 400; - Window.Height := 300; - Window.Color := 00C0C0C0H; - Window.Header := "libimg"; - LoadImage("/rd/1/toolbar.png"); - exit := FALSE; - REPEAT - CASE WaitForEvent() OF - |1: draw_window(Window) - |3: exit := TRUE - ELSE - END - UNTIL exit -END main; - -BEGIN - main -END lib_img. \ No newline at end of file diff --git a/programs/develop/oberon07/Samples/vector_ex.ob07 b/programs/develop/oberon07/Samples/vector_ex.ob07 deleted file mode 100644 index fb32cda191..0000000000 --- a/programs/develop/oberon07/Samples/vector_ex.ob07 +++ /dev/null @@ -1,57 +0,0 @@ -MODULE vector_ex; - -IMPORT C := ConsoleLib, Out, V := Vector; - - -TYPE - - STRING = ARRAY 240 OF CHAR; - - Item = POINTER TO RECORD (V.ANYREC) inf: STRING END; - - -PROCEDURE add(v: V.VECTOR; s: STRING); -VAR item: Item; -BEGIN - NEW(item); - item.inf := s; - V.push(v, item) -END add; - - -PROCEDURE print(v: V.VECTOR; first, last: INTEGER); -VAR any : V.ANYPTR; - i : INTEGER; -BEGIN - i := first; - WHILE i <= last DO - any := V.get(v, i); - Out.String(any(Item).inf); - Out.Ln; - INC(i) - END; -END print; - - -PROCEDURE main; -VAR v: V.VECTOR; -BEGIN - C.open(-1, -1, -1, -1, "vector"); - - v := V.create(1024); - - add(v, "abc"); - add(v, "def"); - add(v, "123"); - add(v, "qwerty"); - add(v, "hello"); - - print(v, 0, V.count(v) - 1); - - C.exit(FALSE) -END main; - - -BEGIN - main -END vector_ex. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/AMD64.ob07 b/programs/develop/oberon07/Source/AMD64.ob07 new file mode 100644 index 0000000000..858880bef4 --- /dev/null +++ b/programs/develop/oberon07/Source/AMD64.ob07 @@ -0,0 +1,2782 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE AMD64; + +IMPORT CODE, BIN, WR := WRITER, CHL := CHUNKLISTS, MACHINE, LISTS, PATHS, + REG, C := CONSOLE, UTILS, mConst := CONSTANTS, S := STRINGS, PE32, ELF, X86; + + +CONST + + rax = REG.R0; + r10 = REG.R10; + r11 = REG.R11; + + rcx = REG.R1; + rdx = REG.R2; + r8 = REG.R8; + r9 = REG.R9; + + rsp = 4; + rbp = 5; + rsi = 6; + rdi = 7; + + je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H; + + sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; + + shl = CODE.opLSL2; shr = CODE.opLSR2; sar = CODE.opASR2; ror = CODE.opROR2; + + sCODE = BIN.PICCODE; + sDATA = BIN.PICDATA; + sBSS = BIN.PICBSS; + sIMP = BIN.PICIMP; + + +TYPE + + COMMAND = CODE.COMMAND; + + Number = POINTER TO RECORD (LISTS.ITEM) value: INTEGER END; + + OPRR = PROCEDURE (reg1, reg2: INTEGER); + + +VAR + + R: REG.REGS; + + Numbers: LISTS.LIST; + Numbers_Count: INTEGER; + Numbers_Offs: INTEGER; + + prog: BIN.PROGRAM; + + dllret: INTEGER; + + Win64RegPar: ARRAY 4 OF INTEGER; + SystemVRegPar: ARRAY 6 OF INTEGER; + + +PROCEDURE OutByte (b: BYTE); +BEGIN + X86.OutByte(b) +END OutByte; + + +PROCEDURE OutByte2 (a, b: BYTE); +BEGIN + OutByte(a); + OutByte(b) +END OutByte2; + + +PROCEDURE OutByte3 (a, b, c: BYTE); +BEGIN + OutByte(a); + OutByte(b); + OutByte(c) +END OutByte3; + + +PROCEDURE OutInt (n: INTEGER); +BEGIN + OutByte(MACHINE.Byte(n, 0)); + OutByte(MACHINE.Byte(n, 1)); + OutByte(MACHINE.Byte(n, 2)); + OutByte(MACHINE.Byte(n, 3)) +END OutInt; + + +PROCEDURE isByte (n: INTEGER): BOOLEAN; + RETURN (-128 <= n) & (n <= 127) +END isByte; + + +PROCEDURE short (n: INTEGER): INTEGER; + RETURN 2 * ORD(isByte(n)) +END short; + + +PROCEDURE long (n: INTEGER): INTEGER; + RETURN 40H * ORD(~isByte(n)) +END long; + + +PROCEDURE OutIntByte (n: INTEGER); +BEGIN + IF isByte(n) THEN + OutByte(MACHINE.Byte(n, 0)) + ELSE + OutInt(n) + END +END OutIntByte; + + +PROCEDURE isLong (n: INTEGER): BOOLEAN; + RETURN (n > MACHINE.max32) OR (n < MACHINE.min32) +END isLong; + + +PROCEDURE NewNumber (value: INTEGER); +VAR + number: Number; + +BEGIN + NEW(number); + number.value := value; + LISTS.push(Numbers, number); + INC(Numbers_Count) +END NewNumber; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + BIN.NewLabel(prog) + RETURN CODE.NewLabel() +END NewLabel; + + +PROCEDURE Rex (reg1, reg2: INTEGER); +BEGIN + OutByte(48H + reg1 DIV 8 + 4 * (reg2 DIV 8)) +END Rex; + + +PROCEDURE lea (reg, offset, section: INTEGER); +BEGIN + Rex(0, reg); + OutByte2(8DH, 05H + 8 * (reg MOD 8)); // lea reg, [rip + offset] + X86.Reloc(section, offset) +END lea; + + +PROCEDURE oprr (op: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 +BEGIN + Rex(reg1, reg2); + OutByte2(op, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) +END oprr; + + +PROCEDURE oprr2 (op1, op2: BYTE; reg1, reg2: INTEGER); // op reg1, reg2 +BEGIN + Rex(reg1, reg2); + OutByte3(op1, op2, 0C0H + 8 * (reg2 MOD 8) + reg1 MOD 8) +END oprr2; + + +PROCEDURE mov (reg1, reg2: INTEGER); // mov reg1, reg2 +BEGIN + oprr(89H, reg1, reg2) +END mov; + + +PROCEDURE xor (reg1, reg2: INTEGER); // xor reg1, reg2 +BEGIN + oprr(31H, reg1, reg2) +END xor; + + +PROCEDURE and (reg1, reg2: INTEGER); // and reg1, reg2 +BEGIN + oprr(21H, reg1, reg2) +END and; + + +PROCEDURE or (reg1, reg2: INTEGER); // and reg1, reg2 +BEGIN + oprr(09H, reg1, reg2) +END or; + + +PROCEDURE add (reg1, reg2: INTEGER); // add reg1, reg2 +BEGIN + oprr(01H, reg1, reg2) +END add; + + +PROCEDURE sub (reg1, reg2: INTEGER); // sub reg1, reg2 +BEGIN + oprr(29H, reg1, reg2) +END sub; + + +PROCEDURE xchg (reg1, reg2: INTEGER); // xchg reg1, reg2 +BEGIN + oprr(87H, reg1, reg2) +END xchg; + + +PROCEDURE cmprr (reg1, reg2: INTEGER); // cmp reg1, reg2 +BEGIN + oprr(39H, reg1, reg2) +END cmprr; + + +PROCEDURE pop (reg: INTEGER); // pop reg +BEGIN + IF reg >= 8 THEN + OutByte(41H) + END; + OutByte(58H + reg MOD 8) +END pop; + + +PROCEDURE push (reg: INTEGER); // push reg +BEGIN + IF reg >= 8 THEN + OutByte(41H) + END; + OutByte(50H + reg MOD 8) +END push; + + +PROCEDURE decr (reg: INTEGER); +BEGIN + Rex(reg, 0); + OutByte2(0FFH, 0C8H + reg MOD 8) // dec reg1 +END decr; + + +PROCEDURE incr (reg: INTEGER); +BEGIN + Rex(reg, 0); + OutByte2(0FFH, 0C0H + reg MOD 8) // inc reg1 +END incr; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE callimp (label: INTEGER); +VAR + reg: INTEGER; + +BEGIN + reg := REG.GetAnyReg(R); + lea(reg, label, sIMP); + IF reg >= 8 THEN // call qword[reg] + OutByte(41H) + END; + OutByte2(0FFH, 10H + reg MOD 8); + drop +END callimp; + + +PROCEDURE pushDA (offs: INTEGER); +VAR + reg: INTEGER; + +BEGIN + reg := REG.GetAnyReg(R); + lea(reg, offs, sDATA); + push(reg); + drop +END pushDA; + + +PROCEDURE CallRTL (proc: INTEGER); +VAR + label: INTEGER; + +BEGIN + REG.Store(R); + label := CODE.codes.rtl[proc]; + IF label < 0 THEN + callimp(-label) + ELSE + X86.call(label) + END; + REG.Restore(R) +END CallRTL; + + +PROCEDURE UnOp (VAR reg: INTEGER); +BEGIN + REG.UnOp(R, reg) +END UnOp; + + +PROCEDURE BinOp (VAR reg1, reg2: INTEGER); +BEGIN + REG.BinOp(R, reg1, reg2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + R.pushed := R.pushed - NumberOfParameters +END PushAll; + + +PROCEDURE movabs (reg, n: INTEGER); +VAR + i: INTEGER; + +BEGIN + Rex(reg, 0); + OutByte(0B8H + reg MOD 8); // movabs reg, n + FOR i := 0 TO 7 DO + OutByte(MACHINE.Byte(n, i)) + END +END movabs; + + +PROCEDURE movrc (reg, n: INTEGER); // mov reg, n +BEGIN + IF isLong(n) THEN + movabs(reg, n) + ELSE + Rex(reg, 0); + OutByte2(0C7H, 0C0H + reg MOD 8); + OutInt(n) + END +END movrc; + + +PROCEDURE test (reg: INTEGER); // test reg, reg +BEGIN + oprr(85H, reg, reg) +END test; + + +PROCEDURE oprlongc (reg, n: INTEGER; oprr: OPRR); +VAR + reg2: INTEGER; + +BEGIN + reg2 := REG.GetAnyReg(R); + movabs(reg2, n); + oprr(reg, reg2); + drop +END oprlongc; + + +PROCEDURE oprc (op, reg, n: INTEGER; oprr: OPRR); +BEGIN + IF isLong(n) THEN + oprlongc(reg, n, oprr) + ELSE + Rex(reg, 0); + OutByte2(81H + short(n), op + reg MOD 8); + OutIntByte(n) + END +END oprc; + + +PROCEDURE cmprc (reg, n: INTEGER); // cmp reg, n +BEGIN + oprc(0F8H, reg, n, cmprr) +END cmprc; + + +PROCEDURE addrc (reg, n: INTEGER); // add reg, n +BEGIN + oprc(0C0H, reg, n, add) +END addrc; + + +PROCEDURE subrc (reg, n: INTEGER); // sub reg, n +BEGIN + oprc(0E8H, reg, n, sub) +END subrc; + + +PROCEDURE andrc (reg, n: INTEGER); // and reg, n +BEGIN + oprc(0E0H, reg, n, and) +END andrc; + + +PROCEDURE pushc (n: INTEGER); +VAR + reg2: INTEGER; + +BEGIN + IF isLong(n) THEN + reg2 := REG.GetAnyReg(R); + movabs(reg2, n); + push(reg2); + drop + ELSE + OutByte(68H + short(n)); OutIntByte(n) // push n + END +END pushc; + + +PROCEDURE not (reg: INTEGER); // not reg +BEGIN + Rex(reg, 0); + OutByte2(0F7H, 0D0H + reg MOD 8) +END not; + + +PROCEDURE neg (reg: INTEGER); // neg reg +BEGIN + Rex(reg, 0); + OutByte2(0F7H, 0D8H + reg MOD 8) +END neg; + + +PROCEDURE movzx (reg1, reg2, offs: INTEGER; word: BOOLEAN); // movzx reg1, byte/word[reg2 + offs] +VAR + b: BYTE; + +BEGIN + Rex(reg2, reg1); + OutByte2(0FH, 0B6H + ORD(word)); + IF (offs = 0) & (reg2 # rbp) THEN + b := 0 + ELSE + b := 40H + long(offs) + END; + OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); + IF reg2 = rsp THEN + OutByte(24H) + END; + IF b # 0 THEN + OutIntByte(offs) + END +END movzx; + + +PROCEDURE _movrm (reg1, reg2, offs, size: INTEGER; mr: BOOLEAN); +VAR + b: BYTE; + +BEGIN + IF size = 16 THEN + OutByte(66H) + END; + IF (reg1 >= 8) OR (reg2 >= 8) OR (size = 64) THEN + OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8) + 8 * ORD(size = 64)) + END; + OutByte(8BH - 2 * ORD(mr) - ORD(size = 8)); + IF (offs = 0) & (reg2 # rbp) THEN + b := 0 + ELSE + b := 40H + long(offs) + END; + OutByte(b + (reg1 MOD 8) * 8 + reg2 MOD 8); + IF reg2 = rsp THEN + OutByte(24H) + END; + IF b # 0 THEN + OutIntByte(offs) + END +END _movrm; + + +PROCEDURE movmr32 (reg1, offs, reg2: INTEGER); // mov dword[reg1+offs], reg2_32 +BEGIN + _movrm(reg2, reg1, offs, 32, TRUE) +END movmr32; + + +PROCEDURE movrm32 (reg1, reg2, offs: INTEGER); // mov reg1_32, dword[reg2+offs] +BEGIN + _movrm(reg1, reg2, offs, 32, FALSE) +END movrm32; + + +PROCEDURE movmr8 (reg1, offs, reg2: INTEGER); // mov byte[reg1+offs], reg2_8 +BEGIN + _movrm(reg2, reg1, offs, 8, TRUE) +END movmr8; + + +PROCEDURE movrm8 (reg1, reg2, offs: INTEGER); // mov reg1_8, byte[reg2+offs] +BEGIN + _movrm(reg1, reg2, offs, 8, FALSE) +END movrm8; + + +PROCEDURE movmr16 (reg1, offs, reg2: INTEGER); // mov word[reg1+offs], reg2_16 +BEGIN + _movrm(reg2, reg1, offs, 16, TRUE) +END movmr16; + + +PROCEDURE movrm16 (reg1, reg2, offs: INTEGER); // mov reg1_16, word[reg2+offs] +BEGIN + _movrm(reg1, reg2, offs, 16, FALSE) +END movrm16; + + +PROCEDURE movmr (reg1, offs, reg2: INTEGER); // mov qword[reg1+offs], reg2 +BEGIN + _movrm(reg2, reg1, offs, 64, TRUE) +END movmr; + + +PROCEDURE movrm (reg1, reg2, offs: INTEGER); // mov reg1, qword[reg2+offs] +BEGIN + _movrm(reg1, reg2, offs, 64, FALSE) +END movrm; + + +PROCEDURE pushm (reg, offs: INTEGER); // push qword[reg+offs] +VAR + b: BYTE; + +BEGIN + IF reg >= 8 THEN + OutByte(41H) + END; + OutByte(0FFH); + IF (offs = 0) & (reg # rbp) THEN + b := 30H + ELSE + b := 70H + long(offs) + END; + OutByte(b + reg MOD 8); + IF reg = rsp THEN + OutByte(24H) + END; + IF b # 30H THEN + OutIntByte(offs) + END +END pushm; + + +PROCEDURE comisd (xmm1, xmm2: INTEGER); // comisd xmm1, xmm2 +BEGIN + OutByte(66H); + IF (xmm1 >= 8) OR (xmm2 >= 8) THEN + OutByte(40H + (xmm1 DIV 8) * 4 + xmm2 DIV 8) + END; + OutByte3(0FH, 2FH, 0C0H + (xmm1 MOD 8) * 8 + xmm2 MOD 8) +END comisd; + + +PROCEDURE _movsdrm (xmm, reg, offs: INTEGER; mr: BOOLEAN); +VAR + b: BYTE; + +BEGIN + OutByte(0F2H); + IF (xmm >= 8) OR (reg >= 8) THEN + OutByte(40H + (xmm DIV 8) * 4 + reg DIV 8) + END; + OutByte2(0FH, 10H + ORD(mr)); + IF (offs = 0) & (reg # rbp) THEN + b := 0 + ELSE + b := 40H + long(offs) + END; + OutByte(b + (xmm MOD 8) * 8 + reg MOD 8); + IF reg = rsp THEN + OutByte(24H) + END; + IF b # 0 THEN + OutIntByte(offs) + END +END _movsdrm; + + +PROCEDURE movsdrm (xmm, reg, offs: INTEGER); // movsd xmm, qword[reg+offs] +BEGIN + _movsdrm(xmm, reg, offs, FALSE) +END movsdrm; + + +PROCEDURE movsdmr (reg, offs, xmm: INTEGER); // movsd qword[reg+offs], xmm +BEGIN + _movsdrm(xmm, reg, offs, TRUE) +END movsdmr; + + +PROCEDURE opxx (op, xmm1, xmm2: INTEGER); +BEGIN + OutByte(0F2H); + IF (xmm1 >= 8) OR (xmm2 >= 8) THEN + OutByte(40H + (xmm1 DIV 8) * 4 + xmm2 DIV 8) + END; + OutByte3(0FH, op, 0C0H + (xmm1 MOD 8) * 8 + xmm2 MOD 8) +END opxx; + + +PROCEDURE jcc (cc, label: INTEGER); // jcc label +BEGIN + X86.jcc(cc, label) +END jcc; + + +PROCEDURE jmp (label: INTEGER); // jmp label +BEGIN + X86.jmp(label) +END jmp; + + +PROCEDURE setcc (cc, reg: INTEGER); //setcc reg8 +BEGIN + IF reg >= 8 THEN + OutByte(41H) + END; + OutByte3(0FH, cc, 0C0H + reg MOD 8) +END setcc; + + +PROCEDURE shiftrc (op, reg, n: INTEGER); +BEGIN + Rex(reg, 0); + IF n = 1 THEN + OutByte(0D1H) + ELSE + OutByte(0C1H) + END; + X86.shift(op, reg MOD 8); + IF n # 1 THEN + OutByte(n) + END +END shiftrc; + + +PROCEDURE getVar (variables: LISTS.LIST; offset: INTEGER): CODE.LOCALVAR; +VAR + cur: CODE.LOCALVAR; + +BEGIN + cur := variables.first(CODE.LOCALVAR); + WHILE (cur # NIL) & (cur.offset # offset) DO + cur := cur.next(CODE.LOCALVAR) + END + + RETURN cur +END getVar; + + +PROCEDURE allocReg (cmd: COMMAND); +VAR + leave: BOOLEAN; + leaf: BOOLEAN; + cur: COMMAND; + variables: LISTS.LIST; + lvar, rvar: CODE.LOCALVAR; + reg: INTEGER; + max: INTEGER; + loop: INTEGER; + +BEGIN + loop := 1; + variables := cmd.variables; + leave := FALSE; + leaf := TRUE; + + cur := cmd.next(COMMAND); + REPEAT + CASE cur.opcode OF + |CODE.opLLOAD64, + CODE.opLLOAD8, + CODE.opLLOAD16, + CODE.opLLOAD32, + CODE.opLLOAD64_PARAM, + CODE.opLLOAD32_PARAM, + CODE.opLADR_SAVE, + CODE.opLADR_INC1, + CODE.opLADR_DEC1, + CODE.opLADR_INC, + CODE.opLADR_DEC, + CODE.opLADR_INC1B, + CODE.opLADR_DEC1B, + CODE.opLADR_INCB, + CODE.opLADR_DECB, + CODE.opLADR_INCL, + CODE.opLADR_EXCL, + CODE.opLADR_UNPK: + lvar := getVar(variables, cur.param2); + IF (lvar # NIL) & (lvar.count # -1) THEN + INC(lvar.count, loop) + END + + |CODE.opLADR_SAVEC, + CODE.opLADR_INCC, + CODE.opLADR_DECC, + CODE.opLADR_INCCB, + CODE.opLADR_DECCB, + CODE.opLADR_INCLC, + CODE.opLADR_EXCLC: + lvar := getVar(variables, cur.param1); + IF (lvar # NIL) & (lvar.count # -1) THEN + INC(lvar.count, loop) + END + + |CODE.opLADR: + lvar := getVar(variables, cur.param2); + IF (lvar # NIL) & (lvar.count # -1) THEN + lvar.count := -1 + END + + |CODE.opLOOP: + INC(loop, 10) + + |CODE.opENDLOOP: + DEC(loop, 10) + + |CODE.opLEAVE, + CODE.opLEAVER, + CODE.opLEAVEF: + leave := TRUE + + |CODE.opCALL, CODE.opCALLP, CODE.opCALLI, + CODE.opWIN64CALL, CODE.opWIN64CALLP, CODE.opWIN64CALLI, + CODE.opSYSVCALL, CODE.opSYSVCALLP, CODE.opSYSVCALLI: + leaf := FALSE + + ELSE + + END; + cur := cur.next(COMMAND) + UNTIL leave OR ~leaf; + + IF leaf THEN + REPEAT + reg := -1; + max := -1; + rvar := NIL; + lvar := variables.first(CODE.LOCALVAR); + WHILE lvar # NIL DO + IF lvar.count > max THEN + max := lvar.count; + rvar := lvar + END; + lvar := lvar.next(CODE.LOCALVAR) + END; + + IF rvar # NIL THEN + reg := REG.GetAnyVarReg(R); + IF reg # -1 THEN + REG.Lock(R, reg, rvar.offset, rvar.size); + REG.Load(R, reg); + rvar.count := -1 + END + END + + UNTIL (rvar = NIL) OR (reg = -1) + END + +END allocReg; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, rax)) +END GetRegA; + + +PROCEDURE Win64Passing (params: INTEGER); +VAR + n, i: INTEGER; + +BEGIN + n := params MOD 32; + params := params DIV 32; + FOR i := 0 TO n - 1 DO + IF i IN BITS(params) THEN + movsdrm(i, rsp, i * 8) + ELSE + movrm(Win64RegPar[i], rsp, i * 8) + END + END +END Win64Passing; + + +PROCEDURE SysVPassing (params: INTEGER); +VAR + n, i, s, p, ofs: INTEGER; + i_count, f_count: INTEGER; + reg: BOOLEAN; + +BEGIN + ASSERT(r10 IN R.regs); + n := params MOD 32; + params := params DIV 32; + s := 0; + + i_count := 0; + f_count := 0; + FOR i := 0 TO n - 1 DO + IF i IN BITS(params) THEN + INC(f_count) + ELSE + INC(i_count) + END + END; + + s := MAX(0, f_count - 8) + MAX(0, i_count - 6); + p := 0; + + subrc(rsp, s * 8); + + i_count := 0; + f_count := 0; + FOR i := 0 TO n - 1 DO + ofs := (i + s) * 8; + IF i IN BITS(params) THEN + reg := f_count <= 7; + IF reg THEN + movsdrm(f_count, rsp, ofs); + INC(f_count) + END + ELSE + reg := i_count <= 5; + IF reg THEN + movrm(SystemVRegPar[i_count], rsp, ofs); + INC(i_count) + END + END; + + IF ~reg THEN + movrm(r10, rsp, ofs); + movmr(rsp, p, r10); + INC(p, 8) + END + END +END SysVPassing; + + +PROCEDURE fcmp (op: INTEGER; xmm: INTEGER); +VAR + cc, reg: INTEGER; + +BEGIN + reg := REG.GetAnyReg(R); + xor(reg, reg); + CASE op OF + |CODE.opEQF, CODE.opEQFI: + comisd(xmm - 1, xmm); + cc := sete + + |CODE.opNEF, CODE.opNEFI: + comisd(xmm - 1, xmm); + cc := setne + + |CODE.opLTF, CODE.opGTFI: + comisd(xmm - 1, xmm); + cc := setc + + |CODE.opGTF, CODE.opLTFI: + comisd(xmm, xmm - 1); + cc := setc + + |CODE.opLEF, CODE.opGEFI: + comisd(xmm, xmm - 1); + cc := setnc + + |CODE.opGEF, CODE.opLEFI: + comisd(xmm - 1, xmm); + cc := setnc + END; + OutByte2(7AH, 3 + reg DIV 8); // jp L + setcc(cc, reg); + //L: +END fcmp; + + +PROCEDURE translate (commands: LISTS.LIST; stroffs: INTEGER); +VAR + cmd, next: COMMAND; + + param1, param2, param3, a, b, c, n, label, L, i, cc: INTEGER; + + reg1, reg2, xmm: INTEGER; + + float: REAL; + + regVar: BOOLEAN; + +BEGIN + xmm := -1; + cmd := commands.first(COMMAND); + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + + CASE cmd.opcode OF + + |CODE.opJMP: + jmp(param1) + + |CODE.opCALL, CODE.opWIN64CALL, CODE.opSYSVCALL: + REG.Store(R); + CASE cmd.opcode OF + |CODE.opCALL: + |CODE.opWIN64CALL: Win64Passing(param2) + |CODE.opSYSVCALL: SysVPassing(param2) + END; + X86.call(param1); + REG.Restore(R) + + |CODE.opCALLP, CODE.opWIN64CALLP, CODE.opSYSVCALLP: + UnOp(reg1); + IF reg1 # rax THEN + GetRegA; + ASSERT(REG.Exchange(R, reg1, rax)); + drop + END; + drop; + REG.Store(R); + CASE cmd.opcode OF + |CODE.opCALLP: + |CODE.opWIN64CALLP: Win64Passing(param2) + |CODE.opSYSVCALLP: SysVPassing(param2) + END; + OutByte2(0FFH, 0D0H); // call rax + REG.Restore(R); + ASSERT(R.top = -1) + + |CODE.opCALLI, CODE.opWIN64CALLI, CODE.opSYSVCALLI: + REG.Store(R); + CASE cmd.opcode OF + |CODE.opCALLI: + |CODE.opWIN64CALLI: Win64Passing(param2) + |CODE.opSYSVCALLI: SysVPassing(param2) + END; + callimp(param1); + REG.Restore(R) + + |CODE.opLABEL: + X86.SetLabel(param2) + + |CODE.opERR: + CallRTL(CODE._error) + + |CODE.opERRC: + pushc(param2) + + |CODE.opPRECALL: + n := param2; + IF (param1 # 0) & (n # 0) THEN + subrc(rsp, 8) + END; + WHILE n > 0 DO + subrc(rsp, 8); + movsdmr(rsp, 0, xmm); + DEC(xmm); + DEC(n) + END; + ASSERT(xmm = -1); + PushAll(0) + + |CODE.opWIN64ALIGN16: + ASSERT(rax IN R.regs); + mov(rax, rsp); + andrc(rsp, -16); + push(rax); + subrc(rsp, (MAX(param2 - 4, 0) MOD 2 + MAX(4 - param2, 0) + 1) * 8) + + |CODE.opSYSVALIGN16: + ASSERT(rax IN R.regs); + mov(rax, rsp); + andrc(rsp, -16); + push(rax); + IF ~ODD(param2) THEN + push(rax) + END + + |CODE.opRESF: + ASSERT(xmm = -1); + INC(xmm); + n := param2; + IF n > 0 THEN + movsdmr(rsp, n * 8, xmm); + DEC(xmm); + INC(n) + END; + + WHILE n > 0 DO + INC(xmm); + movsdrm(xmm, rsp, 0); + addrc(rsp, 8); + DEC(n) + END + + |CODE.opRES: + ASSERT(R.top = -1); + GetRegA; + n := param2; + WHILE n > 0 DO + INC(xmm); + movsdrm(xmm, rsp, 0); + addrc(rsp, 8); + DEC(n) + END + + |CODE.opENTER: + ASSERT(R.top = -1); + + X86.SetLabel(param1); + + param3 := cmd.param3; + + IF param3 > 0 THEN + push(rbp); + mov(rbp, rsp); + + n := param3 MOD 32; + param3 := param3 DIV 32; + + FOR i := 0 TO n - 1 DO + IF i IN BITS(param3) THEN + movsdmr(rbp, i * 8 + 16, i) + ELSE + movmr(rbp, i * 8 + 16, Win64RegPar[i]) + END + END + ELSIF param3 < 0 THEN + param3 := -param3; + n := (param3 MOD 32) * 8; + param3 := param3 DIV 32; + pop(r10); + subrc(rsp, n); + push(r10); + push(rbp); + mov(rbp, rsp); + + a := 0; + b := 0; + c := 0; + + INC(n, 16); + + FOR i := 16 TO n - 8 BY 8 DO + IF ODD(param3) THEN + IF b <= 7 THEN + movsdmr(rbp, i, b); + INC(b) + ELSE + movrm(r10, rbp, n + c); + movmr(rbp, i, r10); + INC(c, 8) + END + ELSE + IF a <= 5 THEN + movmr(rbp, i, SystemVRegPar[a]); + INC(a) + ELSE + movrm(r10, rbp, n + c); + movmr(rbp, i, r10); + INC(c, 8) + END + END; + param3 := param3 DIV 2 + END + ELSE + push(rbp); + mov(rbp, rsp) + END; + + n := param2; + IF n > 4 THEN + movrc(rcx, n); + // L: + pushc(0); + OutByte2(0E2H, 0FCH) // loop L + ELSE + WHILE n > 0 DO + pushc(0); + DEC(n) + END + END; + + IF cmd.allocReg THEN + allocReg(cmd) + END + + |CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: + IF cmd.opcode = CODE.opLEAVER THEN + UnOp(reg1); + IF reg1 # rax THEN + GetRegA; + ASSERT(REG.Exchange(R, reg1, rax)); + drop + END; + drop + END; + + ASSERT(R.top = -1); + + IF cmd.opcode = CODE.opLEAVEF THEN + DEC(xmm) + END; + + ASSERT(xmm = -1); + + mov(rsp, rbp); + pop(rbp); + IF param2 > 0 THEN + OutByte3(0C2H, (param2 * 8) MOD 256, (param2 * 8) DIV 256) // ret param2 + ELSE + OutByte(0C3H) // ret + END; + REG.Reset(R) + + |CODE.opSAVES: + UnOp(reg1); + drop; + PushAll(0); + push(reg1); + pushDA(stroffs + param2); + pushc(param1); + CallRTL(CODE._move) + + |CODE.opSADR: + reg1 := REG.GetAnyReg(R); + lea(reg1, stroffs + param2, sDATA) + + |CODE.opLOAD8: + UnOp(reg1); + movzx(reg1, reg1, 0, FALSE) + + |CODE.opLOAD16: + UnOp(reg1); + movzx(reg1, reg1, 0, TRUE) + + |CODE.opLOAD32: + UnOp(reg1); + movrm32(reg1, reg1, 0); + shiftrc(shl, reg1, 32); + shiftrc(shr, reg1, 32) + + |CODE.opLOAD64: + UnOp(reg1); + movrm(reg1, reg1, 0) + + |CODE.opLLOAD64: + reg1 := REG.GetAnyReg(R); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + mov(reg1, reg2) + ELSE + movrm(reg1, rbp, param2 * 8) + END + + |CODE.opLLOAD8, + CODE.opLLOAD16: + reg1 := REG.GetAnyReg(R); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + mov(reg1, reg2) + ELSE + movzx(reg1, rbp, param2 * 8, cmd.opcode = CODE.opLLOAD16) + END + + |CODE.opLLOAD32: + reg1 := REG.GetAnyReg(R); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + mov(reg1, reg2) + ELSE + n := param2 * 8; + xor(reg1, reg1); + movrm32(reg1, rbp, n) + END + + |CODE.opGLOAD64: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sBSS); + movrm(reg1, reg1, 0) + + |CODE.opGLOAD8: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sBSS); + movzx(reg1, reg1, 0, FALSE) + + |CODE.opGLOAD16: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sBSS); + movzx(reg1, reg1, 0, TRUE) + + |CODE.opGLOAD32: + reg1 := REG.GetAnyReg(R); + xor(reg1, reg1); + lea(reg1, param2, sBSS); + movrm32(reg1, reg1, 0) + + |CODE.opVLOAD64: + reg1 := REG.GetAnyReg(R); + movrm(reg1, rbp, param2 * 8); + movrm(reg1, reg1, 0) + + |CODE.opVLOAD8, + CODE.opVLOAD16: + reg1 := REG.GetAnyReg(R); + movrm(reg1, rbp, param2 * 8); + movzx(reg1, reg1, 0, cmd.opcode = CODE.opVLOAD16) + + |CODE.opVLOAD32: + reg1 := REG.GetAnyReg(R); + reg2 := REG.GetAnyReg(R); + xor(reg1, reg1); + movrm(reg2, rbp, param2 * 8); + movrm32(reg1, reg2, 0); + drop + + |CODE.opLADR: + n := param2 * 8; + next := cmd.next(COMMAND); + IF next.opcode = CODE.opSAVEF THEN + movsdmr(rbp, n, xmm); + DEC(xmm); + cmd := next + ELSIF next.opcode = CODE.opLOADF THEN + INC(xmm); + movsdrm(xmm, rbp, n); + cmd := next + ELSE + reg1 := REG.GetAnyReg(R); + Rex(0, reg1); + OutByte2(8DH, 45H + long(n) + (reg1 MOD 8) * 8); // lea reg1, qword[rbp+n] + OutIntByte(n) + END + + |CODE.opGADR: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sBSS) + + |CODE.opVADR: + reg1 := REG.GetAnyReg(R); + movrm(reg1, rbp, param2 * 8) + + |CODE.opSAVE8C: + UnOp(reg1); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte3(0C6H, reg1 MOD 8, param2); // mov byte[reg1], param2 + drop + + |CODE.opSAVE16C: + UnOp(reg1); + OutByte(66H); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte2(0C7H, reg1 MOD 8); + OutByte2(param2 MOD 256, param2 DIV 256); // mov word[reg1], param2 + drop + + |CODE.opSAVEC: + UnOp(reg1); + IF isLong(param2) THEN + reg2 := REG.GetAnyReg(R); + movrc(reg2, param2); + movmr(reg1, 0, reg2); + drop + ELSE + Rex(reg1, 0); + OutByte2(0C7H, reg1 MOD 8); // mov qword[reg1], param2 + OutInt(param2) + END; + drop + + |CODE.opRSET: + PushAll(2); + CallRTL(CODE._set); + GetRegA + + |CODE.opRSETR: + PushAll(1); + pushc(param2); + CallRTL(CODE._set); + GetRegA + + |CODE.opRSETL: + PushAll(1); + pushc(param2); + CallRTL(CODE._set2); + GetRegA + + |CODE.opRSET1: + UnOp(reg1); + PushAll(1); + push(reg1); + CallRTL(CODE._set); + GetRegA + + |CODE.opINCL, CODE.opEXCL: + BinOp(reg1, reg2); + cmprc(reg1, 64); + OutByte2(73H, 04H); // jnb L + Rex(reg2, reg1); + OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opEXCL), 8 * (reg1 MOD 8) + reg2 MOD 8); // bts/btr qword[reg2], reg1 + // L: + drop; + drop + + |CODE.opINCLC, CODE.opEXCLC: + UnOp(reg1); + Rex(reg1, 0); + OutByte2(0FH, 0BAH); // bts/btr qword[reg1], param2 + OutByte2(28H + 8 * ORD(cmd.opcode = CODE.opEXCLC) + reg1 MOD 8, param2); + drop + + |CODE.opEQS .. CODE.opGES: + PushAll(4); + pushc(cmd.opcode - CODE.opEQS); + CallRTL(CODE._strcmp); + GetRegA + + |CODE.opEQS2 .. CODE.opGES2: + PushAll(4); + pushc(cmd.opcode - CODE.opEQS2); + CallRTL(CODE._strcmp2); + GetRegA + + |CODE.opEQSW .. CODE.opGESW: + PushAll(4); + pushc(cmd.opcode - CODE.opEQSW); + CallRTL(CODE._strcmpw); + GetRegA + + |CODE.opEQSW2 .. CODE.opGESW2: + PushAll(4); + pushc(cmd.opcode - CODE.opEQSW2); + CallRTL(CODE._strcmpw2); + GetRegA + + |CODE.opINC1, CODE.opDEC1: + UnOp(reg1); + Rex(reg1, 0); + OutByte2(0FFH, reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opDEC1)); + drop + + |CODE.opCONST: + reg1 := REG.GetAnyReg(R); + movrc(reg1, param2) + + |CODE.opGT, CODE.opGE, CODE.opLT, + CODE.opLE, CODE.opEQ, CODE.opNE: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + drop; + drop; + cc := X86.cond(cmd.opcode); + + IF cmd.next(COMMAND).opcode = CODE.opJE THEN + label := cmd.next(COMMAND).param1; + jcc(cc, label); + cmd := cmd.next(COMMAND) + + ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + label := cmd.next(COMMAND).param1; + jcc(X86.inv1(cc), label); + cmd := cmd.next(COMMAND) + + ELSE + reg1 := REG.GetAnyReg(R); + setcc(cc + 16, reg1); + andrc(reg1, 1) + END + + |CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, + CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, + CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: + UnOp(reg1); + IF param2 = 0 THEN + test(reg1) + ELSE + cmprc(reg1, param2) + END; + drop; + cc := X86.cond(cmd.opcode); + + IF cmd.next(COMMAND).opcode = CODE.opJE THEN + label := cmd.next(COMMAND).param1; + jcc(cc, label); + cmd := cmd.next(COMMAND) + + ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + label := cmd.next(COMMAND).param1; + jcc(X86.inv1(cc), label); + cmd := cmd.next(COMMAND) + + ELSE + reg1 := REG.GetAnyReg(R); + setcc(cc + 16, reg1); + andrc(reg1, 1) + END + + |CODE.opCODE: + OutByte(param2) + + |CODE.opPUSHIP: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sIMP); + movrm(reg1, reg1, 0) + + |CODE.opPARAM: + n := param2; + IF n = 1 THEN + UnOp(reg1); + push(reg1); + drop + ELSE + ASSERT(R.top + 1 <= n); + PushAll(n) + END + + |CODE.opJNZ: + UnOp(reg1); + test(reg1); + jcc(jne, param1) + + |CODE.opJZ: + UnOp(reg1); + test(reg1); + jcc(je, param1) + + |CODE.opJE: + UnOp(reg1); + test(reg1); + jcc(jne, param1); + drop + + |CODE.opJNE: + UnOp(reg1); + test(reg1); + jcc(je, param1); + drop + + |CODE.opIN: + label := NewLabel(); + L := NewLabel(); + BinOp(reg1, reg2); + cmprc(reg1, 64); + jcc(jb, L); + xor(reg1, reg1); + jmp(label); + X86.SetLabel(L); + Rex(reg2, reg1); + OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 + setcc(setc, reg1); + andrc(reg1, 1); + X86.SetLabel(label); + drop + + |CODE.opINR: + label := NewLabel(); + L := NewLabel(); + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + cmprc(reg1, 64); + jcc(jb, L); + xor(reg1, reg1); + jmp(label); + X86.SetLabel(L); + movrc(reg2, param2); + Rex(reg2, reg1); + OutByte3(0FH, 0A3H, 0C0H + 8 * (reg1 MOD 8) + reg2 MOD 8); // bt reg2, reg1 + setcc(setc, reg1); + andrc(reg1, 1); + X86.SetLabel(label); + drop + + |CODE.opINL: + UnOp(reg1); + Rex(reg1, 0); + OutByte2(0FH, 0BAH); // bt reg1, param2 + OutByte2(0E0H + reg1 MOD 8, param2); + setcc(setc, reg1); + andrc(reg1, 1) + + |CODE.opNOT: + UnOp(reg1); + test(reg1); + setcc(sete, reg1); + andrc(reg1, 1) + + |CODE.opORD: + UnOp(reg1); + test(reg1); + setcc(setne, reg1); + andrc(reg1, 1) + + |CODE.opABS: + UnOp(reg1); + test(reg1); + OutByte2(7DH, 03H); // jge L + neg(reg1) + // L: + + |CODE.opEQB, CODE.opNEB: + BinOp(reg1, reg2); + drop; + drop; + + test(reg1); + OutByte2(74H, 07H); // je L1 + movrc(reg1, 1); + // L1: + test(reg2); + OutByte2(74H, 07H); // je L2 + movrc(reg2, 1); + // L2: + cmprr(reg1, reg2); + reg1 := REG.GetAnyReg(R); + IF cmd.opcode = CODE.opEQB THEN + setcc(sete, reg1) + ELSE + setcc(setne, reg1) + END; + andrc(reg1, 1) + + |CODE.opMULSC: + UnOp(reg1); + andrc(reg1, param2) + + |CODE.opDIVSC, CODE.opADDSL, CODE.opADDSR: + UnOp(reg1); + Rex(reg1, 0); + OutByte2(81H + short(param2), 0C8H + 28H * ORD(cmd.opcode = CODE.opDIVSC) + reg1 MOD 8); // or/xor reg1, param2 + OutIntByte(param2) + + |CODE.opSUBSL: + UnOp(reg1); + not(reg1); + andrc(reg1, param2) + + |CODE.opSUBSR: + UnOp(reg1); + andrc(reg1, ORD(-BITS(param2))) + + |CODE.opMULS: + BinOp(reg1, reg2); + and(reg1, reg2); + drop + + |CODE.opDIVS: + BinOp(reg1, reg2); + xor(reg1, reg2); + drop + + |CODE.opUMINS: + UnOp(reg1); + not(reg1) + + |CODE.opCOPY: + PushAll(2); + pushc(param2); + CallRTL(CODE._move2) + + |CODE.opMOVE: + PushAll(3); + CallRTL(CODE._move2) + + |CODE.opCOPYA: + PushAll(4); + pushc(param2); + CallRTL(CODE._arrcpy); + GetRegA + + |CODE.opCOPYS: + PushAll(4); + pushc(param2); + CallRTL(CODE._strcpy) + + |CODE.opCOPYS2: + PushAll(4); + pushc(param2); + CallRTL(CODE._strcpy2) + + |CODE.opROT: + PushAll(0); + push(rsp); + pushc(param2); + CallRTL(CODE._rot) + + |CODE.opNEW: + PushAll(1); + n := param2 + 16; + ASSERT(MACHINE.Align(n, 64)); + pushc(n); + pushc(param1); + CallRTL(CODE._new) + + |CODE.opDISP: + PushAll(1); + CallRTL(CODE._dispose) + + |CODE.opPUSHT: + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + movrm(reg2, reg1, -8) + + |CODE.opISREC: + PushAll(2); + pushc(param2); + CallRTL(CODE._isrec); + GetRegA + + |CODE.opIS: + PushAll(1); + pushc(param2); + CallRTL(CODE._is); + GetRegA + + |CODE.opTYPEGR: + PushAll(1); + pushc(param2); + CallRTL(CODE._guardrec); + GetRegA + + |CODE.opTYPEGP: + UnOp(reg1); + PushAll(0); + push(reg1); + pushc(param2); + CallRTL(CODE._guard); + GetRegA + + |CODE.opTYPEGD: + UnOp(reg1); + PushAll(0); + pushm(reg1, -8); + pushc(param2); + CallRTL(CODE._guardrec); + GetRegA + + |CODE.opCASET: + push(r10); + push(r10); + pushc(param2); + CallRTL(CODE._guardrec); + pop(r10); + test(rax); + jcc(jne, param1) + + |CODE.opSAVEP: + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + lea(reg2, param2, sCODE); + movmr(reg1, 0, reg2); + drop; + drop + + |CODE.opPUSHP: + reg1 := REG.GetAnyReg(R); + lea(reg1, param2, sCODE) + + |CODE.opINC, CODE.opDEC: + BinOp(reg1, reg2); + // add/sub qword[reg2], reg1 + Rex(reg2, reg1); + OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDEC), reg2 MOD 8 + (reg1 MOD 8) * 8); + drop; + drop + + |CODE.opINCC, CODE.opDECC: + UnOp(reg1); + IF isLong(param2) THEN + reg2 := REG.GetAnyReg(R); + movrc(reg2, param2); + // add/sub qword[reg1], reg2 + Rex(reg1, reg2); + OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opDECC), reg1 MOD 8 + (reg2 MOD 8) * 8); + drop + ELSE + // add/sub qword[reg1], param2 + Rex(reg1, 0); + OutByte2(81H + short(param2), 28H * ORD(cmd.opcode = CODE.opDECC) + reg1 MOD 8); + OutIntByte(param2) + END; + drop + + |CODE.opDROP: + UnOp(reg1); + drop + + |CODE.opSAVE, CODE.opSAVE64: + BinOp(reg2, reg1); + movmr(reg1, 0, reg2); + drop; + drop + + |CODE.opSAVE8: + BinOp(reg2, reg1); + movmr8(reg1, 0, reg2); + drop; + drop + + |CODE.opSAVE16: + BinOp(reg2, reg1); + movmr16(reg1, 0, reg2); + drop; + drop + + |CODE.opSAVE32: + BinOp(reg2, reg1); + movmr32(reg1, 0, reg2); + drop; + drop + + |CODE.opMIN: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + OutByte2(7EH, 3); // jle L + mov(reg1, reg2); + // L: + drop + + |CODE.opMAX: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + OutByte2(7DH, 3); // jge L + mov(reg1, reg2); + // L: + drop + + |CODE.opMINC: + UnOp(reg1); + cmprc(reg1, param2); + label := NewLabel(); + jcc(jle, label); + movrc(reg1, param2); + X86.SetLabel(label) + + |CODE.opMAXC: + UnOp(reg1); + cmprc(reg1, param2); + label := NewLabel(); + jcc(jge, label); + movrc(reg1, param2); + X86.SetLabel(label) + + |CODE.opSBOOL: + BinOp(reg2, reg1); + test(reg2); + setcc(setne, reg2); + movmr8(reg1, 0, reg2); + drop; + drop + + |CODE.opSBOOLC: + UnOp(reg1); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte3(0C6H, reg1 MOD 8, ORD(param2 # 0)); + drop + + |CODE.opODD: + UnOp(reg1); + andrc(reg1, 1) + + |CODE.opUMINUS: + UnOp(reg1); + neg(reg1) + + |CODE.opADD: + BinOp(reg1, reg2); + add(reg1, reg2); + drop + + |CODE.opSUB: + BinOp(reg1, reg2); + sub(reg1, reg2); + drop + + |CODE.opSUBR, CODE.opSUBL: + UnOp(reg1); + n := param2; + IF n = 1 THEN + decr(reg1) + ELSIF n = -1 THEN + incr(reg1) + ELSIF n # 0 THEN + subrc(reg1, n) + END; + IF cmd.opcode = CODE.opSUBL THEN + neg(reg1) + END + + |CODE.opADDL, CODE.opADDR: + IF param2 # 0 THEN + UnOp(reg1); + IF param2 = 1 THEN + incr(reg1) + ELSIF param2 = -1 THEN + decr(reg1) + ELSE + addrc(reg1, param2) + END + END + + |CODE.opDIV: + PushAll(2); + CallRTL(CODE._div); + GetRegA + + |CODE.opDIVR: + a := param2; + IF a > 1 THEN + n := X86.log2(a) + ELSIF a < -1 THEN + n := X86.log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + UnOp(reg1); + neg(reg1) + ELSE + IF n > 0 THEN + UnOp(reg1); + + IF a < 0 THEN + reg2 := REG.GetAnyReg(R); + mov(reg2, reg1); + shiftrc(sar, reg1, n); + sub(reg1, reg2); + drop + ELSE + shiftrc(sar, reg1, n) + END + + ELSE + PushAll(1); + pushc(param2); + CallRTL(CODE._div); + GetRegA + END + END + + |CODE.opDIVL: + PushAll(1); + pushc(param2); + CallRTL(CODE._div2); + GetRegA + + |CODE.opMOD: + PushAll(2); + CallRTL(CODE._mod); + GetRegA + + |CODE.opMODR: + a := param2; + IF a > 1 THEN + n := X86.log2(a) + ELSIF a < -1 THEN + n := X86.log2(-a) + ELSE + n := -1 + END; + + IF ABS(a) = 1 THEN + UnOp(reg1); + xor(reg1, reg1) + ELSE + IF n > 0 THEN + UnOp(reg1); + andrc(reg1, ABS(a) - 1); + + IF a < 0 THEN + test(reg1); + label := NewLabel(); + jcc(je, label); + addrc(reg1, a); + X86.SetLabel(label) + END + + ELSE + PushAll(1); + pushc(param2); + CallRTL(CODE._mod); + GetRegA + END + END + + |CODE.opMODL: + PushAll(1); + pushc(param2); + CallRTL(CODE._mod2); + GetRegA + + |CODE.opMUL: + BinOp(reg1, reg2); + oprr2(0FH, 0AFH, reg2, reg1); // imul reg1, reg2 + drop + + |CODE.opMULC: + UnOp(reg1); + + a := param2; + IF a > 1 THEN + n := X86.log2(a) + ELSIF a < -1 THEN + n := X86.log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + neg(reg1) + ELSIF a = 0 THEN + xor(reg1, reg1) + ELSE + IF n > 0 THEN + IF a < 0 THEN + neg(reg1) + END; + shiftrc(shl, reg1, n) + ELSE + // imul reg1, a + Rex(reg1, reg1); + OutByte2(69H + short(a), 0C0H + (reg1 MOD 8) * 9); + OutIntByte(a) + END + END + + |CODE.opADDS: + BinOp(reg1, reg2); + or(reg1, reg2); + drop + + |CODE.opSUBS: + BinOp(reg1, reg2); + not(reg2); + and(reg1, reg2); + drop + + |CODE.opNOP: + + |CODE.opSWITCH: + UnOp(reg1); + IF param2 = 0 THEN + reg2 := rax + ELSE + reg2 := r10 + END; + IF reg1 # reg2 THEN + ASSERT(REG.GetReg(R, reg2)); + ASSERT(REG.Exchange(R, reg1, reg2)); + drop + END; + drop + + |CODE.opENDSW: + + |CODE.opCASEL: + cmprc(rax, param1); + jcc(jl, param2) + + |CODE.opCASER: + cmprc(rax, param1); + jcc(jg, param2) + + |CODE.opCASELR: + cmprc(rax, param1); + jcc(jl, param2); + jcc(jg, cmd.param3) + + |CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: + BinOp(reg1, reg2); + xchg(reg2, rcx); + Rex(reg1, 0); + OutByte(0D3H); + X86.shift(cmd.opcode, reg1 MOD 8); // shift reg1, cl + xchg(reg2, rcx); + drop + + |CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: + reg1 := REG.GetAnyReg(R); + movrc(reg1, param2); + BinOp(reg1, reg2); + xchg(reg1, rcx); + Rex(reg2, 0); + OutByte(0D3H); + X86.shift(cmd.opcode, reg2 MOD 8); // shift reg2, cl + xchg(reg1, rcx); + drop; + drop; + ASSERT(REG.GetReg(R, reg2)) + + |CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: + UnOp(reg1); + shiftrc(cmd.opcode, reg1, ORD(BITS(param2) * {0..5})) + + |CODE.opGET: + BinOp(reg1, reg2); + drop; + drop; + _movrm(reg1, reg1, 0, param2 * 8, FALSE); + _movrm(reg1, reg2, 0, param2 * 8, TRUE) + + |CODE.opCHKBYTE: + BinOp(reg1, reg2); + cmprc(reg1, 256); + jcc(jb, param1) + + |CODE.opCHKIDX: + UnOp(reg1); + cmprc(reg1, param2); + jcc(jb, param1) + + |CODE.opCHKIDX2: + BinOp(reg1, reg2); + IF param2 # -1 THEN + cmprr(reg2, reg1); + mov(reg1, reg2); + drop; + jcc(jb, param1) + ELSE + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 + END + + |CODE.opLENGTH: + PushAll(2); + CallRTL(CODE._length); + GetRegA + + |CODE.opLENGTHW: + PushAll(2); + CallRTL(CODE._lengthw); + GetRegA + + |CODE.opLEN: + n := param2; + UnOp(reg1); + drop; + EXCL(R.regs, reg1); + + WHILE n > 0 DO + UnOp(reg2); + drop; + DEC(n) + END; + + INCL(R.regs, reg1); + ASSERT(REG.GetReg(R, reg1)) + + |CODE.opCHR: + UnOp(reg1); + andrc(reg1, 255) + + |CODE.opWCHR: + UnOp(reg1); + andrc(reg1, 65535) + + |CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + + CASE cmd.opcode OF + |CODE.opEQP, CODE.opNEP: + lea(reg2, param1, sCODE) + + |CODE.opEQIP, CODE.opNEIP: + lea(reg2, param1, sIMP); + movrm(reg2, reg2, 0) + END; + + cmprr(reg1, reg2); + drop; + drop; + reg1 := REG.GetAnyReg(R); + + CASE cmd.opcode OF + |CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) + |CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) + END; + + andrc(reg1, 1) + + |CODE.opINC1B, CODE.opDEC1B: + UnOp(reg1); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte2(0FEH, 8 * ORD(cmd.opcode = CODE.opDEC1B) + reg1 MOD 8); // inc/dec byte[reg1] + drop + + |CODE.opINCCB, CODE.opDECCB: + UnOp(reg1); + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte3(80H, 28H * ORD(cmd.opcode = CODE.opDECCB) + reg1 MOD 8, param2 MOD 256); // add/sub byte[reg1], param2 MOD 256 + drop + + |CODE.opINCB, CODE.opDECB: + BinOp(reg1, reg2); + IF (reg1 >= 8) OR (reg2 >= 8) THEN + OutByte(40H + reg2 DIV 8 + 4 * (reg1 DIV 8)) + END; + OutByte2(28H * ORD(cmd.opcode = CODE.opDECB), reg2 MOD 8 + 8 * (reg1 MOD 8)); // add/sub byte[reg2], reg1_8 + drop; + drop + + |CODE.opSAVEIP: + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + lea(reg2, param2, sIMP); + movrm(reg2, reg2, 0); + push(reg2); + drop; + IF reg1 >= 8 THEN + OutByte(41H) + END; + OutByte2(8FH, reg1 MOD 8); // pop qword[reg1] + drop + + |CODE.opCLEANUP: + n := param2 * 8; + IF n # 0 THEN + addrc(rsp, n) + END + + |CODE.opPOPSP: + pop(rsp) + + |CODE.opLOADF: + UnOp(reg1); + INC(xmm); + movsdrm(xmm, reg1, 0); + drop + + |CODE.opPUSHF: + subrc(rsp, 8); + movsdmr(rsp, 0, xmm); + DEC(xmm) + + |CODE.opCONSTF: + float := cmd.float; + INC(xmm); + reg1 := REG.GetAnyReg(R); + lea(reg1, Numbers_Offs + Numbers_Count * 8, sDATA); + movsdrm(xmm, reg1, 0); + drop; + NewNumber(UTILS.splitf(float, a, b)) + + |CODE.opSAVEF: + UnOp(reg1); + movsdmr(reg1, 0, xmm); + DEC(xmm); + drop + + |CODE.opADDF, CODE.opADDFI: + opxx(58H, xmm - 1, xmm); + DEC(xmm) + + |CODE.opSUBF: + opxx(5CH, xmm - 1, xmm); + DEC(xmm) + + |CODE.opSUBFI: + opxx(5CH, xmm, xmm - 1); + opxx(10H, xmm - 1, xmm); + DEC(xmm) + + |CODE.opMULF: + opxx(59H, xmm - 1, xmm); + DEC(xmm) + + |CODE.opDIVF: + opxx(5EH, xmm - 1, xmm); + DEC(xmm) + + |CODE.opDIVFI: + opxx(5EH, xmm, xmm - 1); + opxx(10H, xmm - 1, xmm); + DEC(xmm) + + |CODE.opUMINF: + reg1 := REG.GetAnyReg(R); + lea(reg1, Numbers_Offs, sDATA); + OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // xorpd xmm, xmmword[reg1] + OutByte2(57H, reg1 MOD 8 + (xmm MOD 8) * 8); + drop + + |CODE.opFABS: + reg1 := REG.GetAnyReg(R); + lea(reg1, Numbers_Offs + 16, sDATA); + OutByte3(66H, 40H + reg1 DIV 8 + (xmm DIV 8) * 4, 0FH); // andpd xmm, xmmword[reg1] + OutByte2(54H, reg1 MOD 8 + (xmm MOD 8) * 8); + drop + + |CODE.opFLT: + UnOp(reg1); + INC(xmm); + OutByte(0F2H); Rex(reg1, xmm); OutByte(0FH); // cvtsi2sd xmm, reg1 + OutByte2(2AH, 0C0H + (xmm MOD 8) * 8 + reg1 MOD 8); + drop + + |CODE.opFLOOR: + reg1 := REG.GetAnyReg(R); + subrc(rsp, 8); + OutByte3(00FH, 0AEH, 05CH); OutByte2(024H, 004H); // stmxcsr dword[rsp+4]; + OutByte2(00FH, 0AEH); OutByte2(01CH, 024H); // stmxcsr dword[rsp]; + OutByte3(081H, 024H, 024H); OutByte2(0FFH, 09FH); OutByte2(0FFH, 0FFH); // and dword[rsp],11111111111111111001111111111111b; + OutByte3(081H, 00CH, 024H); OutByte2(000H, 020H); OutByte2(000H, 000H); // or dword[rsp],00000000000000000010000000000000b; + OutByte2(00FH, 0AEH); OutByte2(014H, 024H); // ldmxcsr dword[rsp]; + OutByte(0F2H); Rex(xmm, reg1); OutByte(0FH); // cvtsd2si reg1, xmm + OutByte2(2DH, 0C0H + xmm MOD 8 + (reg1 MOD 8) * 8); + OutByte3(00FH, 0AEH, 054H); OutByte2(024H, 004H); // ldmxcsr dword[rsp+4]; + addrc(rsp, 8); + DEC(xmm) + + |CODE.opEQF .. CODE.opGEFI: + fcmp(cmd.opcode, xmm); + DEC(xmm, 2) + + |CODE.opINF: + INC(xmm); + reg1 := REG.GetAnyReg(R); + lea(reg1, Numbers_Offs + 32, sDATA); + movsdrm(xmm, reg1, 0); + drop + + |CODE.opPACK, CODE.opPACKC: + IF cmd.opcode = CODE.opPACK THEN + BinOp(reg1, reg2) + ELSE + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + movrc(reg2, param2) + END; + push(reg1); + movrm(reg1, reg1, 0); + shiftrc(shl, reg1, 1); + shiftrc(shr, reg1, 53); + add(reg1, reg2); + andrc(reg1, ORD({0..10})); + shiftrc(shl, reg1, 52); + movrm(reg2, rsp, 0); + movrm(reg2, reg2, 0); + + push(reg1); + lea(reg1, Numbers_Offs + 40, sDATA); // {0..51, 63} + movrm(reg1, reg1, 0); + and(reg2, reg1); + pop(reg1); + + or(reg2, reg1); + pop(reg1); + movmr(reg1, 0, reg2); + drop; + drop + + |CODE.opUNPK, CODE.opLADR_UNPK: + + IF cmd.opcode = CODE.opLADR_UNPK THEN + n := param2 * 8; + UnOp(reg1); + reg2 := REG.GetVarReg(R, param2); + regVar := reg2 # -1; + IF ~regVar THEN + reg2 := REG.GetAnyReg(R); + Rex(0, reg2); + OutByte2(8DH, 45H + long(n) + (reg2 MOD 8) * 8); // lea reg2, qword[rbp+n] + OutIntByte(n) + END + ELSE + BinOp(reg1, reg2); + regVar := FALSE + END; + + push(reg1); + movrm(reg1, reg1, 0); + shiftrc(shl, reg1, 1); + shiftrc(shr, reg1, 53); + subrc(reg1, 1023); + + IF regVar THEN + mov(reg2, reg1); + reg2 := REG.GetAnyReg(R) + ELSE + movmr(reg2, 0, reg1) + END; + + pop(reg2); + movrm(reg1, reg2, 0); + + push(reg2); + lea(reg2, Numbers_Offs + 48, sDATA); // {52..61} + movrm(reg2, reg2, 0); + or(reg1, reg2); + pop(reg2); + + Rex(reg1, 0); + OutByte2(0FH, 0BAH); + OutByte2(0F0H + reg1 MOD 8, 3EH); // btr reg1, 62 + movmr(reg2, 0, reg1); + drop; + drop + + |CODE.opSADR_PARAM: + pushDA(stroffs + param2) + + |CODE.opVADR_PARAM: + pushm(rbp, param2 * 8) + + |CODE.opLOAD64_PARAM: + UnOp(reg1); + pushm(reg1, 0); + drop + + |CODE.opLLOAD64_PARAM: + reg1 := REG.GetVarReg(R, param2); + IF reg1 # -1 THEN + push(reg1) + ELSE + pushm(rbp, param2 * 8) + END + + |CODE.opGLOAD64_PARAM: + reg2 := REG.GetAnyReg(R); + lea(reg2, param2, sBSS); + movrm(reg2, reg2, 0); + push(reg2); + drop + + |CODE.opCONST_PARAM: + pushc(param2) + + |CODE.opGLOAD32_PARAM: + reg1 := REG.GetAnyReg(R); + xor(reg1, reg1); + lea(reg1, param2, sBSS); + movrm32(reg1, reg1, 0); + push(reg1); + drop + + |CODE.opLOAD32_PARAM: + UnOp(reg1); + movrm32(reg1, reg1, 0); + shiftrc(shl, reg1, 32); + shiftrc(shr, reg1, 32); + push(reg1); + drop + + |CODE.opLLOAD32_PARAM: + reg1 := REG.GetAnyReg(R); + xor(reg1, reg1); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + mov(reg1, reg2) + ELSE + movrm32(reg1, rbp, param2 * 8) + END; + push(reg1); + drop + + |CODE.opLADR_SAVEC: + n := param1 * 8; + reg1 := REG.GetVarReg(R, param1); + IF reg1 # -1 THEN + movrc(reg1, param2) + ELSE + IF isLong(param2) THEN + reg2 := REG.GetAnyReg(R); + movrc(reg2, param2); + movmr(rbp, n, reg2); + drop + ELSE + OutByte3(48H, 0C7H, 45H + long(n)); // mov qword[rbp+n],param2 + OutIntByte(n); + OutInt(param2) + END + END + + |CODE.opGADR_SAVEC: + IF isLong(param2) THEN + reg1 := REG.GetAnyReg(R); + movrc(reg1, param2); + reg2 := REG.GetAnyReg(R); + lea(reg2, param1, sBSS); + movmr(reg2, 0, reg1); + drop; + drop + ELSE + reg2 := REG.GetAnyReg(R); + lea(reg2, param1, sBSS); + Rex(reg2, 0); + OutByte2(0C7H, reg2 MOD 8); // mov qword[reg2], param2 + OutInt(param2); + drop + END + + |CODE.opLADR_SAVE: + UnOp(reg1); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + mov(reg2, reg1) + ELSE + movmr(rbp, param2 * 8, reg1) + END; + drop + + |CODE.opLADR_INC1: + reg1 := REG.GetVarReg(R, param2); + IF reg1 # -1 THEN + incr(reg1) + ELSE + n := param2 * 8; + OutByte3(48H, 0FFH, 45H + long(n)); // inc qword[rbp+n] + OutIntByte(n) + END + + |CODE.opLADR_DEC1: + reg1 := REG.GetVarReg(R, param2); + IF reg1 # -1 THEN + decr(reg1) + ELSE + n := param2 * 8; + OutByte3(48H, 0FFH, 4DH + long(n)); // dec qword[rbp+n] + OutIntByte(n) + END + + |CODE.opLADR_INCC, CODE.opLADR_DECC: + reg1 := REG.GetVarReg(R, param1); + IF isLong(param2) THEN + reg2 := REG.GetAnyReg(R); + movrc(reg2, param2); + IF reg1 # -1 THEN + IF cmd.opcode = CODE.opLADR_DECC THEN + sub(reg1, reg2) + ELSE + add(reg1, reg2) + END + ELSE + n := param1 * 8; + Rex(0, reg2); + OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DECC), 45H + long(n) + (reg2 MOD 8) * 8); + OutIntByte(n) // add/sub qword[rbp+n],reg2 + END; + drop + ELSE + IF reg1 # -1 THEN + IF cmd.opcode = CODE.opLADR_DECC THEN + subrc(reg1, param2) + ELSE + addrc(reg1, param2) + END + ELSE + n := param1 * 8; + OutByte3(48H, 81H + short(param2), 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECC)); + OutIntByte(n); + OutIntByte(param2) // add/sub qword[rbp+n],param2 + END + END + + |CODE.opLADR_INC1B, CODE.opLADR_DEC1B: + reg1 := REG.GetVarReg(R, param2); + IF reg1 # -1 THEN + IF cmd.opcode = CODE.opLADR_DEC1B THEN + decr(reg1) + ELSE + incr(reg1) + END; + andrc(reg1, 255) + ELSE + n := param2 * 8; + OutByte2(0FEH, 45H + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_DEC1B)); + OutIntByte(n) // inc/dec byte[rbp+n] + END + + |CODE.opLADR_INCCB, CODE.opLADR_DECCB: + reg1 := REG.GetVarReg(R, param1); + param2 := param2 MOD 256; + IF reg1 # -1 THEN + IF cmd.opcode = CODE.opLADR_DECCB THEN + subrc(reg1, param2) + ELSE + addrc(reg1, param2) + END; + andrc(reg1, 255) + ELSE + n := param1 * 8; + OutByte2(80H, 45H + long(n) + 28H * ORD(cmd.opcode = CODE.opLADR_DECCB)); + OutIntByte(n); + OutByte(param2) // add/sub byte[rbp+n],param2 + END + + |CODE.opLADR_INC, CODE.opLADR_DEC: + UnOp(reg1); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + IF cmd.opcode = CODE.opLADR_DEC THEN + sub(reg2, reg1) + ELSE + add(reg2, reg1) + END + ELSE + n := param2 * 8; + Rex(0, reg1); + OutByte2(01H + 28H * ORD(cmd.opcode = CODE.opLADR_DEC), 45H + long(n) + (reg1 MOD 8) * 8); + OutIntByte(n) // add/sub qword[rbp+n],reg1 + END; + drop + + |CODE.opLADR_INCB, CODE.opLADR_DECB: + UnOp(reg1); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + IF cmd.opcode = CODE.opLADR_DECB THEN + sub(reg2, reg1) + ELSE + add(reg2, reg1) + END; + andrc(reg2, 255) + ELSE + n := param2 * 8; + IF reg1 >= 8 THEN + OutByte(44H) + END; + OutByte2(28H * ORD(cmd.opcode = CODE.opLADR_DECB), 45H + long(n) + 8 * (reg1 MOD 8)); + OutIntByte(n) // add/sub byte[rbp+n], reg1_8 + END; + drop + + |CODE.opLADR_INCL, CODE.opLADR_EXCL: + UnOp(reg1); + cmprc(reg1, 64); + reg2 := REG.GetVarReg(R, param2); + IF reg2 # -1 THEN + OutByte2(73H, 4); // jnb L + oprr2(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), reg2, reg1) // bts/btr reg2, reg1 + ELSE + n := param2 * 8; + OutByte2(73H, 5 + 3 * ORD(~isByte(n))); // jnb L + Rex(0, reg1); + OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + 8 * (reg1 MOD 8)); + OutIntByte(n) // bts/btr qword[rbp+n], reg1 + END; + // L: + drop + + |CODE.opLADR_INCLC, CODE.opLADR_EXCLC: + reg1 := REG.GetVarReg(R, param1); + IF reg1 # -1 THEN + Rex(reg1, 0); + OutByte3(0FH, 0BAH, 0E8H); // bts/btr reg1, param2 + OutByte2(reg1 MOD 8 + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC), param2) + ELSE + n := param1 * 8; + OutByte3(48H, 0FH, 0BAH); // bts/btr qword[rbp+n], param2 + OutByte(6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); + OutIntByte(n); + OutByte(param2) + END + + |CODE.opLOOP, CODE.opENDLOOP: + + END; + + cmd := cmd.next(COMMAND) + END; + + ASSERT(R.pushed = 0); + ASSERT(R.top = -1); + ASSERT(xmm = -1) +END translate; + + +PROCEDURE prolog (code: CODE.CODES; modname: ARRAY OF CHAR; target, stack_size: INTEGER); +VAR + ModName_Offs, entry: INTEGER; + +BEGIN + ModName_Offs := CHL.Length(code.types) * 8 + CHL.Length(code.data); + Numbers_Offs := ModName_Offs + LENGTH(modname) + 1; + ASSERT(MACHINE.Align(Numbers_Offs, 16)); + + entry := NewLabel(); + X86.SetLabel(entry); + + IF target = mConst.Target_iDLL64 THEN + dllret := NewLabel(); + push(r8); + push(rdx); + push(rcx); + CallRTL(CODE._dllentry); + test(rax); + jcc(je, dllret) + END; + + push(rsp); + lea(rax, entry, sCODE); + push(rax); + pushDA(0); //TYPES + pushc(CHL.Length(code.types)); + pushDA(ModName_Offs); //MODNAME + CallRTL(CODE._init) +END prolog; + + +PROCEDURE epilog (code: CODE.CODES; modname: ARRAY OF CHAR; target: INTEGER); +VAR + i, n: INTEGER; + number: Number; + exp: CODE.EXPORT_PROC; + + + PROCEDURE import (imp: LISTS.LIST); + VAR + lib: CODE.IMPORT_LIB; + proc: CODE.IMPORT_PROC; + + BEGIN + + lib := imp.first(CODE.IMPORT_LIB); + WHILE lib # NIL DO + BIN.Import(prog, lib.name, 0); + proc := lib.procs.first(CODE.IMPORT_PROC); + WHILE proc # NIL DO + BIN.Import(prog, proc.name, proc.label); + proc := proc.next(CODE.IMPORT_PROC) + END; + lib := lib.next(CODE.IMPORT_LIB) + END + + END import; + + +BEGIN + IF target = mConst.Target_iDLL64 THEN + X86.SetLabel(dllret); + OutByte(0C3H) // ret + ELSE + pushc(0); + CallRTL(CODE._exit) + END; + + X86.fixup; + + i := 0; + WHILE i < CHL.Length(code.types) DO + BIN.PutData64LE(prog, CHL.GetInt(code.types, i)); + INC(i) + END; + + i := 0; + WHILE i < CHL.Length(code.data) DO + BIN.PutData(prog, CHL.GetByte(code.data, i)); + INC(i) + END; + + BIN.PutDataStr(prog, modname); + BIN.PutData(prog, 0); + n := CHL.Length(prog.data); + ASSERT(MACHINE.Align(n, 16)); + i := n - CHL.Length(prog.data); + WHILE i > 0 DO + BIN.PutData(prog, 0); + DEC(i) + END; + number := Numbers.first(Number); + FOR i := 0 TO Numbers_Count - 1 DO + BIN.PutData64LE(prog, number.value); + number := number.next(Number) + END; + + exp := code.export.first(CODE.EXPORT_PROC); + WHILE exp # NIL DO + BIN.Export(prog, exp.name, exp.label); + exp := exp.next(CODE.EXPORT_PROC) + END; + + import(code.import) +END epilog; + + +PROCEDURE rload (reg, offs, size: INTEGER); +BEGIN + offs := offs * 8; + CASE size OF + |1: movzx(reg, rbp, offs, FALSE) + |2: movzx(reg, rbp, offs, TRUE) + |4: xor(reg, reg); movrm32(reg, rbp, offs) + |8: movrm(reg, rbp, offs) + END +END rload; + + +PROCEDURE rsave (reg, offs, size: INTEGER); +BEGIN + offs := offs * 8; + CASE size OF + |1: movmr8(rbp, offs, reg) + |2: movmr16(rbp, offs, reg) + |4: movmr32(rbp, offs, reg) + |8: movmr(rbp, offs, reg) + END +END rsave; + + +PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base: INTEGER); +VAR + path, modname, ext: PATHS.PATH; + n: INTEGER; + +BEGIN + Win64RegPar[0] := rcx; + Win64RegPar[1] := rdx; + Win64RegPar[2] := r8; + Win64RegPar[3] := r9; + + SystemVRegPar[0] := rdi; + SystemVRegPar[1] := rsi; + SystemVRegPar[2] := rdx; + SystemVRegPar[3] := rcx; + SystemVRegPar[4] := r8; + SystemVRegPar[5] := r9; + + PATHS.split(outname, path, modname, ext); + S.append(modname, ext); + + R := REG.Create(push, pop, mov, xchg, rload, rsave, {rax, r10, r11}, {rcx, rdx, r8, r9}); + + n := code.dmin - CHL.Length(code.data); + IF n > 0 THEN + INC(code.bss, n) + END; + code.bss := MAX(code.bss, 8); + + Numbers := LISTS.create(NIL); + Numbers_Count := 0; + NewNumber(ROR(1, 1)); (* 8000000000000000H *) + NewNumber(0); + NewNumber(ROR(-2, 1)); (* 7FFFFFFFFFFFFFFFH *) + NewNumber(-1); + NewNumber(ROR(7FFH, 12)); (* +Infinity *) + NewNumber(ORD(-BITS(LSR(ASR(ROR(1, 1), 10), 1)))); (* {0..51, 63} *) + NewNumber(LSR(ASR(ROR(1, 1), 9), 2)); (* {52..61} *) + + prog := BIN.create(code.lcount); + BIN.SetParams(prog, code.bss, stack, WCHR(1), WCHR(0)); + + X86.SetProgram(prog); + + prolog(code, modname, target, stack); + translate(code.commands, CHL.Length(code.types) * 8); + epilog(code, modname, target); + + BIN.fixup(prog); + IF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN + PE32.write(prog, outname, base, target = mConst.Target_iConsole64, target = mConst.Target_iDLL64, TRUE) + ELSIF target = mConst.Target_iELF64 THEN + ELF.write(prog, outname, TRUE) + END +END CodeGen; + + +END AMD64. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ARITH.ob07 b/programs/develop/oberon07/Source/ARITH.ob07 new file mode 100644 index 0000000000..3ee0ab9a6e --- /dev/null +++ b/programs/develop/oberon07/Source/ARITH.ob07 @@ -0,0 +1,861 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE ARITH; + +IMPORT AVLTREES, STRINGS, MACHINE, UTILS; + + +CONST + + tINTEGER* = 1; tREAL* = 2; tSET* = 3; + tBOOLEAN* = 4; tCHAR* = 5; tWCHAR* = 6; + tSTRING* = 7; + + +TYPE + + RELATION* = ARRAY 3 OF CHAR; + + VALUE* = RECORD + + typ*: INTEGER; + + int: INTEGER; + float: REAL; + set: SET; + bool: BOOLEAN; + + string*: AVLTREES.DATA + + END; + + +VAR + + digit: ARRAY 256 OF INTEGER; + + +PROCEDURE Int* (v: VALUE): INTEGER; +VAR + res: INTEGER; + +BEGIN + + IF v.typ = tINTEGER THEN + res := v.int + ELSIF v.typ = tCHAR THEN + res := v.int + ELSIF v.typ = tWCHAR THEN + res := v.int + ELSIF v.typ = tSET THEN + res := ORD(v.set); + IF MACHINE._64to32 THEN + res := MACHINE.Int32To64(res) + END + ELSIF v.typ = tBOOLEAN THEN + res := ORD(v.bool) + END + + RETURN res +END Int; + + +PROCEDURE getBool* (v: VALUE): BOOLEAN; +BEGIN + ASSERT(v.typ = tBOOLEAN); + + RETURN v.bool +END getBool; + + +PROCEDURE Float* (v: VALUE): REAL; +BEGIN + ASSERT(v.typ = tREAL); + + RETURN v.float +END Float; + + +PROCEDURE check* (v: VALUE): BOOLEAN; +VAR + error: BOOLEAN; + +BEGIN + error := FALSE; + + IF (v.typ = tINTEGER) & ((v.int < MACHINE.target.minInt) OR (v.int > MACHINE.target.maxInt)) THEN + error := TRUE + ELSIF (v.typ = tCHAR) & ((v.int < 0) OR (v.int > 255)) THEN + error := TRUE + ELSIF (v.typ = tWCHAR) & ((v.int < 0) OR (v.int > 65535)) THEN + error := TRUE + ELSIF (v.typ = tREAL) & ((v.float < -MACHINE.target.maxReal) OR (v.float > MACHINE.target.maxReal)) THEN + error := TRUE + END + + RETURN ~error +END check; + + +PROCEDURE isZero* (v: VALUE): BOOLEAN; +VAR + res: BOOLEAN; +BEGIN + ASSERT(v.typ IN {tINTEGER, tREAL}); + + IF v.typ = tINTEGER THEN + res := v.int = 0 + ELSIF v.typ = tREAL THEN + res := v.float = 0.0 + END + + RETURN res +END isZero; + + +PROCEDURE iconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER); +VAR + value: INTEGER; + i: INTEGER; + d: INTEGER; + +BEGIN + error := 0; + value := 0; + + i := 0; + WHILE STRINGS.digit(s[i]) & (error = 0) DO + d := digit[ORD(s[i])]; + IF value <= (UTILS.maxint - d) DIV 10 THEN + value := value * 10 + d; + INC(i) + ELSE + error := 1 + END + END; + + IF error = 0 THEN + v.int := value; + v.typ := tINTEGER; + IF ~check(v) THEN + error := 1 + END + END + +END iconv; + + +PROCEDURE hconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER); +VAR + value: INTEGER; + i: INTEGER; + n: INTEGER; + d: INTEGER; + +BEGIN + ASSERT(STRINGS.digit(s[0])); + + error := 0; + value := 0; + + n := -1; + i := 0; + WHILE (s[i] # "H") & (s[i] # "X") & (error = 0) DO + + d := digit[ORD(s[i])]; + IF (n = -1) & (d # 0) THEN + n := i + END; + + IF (n # -1) & (i - n + 1 > MACHINE.target.maxHex) THEN + error := 2 + ELSE + value := value * 16 + d; + INC(i) + END + + END; + + IF MACHINE._64to32 THEN + value := MACHINE.Int32To64(value); + END; + + IF (s[i] = "X") & (n # -1) & (i - n > 4) THEN + error := 3 + END; + + IF error = 0 THEN + v.int := value; + IF s[i] = "X" THEN + v.typ := tCHAR; + IF ~check(v) THEN + v.typ := tWCHAR; + IF ~check(v) THEN + error := 3 + END + END + ELSE + v.typ := tINTEGER; + IF ~check(v) THEN + error := 2 + END + END + END + +END hconv; + + +PROCEDURE opFloat2 (VAR a: REAL; b: REAL; op: CHAR): BOOLEAN; +VAR + max: REAL; + res: BOOLEAN; + +BEGIN + max := UTILS.maxreal; + + CASE op OF + |"+": + IF (a < 0.0) & (b < 0.0) THEN + res := a > -max - b + ELSIF (a > 0.0) & (b > 0.0) THEN + res := a < max - b + ELSE + res := TRUE + END; + IF res THEN + a := a + b + END + + |"-": + IF (a < 0.0) & (b > 0.0) THEN + res := a > b - max + ELSIF (a > 0.0) & (b < 0.0) THEN + res := a < b + max + ELSE + res := TRUE + END; + IF res THEN + a := a - b + END + + |"*": + IF (ABS(a) > 1.0) & (ABS(b) > 1.0) THEN + res := ABS(a) < max / ABS(b) + ELSE + res := TRUE + END; + IF res THEN + a := a * b + END + + |"/": + IF ABS(b) < 1.0 THEN + res := ABS(a) < max * ABS(b) + ELSE + res := TRUE + END; + IF res THEN + a := a / b + END + + END + + RETURN res +END opFloat2; + + +PROCEDURE fconv* (s: ARRAY OF CHAR; VAR v: VALUE; VAR error: INTEGER); +VAR + value: REAL; + exp10: REAL; + i, n, d: INTEGER; + minus: BOOLEAN; + +BEGIN + error := 0; + value := 0.0; + exp10 := 10.0; + minus := FALSE; + n := 0; + + i := 0; + WHILE (error = 0) & STRINGS.digit(s[i]) DO + IF opFloat2(value, 10.0, "*") & opFloat2(value, FLT(digit[ORD(s[i])]), "+") THEN + INC(i) + ELSE + error := 4 + END + END; + + INC(i); + + WHILE (error = 0) & STRINGS.digit(s[i]) DO + IF opFloat2(value, FLT(digit[ORD(s[i])]) / exp10, "+") & opFloat2(exp10, 10.0, "*") THEN + INC(i) + ELSE + error := 4 + END + END; + + IF s[i] = "E" THEN + INC(i) + END; + + IF (s[i] = "-") OR (s[i] = "+") THEN + minus := s[i] = "-"; + INC(i) + END; + + WHILE (error = 0) & STRINGS.digit(s[i]) DO + d := digit[ORD(s[i])]; + IF n <= (UTILS.maxint - d) DIV 10 THEN + n := n * 10 + d; + INC(i) + ELSE + error := 5 + END + END; + + exp10 := 1.0; + WHILE (error = 0) & (n > 0) DO + IF opFloat2(exp10, 10.0, "*") THEN + DEC(n) + ELSE + error := 4 + END + END; + + IF error = 0 THEN + IF minus THEN + IF ~opFloat2(value, exp10, "/") THEN + error := 4 + END + ELSE + IF ~opFloat2(value, exp10, "*") THEN + error := 4 + END + END + END; + + IF error = 0 THEN + v.float := value; + v.typ := tREAL; + IF ~check(v) THEN + error := 4 + END + END + +END fconv; + + +PROCEDURE setChar* (VAR v: VALUE; ord: INTEGER); +BEGIN + v.typ := tCHAR; + v.int := ord +END setChar; + + +PROCEDURE setWChar* (VAR v: VALUE; ord: INTEGER); +BEGIN + v.typ := tWCHAR; + v.int := ord +END setWChar; + + +PROCEDURE addInt (VAR a: INTEGER; b: INTEGER): BOOLEAN; +VAR + error: BOOLEAN; + +BEGIN + IF (a > 0) & (b > 0) THEN + error := a > UTILS.maxint - b + ELSIF (a < 0) & (b < 0) THEN + error := a < UTILS.minint - b + ELSE + error := FALSE + END; + + IF ~error THEN + a := a + b + ELSE + a := 0 + END + + RETURN ~error +END addInt; + + +PROCEDURE subInt (VAR a: INTEGER; b: INTEGER): BOOLEAN; +VAR + error: BOOLEAN; + +BEGIN + IF (a > 0) & (b < 0) THEN + error := a > UTILS.maxint + b + ELSIF (a < 0) & (b > 0) THEN + error := a < UTILS.minint + b + ELSIF (a = 0) & (b < 0) THEN + error := b = UTILS.minint + ELSE + error := FALSE + END; + + IF ~error THEN + a := a - b + ELSE + a := 0 + END + + RETURN ~error +END subInt; + + +PROCEDURE lg2 (x: INTEGER): INTEGER; +VAR + n: INTEGER; + +BEGIN + ASSERT(x > 0); + + n := 0; + WHILE ~ODD(x) DO + x := x DIV 2; + INC(n) + END; + + IF x # 1 THEN + n := 255 + END + + RETURN n +END lg2; + + +PROCEDURE mulInt* (VAR a: INTEGER; b: INTEGER): BOOLEAN; +VAR + error: BOOLEAN; + min, max: INTEGER; + +BEGIN + min := UTILS.minint; + max := UTILS.maxint; + + IF ((a > 1) & (b > 1)) OR ((a < 0) & (b < 0)) THEN + error := (a = min) OR (b = min) OR (ABS(a) > max DIV ABS(b)) + + ELSIF ((a > 1) & (b < 0)) OR ((a < 0) & (b > 1)) THEN + error := (a = min) OR (b = min); + IF ~error THEN + IF lg2(ABS(a)) + lg2(ABS(b)) >= UTILS.bit_depth THEN + error := ABS(a) > max DIV ABS(b) + END + END + + ELSE + error := FALSE + END; + + IF ~error THEN + a := a * b + ELSE + a := 0 + END + + RETURN ~error +END mulInt; + + +PROCEDURE _ASR (x, n: INTEGER): INTEGER; +BEGIN + IF MACHINE._64to32 THEN + x := MACHINE.Int32To64(x) + END + + RETURN ASR(x, n) +END _ASR; + + +PROCEDURE _LSR (x, n: INTEGER): INTEGER; +BEGIN + IF MACHINE._64to32 THEN + x := MACHINE.Int64To32(x); + x := LSR(x, n); + x := MACHINE.Int32To64(x) + ELSE + x := LSR(x, n) + END + + RETURN x +END _LSR; + + +PROCEDURE _LSL (x, n: INTEGER): INTEGER; +BEGIN + x := LSL(x, n); + IF MACHINE._64to32 THEN + x := MACHINE.Int32To64(x) + END + + RETURN x +END _LSL; + + +PROCEDURE _ROR1_32 (x: INTEGER): INTEGER; +BEGIN + x := MACHINE.Int64To32(x); + x := ORD(BITS(LSR(x, 1)) + BITS(LSL(x, 31))) + RETURN MACHINE.Int32To64(x) +END _ROR1_32; + + +PROCEDURE _ROR (x, n: INTEGER): INTEGER; +BEGIN + IF MACHINE._64to32 THEN + n := n MOD 32; + WHILE n > 0 DO + x := _ROR1_32(x); + DEC(n) + END + ELSE + x := ROR(x, n) + END + + RETURN x +END _ROR; + + +PROCEDURE opInt* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN; +VAR + success: BOOLEAN; + +BEGIN + success := TRUE; + + CASE op OF + |"+": success := addInt(a.int, b.int) + |"-": success := subInt(a.int, b.int) + |"*": success := mulInt(a.int, b.int) + |"/": success := FALSE + |"D": IF (b.int # -1) OR (a.int # UTILS.minint) THEN a.int := a.int DIV b.int ELSE success := FALSE END + |"M": a.int := a.int MOD b.int + |"L": a.int := _LSL(a.int, b.int) + |"A": a.int := _ASR(a.int, b.int) + |"O": a.int := _ROR(a.int, b.int) + |"R": a.int := _LSR(a.int, b.int) + |"m": a.int := MIN(a.int, b.int) + |"x": a.int := MAX(a.int, b.int) + END; + a.typ := tINTEGER + + RETURN success & check(a) +END opInt; + + +PROCEDURE charToStr* (c: VALUE; VAR s: ARRAY OF CHAR); +BEGIN + s[0] := CHR(c.int); + s[1] := 0X +END charToStr; + + +PROCEDURE opSet* (VAR a: VALUE; b: VALUE; op: CHAR); +BEGIN + CASE op OF + |"+": a.set := a.set + b.set + |"-": a.set := a.set - b.set + |"*": a.set := a.set * b.set + |"/": a.set := a.set / b.set + END; + a.typ := tSET +END opSet; + + +PROCEDURE opFloat* (VAR a: VALUE; b: VALUE; op: CHAR): BOOLEAN; +BEGIN + a.typ := tREAL + RETURN opFloat2(a.float, b.float, op) & check(a) +END opFloat; + + +PROCEDURE ord* (VAR v: VALUE); +BEGIN + CASE v.typ OF + |tCHAR, tWCHAR: + |tBOOLEAN: v.int := ORD(v.bool) + |tSET: + v.int := ORD(v.set); + IF MACHINE._64to32 THEN + v.int := MACHINE.Int32To64(v.int) + END + END; + v.typ := tINTEGER +END ord; + + +PROCEDURE odd* (VAR v: VALUE); +BEGIN + v.typ := tBOOLEAN; + v.bool := ODD(v.int) +END odd; + + +PROCEDURE bits* (VAR v: VALUE); +BEGIN + v.typ := tSET; + v.set := BITS(v.int) +END bits; + + +PROCEDURE abs* (VAR v: VALUE): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := FALSE; + + CASE v.typ OF + |tREAL: + v.float := ABS(v.float); + res := TRUE + |tINTEGER: + IF v.int # UTILS.minint THEN + v.int := ABS(v.int); + res := TRUE + END + END + + RETURN res +END abs; + + +PROCEDURE floor* (VAR v: VALUE): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + v.typ := tINTEGER; + res := (FLT(UTILS.minint) <= v.float) & (v.float <= FLT(UTILS.maxint)); + IF res THEN + v.int := FLOOR(v.float) + END + + RETURN res +END floor; + + +PROCEDURE flt* (VAR v: VALUE); +BEGIN + v.typ := tREAL; + v.float := FLT(v.int) +END flt; + + +PROCEDURE neg* (VAR v: VALUE): BOOLEAN; +VAR + z: VALUE; + res: BOOLEAN; + +BEGIN + res := TRUE; + + z.typ := tINTEGER; + z.int := 0; + + CASE v.typ OF + |tREAL: v.float := -v.float + |tSET: v.set := -v.set + |tINTEGER: res := opInt(z, v, "-"); v := z + |tBOOLEAN: v.bool := ~v.bool + END + + RETURN res +END neg; + + +PROCEDURE setbool* (VAR v: VALUE; b: BOOLEAN); +BEGIN + v.bool := b; + v.typ := tBOOLEAN +END setbool; + + +PROCEDURE opBoolean* (VAR a: VALUE; b: VALUE; op: CHAR); +BEGIN + CASE op OF + |"&": a.bool := a.bool & b.bool + |"|": a.bool := a.bool OR b.bool + END; + a.typ := tBOOLEAN +END opBoolean; + + +PROCEDURE range* (i: VALUE; a, b: INTEGER): BOOLEAN; + RETURN (a <= i.int) & (i.int <= b) +END range; + + +PROCEDURE less (v, v2: VALUE; VAR error: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := FALSE; + + IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN + CASE v.typ OF + |tINTEGER, + tWCHAR, + tCHAR: res := v.int < v2.int + |tREAL: res := v.float < v2.float + |tBOOLEAN, + tSET: error := 1 + END + ELSE + error := 1 + END + + RETURN res +END less; + + +PROCEDURE equal (v, v2: VALUE; VAR error: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := FALSE; + + IF (v.typ = v2.typ) OR (v.typ IN {tCHAR, tWCHAR}) & (v2.typ IN {tCHAR, tWCHAR}) THEN + CASE v.typ OF + |tINTEGER, + tWCHAR, + tCHAR: res := v.int = v2.int + |tREAL: res := v.float = v2.float + |tBOOLEAN: res := v.bool = v2.bool + |tSET: res := v.set = v2.set + END + ELSE + error := 1 + END + + RETURN res +END equal; + + +PROCEDURE relation* (VAR v: VALUE; v2: VALUE; operator: RELATION; VAR error: INTEGER); +VAR + res: BOOLEAN; + +BEGIN + error := 0; + + res := FALSE; + + CASE operator[0] OF + + |"=": + res := equal(v, v2, error) + + |"#": + res := ~equal(v, v2, error) + + |"<": + IF operator[1] = "=" THEN + res := less(v, v2, error); + IF error = 0 THEN + res := equal(v, v2, error) OR res + END + ELSE + res := less(v, v2, error) + END + + |">": + IF operator[1] = "=" THEN + res := ~less(v, v2, error) + ELSE + res := less(v, v2, error); + IF error = 0 THEN + res := equal(v, v2, error) OR res + END; + res := ~res + END + + |"I": + IF (v.typ = tINTEGER) & (v2.typ = tSET) THEN + IF range(v, 0, MACHINE.target.maxSet) THEN + res := v.int IN v2.set + ELSE + error := 2 + END + ELSE + error := 1 + END + + END; + + IF error = 0 THEN + v.bool := res; + v.typ := tBOOLEAN + END + +END relation; + + +PROCEDURE emptySet* (VAR v: VALUE); +BEGIN + v.typ := tSET; + v.set := {} +END emptySet; + + +PROCEDURE constrSet* (VAR v: VALUE; a, b: VALUE); +BEGIN + v.typ := tSET; + v.set := {a.int .. b.int} +END constrSet; + + +PROCEDURE getInt* (v: VALUE): INTEGER; +BEGIN + ASSERT(check(v)) + + RETURN v.int +END getInt; + + +PROCEDURE setInt* (VAR v: VALUE; i: INTEGER): BOOLEAN; +BEGIN + v.int := i; + v.typ := tINTEGER + + RETURN check(v) +END setInt; + + +PROCEDURE init; +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO LEN(digit) - 1 DO + digit[i] := -1 + END; + + FOR i := ORD("0") TO ORD("9") DO + digit[i] := i - ORD("0") + END; + + FOR i := ORD("A") TO ORD("F") DO + digit[i] := i - ORD("A") + 10 + END +END init; + + +BEGIN + init +END ARITH. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/AVLTREES.ob07 b/programs/develop/oberon07/Source/AVLTREES.ob07 new file mode 100644 index 0000000000..2fe539173a --- /dev/null +++ b/programs/develop/oberon07/Source/AVLTREES.ob07 @@ -0,0 +1,197 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE AVLTREES; + +IMPORT C := COLLECTIONS; + + +TYPE + + DATA* = POINTER TO RECORD (C.ITEM) END; + + NODE* = POINTER TO RECORD (C.ITEM) + + data*: DATA; + + height: INTEGER; + + left*, right*: NODE + + END; + + CMP* = PROCEDURE (a, b: DATA): INTEGER; + + DESTRUCTOR* = PROCEDURE (VAR data: DATA); + + +VAR + + nodes: C.COLLECTION; + + +PROCEDURE NewNode (data: DATA): NODE; +VAR + node: NODE; + citem: C.ITEM; + +BEGIN + citem := C.pop(nodes); + IF citem = NIL THEN + NEW(node) + ELSE + node := citem(NODE) + END; + + node.data := data; + node.left := NIL; + node.right := NIL; + node.height := 1 + + RETURN node +END NewNode; + + +PROCEDURE height (p: NODE): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF p = NIL THEN + res := 0 + ELSE + res := p.height + END + + RETURN res +END height; + + +PROCEDURE bfactor (p: NODE): INTEGER; + RETURN height(p.right) - height(p.left) +END bfactor; + + +PROCEDURE fixheight (p: NODE); +BEGIN + p.height := MAX(height(p.left), height(p.right)) + 1 +END fixheight; + + +PROCEDURE rotateright (p: NODE): NODE; +VAR + q: NODE; + +BEGIN + q := p.left; + p.left := q.right; + q.right := p; + fixheight(p); + fixheight(q) + + RETURN q +END rotateright; + + +PROCEDURE rotateleft (q: NODE): NODE; +VAR + p: NODE; + +BEGIN + p := q.right; + q.right := p.left; + p.left := q; + fixheight(q); + fixheight(p) + + RETURN p +END rotateleft; + + +PROCEDURE balance (p: NODE): NODE; +VAR + res: NODE; + +BEGIN + fixheight(p); + + IF bfactor(p) = 2 THEN + IF bfactor(p.right) < 0 THEN + p.right := rotateright(p.right) + END; + res := rotateleft(p) + + ELSIF bfactor(p) = -2 THEN + IF bfactor(p.left) > 0 THEN + p.left := rotateleft(p.left) + END; + res := rotateright(p) + + ELSE + res := p + END + + RETURN res +END balance; + + +PROCEDURE insert* (p: NODE; data: DATA; cmp: CMP; VAR newnode: BOOLEAN; VAR node: NODE): NODE; +VAR + res: NODE; + rescmp: INTEGER; + +BEGIN + IF p = NIL THEN + res := NewNode(data); + node := res; + newnode := TRUE + ELSE + + rescmp := cmp(data, p.data); + IF rescmp < 0 THEN + p.left := insert(p.left, data, cmp, newnode, node); + res := balance(p) + ELSIF rescmp > 0 THEN + p.right := insert(p.right, data, cmp, newnode, node); + res := balance(p) + ELSE + res := p; + node := res; + newnode := FALSE + END + + END + + RETURN res +END insert; + + +PROCEDURE destroy* (VAR node: NODE; destructor: DESTRUCTOR); +VAR + left, right: NODE; + +BEGIN + IF node # NIL THEN + left := node.left; + right := node.right; + + IF destructor # NIL THEN + destructor(node.data) + END; + + C.push(nodes, node); + node := NIL; + + destroy(left, destructor); + destroy(right, destructor) + END +END destroy; + + +BEGIN + nodes := C.create() +END AVLTREES. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/BIN.ob07 b/programs/develop/oberon07/Source/BIN.ob07 new file mode 100644 index 0000000000..faba2e6fc2 --- /dev/null +++ b/programs/develop/oberon07/Source/BIN.ob07 @@ -0,0 +1,396 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE BIN; + +IMPORT LISTS, MACHINE, CHL := CHUNKLISTS, ARITH, UTILS; + + +CONST + + RCODE* = 1; + RDATA* = 2; + RBSS* = 3; + RIMP* = 4; + + PICCODE* = 5; + PICDATA* = 6; + PICBSS* = 7; + PICIMP* = 8; + + IMPTAB* = 9; + + +TYPE + + RELOC* = POINTER TO RECORD (LISTS.ITEM) + + opcode*: INTEGER; + offset*: INTEGER + + END; + + IMPRT* = POINTER TO RECORD (LISTS.ITEM) + + nameoffs*: INTEGER; + label*: INTEGER; + + OriginalFirstThunk*, + FirstThunk*: INTEGER + + END; + + EXPRT* = POINTER TO RECORD (LISTS.ITEM) + + nameoffs*: INTEGER; + label*: INTEGER + + END; + + PROGRAM* = POINTER TO RECORD + + code*: CHL.BYTELIST; + data*: CHL.BYTELIST; + labels: CHL.INTLIST; + bss*: INTEGER; + stack*: INTEGER; + vmajor*, + vminor*: WCHAR; + modname*: INTEGER; + import*: CHL.BYTELIST; + export*: CHL.BYTELIST; + rel_list*: LISTS.LIST; + imp_list*: LISTS.LIST; + exp_list*: LISTS.LIST + + END; + + +PROCEDURE create* (NumberOfLabels: INTEGER): PROGRAM; +VAR + program: PROGRAM; + i: INTEGER; + +BEGIN + NEW(program); + + program.bss := 0; + + program.labels := CHL.CreateIntList(); + FOR i := 0 TO NumberOfLabels - 1 DO + CHL.PushInt(program.labels, 0) + END; + + program.rel_list := LISTS.create(NIL); + program.imp_list := LISTS.create(NIL); + program.exp_list := LISTS.create(NIL); + + program.data := CHL.CreateByteList(); + program.code := CHL.CreateByteList(); + program.import := CHL.CreateByteList(); + program.export := CHL.CreateByteList() + + RETURN program +END create; + + +PROCEDURE SetParams* (program: PROGRAM; bss, stack: INTEGER; vmajor, vminor: WCHAR); +BEGIN + program.bss := bss; + program.stack := stack; + program.vmajor := vmajor; + program.vminor := vminor +END SetParams; + + +PROCEDURE PutReloc* (program: PROGRAM; opcode: INTEGER); +VAR + cmd: RELOC; + +BEGIN + NEW(cmd); + cmd.opcode := opcode; + cmd.offset := CHL.Length(program.code); + LISTS.push(program.rel_list, cmd) +END PutReloc; + + +PROCEDURE PutData* (program: PROGRAM; b: BYTE); +BEGIN + CHL.PushByte(program.data, b) +END PutData; + + +PROCEDURE get32le* (array: CHL.BYTELIST; idx: INTEGER): INTEGER; +VAR + i: INTEGER; + x: INTEGER; + +BEGIN + x := 0; + + FOR i := 3 TO 0 BY -1 DO + x := LSL(x, 8) + CHL.GetByte(array, idx + i) + END; + + IF UTILS.bit_depth = 64 THEN + x := MACHINE.Int32To64(x) + END + + RETURN x +END get32le; + + +PROCEDURE put32le* (array: CHL.BYTELIST; idx: INTEGER; x: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 3 DO + CHL.SetByte(array, idx + i, MACHINE.Byte(x, i)) + END +END put32le; + + +PROCEDURE PutData32LE* (program: PROGRAM; x: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 3 DO + CHL.PushByte(program.data, MACHINE.Byte(x, i)) + END +END PutData32LE; + + +PROCEDURE PutData64LE* (program: PROGRAM; x: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 7 DO + CHL.PushByte(program.data, MACHINE.Byte(x, i)) + END +END PutData64LE; + + +PROCEDURE PutDataStr* (program: PROGRAM; s: ARRAY OF CHAR); +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE s[i] # 0X DO + PutData(program, ORD(s[i])); + INC(i) + END +END PutDataStr; + + +PROCEDURE PutCode* (program: PROGRAM; b: BYTE); +BEGIN + CHL.PushByte(program.code, b) +END PutCode; + + +PROCEDURE PutCode32LE* (program: PROGRAM; x: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 3 DO + CHL.PushByte(program.code, MACHINE.Byte(x, i)) + END +END PutCode32LE; + + +PROCEDURE SetLabel* (program: PROGRAM; label, offset: INTEGER); +BEGIN + CHL.SetInt(program.labels, label, offset) +END SetLabel; + + +PROCEDURE Import* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); +VAR + imp: IMPRT; + i: INTEGER; + +BEGIN + CHL.PushByte(program.import, 0); + CHL.PushByte(program.import, 0); + + IF ODD(CHL.Length(program.import)) THEN + CHL.PushByte(program.import, 0) + END; + + NEW(imp); + imp.nameoffs := CHL.Length(program.import); + imp.label := label; + LISTS.push(program.imp_list, imp); + + i := 0; + WHILE name[i] # 0X DO + CHL.PushByte(program.import, ORD(name[i])); + INC(i) + END; + CHL.PushByte(program.import, 0) +END Import; + + +PROCEDURE less (bytes: CHL.BYTELIST; a, b: EXPRT): BOOLEAN; +VAR + i, j: INTEGER; + +BEGIN + i := a.nameoffs; + j := b.nameoffs; + + WHILE (CHL.GetByte(bytes, i) # 0) & (CHL.GetByte(bytes, j) # 0) & + (CHL.GetByte(bytes, i) = CHL.GetByte(bytes, j)) DO + INC(i); + INC(j) + END + + RETURN CHL.GetByte(bytes, i) < CHL.GetByte(bytes, j) +END less; + + +PROCEDURE Export* (program: PROGRAM; name: ARRAY OF CHAR; label: INTEGER); +VAR + exp, cur: EXPRT; + i: INTEGER; + +BEGIN + NEW(exp); + exp.nameoffs := CHL.Length(program.export); + exp.label := CHL.GetInt(program.labels, label); + + i := 0; + WHILE name[i] # 0X DO + CHL.PushByte(program.export, ORD(name[i])); + INC(i) + END; + CHL.PushByte(program.export, 0); + + cur := program.exp_list.first(EXPRT); + WHILE (cur # NIL) & less(program.export, cur, exp) DO + cur := cur.next(EXPRT) + END; + + IF cur # NIL THEN + IF cur.prev # NIL THEN + LISTS.insert(program.exp_list, cur.prev, exp) + ELSE + LISTS.insertL(program.exp_list, cur, exp) + END + ELSE + LISTS.push(program.exp_list, exp) + END + +END Export; + + +PROCEDURE GetIProc* (program: PROGRAM; n: INTEGER): IMPRT; +VAR + import: IMPRT; + res: IMPRT; + +BEGIN + import := program.imp_list.first(IMPRT); + + res := NIL; + WHILE (import # NIL) & (n >= 0) DO + IF import.label # 0 THEN + res := import; + DEC(n) + END; + import := import.next(IMPRT) + END; + + ASSERT(n = -1) + RETURN res +END GetIProc; + + +PROCEDURE GetLabel* (program: PROGRAM; label: INTEGER): INTEGER; + RETURN CHL.GetInt(program.labels, label) +END GetLabel; + + +PROCEDURE NewLabel* (program: PROGRAM); +BEGIN + CHL.PushInt(program.labels, 0) +END NewLabel; + + +PROCEDURE fixup* (program: PROGRAM); +VAR + rel: RELOC; + imp: IMPRT; + nproc: INTEGER; + L: INTEGER; + +BEGIN + + nproc := 0; + imp := program.imp_list.first(IMPRT); + WHILE imp # NIL DO + IF imp.label # 0 THEN + CHL.SetInt(program.labels, imp.label, nproc); + INC(nproc) + END; + imp := imp.next(IMPRT) + END; + + rel := program.rel_list.first(RELOC); + WHILE rel # NIL DO + + IF rel.opcode IN {RIMP, PICIMP} THEN + L := get32le(program.code, rel.offset); + put32le(program.code, rel.offset, GetLabel(program, L)) + END; + + rel := rel.next(RELOC) + END + +END fixup; + + +PROCEDURE InitArray* (VAR array: ARRAY OF BYTE; VAR idx: INTEGER; hex: ARRAY OF CHAR); +VAR + i, k: INTEGER; + + + PROCEDURE hexdgt (dgt: CHAR): INTEGER; + VAR + res: INTEGER; + + BEGIN + IF dgt < "A" THEN + res := ORD(dgt) - ORD("0") + ELSE + res := ORD(dgt) - ORD("A") + 10 + END + + RETURN res + END hexdgt; + + +BEGIN + k := LENGTH(hex); + ASSERT(~ODD(k)); + k := k DIV 2; + + FOR i := 0 TO k - 1 DO + array[i + idx] := hexdgt(hex[2 * i]) * 16 + hexdgt(hex[2 * i + 1]) + END; + + idx := idx + k +END InitArray; + + +END BIN. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CHUNKLISTS.ob07 b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 new file mode 100644 index 0000000000..015fe6f1bb --- /dev/null +++ b/programs/develop/oberon07/Source/CHUNKLISTS.ob07 @@ -0,0 +1,251 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE CHUNKLISTS; + +IMPORT LISTS, WR := WRITER; + + +CONST + + LENOFBYTECHUNK = 64000; + LENOFINTCHUNK = 16000; + + +TYPE + + ANYLIST = POINTER TO RECORD (LISTS.LIST) + + length: INTEGER + + END; + + BYTELIST* = POINTER TO RECORD (ANYLIST) END; + + BYTECHUNK = POINTER TO RECORD (LISTS.ITEM) + + data: ARRAY LENOFBYTECHUNK OF BYTE; + count: INTEGER + + END; + + + INTLIST* = POINTER TO RECORD (ANYLIST) END; + + INTCHUNK = POINTER TO RECORD (LISTS.ITEM) + + data: ARRAY LENOFINTCHUNK OF INTEGER; + count: INTEGER + + END; + + +PROCEDURE SetByte* (list: BYTELIST; idx: INTEGER; byte: BYTE); +VAR + ChunkNum: INTEGER; + chunk: BYTECHUNK; + +BEGIN + ASSERT(idx >= 0); + ASSERT(list # NIL); + + ChunkNum := idx DIV LENOFBYTECHUNK; + idx := idx MOD LENOFBYTECHUNK; + + chunk := list.first(BYTECHUNK); + + WHILE (chunk # NIL) & (ChunkNum > 0) DO + chunk := chunk.next(BYTECHUNK); + DEC(ChunkNum) + END; + + ASSERT(chunk # NIL); + ASSERT(idx < chunk.count); + + chunk.data[idx] := byte +END SetByte; + + +PROCEDURE GetByte* (list: BYTELIST; idx: INTEGER): BYTE; +VAR + ChunkNum: INTEGER; + chunk: BYTECHUNK; + +BEGIN + ASSERT(idx >= 0); + ASSERT(list # NIL); + + ChunkNum := idx DIV LENOFBYTECHUNK; + idx := idx MOD LENOFBYTECHUNK; + + chunk := list.first(BYTECHUNK); + + WHILE (chunk # NIL) & (ChunkNum > 0) DO + chunk := chunk.next(BYTECHUNK); + DEC(ChunkNum) + END; + + ASSERT(chunk # NIL); + ASSERT(idx < chunk.count) + + RETURN chunk.data[idx] +END GetByte; + + +PROCEDURE PushByte* (list: BYTELIST; byte: BYTE); +VAR + chunk: BYTECHUNK; + +BEGIN + ASSERT(list # NIL); + + chunk := list.last(BYTECHUNK); + + IF chunk.count = LENOFBYTECHUNK THEN + NEW(chunk); + chunk.count := 0; + LISTS.push(list, chunk) + END; + + chunk.data[chunk.count] := byte; + INC(chunk.count); + + INC(list.length) +END PushByte; + + +PROCEDURE WriteToFile* (file: WR.FILE; list: BYTELIST); +VAR + chunk: BYTECHUNK; + +BEGIN + chunk := list.first(BYTECHUNK); + WHILE chunk # NIL DO + WR.Write(file, chunk.data, chunk.count); + chunk := chunk.next(BYTECHUNK) + END +END WriteToFile; + + +PROCEDURE CreateByteList* (): BYTELIST; +VAR + bytelist: BYTELIST; + list: LISTS.LIST; + chunk: BYTECHUNK; + +BEGIN + NEW(bytelist); + list := LISTS.create(bytelist); + bytelist.length := 0; + + NEW(chunk); + chunk.count := 0; + LISTS.push(list, chunk) + + RETURN list(BYTELIST) +END CreateByteList; + + +PROCEDURE SetInt* (list: INTLIST; idx: INTEGER; int: INTEGER); +VAR + ChunkNum: INTEGER; + chunk: INTCHUNK; + +BEGIN + ASSERT(idx >= 0); + ASSERT(list # NIL); + + ChunkNum := idx DIV LENOFINTCHUNK; + idx := idx MOD LENOFINTCHUNK; + + chunk := list.first(INTCHUNK); + + WHILE (chunk # NIL) & (ChunkNum > 0) DO + chunk := chunk.next(INTCHUNK); + DEC(ChunkNum) + END; + + ASSERT(chunk # NIL); + ASSERT(idx < chunk.count); + + chunk.data[idx] := int +END SetInt; + + +PROCEDURE GetInt* (list: INTLIST; idx: INTEGER): INTEGER; +VAR + ChunkNum: INTEGER; + chunk: INTCHUNK; + +BEGIN + ASSERT(idx >= 0); + ASSERT(list # NIL); + + ChunkNum := idx DIV LENOFINTCHUNK; + idx := idx MOD LENOFINTCHUNK; + + chunk := list.first(INTCHUNK); + + WHILE (chunk # NIL) & (ChunkNum > 0) DO + chunk := chunk.next(INTCHUNK); + DEC(ChunkNum) + END; + + ASSERT(chunk # NIL); + ASSERT(idx < chunk.count) + + RETURN chunk.data[idx] +END GetInt; + + +PROCEDURE PushInt* (list: INTLIST; int: INTEGER); +VAR + chunk: INTCHUNK; + +BEGIN + ASSERT(list # NIL); + + chunk := list.last(INTCHUNK); + + IF chunk.count = LENOFINTCHUNK THEN + NEW(chunk); + chunk.count := 0; + LISTS.push(list, chunk) + END; + + chunk.data[chunk.count] := int; + INC(chunk.count); + + INC(list.length) +END PushInt; + + +PROCEDURE CreateIntList* (): INTLIST; +VAR + intlist: INTLIST; + list: LISTS.LIST; + chunk: INTCHUNK; + +BEGIN + NEW(intlist); + list := LISTS.create(intlist); + intlist.length := 0; + + NEW(chunk); + chunk.count := 0; + LISTS.push(list, chunk) + + RETURN list(INTLIST) +END CreateIntList; + + +PROCEDURE Length* (list: ANYLIST): INTEGER; + RETURN list.length +END Length; + + +END CHUNKLISTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CODE.ob07 b/programs/develop/oberon07/Source/CODE.ob07 new file mode 100644 index 0000000000..cd8465e342 --- /dev/null +++ b/programs/develop/oberon07/Source/CODE.ob07 @@ -0,0 +1,1179 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE CODE; + +IMPORT LISTS, SCAN, STRINGS, CHL := CHUNKLISTS, C := COLLECTIONS; + + +CONST + + little_endian* = 0; + big_endian* = 1; + + call_stack* = 0; + call_win64* = 1; + call_sysv* = 2; + + opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; + opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; + opDIV* = 10; opMOD* = 11; opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; + opUMINUS* = 16; + opADD* = 17; opSUB* = 18; opADDL* = 19; opSUBL* = 20; opADDR* = 21; opSUBR* = 22; + opSAVE* = 23; opSAVEC* = 24; opSAVE8* = 25; opSAVE8C* = 26; opCHKBYTE* = 27; opDROP* = 28; + opNOT* = 29; + + opEQ* = 30; opNE* = 31; opLT* = 32; opLE* = 33; opGT* = 34; opGE* = 35; + opEQL* = 36; opNEL* = 37; opLTL* = 38; opLEL* = 39; opGTL* = 40; opGEL* = 41; + opEQR* = 42; opNER* = 43; opLTR* = 44; opLER* = 45; opGTR* = 46; opGER* = 47; + + opVLOAD32* = 48; opGLOAD32* = 49; + + opJNE* = 50; opJE* = 51; + + opEQS* = 52; opNES* = opEQS + 1; opLTS* = opEQS + 2; opLES* = opEQS + 3; opGTS* = opEQS + 4; opGES* = opEQS + 5 (* 58 *); + + opSAVE32* = 58; opLLOAD8* = 59; + + opCONSTF* = 60; opLOADF* = 61; opSAVEF* = 62; opMULF* = 63; opDIVF* = 64; opDIVFI* = 65; + opUMINF* = 66; opADDFI* = 67; opSUBFI* = 68; opADDF* = 69; opSUBF* = 70; + + opINC1B* = 71; opDEC1B* = 72; opINCCB* = 73; opDECCB* = 74; opINCB* = 75; opDECB* = 76; + + opCASEL* = 77; opCASER* = 78; opCASELR* = 79; + + opEQF* = 80; opNEF* = opEQF + 1; opLTF* = opEQF + 2; opLEF* = opEQF + 3; opGTF* = opEQF + 4; opGEF* = opEQF + 5; + opEQFI* = opEQF + 6; opNEFI* = opEQF + 7; opLTFI* = opEQF + 8; opLEFI* = opEQF + 9; opGTFI* = opEQF + 10; opGEFI* = opEQF + 11; (* 91 *) + + opLOAD8* = 92; opLOAD16* = 93; opLOAD32* = 94; opPRECALL* = 95; opRES* = 96; opRESF* = 97; + opERRC* = 98; opSWITCH* = 99; + + opSBOOL* = 100; opSBOOLC* = 101; opNOP* = 102; + + opMULS* = 103; opMULSC* = 104; opDIVS* = 105; opDIVSC* = 106; + opADDS* = 107; opSUBS* = 108; opADDSL* = 109; opSUBSL* = 110; opADDSR* = 111; opSUBSR* = 112; + opUMINS* = 113; opIN* = 114; opINL* = 115; opINR* = 116; + opRSET* = 117; opRSETL* = 118; opRSETR* = 119; opRSET1* = 120; opLENGTH* = 121; + + opINC1* = 122; opDEC1* = 123; opINCC* = 124; opDECC* = 125; opINC* = 126; opDEC* = 127; + opINCL* = 128; opEXCL* = 129; opINCLC* = 130; opEXCLC* = 131; opNEW* = 132; opDISP* = 133; + opPACK* = 134; opPACKC* = 135; opUNPK* = 136; opCOPY* = 137; opENTER* = 138; opLEAVE* = 139; + opCALL* = 140; opSAVEP* = 141; opCALLP* = 142; opEQP* = 143; opNEP* = 144; opLEAVER* = 145; + opGET* = 146; opSAVE16* = 147; opABS* = 148; opFABS* = 149; opFLOOR* = 150; opFLT* = 151; + opODD* = 152; opORD* = 153; opASR* = 154; opLSL* = 155; opROR* = 156; + opASR1* = 157; opLSL1* = 158; opROR1* = 159; opASR2* = 160; opLSL2* = 161; opROR2* = 162; + opPUSHP* = 163; opLADR* = 164; opTYPEGP* = 165; opIS* = 166; opPUSHF* = 167; opVADR* = 168; + opPUSHT* = 169; opTYPEGR* = 170; opISREC* = 171; opCHKIDX* = 172; opPARAM* = 173; + opCHKIDX2* = 174; opLEN* = 175; opROT* = 176; opSAVES* = 177; opSADR* = 178; opERR* = 179; + + opCHR* = 180; opENDSW* = 181; opLEAVEF* = 182; opCLEANUP* = 183; opMOVE* = 184; + opLSR* = 185; opLSR1* = 186; opLSR2* = 187; + opMIN* = 188; opMINC* = 189; opMAX* = 190; opMAXC* = 191; opJNZ* = 192; + opEQB* = 193; opNEB* = 194; opINF* = 195; opJZ* = 196; opVLOAD8* = 197; opGLOAD8* = 198; + opLLOAD16* = 199; opVLOAD16* = 200; opGLOAD16* = 201; + opLOAD64* = 202; opLLOAD64* = 203; opVLOAD64* = 204; opGLOAD64* = 205; opSAVE64* = 206; + + opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; + opSAVE16C* = 213; opWCHR* = 214; opCOPYS2* = 215; opLENGTHW* = 216; + + opEQS2* = 217; opNES2* = opEQS2 + 1; opLTS2* = opEQS2 + 2; opLES2* = opEQS2 + 3; opGTS2* = opEQS2 + 4; opGES2* = opEQS2 + 5 (* 222 *); + opEQSW* = 223; opNESW* = opEQSW + 1; opLTSW* = opEQSW + 2; opLESW* = opEQSW + 3; opGTSW* = opEQSW + 4; opGESW* = opEQSW + 5 (* 228 *); + opEQSW2* = 229; opNESW2* = opEQSW2 + 1; opLTSW2* = opEQSW2 + 2; opLESW2* = opEQSW2 + 3; opGTSW2* = opEQSW2 + 4; opGESW2* = opEQSW2 + 5 (* 234 *); + + opCODE* = 235; + + opALIGN16* = 236; opPOPSP* = 237; + opWIN64CALL* = 238; opWIN64CALLI* = 239; opWIN64CALLP* = 240; opLOOP* = 241; opENDLOOP* = 242; + opSYSVCALL* = 243; opSYSVCALLI* = 244; opSYSVCALLP* = 245; opSYSVALIGN16* = 246; opWIN64ALIGN16* = 247; + + + opSADR_PARAM* = 1000; opLOAD64_PARAM* = 1001; opLLOAD64_PARAM* = 1002; opGLOAD64_PARAM* = 1003; + opVADR_PARAM* = 1004; opCONST_PARAM* = 1005; opGLOAD32_PARAM* = 1006; opLLOAD32_PARAM* = 1007; + opLOAD32_PARAM* = 1008; + + opLADR_SAVEC* = 1009; opGADR_SAVEC* = 1010; opLADR_SAVE* = 1011; + + opLADR_INC1* = 1012; opLADR_DEC1* = 1013; opLADR_INCC* = 1014; opLADR_DECC* = 1015; + opLADR_INC1B* = 1016; opLADR_DEC1B* = 1017; opLADR_INCCB* = 1018; opLADR_DECCB* = 1019; + opLADR_INC* = 1020; opLADR_DEC* = 1021; opLADR_INCB* = 1022; opLADR_DECB* = 1023; + opLADR_INCL* = 1024; opLADR_EXCL* = 1025; opLADR_INCLC* = 1026; opLADR_EXCLC* = 1027; + opLADR_UNPK* = 1028; + + + _move *= 0; + _move2 *= 1; + _strcmpw *= 2; + _strcmpw2 *= 3; + _set *= 4; + _set2 *= 5; + _lengthw *= 6; + _strcmp2 *= 7; + _div *= 8; + _mod *= 9; + _div2 *= 10; + _mod2 *= 11; + _arrcpy *= 12; + _rot *= 13; + _new *= 14; + _dispose *= 15; + _strcmp *= 16; + _error *= 17; + _is *= 18; + _isrec *= 19; + _guard *= 20; + _guardrec *= 21; + _length *= 22; + _init *= 23; + _dllentry *= 24; + _strcpy *= 25; + _exit *= 26; + _strcpy2 *= 27; + + +TYPE + + LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) + + offset*, size*, count*: INTEGER + + END; + + COMMAND* = POINTER TO RECORD (LISTS.ITEM) + + opcode*: INTEGER; + param1*: INTEGER; + param2*: INTEGER; + param3*: INTEGER; + float*: REAL; + variables*: LISTS.LIST; + allocReg*: BOOLEAN + + END; + + CMDSTACK = POINTER TO RECORD + + data: ARRAY 1000 OF COMMAND; + top: INTEGER + + END; + + EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + name*: SCAN.LEXSTR + + END; + + IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) + + name*: SCAN.LEXSTR; + procs*: LISTS.LIST + + END; + + IMPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + lib*: IMPORT_LIB; + name*: SCAN.LEXSTR; + count: INTEGER + + END; + + + CODES* = POINTER TO RECORD + + last: COMMAND; + begcall: CMDSTACK; + endcall: CMDSTACK; + commands*: LISTS.LIST; + export*: LISTS.LIST; + import*: LISTS.LIST; + types*: CHL.INTLIST; + data*: CHL.BYTELIST; + dmin*: INTEGER; + lcount*: INTEGER; + bss*: INTEGER; + rtl*: ARRAY 28 OF INTEGER; + + charoffs: ARRAY 256 OF INTEGER; + wcharoffs: ARRAY 65536 OF INTEGER; + + fregs: INTEGER; + wstr: ARRAY 4*1024 OF WCHAR; + + errlabel*: INTEGER + + END; + + +VAR + + codes*: CODES; + endianness: INTEGER; + numRegsFloat: INTEGER; + + commands, variables: C.COLLECTION; + + +PROCEDURE NewCmd (): COMMAND; +VAR + cmd: COMMAND; + citem: C.ITEM; + +BEGIN + citem := C.pop(commands); + IF citem = NIL THEN + NEW(cmd) + ELSE + cmd := citem(COMMAND) + END; + + cmd.allocReg := FALSE + + RETURN cmd +END NewCmd; + + +PROCEDURE NewVar* (): LOCALVAR; +VAR + lvar: LOCALVAR; + citem: C.ITEM; + +BEGIN + citem := C.pop(variables); + IF citem = NIL THEN + NEW(lvar) + ELSE + lvar := citem(LOCALVAR) + END; + + lvar.count := 0 + + RETURN lvar +END NewVar; + + +PROCEDURE setlast* (cmd: COMMAND); +BEGIN + codes.last := cmd +END setlast; + + +PROCEDURE getlast* (): COMMAND; + RETURN codes.last +END getlast; + + +PROCEDURE PutByte (codes: CODES; b: BYTE); +BEGIN + CHL.PushByte(codes.data, b) +END PutByte; + + +PROCEDURE putstr* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; +BEGIN + res := CHL.Length(codes.data); + + i := 0; + n := LENGTH(s); + WHILE i < n DO + PutByte(codes, ORD(s[i])); + INC(i) + END; + + PutByte(codes, 0) + + RETURN res +END putstr; + + +PROCEDURE putstr1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.charoffs[c] = -1 THEN + res := CHL.Length(codes.data); + PutByte(codes, c); + PutByte(codes, 0); + codes.charoffs[c] := res + ELSE + res := codes.charoffs[c] + END + + RETURN res +END putstr1; + + +PROCEDURE putstrW* (s: ARRAY OF CHAR): INTEGER; +VAR + i, n, res: INTEGER; + +BEGIN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(codes, 0); + INC(res) + END; + + n := STRINGS.Utf8To16(s, codes.wstr); + + i := 0; + WHILE i < n DO + IF endianness = little_endian THEN + PutByte(codes, ORD(codes.wstr[i]) MOD 256); + PutByte(codes, ORD(codes.wstr[i]) DIV 256) + ELSIF endianness = big_endian THEN + PutByte(codes, ORD(codes.wstr[i]) DIV 256); + PutByte(codes, ORD(codes.wstr[i]) MOD 256) + END; + INC(i) + END; + + PutByte(codes, 0); + PutByte(codes, 0) + + RETURN res +END putstrW; + + +PROCEDURE putstrW1* (c: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF codes.wcharoffs[c] = -1 THEN + res := CHL.Length(codes.data); + + IF ODD(res) THEN + PutByte(codes, 0); + INC(res) + END; + + IF endianness = little_endian THEN + PutByte(codes, c MOD 256); + PutByte(codes, c DIV 256) + ELSIF endianness = big_endian THEN + PutByte(codes, c DIV 256); + PutByte(codes, c MOD 256) + END; + + PutByte(codes, 0); + PutByte(codes, 0); + + codes.wcharoffs[c] := res + ELSE + res := codes.wcharoffs[c] + END + + RETURN res +END putstrW1; + + +PROCEDURE SetMinDataSize* (size: INTEGER); +BEGIN + codes.dmin := CHL.Length(codes.data) + size +END SetMinDataSize; + + +PROCEDURE push (stk: CMDSTACK; cmd: COMMAND); +BEGIN + INC(stk.top); + stk.data[stk.top] := cmd +END push; + + +PROCEDURE pop (stk: CMDSTACK): COMMAND; +VAR + res: COMMAND; +BEGIN + res := stk.data[stk.top]; + DEC(stk.top) + RETURN res +END pop; + + +PROCEDURE pushBegEnd* (VAR beg, end: COMMAND); +BEGIN + push(codes.begcall, beg); + push(codes.endcall, end); + beg := codes.last; + end := beg.next(COMMAND) +END pushBegEnd; + + +PROCEDURE popBegEnd* (VAR beg, end: COMMAND); +BEGIN + beg := pop(codes.begcall); + end := pop(codes.endcall) +END popBegEnd; + + +PROCEDURE AddRec* (base: INTEGER); +BEGIN + CHL.PushInt(codes.types, base) +END AddRec; + + +PROCEDURE insert (cur, nov: COMMAND); +VAR + old_opcode, param2: INTEGER; + + + PROCEDURE set (cur: COMMAND; opcode, param2: INTEGER); + BEGIN + cur.opcode := opcode; + cur.param1 := cur.param2; + cur.param2 := param2 + END set; + + +BEGIN + old_opcode := cur.opcode; + param2 := nov.param2; + + IF (nov.opcode = opPARAM) & (param2 = 1) THEN + + CASE old_opcode OF + |opGLOAD64: cur.opcode := opGLOAD64_PARAM + |opLLOAD64: cur.opcode := opLLOAD64_PARAM + |opLOAD64: cur.opcode := opLOAD64_PARAM + |opGLOAD32: cur.opcode := opGLOAD32_PARAM + |opLLOAD32: cur.opcode := opLLOAD32_PARAM + |opLOAD32: cur.opcode := opLOAD32_PARAM + |opSADR: cur.opcode := opSADR_PARAM + |opVADR: cur.opcode := opVADR_PARAM + |opCONST: cur.opcode := opCONST_PARAM + ELSE + old_opcode := -1 + END + + ELSIF old_opcode = opLADR THEN + + CASE nov.opcode OF + |opSAVEC: set(cur, opLADR_SAVEC, param2) + |opSAVE: cur.opcode := opLADR_SAVE + |opINC1: cur.opcode := opLADR_INC1 + |opDEC1: cur.opcode := opLADR_DEC1 + |opINC: cur.opcode := opLADR_INC + |opDEC: cur.opcode := opLADR_DEC + |opINC1B: cur.opcode := opLADR_INC1B + |opDEC1B: cur.opcode := opLADR_DEC1B + |opINCB: cur.opcode := opLADR_INCB + |opDECB: cur.opcode := opLADR_DECB + |opINCL: cur.opcode := opLADR_INCL + |opEXCL: cur.opcode := opLADR_EXCL + |opUNPK: cur.opcode := opLADR_UNPK + |opINCC: set(cur, opLADR_INCC, param2) + |opDECC: set(cur, opLADR_DECC, param2) + |opINCCB: set(cur, opLADR_INCCB, param2) + |opDECCB: set(cur, opLADR_DECCB, param2) + |opINCLC: set(cur, opLADR_INCLC, param2) + |opEXCLC: set(cur, opLADR_EXCLC, param2) + ELSE + old_opcode := -1 + END + + ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN + set(cur, opGADR_SAVEC, param2) + + ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN + cur.param2 := param2 * cur.param2 + + ELSE + old_opcode := -1 + END; + + IF old_opcode = -1 THEN + LISTS.insert(codes.commands, cur, nov); + codes.last := nov + ELSE + C.push(commands, nov); + codes.last := cur + END +END insert; + + +PROCEDURE AddCmd* (opcode: INTEGER; param: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := 0; + cmd.param2 := param; + insert(codes.last, cmd) +END AddCmd; + + +PROCEDURE AddCmd2* (opcode: INTEGER; param1, param2: INTEGER); +VAR + cmd: COMMAND; +BEGIN + cmd := NewCmd(); + cmd.opcode := opcode; + cmd.param1 := param1; + cmd.param2 := param2; + insert(codes.last, cmd) +END AddCmd2; + + +PROCEDURE NewLabel* (): INTEGER; +BEGIN + INC(codes.lcount) + RETURN codes.lcount - 1 +END NewLabel; + + +PROCEDURE SetLabel* (label: INTEGER); +BEGIN + AddCmd(opLABEL, label) +END SetLabel; + + +PROCEDURE SetErrLabel*; +BEGIN + codes.errlabel := NewLabel(); + SetLabel(codes.errlabel) +END SetErrLabel; + + +PROCEDURE AddCmd0* (opcode: INTEGER); +BEGIN + AddCmd(opcode, 0) +END AddCmd0; + + +PROCEDURE deleteVarList (list: LISTS.LIST); +VAR + last: LISTS.ITEM; + +BEGIN + WHILE list.last # NIL DO + last := LISTS.pop(list); + C.push(variables, last) + END +END deleteVarList; + + +PROCEDURE delete (cmd: COMMAND); +BEGIN + IF cmd.variables # NIL THEN + deleteVarList(cmd.variables) + END; + LISTS.delete(codes.commands, cmd); + C.push(commands, cmd) +END delete; + + +PROCEDURE delete2* (first, last: LISTS.ITEM); +VAR + cur, next: LISTS.ITEM; + +BEGIN + cur := first; + + IF first # last THEN + REPEAT + next := cur.next; + LISTS.delete(codes.commands, cur); + C.push(commands, cur); + cur := next + UNTIL cur = last + END; + + LISTS.delete(codes.commands, cur); + C.push(commands, cur) +END delete2; + + +PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); +VAR + prev: COMMAND; + not: BOOLEAN; + +BEGIN + prev := codes.last; + not := prev.opcode = opNOT; + IF not THEN + IF opcode = opJE THEN + opcode := opJNE + ELSIF opcode = opJNE THEN + opcode := opJE + ELSE + not := FALSE + END + END; + + AddCmd2(opcode, label, label); + + IF not THEN + delete(prev) + END + +END AddJmpCmd; + + +PROCEDURE OnError* (line, error: INTEGER); +BEGIN + AddCmd(opERRC, LSL(line, 4) + error); + AddJmpCmd(opJMP, codes.errlabel) +END OnError; + + +PROCEDURE TypeGuard* (op, t: INTEGER; line, error: INTEGER); +VAR + label: INTEGER; +BEGIN + AddCmd(op, t); + label := NewLabel(); + AddJmpCmd(opJE, label); + OnError(line, error); + SetLabel(label) +END TypeGuard; + + +PROCEDURE TypeCheck* (t: INTEGER); +BEGIN + AddCmd(opIS, t) +END TypeCheck; + + +PROCEDURE TypeCheckRec* (t: INTEGER); +BEGIN + AddCmd(opISREC, t) +END TypeCheckRec; + + +PROCEDURE New* (size, typenum: INTEGER); +BEGIN + AddCmd2(opNEW, typenum, size) +END New; + + +PROCEDURE fcmp* (opcode: INTEGER); +BEGIN + AddCmd(opcode, 0); + DEC(codes.fregs, 2); + ASSERT(codes.fregs >= 0) +END fcmp; + + +PROCEDURE not*; +VAR + prev: COMMAND; +BEGIN + prev := codes.last; + IF prev.opcode = opNOT THEN + codes.last := prev.prev(COMMAND); + delete(prev) + ELSE + AddCmd0(opNOT) + END +END not; + + +PROCEDURE Enter* (label, params: INTEGER): COMMAND; +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opENTER; + cmd.param1 := label; + cmd.param3 := params; + cmd.allocReg := TRUE; + insert(codes.last, cmd) + + RETURN codes.last +END Enter; + + +PROCEDURE Leave* (result, float: BOOLEAN; paramsize: INTEGER): COMMAND; +BEGIN + IF result THEN + IF float THEN + AddCmd(opLEAVEF, paramsize) + ELSE + AddCmd(opLEAVER, paramsize) + END + ELSE + AddCmd(opLEAVE, paramsize) + END + + RETURN codes.last +END Leave; + + +PROCEDURE Call* (proc, callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALL, proc) + |call_win64: AddJmpCmd(opWIN64CALL, proc) + |call_sysv: AddJmpCmd(opSYSVCALL, proc) + END; + codes.last(COMMAND).param2 := fparams +END Call; + + +PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) + |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) + |call_sysv: AddJmpCmd(opSYSVCALLI, proc(IMPORT_PROC).label) + END; + codes.last(COMMAND).param2 := fparams +END CallImp; + + +PROCEDURE CallP* (callconv, fparams: INTEGER); +BEGIN + CASE callconv OF + |call_stack: AddCmd0(opCALLP) + |call_win64: AddCmd(opWIN64CALLP, fparams) + |call_sysv: AddCmd(opSYSVCALLP, fparams) + END +END CallP; + + +PROCEDURE AssignProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opSAVEP, proc) +END AssignProc; + + +PROCEDURE AssignImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) +END AssignImpProc; + + +PROCEDURE PushProc* (proc: INTEGER); +BEGIN + AddJmpCmd(opPUSHP, proc) +END PushProc; + + +PROCEDURE PushImpProc* (proc: LISTS.ITEM); +BEGIN + AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) +END PushImpProc; + + +PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQP, proc) + ELSE + AddJmpCmd(opNEP, proc) + END +END ProcCmp; + + +PROCEDURE ProcImpCmp* (proc: LISTS.ITEM; eq: BOOLEAN); +BEGIN + IF eq THEN + AddJmpCmd(opEQIP, proc(IMPORT_PROC).label) + ELSE + AddJmpCmd(opNEIP, proc(IMPORT_PROC).label) + END +END ProcImpCmp; + + +PROCEDURE SysGet* (size: INTEGER); +BEGIN + AddCmd(opGET, size) +END SysGet; + + +PROCEDURE load* (size: INTEGER); +VAR + last: COMMAND; + +BEGIN + last := codes.last; + CASE size OF + |1: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD8 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD8 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD8 + ELSE + AddCmd0(opLOAD8) + END + + |2: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD16 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD16 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD16 + ELSE + AddCmd0(opLOAD16) + END + + |4: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD32 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD32 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD32 + ELSE + AddCmd0(opLOAD32) + END + + |8: + IF last.opcode = opLADR THEN + last.opcode := opLLOAD64 + ELSIF last.opcode = opVADR THEN + last.opcode := opVLOAD64 + ELSIF last.opcode = opGADR THEN + last.opcode := opGLOAD64 + ELSE + AddCmd0(opLOAD64) + END + END +END load; + + +PROCEDURE SysPut* (size: INTEGER); +BEGIN + CASE size OF + |1: AddCmd0(opSAVE8) + |2: AddCmd0(opSAVE16) + |4: AddCmd0(opSAVE32) + |8: AddCmd0(opSAVE64) + END +END SysPut; + + +PROCEDURE savef*; +BEGIN + AddCmd0(opSAVEF); + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END savef; + + +PROCEDURE pushf*; +BEGIN + AddCmd0(opPUSHF); + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END pushf; + + +PROCEDURE loadf* (): BOOLEAN; +BEGIN + AddCmd0(opLOADF); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END loadf; + + +PROCEDURE inf* (): BOOLEAN; +BEGIN + AddCmd0(opINF); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END inf; + + +PROCEDURE fbinop* (opcode: INTEGER); +BEGIN + AddCmd0(opcode); + DEC(codes.fregs); + ASSERT(codes.fregs > 0) +END fbinop; + + +PROCEDURE saves* (offset, length: INTEGER); +BEGIN + AddCmd2(opSAVES, length, offset) +END saves; + + +PROCEDURE abs* (real: BOOLEAN); +BEGIN + IF real THEN + AddCmd0(opFABS) + ELSE + AddCmd0(opABS) + END +END abs; + + +PROCEDURE floor*; +BEGIN + AddCmd0(opFLOOR); + DEC(codes.fregs); + ASSERT(codes.fregs >= 0) +END floor; + + +PROCEDURE flt* (): BOOLEAN; +BEGIN + AddCmd0(opFLT); + INC(codes.fregs) + RETURN codes.fregs < numRegsFloat +END flt; + + +PROCEDURE odd*; +BEGIN + AddCmd0(opODD) +END odd; + + +PROCEDURE ord*; +BEGIN + AddCmd0(opORD) +END ord; + + +PROCEDURE shift_minmax* (op: CHAR); +BEGIN + CASE op OF + |"A": AddCmd0(opASR) + |"L": AddCmd0(opLSL) + |"O": AddCmd0(opROR) + |"R": AddCmd0(opLSR) + |"m": AddCmd0(opMIN) + |"x": AddCmd0(opMAX) + END +END shift_minmax; + + +PROCEDURE shift_minmax1* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR1, x) + |"L": AddCmd(opLSL1, x) + |"O": AddCmd(opROR1, x) + |"R": AddCmd(opLSR1, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax1; + + +PROCEDURE shift_minmax2* (op: CHAR; x: INTEGER); +BEGIN + CASE op OF + |"A": AddCmd(opASR2, x) + |"L": AddCmd(opLSL2, x) + |"O": AddCmd(opROR2, x) + |"R": AddCmd(opLSR2, x) + |"m": AddCmd(opMINC, x) + |"x": AddCmd(opMAXC, x) + END +END shift_minmax2; + + +PROCEDURE len* (dim: INTEGER); +BEGIN + AddCmd(opLEN, dim) +END len; + + +PROCEDURE Float* (r: REAL); +VAR + cmd: COMMAND; + +BEGIN + cmd := NewCmd(); + cmd.opcode := opCONSTF; + cmd.float := r; + insert(codes.last, cmd); + INC(codes.fregs); + ASSERT(codes.fregs <= numRegsFloat) +END Float; + + +PROCEDURE precall* (flt: BOOLEAN): INTEGER; +VAR + res: INTEGER; +BEGIN + res := codes.fregs; + AddCmd2(opPRECALL, ORD(flt), res); + codes.fregs := 0 + RETURN res +END precall; + + +PROCEDURE resf* (fregs: INTEGER): BOOLEAN; +BEGIN + AddCmd(opRESF, fregs); + codes.fregs := fregs + 1 + RETURN codes.fregs < numRegsFloat +END resf; + + +PROCEDURE res* (fregs: INTEGER); +BEGIN + AddCmd(opRES, fregs); + codes.fregs := fregs +END res; + + +PROCEDURE retf*; +BEGIN + DEC(codes.fregs); + ASSERT(codes.fregs = 0) +END retf; + + +PROCEDURE drop*; +BEGIN + AddCmd0(opDROP) +END drop; + + +PROCEDURE case* (a, b, L, R: INTEGER); +VAR + cmd: COMMAND; + +BEGIN + IF a = b THEN + cmd := NewCmd(); + cmd.opcode := opCASELR; + cmd.param1 := a; + cmd.param2 := L; + cmd.param3 := R; + insert(codes.last, cmd) + ELSE + AddCmd2(opCASEL, a, L); + AddCmd2(opCASER, b, R) + END +END case; + + +PROCEDURE caset* (a, label: INTEGER); +BEGIN + AddCmd2(opCASET, label, a) +END caset; + + +PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); +VAR + exp: EXPORT_PROC; + +BEGIN + NEW(exp); + exp.label := label; + exp.name := name; + LISTS.push(codes.export, exp) +END AddExp; + + +PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; +VAR + lib: IMPORT_LIB; + p: IMPORT_PROC; + +BEGIN + lib := codes.import.first(IMPORT_LIB); + WHILE (lib # NIL) & (lib.name # dll) DO + lib := lib.next(IMPORT_LIB) + END; + + IF lib = NIL THEN + NEW(lib); + lib.name := dll; + lib.procs := LISTS.create(NIL); + LISTS.push(codes.import, lib) + END; + + p := lib.procs.first(IMPORT_PROC); + WHILE (p # NIL) & (p.name # proc) DO + p := p.next(IMPORT_PROC) + END; + + IF p = NIL THEN + NEW(p); + p.name := proc; + p.label := NewLabel(); + p.lib := lib; + p.count := 1; + LISTS.push(lib.procs, p) + ELSE + INC(p.count) + END + + RETURN p +END AddImp; + + +PROCEDURE DelImport* (imp: LISTS.ITEM); +VAR + lib: IMPORT_LIB; + +BEGIN + DEC(imp(IMPORT_PROC).count); + IF imp(IMPORT_PROC).count = 0 THEN + lib := imp(IMPORT_PROC).lib; + LISTS.delete(lib.procs, imp); + IF lib.procs.first = NIL THEN + LISTS.delete(codes.import, lib) + END + END +END DelImport; + + +PROCEDURE init* (pNumRegsFloat, pEndianness: INTEGER); +VAR + cmd: COMMAND; + i: INTEGER; + +BEGIN + commands := C.create(); + variables := C.create(); + numRegsFloat := pNumRegsFloat; + endianness := pEndianness; + + NEW(codes); + NEW(codes.begcall); + codes.begcall.top := -1; + NEW(codes.endcall); + codes.endcall.top := -1; + codes.commands := LISTS.create(NIL); + codes.export := LISTS.create(NIL); + codes.import := LISTS.create(NIL); + codes.types := CHL.CreateIntList(); + codes.data := CHL.CreateByteList(); + + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + codes.last := cmd; + NEW(cmd); cmd.opcode := opNOP; LISTS.push(codes.commands, cmd); + + AddRec(0); + + codes.lcount := 0; + + codes.fregs := 0; + + FOR i := 0 TO LEN(codes.charoffs) - 1 DO + codes.charoffs[i] := -1 + END; + + FOR i := 0 TO LEN(codes.wcharoffs) - 1 DO + codes.wcharoffs[i] := -1 + END + +END init; + + +END CODE. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/COLLECTIONS.ob07 b/programs/develop/oberon07/Source/COLLECTIONS.ob07 new file mode 100644 index 0000000000..3e4175af1d --- /dev/null +++ b/programs/develop/oberon07/Source/COLLECTIONS.ob07 @@ -0,0 +1,59 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE COLLECTIONS; + + +TYPE + + ITEM* = POINTER TO RECORD + + link: ITEM + + END; + + COLLECTION* = POINTER TO RECORD + + last: ITEM + + END; + + +PROCEDURE push* (collection: COLLECTION; item: ITEM); +BEGIN + item.link := collection.last; + collection.last := item +END push; + + +PROCEDURE pop* (collection: COLLECTION): ITEM; +VAR + item: ITEM; + +BEGIN + item := collection.last; + IF item # NIL THEN + collection.last := item.link + END + + RETURN item +END pop; + + +PROCEDURE create* (): COLLECTION; +VAR + collection: COLLECTION; + +BEGIN + NEW(collection); + collection.last := NIL + + RETURN collection +END create; + + +END COLLECTIONS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CONSOLE.ob07 b/programs/develop/oberon07/Source/CONSOLE.ob07 new file mode 100644 index 0000000000..e5c293a429 --- /dev/null +++ b/programs/develop/oberon07/Source/CONSOLE.ob07 @@ -0,0 +1,72 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE CONSOLE; + +IMPORT UTILS, STRINGS; + + +PROCEDURE String* (s: ARRAY OF CHAR); +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE (i < LEN(s)) & (s[i] # 0X) DO + UTILS.OutChar(s[i]); + INC(i) + END +END String; + + +PROCEDURE Int* (n: INTEGER); +VAR + s: ARRAY 32 OF CHAR; + +BEGIN + STRINGS.IntToStr(n, s); + String(s) +END Int; + + +PROCEDURE Int2* (n: INTEGER); +BEGIN + IF n < 10 THEN + String("0") + END; + Int(n) +END Int2; + + +PROCEDURE Ln*; +BEGIN + String(UTILS.eol) +END Ln; + + +PROCEDURE StringLn* (s: ARRAY OF CHAR); +BEGIN + String(s); + Ln +END StringLn; + + +PROCEDURE IntLn* (n: INTEGER); +BEGIN + Int(n); + Ln +END IntLn; + + +PROCEDURE Int2Ln* (n: INTEGER); +BEGIN + Int2(n); + Ln +END Int2Ln; + + +END CONSOLE. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/CONSTANTS.ob07 b/programs/develop/oberon07/Source/CONSTANTS.ob07 new file mode 100644 index 0000000000..db218cada1 --- /dev/null +++ b/programs/develop/oberon07/Source/CONSTANTS.ob07 @@ -0,0 +1,43 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE CONSTANTS; + +CONST + + vMajor* = 0; + vMinor* = 98; + + FILE_EXT* = ".ob07"; + RTL_NAME* = "RTL"; + + MAX_GLOBAL_SIZE* = 1600000000; + + Target_iConsole* = 1; + Target_iGUI* = 2; + Target_iDLL* = 3; + Target_iKolibri* = 4; + Target_iObject* = 5; + Target_iConsole64* = 6; + Target_iGUI64* = 7; + Target_iDLL64* = 8; + Target_iELF32* = 9; + Target_iELF64* = 10; + + Target_sConsole* = "console"; + Target_sGUI* = "gui"; + Target_sDLL* = "dll"; + Target_sKolibri* = "kos"; + Target_sObject* = "obj"; + Target_sConsole64* = "console64"; + Target_sGUI64* = "gui64"; + Target_sDLL64* = "dll64"; + Target_sELF32* = "elfexe"; + Target_sELF64* = "elfexe64"; + + +END CONSTANTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/Compiler.ob07 b/programs/develop/oberon07/Source/Compiler.ob07 index 9c00db1d72..d53c866736 100644 --- a/programs/develop/oberon07/Source/Compiler.ob07 +++ b/programs/develop/oberon07/Source/Compiler.ob07 @@ -1,1958 +1,280 @@ -(* - Copyright 2016, 2017, 2018 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE Compiler; -IMPORT DECL, SCAN, UTILS, X86, SYSTEM; +IMPORT ST := STATEMENTS, PARS, UTILS, PATHS, C := CONSOLE, ERRORS, STRINGS, mConst := CONSTANTS, WRITER; -CONST - - Slash = UTILS.Slash; - - lxEOF = 0; lxINT = -1; lxREAL = -2; lxSTRING = -3; lxIDENT = -4; lxHEX = -5; lxCHX = -6; lxLONGREAL = -7; - lxARRAY = 1; lxBEGIN = 2; lxBY = 3; lxCASE = 4; lxCONST = 5; lxDIV = 6; lxDO = 7; lxELSE = 8; - lxELSIF = 9; lxEND = 10; lxFALSE = 11; lxFOR = 12; lxIF = 13; lxIMPORT = 14; lxIN = 15; lxIS = 16; - lxMOD = 17; lxMODULE = 18; lxNIL = 19; lxOF = 20; lxOR = 21; lxPOINTER = 22; lxPROCEDURE = 23; - lxRECORD = 24; lxREPEAT = 25; lxRETURN = 26; lxTHEN = 27; lxTO = 28; lxTRUE = 29; lxTYPE = 30; - lxUNTIL = 31; lxVAR = 32; lxWHILE = 33; - - lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; lxNot = 55; lxAnd = 56; lxComma = 57; lxSemi = 58; - lxStick = 59; lxLRound = 60; lxLSquare = 61; lxLCurly = 62; lxCaret = 63; lxRRound = 64; lxRSquare = 65; - lxRCurly = 66; lxDot = 67; lxDbl = 68; lxAssign = 69; lxColon = 70; - lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76; - - TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; - TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14; - - TNUM = {TINTEGER, TREAL, TLONGREAL}; - TFLOAT = {TREAL, TLONGREAL}; - TOBJECT = {TRECORD, TPOINTER}; - TSTRUCT = {TARRAY, TRECORD}; - - eVAR = 1; eCONST = 2; eEXP = 3; ePROC = 4; eSTPROC = 5; eSYSPROC = 6; - - IDMOD = 1; IDCONST = 2; IDTYPE = 3; IDVAR = 4; IDPROC = 5; IDSTPROC = 6; IDGUARD = 7; IDPARAM = 8; IDSYSPROC = 9; - - stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8; - stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15; - stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22; - stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27; - - sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105; - sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109; - -TYPE - - LABEL = POINTER TO RECORD (UTILS.rITEM) - a, b: INTEGER - END; +PROCEDURE Target (s: ARRAY OF CHAR): INTEGER; VAR - - pExpr, pFactor: PROCEDURE (VAR e: DECL.EXPRESSION); - pOpSeq: PROCEDURE; - sttypes: DECL.stTYPES; - voidtype, inttype, booltype, strtype, settype, realtype, longrealtype, chartype, niltype: DECL.pTYPE; - -PROCEDURE Load(e: DECL.EXPRESSION); -BEGIN - IF e.eType = eVAR THEN - X86.Load(e.T.tType) - END -END Load; - -PROCEDURE LenString(adr: LONGREAL): INTEGER; -VAR s: UTILS.STRCONST; -BEGIN - s := DECL.GetString(adr) - RETURN s.Len -END LenString; - -PROCEDURE Assert(cond: BOOLEAN; coord: SCAN.TCoord; code: INTEGER); -BEGIN - IF ~cond THEN - DECL.Assert(FALSE, coord, code) - END -END Assert; - -PROCEDURE Assert2(cond: BOOLEAN; code: INTEGER); -BEGIN - IF ~cond THEN - DECL.Assert(FALSE, SCAN.coord, code) - END -END Assert2; - -PROCEDURE IntType(T: DECL.pTYPE; coord: SCAN.TCoord); -BEGIN - Assert(T.tType = TINTEGER, coord, 52) -END IntType; - -PROCEDURE Next; -BEGIN - DECL.Next -END Next; - -PROCEDURE Coord(VAR coord: SCAN.TCoord); -BEGIN - coord := SCAN.coord -END Coord; - -PROCEDURE NextCoord(VAR coord: SCAN.TCoord); -BEGIN - DECL.Next; - coord := SCAN.coord -END NextCoord; - -PROCEDURE Check(key: INTEGER); -BEGIN - DECL.Check(key) -END Check; - -PROCEDURE NextCheck(key: INTEGER); -BEGIN - DECL.Next; - DECL.Check(key) -END NextCheck; - -PROCEDURE BaseOf(T0, T1: DECL.pTYPE): BOOLEAN; -BEGIN - IF (T0.tType = T1.tType) & (T0.tType IN TOBJECT) THEN - IF T0.tType = TPOINTER THEN - T0 := T0.Base; - T1 := T1.Base - END; - WHILE (T1 # NIL) & (T1 # T0) DO - T1 := T1.Base - END - END - RETURN T0 = T1 -END BaseOf; - -PROCEDURE Designator(VAR e: DECL.EXPRESSION); -VAR id, id2: DECL.IDENT; name: SCAN.NODE; e1: DECL.EXPRESSION; - coord: SCAN.TCoord; i, n, bases, glob, loc, idx: INTEGER; - imp, break, guard: BOOLEAN; f: DECL.FIELD; - T, BaseT: DECL.pTYPE; s: UTILS.STRCONST; - - PROCEDURE LoadVar; - BEGIN - IF glob # -1 THEN - X86.GlobalAdr(glob); - glob := -1 - ELSIF loc # -1 THEN - X86.LocalAdr(loc, bases); - loc := -1 - END - END LoadVar; + res: INTEGER; BEGIN - glob := -1; - loc := -1; - Coord(coord); - Check(lxIDENT); - name := SCAN.id; - id := DECL.GetIdent(name); - IF (id # NIL) & (id.iType = IDMOD) THEN - NextCheck(lxDot); - NextCheck(lxIDENT); - Coord(coord); - name := SCAN.id; - imp := id.Unit # DECL.unit; - id := DECL.GetQIdent(id.Unit, name) - END; - Assert(id # NIL, coord, 42); - e.vparam := FALSE; - e.deref := FALSE; - e.id := id; - Next; - CASE id.iType OF - |IDVAR: - e.eType := eVAR; - e.T := id.T; - IF id.VarKind = 0 THEN - e.Read := imp + IF s = mConst.Target_sConsole THEN + res := mConst.Target_iConsole + ELSIF s = mConst.Target_sGUI THEN + res := mConst.Target_iGUI + ELSIF s = mConst.Target_sDLL THEN + res := mConst.Target_iDLL + ELSIF s = mConst.Target_sKolibri THEN + res := mConst.Target_iKolibri + ELSIF s = mConst.Target_sObject THEN + res := mConst.Target_iObject + ELSIF s = mConst.Target_sConsole64 THEN + res := mConst.Target_iConsole64 + ELSIF s = mConst.Target_sGUI64 THEN + res := mConst.Target_iGUI64 + ELSIF s = mConst.Target_sDLL64 THEN + res := mConst.Target_iDLL64 + ELSIF s = mConst.Target_sELF32 THEN + res := mConst.Target_iELF32 + ELSIF s = mConst.Target_sELF64 THEN + res := mConst.Target_iELF64 ELSE - e.Read := (id.VarKind = DECL.param) & (id.T.tType IN TSTRUCT); - e.vparam := id.VarKind = DECL.paramvar - END; - bases := DECL.unit.Level - id.Level; - IF id.Level = 3 THEN - glob := id.Offset - ELSIF (id.VarKind = 0) OR (id.VarKind = DECL.param) & ~(id.T.tType IN TSTRUCT) THEN - loc := id.Offset - ELSIF (id.VarKind = DECL.paramvar) OR (id.T.tType IN TSTRUCT) THEN - IF DECL.Dim(e.T) > 0 THEN - n := DECL.Dim(e.T); - FOR i := n TO 1 BY -1 DO - X86.LocalAdr(id.Offset + i * 4, bases); - X86.Load(TINTEGER) - END - END; - X86.LocalAdr(id.Offset, bases); - X86.Load(TINTEGER) + res := 0 END - |IDCONST: - Assert(id.T # NIL, coord, 75); - e.eType := eCONST; - e.T := id.T; - e.Value := id.Value; - IF id.T.tType IN {TINTEGER, TSET, TBOOLEAN} THEN - X86.PushConst(FLOOR(e.Value)) - ELSIF id.T.tType IN TFLOAT THEN - X86.PushFlt(e.Value) - ELSIF id.T.tType = TSTRING THEN - s := DECL.GetString(e.Value); - IF s.Len = 1 THEN - X86.PushConst(ORD(s.Str[0])) - ELSE - X86.PushInt(s.Number) - END - END - |IDPROC: - e.eType := ePROC; - NEW(id2); - UTILS.MemErr(id2 = NIL); - id2^ := id^; - UTILS.Push(DECL.curproc.Procs, id2); - e.T := voidtype - |IDTYPE: - Assert(FALSE, coord, 101) - |IDSTPROC: - e.eType := eSTPROC; - e.T := voidtype - |IDSYSPROC: - e.eType := eSYSPROC; - e.T := voidtype - ELSE - END; - break := FALSE; - guard := FALSE; - REPEAT - CASE SCAN.tLex OF - |lxDot: - e.deref := FALSE; - Assert2(e.T.tType IN TOBJECT, 105); - IF e.T.tType = TPOINTER THEN - e.Read := FALSE; - LoadVar; - e.T := e.T.Base; - X86.Load(TINTEGER); - IF ~guard THEN - X86.CheckNIL - END - END; - NextCheck(lxIDENT); - Coord(coord); - name := SCAN.id; - T := e.T; - REPEAT - f := DECL.GetField(T, name); - T := T.Base - UNTIL (f # NIL) OR (T = NIL); - Assert(f # NIL, coord, 99); - IF f.Unit # DECL.unit THEN - Assert(f.Export, coord, 99) - END; - IF glob # -1 THEN - glob := glob + f.Offset - ELSIF loc # -1 THEN - loc := loc + f.Offset - ELSE - X86.Field(f.Offset) - END; - e.T := f.T; - e.vparam := FALSE; - guard := FALSE; - Next - |lxLSquare: - LoadVar; - REPEAT - Assert2(e.T.tType = TARRAY, 102); - NextCoord(coord); - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - IF e.T.Len = 0 THEN - IF e1.eType = eCONST THEN - idx := FLOOR(e1.Value); - Assert(idx >= 0, coord, 159) - END; - BaseT := DECL.OpenBase(e.T); - X86.PushConst(BaseT.Size); - X86.OpenIdx(DECL.Dim(e.T)) - ELSE - IF e1.eType = eCONST THEN - idx := FLOOR(e1.Value); - Assert((idx >= 0) & (idx < e.T.Len), coord, 159); - IF e.T.Base.Size # 1 THEN - X86.Drop; - X86.PushConst(e.T.Base.Size * idx) + + RETURN res +END Target; + + +PROCEDURE keys (VAR StackSize, BaseAddress, Version: INTEGER; VAR pic: BOOLEAN; VAR checking: SET); +VAR + param: PARS.PATH; + i, j: INTEGER; + end: BOOLEAN; + value: INTEGER; + minor, + major: INTEGER; + +BEGIN + end := FALSE; + i := 4; + REPEAT + UTILS.GetArg(i, param); + + IF param = "-stk" THEN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToInt(param, value) & (1 <= value) & (value <= 32) THEN + StackSize := value END; - X86.Idx - ELSE - X86.FixIdx(e.T.Len, e.T.Base.Size) - END - END; - e.T := e.T.Base - UNTIL SCAN.tLex # lxComma; - Check(lxRSquare); - e.vparam := FALSE; - guard := FALSE; - Next - |lxCaret: - LoadVar; - Assert2(e.T.tType = TPOINTER, 104); - e.Read := FALSE; - X86.Load(TINTEGER); - IF ~guard THEN - X86.CheckNIL - END; - e.T := e.T.Base; - e.vparam := FALSE; - e.deref := TRUE; - guard := FALSE; - Next - |lxLRound: - LoadVar; - IF e.T.tType IN TOBJECT THEN - IF e.T.tType = TRECORD THEN - Assert2(e.vparam, 108) - END; - NextCheck(lxIDENT); - Coord(coord); - T := DECL.IdType(coord); - Assert(T # NIL, coord, 42); - IF e.T.tType = TRECORD THEN - Assert(T.tType = TRECORD, coord, 106) + IF param[0] = "-" THEN + DEC(i) + END + + ELSIF param = "-base" THEN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToInt(param, value) THEN + BaseAddress := ((value DIV 64) * 64) * 1024 + END; + IF param[0] = "-" THEN + DEC(i) + END + + ELSIF param = "-nochk" THEN + INC(i); + UTILS.GetArg(i, param); + + IF param[0] = "-" THEN + DEC(i) + ELSE + j := 0; + WHILE param[j] # 0X DO + + IF param[j] = "p" THEN + EXCL(checking, ST.chkPTR) + ELSIF param[j] = "t" THEN + EXCL(checking, ST.chkGUARD) + ELSIF param[j] = "i" THEN + EXCL(checking, ST.chkIDX) + ELSIF param[j] = "b" THEN + EXCL(checking, ST.chkBYTE) + ELSIF param[j] = "c" THEN + EXCL(checking, ST.chkCHR) + ELSIF param[j] = "w" THEN + EXCL(checking, ST.chkWCHR) + ELSIF param[j] = "r" THEN + EXCL(checking, ST.chkCHR); + EXCL(checking, ST.chkWCHR); + EXCL(checking, ST.chkBYTE) + ELSIF param[j] = "a" THEN + checking := {} + END; + + INC(j) + END + END + + ELSIF param = "-ver" THEN + INC(i); + UTILS.GetArg(i, param); + IF STRINGS.StrToVer(param, major, minor) THEN + Version := major * 65536 + minor + END; + IF param[0] = "-" THEN + DEC(i) + END + + ELSIF param = "-pic" THEN + pic := TRUE + + ELSIF param = "" THEN + end := TRUE + ELSE - Assert(T.tType = TPOINTER, coord, 107) + ERRORS.error3("bad parameter: ", param, "") END; - Assert(BaseOf(e.T, T), coord, 108); - e.T := T; - Check(lxRRound); - Next; - IF e.T.tType = TPOINTER THEN - IF (SCAN.tLex = lxDot) OR (SCAN.tLex = lxCaret) THEN - X86.DupLoadCheck - ELSE - X86.DupLoad - END; - guard := TRUE; - T := T.Base - ELSE - X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) - END; - X86.Guard(T.Number, FALSE) - ELSE - break := TRUE - END - ELSE - break := TRUE - END - UNTIL break; - LoadVar -END Designator; -PROCEDURE Set(VAR e: DECL.EXPRESSION); -VAR a, b: DECL.EXPRESSION; coord: SCAN.TCoord; fpu: INTEGER; s: SET; flag: BOOLEAN; - beg: X86.ASMLINE; -BEGIN - Next; - e.eType := eEXP; - e.T := settype; - e.Value := 0.0D0; - e.vparam := FALSE; - s := {}; - flag := TRUE; - fpu := X86.fpu; - beg := X86.current; - X86.PushConst(0); - WHILE SCAN.tLex # lxRCurly DO - Coord(coord); - pExpr(a); - IntType(a.T, coord); - IF a.eType = eCONST THEN - Assert(ASR(FLOOR(a.Value), 5) = 0, coord, 53) - END; - Load(a); - b := a; - IF SCAN.tLex = lxDbl THEN - NextCoord(coord); - pExpr(b); - IntType(b.T, coord); - IF b.eType = eCONST THEN - Assert(ASR(FLOOR(b.Value), 5) = 0, coord, 53); - IF a.eType = eCONST THEN - Assert(a.Value <= b.Value, coord, 54) - END - END; - Load(b) - ELSE - X86.Dup - END; - X86.rset; - X86.Set(lxPlus); - flag := (a.eType = eCONST) & (b.eType = eCONST) & flag; - IF flag THEN - s := s + {FLOOR(a.Value) .. FLOOR(b.Value)} - END; - IF SCAN.tLex = lxComma THEN - Next; - Assert2(SCAN.tLex # lxRCurly, 36) - ELSE - Check(lxRCurly) - END - END; - IF flag THEN - e.Value := LONG(FLT(ORD(s))); - e.eType := eCONST; - X86.Del(beg); - X86.Setfpu(fpu); - IF ~DECL.Const THEN - X86.PushConst(ORD(s)) - END - END; - Next -END Set; - -PROCEDURE IsString(a: DECL.EXPRESSION): BOOLEAN; - RETURN (a.T.tType = TSTRING) OR (a.T.tType = TARRAY) & (a.T.Base.tType = TCHAR) -END IsString; - -PROCEDURE Str(e: DECL.EXPRESSION); -VAR A: X86.TIDX; -BEGIN - IF (e.T.tType = TARRAY) & (e.T.Base.tType = TCHAR) & (e.T.Len # 0) THEN - A[0] := e.T.Len; - X86.OpenArray(A, 1) - ELSIF e.T.tType = TSTRING THEN - A[0] := LenString(e.Value) + 1; - IF A[0] # 2 THEN - X86.OpenArray(A, 1) - END - END -END Str; - -PROCEDURE StFunc(VAR e: DECL.EXPRESSION; func: INTEGER); -VAR coord, coord2: SCAN.TCoord; a, b, p: INTEGER; e1, e2: DECL.EXPRESSION; - T: DECL.pTYPE; str, str2: UTILS.STRCONST; -BEGIN - e.vparam := FALSE; - e.eType := eEXP; - Coord(coord2); - Check(lxLRound); - NextCoord(coord); - CASE func OF - |stABS: - pExpr(e1); - Assert(e1.T.tType IN TNUM, coord, 57); - Load(e1); - IF e1.eType = eCONST THEN - e.Value := ABS(e1.Value); - e.eType := eCONST; - Assert(~((e1.T.tType = TINTEGER) & (e1.Value = LONG(FLT(SCAN.minINT)))), coord, DECL.IOVER) - END; - IF e1.T.tType = TINTEGER THEN - X86.StFunc(X86.stABS) - ELSE - X86.StFunc(X86.stFABS) - END; - e.T := e1.T - |stODD: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - IF e1.eType = eCONST THEN - e.Value := LONG(FLT(ORD(ODD(FLOOR(e1.Value))))); - e.eType := eCONST - END; - X86.StFunc(X86.stODD); - e.T := booltype - |stLEN: - Designator(e1); - Assert((e1.eType = eVAR) & (e1.T.tType = TARRAY), coord, 102); - IF e1.T.Len > 0 THEN - X86.Len(-e1.T.Len) - ELSE - X86.Len(DECL.Dim(e1.T)) - END; - e.T := inttype - |stLSL, stASR, stROR, stLSR: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - Check(lxComma); - NextCoord(coord); - pExpr(e2); - IntType(e2.T, coord); - Load(e2); - IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN - a := FLOOR(e1.Value); - b := FLOOR(e2.Value); - CASE func OF - |stLSL: a := LSL(a, b) - |stASR: a := ASR(a, b) - |stROR: a := ROR(a, b) - |stLSR: a := LSR(a, b) - ELSE - END; - e.Value := LONG(FLT(a)); - e.eType := eCONST - END; - CASE func OF - |stLSL: X86.StFunc(X86.stLSL) - |stASR: X86.StFunc(X86.stASR) - |stROR: X86.StFunc(X86.stROR) - |stLSR: X86.StFunc(X86.stLSR) - ELSE - END; - e.T := inttype - |stFLOOR: - pExpr(e1); - Assert(e1.T.tType IN TFLOAT, coord, 66); - Load(e1); - IF e1.eType = eCONST THEN - Assert((e1.Value - 1.0D0 < LONG(FLT(SCAN.maxINT))) & (e1.Value >= LONG(FLT(SCAN.minINT))), coord, 74); - e.Value := LONG(FLT(FLOOR(e1.Value))); - e.eType := eCONST - END; - X86.StFunc(X86.stFLOOR); - e.T := inttype - |stFLT: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - IF e1.eType = eCONST THEN - e.Value := e1.Value; - e.eType := eCONST - END; - X86.StFunc(X86.stFLT); - e.T := realtype - |stORD: - pExpr(e1); - Assert(e1.T.tType IN {TCHAR, TBOOLEAN, TSET, TSTRING}, coord, 68); - IF e1.T.tType = TSTRING THEN - Assert(LenString(e1.Value) = 1, coord, 94) - END; - Load(e1); - IF e1.eType = eCONST THEN - IF e1.T.tType = TSTRING THEN - str := DECL.GetString(e1.Value); - e.Value := LONG(FLT(ORD(str.Str[0]))) - ELSE - e.Value := e1.Value - END; - e.eType := eCONST - END; - IF e1.T.tType = TBOOLEAN THEN - X86.StFunc(X86.stORD) - END; - e.T := inttype - |stBITS: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - IF e1.eType = eCONST THEN - e.Value := e1.Value; - e.eType := eCONST - END; - e.T := settype - |stCHR: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - e.T := chartype; - IF e1.eType = eCONST THEN - Assert(ASR(FLOOR(e1.Value), 8) = 0, coord, 76); - str2 := DECL.AddMono(CHR(FLOOR(e1.Value))); - SYSTEM.GET(SYSTEM.ADR(str2), p); - e.Value := LONG(FLT(p)); - e.T := strtype; - e.eType := eCONST - END - |stLONG: - pExpr(e1); - Assert(e1.T.tType = TREAL, coord, 71); - IF e1.eType = eCONST THEN - e.Value := e1.Value; - e.eType := eCONST - END; - Load(e1); - e.T := longrealtype - |stSHORT: - pExpr(e1); - Assert(e1.T.tType = TLONGREAL, coord, 70); - IF e1.eType = eCONST THEN - Assert(ABS(e1.Value) <= LONG(SCAN.maxREAL), coord, DECL.FOVER); - Assert(ABS(e1.Value) >= LONG(SCAN.minREAL), coord, DECL.UNDER); - e.Value := e1.Value; - e.eType := eCONST - END; - Load(e1); - e.T := realtype - |stLENGTH: - pExpr(e1); - Assert(IsString(e1), coord, 141); - IF e1.T.tType = TSTRING THEN - str := DECL.GetString(e1.Value); - IF str.Len = 1 THEN - X86.Mono(str.Number); - X86.StrMono - END; - e.Value := LONG(FLT(LENGTH(str.Str))); - e.eType := eCONST - END; - Str(e1); - e.T := inttype; - X86.StFunc(X86.stLENGTH) - |stMIN, stMAX: - pExpr(e1); - IntType(e1.T, coord); - Load(e1); - Check(lxComma); - NextCoord(coord); - pExpr(e2); - IntType(e2.T, coord); - Load(e2); - IF (e1.eType = eCONST) & (e2.eType = eCONST) THEN - a := FLOOR(e1.Value); - b := FLOOR(e2.Value); - CASE func OF - |stMIN: a := MIN(a, b) - |stMAX: a := MAX(a, b) - ELSE - END; - e.Value := LONG(FLT(a)); - e.eType := eCONST - END; - IF func = stMIN THEN - X86.StFunc(X86.stMIN) - ELSE - X86.StFunc(X86.stMAX) - END; - e.T := inttype - |sysADR: - Assert((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxSTRING) OR (SCAN.tLex = lxCHX), coord, 43); - IF SCAN.tLex = lxIDENT THEN - Designator(e1); - Assert((e1.eType = eVAR) OR (e1.eType = ePROC) OR (e1.T = strtype), coord, 43); - IF e1.eType = ePROC THEN - X86.PushInt(e1.id.Number) - END - ELSE - pFactor(e1) - END; - IF e1.T = strtype THEN - str := DECL.GetString(e1.Value); - IF str.Len = 1 THEN - X86.Drop; - X86.PushInt(str.Number) - END - END; - e.T := inttype; - X86.ADR(DECL.Dim(e1.T)) - |sysSIZE, sysTYPEID, sysINF: - DECL.SetSizeFunc; - Check(lxIDENT); - T := DECL.IdType(coord); - Assert(T # NIL, coord, 42); - e.eType := eCONST; - IF func = sysTYPEID THEN - e.T := inttype; - Assert(T.tType IN TOBJECT, coord, 47); - IF T.tType = TPOINTER THEN - T := T.Base - END; - e.Value := LONG(FLT(T.Number)); - X86.PushConst(T.Number) - ELSIF func = sysSIZE THEN - e.T := inttype; - e.Value := LONG(FLT(T.Size)); - X86.PushConst(T.Size) - ELSIF func = sysINF THEN - Assert(T.tType IN TFLOAT, coord, 91); - e.T := T; - e.Value := SYSTEM.INF(LONGREAL); - X86.PushFlt(e.Value) - END - ELSE - Assert(FALSE, coord2, 73) - END; - Check(lxRRound); - Next -END StFunc; - -PROCEDURE ProcTypeComp(T1, T2: DECL.pTYPE): BOOLEAN; -VAR sp: INTEGER; stk: ARRAY 100, 2 OF DECL.pTYPE; - - PROCEDURE ProcTypeComp1(T1, T2: DECL.pTYPE): BOOLEAN; - VAR fp, ft: DECL.FIELD; Res: BOOLEAN; - - PROCEDURE TypeComp(T1, T2: DECL.pTYPE): BOOLEAN; - VAR Res: BOOLEAN; - BEGIN - IF (T1.tType = TARRAY) & (T2.tType = TARRAY) & (T1.Len = 0) & (T2.Len = 0) THEN - Res := TypeComp(T1.Base, T2.Base) - ELSE - Res := ProcTypeComp1(T1, T2) - END - RETURN Res - END TypeComp; - - PROCEDURE Check(): BOOLEAN; - VAR i: INTEGER; res: BOOLEAN; - BEGIN - i := 0; - res := FALSE; - WHILE (i < sp) & ~res DO - res := ((stk[i][0] = T1) & (stk[i][1] = T2)) OR ((stk[i][0] = T2) & (stk[i][1] = T1)); INC(i) - END - RETURN res - END Check; + UNTIL end - BEGIN - INC(sp); - stk[sp][0] := T1; - stk[sp][1] := T2; - IF Check() THEN - Res := TRUE - ELSE - IF (T1.tType = TPROC) & (T2.tType = TPROC) & (T1 # T2) THEN - Res := (T1.Call = T2.Call) & (T1.Fields.Count = T2.Fields.Count) & ProcTypeComp1(T1.Base, T2.Base); - fp := T1.Fields.First(DECL.FIELD); - ft := T2.Fields.First(DECL.FIELD); - WHILE Res & (fp # NIL) DO - Res := (fp.ByRef = ft.ByRef) & TypeComp(fp.T, ft.T); - fp := fp.Next(DECL.FIELD); - ft := ft.Next(DECL.FIELD) - END - ELSE - Res := T1 = T2 - END - END; - DEC(sp) - RETURN Res - END ProcTypeComp1; +END keys; + + +PROCEDURE main; +VAR + path: PARS.PATH; + inname: PARS.PATH; + ext: PARS.PATH; + app_path: PARS.PATH; + lib_path: PARS.PATH; + modname: PARS.PATH; + outname: PARS.PATH; + param: PARS.PATH; + temp: PARS.PATH; + + target: INTEGER; + + time: INTEGER; + + StackSize, + Version, + BaseAdr: INTEGER; + pic: BOOLEAN; + checking: SET; + + bits64: BOOLEAN; BEGIN - sp := -1 - RETURN ProcTypeComp1(T1, T2) -END ProcTypeComp; + StackSize := 2; + Version := 65536; + pic := FALSE; + checking := ST.chkALL; -PROCEDURE ArrComp(Ta, Tf: DECL.pTYPE): BOOLEAN; -VAR Res: BOOLEAN; -BEGIN - IF (Tf.tType = TARRAY) & (Tf.Len = 0) & (Ta.tType = TARRAY) THEN - Res := ArrComp(Ta.Base, Tf.Base) - ELSE - Res := ProcTypeComp(Ta, Tf) - END - RETURN Res -END ArrComp; + PATHS.GetCurrentDirectory(app_path); + lib_path := app_path; -PROCEDURE AssComp(e: DECL.EXPRESSION; T: DECL.pTYPE; param: BOOLEAN): BOOLEAN; -VAR Res: BOOLEAN; -BEGIN - CASE T.tType OF - |TINTEGER, TREAL, TLONGREAL, TSET, TBOOLEAN, TCARD16: - Res := e.T = T - |TCHAR: - IF e.T.tType = TSTRING THEN - Res := LenString(e.Value) = 1 - ELSE - Res := e.T.tType = TCHAR - END - |TARRAY: - IF param THEN - IF T.Len = 0 THEN - IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN - Res := TRUE - ELSE - Res := ArrComp(e.T, T) - END - ELSE - IF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN - Res := LenString(e.Value) <= T.Len - ELSE - Res := e.T = T - END - END - ELSE - IF T.Len = 0 THEN - Res := FALSE - ELSIF (T.Base.tType = TCHAR) & (e.T.tType = TSTRING) THEN - Res := LenString(e.Value) <= T.Len - ELSE - Res := e.T = T - END - END - |TRECORD: Res := BaseOf(T, e.T) - |TPOINTER: Res := BaseOf(T, e.T) OR (e.T.tType = TNIL) - |TPROC: Res := (e.T.tType = TNIL) OR (e.eType = ePROC) & ProcTypeComp(e.id.T, T) OR - (e.eType # ePROC) & ProcTypeComp(e.T, T) - ELSE - Res := FALSE - END - RETURN Res -END AssComp; + UTILS.GetArg(1, inname); -PROCEDURE ParamComp(e: DECL.EXPRESSION; T: DECL.pTYPE; ByRef: BOOLEAN): BOOLEAN; -VAR Res: BOOLEAN; -BEGIN - IF ByRef THEN - IF e.eType = eVAR THEN - CASE T.tType OF - |TINTEGER, TREAL, TLONGREAL, TCHAR, - TSET, TBOOLEAN, TPOINTER, TCARD16: - Res := e.T = T - |TARRAY: - IF T.Len > 0 THEN - Res := e.T = T - ELSE - Res := ArrComp(e.T, T) - END - |TRECORD: - Res := BaseOf(T, e.T) - |TPROC: - Res := ProcTypeComp(e.T, T) - ELSE - END - ELSE - Res := FALSE - END - ELSE - Res := AssComp(e, T, TRUE) - END - RETURN Res -END ParamComp; - -PROCEDURE Call(param: DECL.FIELD); -VAR coord: SCAN.TCoord; i, n: INTEGER; e1: DECL.EXPRESSION; s: UTILS.STRCONST; A: X86.TIDX; TA: DECL.pTYPE; -BEGIN - WHILE param # NIL DO - Coord(coord); - X86.Param; - pExpr(e1); - Assert(ParamComp(e1, param.T, param.ByRef), coord, 114); - Assert(~(param.ByRef & e1.Read), coord, 115); - Assert(~((e1.eType = ePROC) & (e1.id.Level > 3)), coord, 116); - IF (e1.eType = eVAR) & ~param.ByRef THEN - X86.Load(e1.T.tType) - END; - IF param.ByRef & (e1.T.tType = TRECORD) THEN - IF e1.vparam THEN - X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); - X86.Load(TINTEGER) - ELSIF e1.deref THEN - X86.DerefType(0) - ELSE - X86.PushConst(e1.T.Number) - END - END; - IF ~param.ByRef & (param.T.tType IN TFLOAT) THEN - X86.DropFpu(param.T.tType = TLONGREAL) - END; - IF (e1.T.tType = TSTRING) & (param.T.tType = TARRAY) THEN - IF param.T.Len > X86.maxstrlen THEN - X86.set_maxstrlen(param.T.Len) - END; - s := DECL.GetString(e1.Value); - IF s.Len = 1 THEN - X86.Mono(s.Number) - END; - IF param.T.Len = 0 THEN - A[0] := s.Len + 1; - X86.OpenArray(A, 1) - END - END; - IF (e1.T.tType = TARRAY) & (DECL.Dim(param.T) > DECL.Dim(e1.T)) THEN - n := DECL.Dim(param.T) - DECL.Dim(e1.T); - TA := DECL.OpenBase(e1.T); - FOR i := 0 TO n - 1 DO - A[i] := TA.Len; - TA := TA.Base - END; - IF DECL.Dim(e1.T) = 0 THEN - X86.OpenArray(A, n) - ELSE - X86.ExtArray(A, n, DECL.Dim(e1.T)) - END - END; - param := param.Next(DECL.FIELD); - IF param # NIL THEN - Check(lxComma); - Next - END - END; - Check(lxRRound); - Next -END Call; - -PROCEDURE Factor(VAR e: DECL.EXPRESSION); -VAR coord: SCAN.TCoord; ccall, p: INTEGER; begcall: X86.ASMLINE; s, str2: UTILS.STRCONST; -BEGIN - e.eType := eCONST; - e.vparam := FALSE; - CASE SCAN.tLex OF - |lxIDENT: - begcall := X86.current; - Designator(e); - IF e.eType = ePROC THEN - IF SCAN.tLex = lxLRound THEN - Assert2(e.id.T.Base.tType # TVOID, 73); - Next; - X86.PushCall(begcall); - Call(e.id.T.Fields.First(DECL.FIELD)); - X86.EndCall; - e.eType := eEXP; - e.T := e.id.T.Base; - IF e.id.Level = 3 THEN - ccall := 0 - ELSIF e.id.Level > DECL.curBlock.Level THEN - ccall := 1 - ELSE - ccall := 2 + IF inname = "" THEN + C.String("Akron Oberon-07/16 Compiler v"); C.Int(mConst.vMajor); C.String("."); C.Int2(mConst.vMinor); + C.String(" ("); C.Int(UTILS.bit_depth); C.StringLn("-bit)"); C.Ln; + C.StringLn("Usage: Compiler
[optional settings]"); C.Ln; + IF UTILS.bit_depth = 64 THEN + C.StringLn('target = console | gui | dll | console64 | gui64 | dll64 | kos | obj | elfexe | elfexe64'); C.Ln; + ELSIF UTILS.bit_depth = 32 THEN + C.StringLn('target = console | gui | dll | kos | obj | elfexe'); C.Ln; END; - X86.Call(e.id.Number, TRUE, e.T.tType IN TFLOAT, e.id.T.Call, ccall, e.id.Level - 3, - DECL.curBlock.Level - 3, e.id.ParamSize, DECL.curBlock.LocalSize) - ELSE - X86.PushInt(e.id.Number) - END - ELSIF (e.eType = eVAR) & (e.T.tType = TPROC) & (SCAN.tLex = lxLRound) THEN - Assert2(e.T.Base.tType # TVOID, 73); - Next; - X86.PushCall(begcall); - Call(e.T.Fields.First(DECL.FIELD)); - X86.EndCall; - e.eType := eEXP; - X86.CallVar(TRUE, e.T.Base.tType IN TFLOAT, e.T.Call, e.T.Len, DECL.curBlock.LocalSize); - e.T := e.T.Base; - ELSIF e.eType IN {eSTPROC, eSYSPROC} THEN - StFunc(e, e.id.StProc) - END - |lxNIL: - e.T := niltype; - e.Value := 0.0D0; - X86.PushConst(0); - Next - |lxTRUE: - e.T := booltype; - e.Value := 1.0D0; - X86.PushConst(1); - Next - |lxFALSE: - e.T := booltype; - e.Value := 0.0D0; - X86.PushConst(0); - Next - |lxCHX, lxSTRING: - IF SCAN.tLex = lxSTRING THEN - str2 := DECL.AddString(SCAN.Lex); - SYSTEM.GET(SYSTEM.ADR(str2), p); - e.Value := LONG(FLT(p)); - s := DECL.GetString(e.Value); - IF s.Len = 1 THEN - X86.PushConst(ORD(s.Str[0])) - ELSE - X86.PushInt(s.Number) - END - ELSE - str2 := DECL.AddMono(SCAN.vCHX); - SYSTEM.GET(SYSTEM.ADR(str2), p); - e.Value := LONG(FLT(p)); - X86.PushConst(ORD(SCAN.vCHX)) + C.StringLn("optional settings:"); C.Ln; + C.StringLn(" -stk set size of stack in megabytes"); C.Ln; + C.StringLn(" -base
set base address of image in kilobytes"); C.Ln; + C.StringLn(' -ver set version of program'); C.Ln; + C.StringLn(' -nochk <"ptibcwra"> disable runtime checking (pointers, types, indexes,'); + C.StringLn(' BYTE, CHR, WCHR)'); C.Ln; + UTILS.Exit(0) END; - e.T := strtype; - Next - |lxREAL: - e.T := realtype; - e.Value := SCAN.vFLT; - X86.PushFlt(SCAN.vFLT); - Next - |lxLONGREAL: - e.T := longrealtype; - e.Value := SCAN.vFLT; - X86.PushFlt(SCAN.vFLT); - Next - |lxINT, lxHEX: - e.T := inttype; - e.Value := LONG(FLT(SCAN.vINT)); - X86.PushConst(SCAN.vINT); - Next - |lxLRound: - Next; - pExpr(e); - Check(lxRRound); - Next - |lxNot: - NextCoord(coord); - Factor(e); - Assert(e.T.tType = TBOOLEAN, coord, 37); - Load(e); - IF e.eType = eCONST THEN - e.Value := LONG(FLT(ORD(e.Value = 0.0D0))) - ELSE - e.eType := eEXP + + PATHS.split(inname, path, modname, ext); + + IF ext # mConst.FILE_EXT THEN + ERRORS.error3('inputfile name extension must be "', mConst.FILE_EXT, '"') END; - X86.Not; - e.vparam := FALSE - |lxLCurly: - Set(e) - ELSE - Assert2(FALSE, 36) - END -END Factor; - -PROCEDURE IsChr(a: DECL.EXPRESSION): BOOLEAN; - RETURN (a.T.tType = TSTRING) & (LenString(a.Value) = 1) OR (a.T.tType = TCHAR) -END IsChr; - -PROCEDURE StrRel(a, b: DECL.EXPRESSION; Op: INTEGER); -BEGIN - IF ~(IsChr(a) OR IsChr(b)) THEN - X86.strcmp(Op, 0) - ELSIF IsChr(a) & IsChr(b) THEN - X86.CmpInt(Op) - ELSIF IsChr(a) THEN - X86.strcmp(Op, 1) - ELSE - X86.strcmp(Op, -1) - END -END StrRel; - -PROCEDURE log2(n: INTEGER): INTEGER; -VAR x, i: INTEGER; -BEGIN - x := 1; - i := 0; - WHILE (x # n) & (i < 31) DO - x := LSL(x, 1); - INC(i) - END; - IF x # n THEN - i := -1 - END - RETURN i -END log2; - -PROCEDURE Operation(VAR a, b: DECL.EXPRESSION; Op: INTEGER; coord: SCAN.TCoord); -VAR n, m: INTEGER; -BEGIN - CASE Op OF - |lxPlus, lxMinus, lxMult, lxSlash: - Assert((a.T.tType IN (TNUM + {TSET})) & (a.T.tType = b.T.tType), coord, 37); - Assert(~((Op = lxSlash) & (a.T.tType = TINTEGER)), coord, 37); - CASE a.T.tType OF - |TINTEGER: X86.Int(Op) - |TSET: X86.Set(Op) - |TREAL, TLONGREAL: X86.farith(Op) - ELSE - END - |lxDIV, lxMOD: - Assert((a.T.tType = TINTEGER) & (b.T.tType = TINTEGER), coord, 37); - IF b.eType = eCONST THEN - m := FLOOR(b.Value); - Assert(m # 0, coord, 48); - n := log2(m); - IF n = -1 THEN - X86.idivmod(Op = lxMOD) - ELSE - X86.Drop; - IF Op = lxMOD THEN - n := ORD(-BITS(LSL(-1, n))); - X86.PushConst(n); - X86.Set(lxMult) - ELSE - X86.PushConst(n); - X86.StFunc(X86.stASR) - END - END - ELSE - X86.idivmod(Op = lxMOD) - END - |lxAnd, lxOR: - Assert((a.T.tType = TBOOLEAN) & (b.T.tType = TBOOLEAN), coord, 37) - |lxIN: - Assert((a.T.tType = TINTEGER) & (b.T.tType = TSET), coord, 37); - X86.inset - |lxLT, lxLE, lxGT, lxGE: - Assert(((a.T.tType IN TNUM) & (a.T.tType = b.T.tType)) OR - (IsChr(a) OR IsString(a)) & (IsChr(b) OR IsString(b)) OR - (a.T.tType = TSET) & (b.T.tType = TSET) & ((Op = lxLE) OR (Op = lxGE)), coord, 37); - IF a.T.tType IN TFLOAT THEN - X86.fcmp(Op) - ELSIF a.T.tType = TSET THEN - X86.Inclusion(Op) - ELSIF IsString(a) OR IsString(b) THEN - StrRel(a, b, Op) - ELSE - X86.CmpInt(Op) - END - |lxEQ, lxNE: - Assert(((a.T.tType IN (TNUM + {TSET, TBOOLEAN})) & (a.T.tType = b.T.tType)) OR - (IsChr(a) OR IsString(a)) & (IsChr(b) OR IsString(b)) OR - (a.T.tType IN {TPOINTER, TPROC, TNIL}) & (b.T.tType = TNIL) OR - (b.T.tType IN {TPOINTER, TPROC, TNIL}) & (a.T.tType = TNIL) OR - (a.T.tType = TPOINTER) & (b.T.tType = TPOINTER) & (BaseOf(a.T, b.T) OR BaseOf(b.T, a.T)) OR - (a.T.tType = TPROC) & ProcTypeComp(b.T, a.T) OR (a.eType = ePROC) & ProcTypeComp(b.T, a.id.T) OR - (b.eType = ePROC) & ProcTypeComp(a.T, b.id.T), coord, 37); - IF a.T.tType IN TFLOAT THEN - X86.fcmp(Op) - ELSIF IsString(a) OR IsString(b) THEN - StrRel(a, b, Op) - ELSE - X86.CmpInt(Op) - END - ELSE - END; - IF (a.eType # eCONST) OR (b.eType # eCONST) THEN - a.eType := eEXP; - IF DECL.Relation(Op) THEN - a.T := booltype - END - ELSE - DECL.Calc(a.Value, b.Value, a.T, b.T, Op, coord, a.Value, a.T) - END; - a.vparam := FALSE -END Operation; - -PROCEDURE Term(VAR e: DECL.EXPRESSION); -VAR a: DECL.EXPRESSION; Op, L: INTEGER; coord: SCAN.TCoord; -BEGIN - Factor(e); - WHILE (SCAN.tLex = lxMult) OR (SCAN.tLex = lxSlash) OR - (SCAN.tLex = lxDIV) OR (SCAN.tLex = lxMOD) OR - (SCAN.tLex = lxAnd) DO - Load(e); - Coord(coord); - Op := SCAN.tLex; - Next; - IF Op = lxAnd THEN - L := X86.NewLabel(); - X86.IfWhile(L, FALSE) + IF PATHS.isRelative(path) THEN + PATHS.RelPath(app_path, path, temp); + path := temp END; - Factor(a); - Load(a); - IF Op = lxAnd THEN - X86.Label(L) + + UTILS.GetArg(2, outname); + IF outname = "" THEN + ERRORS.error1("not enough parameters") END; - Operation(e, a, Op, coord) - END -END Term; - -PROCEDURE Simple(VAR e: DECL.EXPRESSION); -VAR a: DECL.EXPRESSION; Op, uOp, L: INTEGER; coord, ucoord: SCAN.TCoord; -BEGIN - uOp := 0; - IF (SCAN.tLex = lxPlus) OR (SCAN.tLex = lxMinus) THEN - Coord(ucoord); - uOp := SCAN.tLex; - Next - END; - Term(e); - IF uOp # 0 THEN - Assert(e.T.tType IN (TNUM + {TSET}), ucoord, 37); - Load(e); - IF uOp = lxMinus THEN - CASE e.T.tType OF - |TINTEGER: X86.NegInt - |TSET: X86.NegSet - |TREAL, TLONGREAL: X86.fneg - ELSE - END + IF PATHS.isRelative(outname) THEN + PATHS.RelPath(app_path, outname, temp); + outname := temp END; - IF (uOp = lxMinus) & (e.eType = eCONST) THEN - CASE e.T.tType OF - |TINTEGER: - Assert(e.Value # LONG(FLT(SCAN.minINT)), ucoord, DECL.IOVER) - |TSET: - e.Value := -LONG(FLT(ORD(-BITS(FLOOR(e.Value))))) - ELSE - END; - e.Value := -e.Value + + UTILS.GetArg(3, param); + IF param = "" THEN + ERRORS.error1("not enough parameters") END; - IF e.eType # eCONST THEN - e.eType := eEXP + + target := Target(param); + + IF target = 0 THEN + ERRORS.error1("bad parameter ") END; - e.vparam := FALSE - END; - WHILE (SCAN.tLex = lxPlus) OR (SCAN.tLex = lxMinus) OR (SCAN.tLex = lxOR) DO - Load(e); - Coord(coord); - Op := SCAN.tLex; - Next; - IF Op = lxOR THEN - L := X86.NewLabel(); - X86.IfWhile(L, TRUE) - END; - Term(a); - Load(a); - IF Op = lxOR THEN - X86.Label(L) - END; - Operation(e, a, Op, coord) - END -END Simple; -PROCEDURE Expr(VAR e: DECL.EXPRESSION); -VAR a: DECL.EXPRESSION; coord, coord2: SCAN.TCoord; Op, fpu: INTEGER; T: DECL.pTYPE; beg: X86.ASMLINE; s: UTILS.STRCONST; -BEGIN - fpu := X86.fpu; - beg := X86.current; - Simple(e); - IF DECL.Relation(SCAN.tLex) THEN - Coord(coord); - Op := SCAN.tLex; - Next; - IF Op = lxIS THEN - Assert(e.T.tType IN TOBJECT, coord, 37); - IF e.T.tType = TRECORD THEN - Assert(e.vparam, coord, 37) - END; - Check(lxIDENT); - Coord(coord2); - T := DECL.IdType(coord2); - Assert(T # NIL, coord2, 42); - IF e.T.tType = TRECORD THEN - Assert(T.tType = TRECORD, coord2, 106) - ELSE - Assert(T.tType = TPOINTER, coord2, 107) - END; - Assert(BaseOf(e.T, T), coord, 37); - IF e.T.tType = TRECORD THEN - X86.Drop; - X86.LocalAdr(e.id.Offset, DECL.unit.Level - e.id.Level) - END; - Load(e); - IF e.T.tType = TPOINTER THEN - T := T.Base - END; - X86.Guard(T.Number, TRUE); - e.T := booltype; - e.eType := eEXP; - e.vparam := FALSE - ELSE - Load(e); - Str(e); - Simple(a); - Load(a); - Str(a); - Operation(e, a, Op, coord) - END - END; - IF e.eType = eCONST THEN - X86.Del(beg); - X86.Setfpu(fpu); - IF ~DECL.Const THEN - CASE e.T.tType OF - |TREAL, TLONGREAL: - X86.PushFlt(e.Value) - |TINTEGER, TSET, TBOOLEAN, TNIL: - X86.PushConst(FLOOR(e.Value)) - |TSTRING: - s := DECL.GetString(e.Value); - IF s.Len = 1 THEN - X86.PushConst(ORD(s.Str[0])) - ELSE - X86.PushInt(s.Number) - END - ELSE - END - END - END -END Expr; + bits64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; -PROCEDURE IfWhileOper(wh: BOOLEAN); -VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; L, L3: INTEGER; -BEGIN - L := X86.NewLabel(); - IF wh THEN - X86.Label(L) - END; - REPEAT - NextCoord(coord); - Expr(e); - Assert(e.T.tType = TBOOLEAN, coord, 117); - Load(e); - IF wh THEN - Check(lxDO) - ELSE - Check(lxTHEN) - END; - L3 := X86.NewLabel(); - X86.ifwh(L3); - Next; - pOpSeq; - X86.jmp(X86.JMP, L); - X86.Label(L3) - UNTIL SCAN.tLex # lxELSIF; - IF ~wh & (SCAN.tLex = lxELSE) THEN - Next; - pOpSeq - END; - Check(lxEND); - IF ~wh THEN - X86.Label(L) - END; - Next -END IfWhileOper; - -PROCEDURE RepeatOper; -VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; L: INTEGER; -BEGIN - Next; - L := X86.NewLabel(); - X86.Label(L); - pOpSeq; - Check(lxUNTIL); - NextCoord(coord); - Expr(e); - Assert(e.T.tType = TBOOLEAN, coord, 117); - Load(e); - X86.ifwh(L) -END RepeatOper; - -PROCEDURE ForOper; -VAR e: DECL.EXPRESSION; coord: SCAN.TCoord; LBeg, LEnd, iValue: INTEGER; Value: LONGREAL; - T: DECL.pTYPE; name: SCAN.NODE; id: DECL.IDENT; -BEGIN - NextCheck(lxIDENT); - name := SCAN.id; - id := DECL.GetIdent(name); - Assert2(id # NIL, 42); - Assert2(id.iType = IDVAR, 126); - Assert2(id.VarKind = 0, 127); - Assert2(id.T.tType = TINTEGER, 128); - Assert2(id.Level = DECL.unit.Level, 129); - NextCheck(lxAssign); - NextCoord(coord); - IF id.Level = 3 THEN - X86.GlobalAdr(id.Offset) - ELSE - X86.LocalAdr(id.Offset, 0) - END; - X86.Dup; - Expr(e); - IntType(e.T, coord); - Load(e); - X86.Save(TINTEGER); - Check(lxTO); - NextCoord(coord); - Expr(e); - IntType(e.T, coord); - Load(e); - iValue := 1; - IF SCAN.tLex = lxBY THEN - NextCoord(coord); - DECL.ConstExpr(Value, T); - IntType(T, coord); - iValue := FLOOR(Value); - Assert(iValue # 0, coord, 122) - END; - Check(lxDO); - Next; - X86.For(iValue > 0, LBeg, LEnd); - pOpSeq; - X86.NextFor(iValue, LBeg, LEnd); - Check(lxEND); - Next -END ForOper; - -PROCEDURE CheckLabel(a, b: INTEGER; Labels: UTILS.LIST): BOOLEAN; -VAR cur: LABEL; -BEGIN - cur := Labels.First(LABEL); - WHILE (cur # NIL) & ((b < cur.a) OR (a > cur.b)) DO - cur := cur.Next(LABEL) - END - RETURN cur = NIL -END CheckLabel; - -PROCEDURE LabelVal(VAR a: INTEGER; int: BOOLEAN); -VAR Value: LONGREAL; T: DECL.pTYPE; s: UTILS.STRCONST; coord: SCAN.TCoord; -BEGIN - Coord(coord); - DECL.ConstExpr(Value, T); - IF int THEN - Assert(T.tType = TINTEGER, coord, 161); - a := FLOOR(Value) - ELSE - Assert(T.tType = TSTRING, coord, 55); - s := DECL.GetString(Value); - Assert(s.Len = 1, coord, 94); - a := ORD(s.Str[0]) - END -END LabelVal; - -PROCEDURE Label(int: BOOLEAN; Labels: UTILS.LIST; LBeg: INTEGER); -VAR a, b: INTEGER; label: LABEL; coord: SCAN.TCoord; -BEGIN - Coord(coord); - LabelVal(a, int); - b := a; - IF SCAN.tLex = lxDbl THEN - Next; - LabelVal(b, int) - END; - Assert(a <= b, coord, 54); - Assert(CheckLabel(a, b, Labels), coord, 100); - NEW(label); - DECL.MemErr(label = NIL); - label.a := a; - label.b := b; - UTILS.Push(Labels, label); - X86.CaseLabel(a, b, LBeg) -END Label; - -PROCEDURE Variant(int: BOOLEAN; Labels: UTILS.LIST; EndCase: INTEGER); -VAR LBeg, LEnd: INTEGER; -BEGIN - LBeg := X86.NewLabel(); - LEnd := X86.NewLabel(); - IF ~((SCAN.tLex = lxStick) OR (SCAN.tLex = lxEND)) THEN - Label(int, Labels, LBeg); - WHILE SCAN.tLex = lxComma DO - Next; - Label(int, Labels, LBeg) - END; - Check(lxColon); - Next; - X86.jmp(X86.JMP, LEnd); - X86.Label(LBeg); - pOpSeq; - X86.jmp(X86.JMP, EndCase); - X86.Label(LEnd) - END -END Variant; - -PROCEDURE CaseOper; -VAR e: DECL.EXPRESSION; int: BOOLEAN; coord: SCAN.TCoord; EndCase: INTEGER; Labels: UTILS.LIST; -BEGIN - NextCoord(coord); - Expr(e); - Assert(e.T.tType IN {TCHAR, TSTRING, TINTEGER}, coord, 156); - Assert(~((e.T.tType = TSTRING) & (LenString(e.Value) # 1)), coord, 94); - int := e.T.tType = TINTEGER; - Check(lxOF); - Load(e); - X86.Drop; - Labels := UTILS.CreateList(); - Next; - EndCase := X86.NewLabel(); - Variant(int, Labels, EndCase); - WHILE SCAN.tLex = lxStick DO - Next; - Variant(int, Labels, EndCase) - END; - IF SCAN.tLex = lxELSE THEN - Next; - pOpSeq - ELSE - UTILS.UnitLine(DECL.UnitNumber, SCAN.coord.line); - X86.OnError(7) - END; - Check(lxEND); - X86.Label(EndCase); - Next; - UTILS.Clear(Labels) -END CaseOper; - -PROCEDURE CheckCode(Code: UTILS.STRING; Len: INTEGER; coord: SCAN.TCoord); -VAR i: INTEGER; -BEGIN - Assert(~ODD(Len), coord, 34); - FOR i := 0 TO Len - 1 DO - Assert(SCAN.HexDigit(Code[i]), coord, 34) - END -END CheckCode; - -PROCEDURE StProc(proc: INTEGER); -VAR coord, coord2: SCAN.TCoord; iValue: INTEGER; e1, e2: DECL.EXPRESSION; Value: LONGREAL; - T: DECL.pTYPE; str: UTILS.STRCONST; begcall: X86.ASMLINE; -BEGIN - Coord(coord2); - Check(lxLRound); - NextCoord(coord); - CASE proc OF - |stINC, stDEC: - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Assert(~e1.Read, coord, 115); - Assert(e1.T.tType = TINTEGER, coord, 128); - IF SCAN.tLex = lxComma THEN - NextCoord(coord); - DECL.ConstExpr(Value, T); - IntType(T, coord); - iValue := FLOOR(Value); - Assert(iValue # 0, coord, 122); - IF iValue < 0 THEN - IF proc = stINC THEN - proc := stDEC - ELSE - proc := stINC + IF bits64 THEN + IF UTILS.bit_depth = 32 THEN + ERRORS.error1("bad parameter ") END; - iValue := -iValue - END; - IF iValue # 1 THEN - X86.PushConst(iValue); - IF proc = stDEC THEN - X86.StProc(X86.stDEC) + PARS.init(64, target) + ELSE + PARS.init(32, target) + END; + + PARS.program.dll := target IN {mConst.Target_iDLL, mConst.Target_iObject, mConst.Target_iDLL64}; + PARS.program.obj := target = mConst.Target_iObject; + + STRINGS.append(lib_path, "lib"); + STRINGS.append(lib_path, UTILS.slash); + + IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN + IF target = mConst.Target_iDLL THEN + BaseAdr := 10000000H ELSE - X86.StProc(X86.stINC) - END - ELSE - IF proc = stDEC THEN - X86.StProc(X86.stDEC1) - ELSE - X86.StProc(X86.stINC1) - END - END - ELSE - IF proc = stDEC THEN - X86.StProc(X86.stDEC1) - ELSE - X86.StProc(X86.stINC1) - END - END - |stINCL, stEXCL: - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Assert(~e1.Read, coord, 115); - Assert(e1.T.tType = TSET, coord, 138); - Check(lxComma); - NextCoord(coord); - DECL.ConstExpr(Value, T); - IntType(T, coord); - iValue := FLOOR(Value); - Assert(ASR(iValue, 5) = 0, coord, 53); - IF proc = stINCL THEN - X86.PushConst(ORD({iValue})); - X86.StProc(X86.stINCL) - ELSE - X86.PushConst(ORD(-{iValue})); - X86.StProc(X86.stEXCL) - END - |stCOPY: - Expr(e1); - Assert(IsString(e1), coord, 141); - Check(lxComma); - IF e1.T.tType = TSTRING THEN - str := DECL.GetString(e1.Value); - IF str.Len = 1 THEN - X86.Mono(str.Number); - X86.StrMono - END - END; - Str(e1); - NextCoord(coord); - Designator(e2); - Assert(e2.eType = eVAR, coord, 63); - Assert(IsString(e2), coord, 143); - Assert(~e2.Read, coord, 115); - Str(e2); - X86.StProc(X86.stCOPY) - |stNEW, stDISPOSE: - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Assert(~e1.Read, coord, 115); - Assert(e1.T.tType = TPOINTER, coord, 145); - IF proc = stNEW THEN - X86.PushConst(e1.T.Base.Number); - X86.PushConst(X86.Align(e1.T.Base.Size + 8, 32)); - X86.newrec - ELSE - X86.disprec - END - |stASSERT: - Expr(e1); - Assert(e1.T.tType = TBOOLEAN, coord, 117); - Load(e1); - IF SCAN.tLex = lxComma THEN - NextCoord(coord); - DECL.ConstExpr(Value, T); - IntType(T, coord); - Assert((Value >= 0.0D0) & (Value <= 127.0D0), coord, 95); - X86.Assert(X86.stASSERT, FLOOR(Value)) - ELSE - X86.Assert(X86.stASSERT1, 0) - END - |stPACK, stUNPK: - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Assert(e1.T.tType IN TFLOAT, coord, 149); - Assert(~e1.Read, coord, 115); - Check(lxComma); - NextCoord(coord); - IF proc = stUNPK THEN - Designator(e2); - Assert(e2.eType = eVAR, coord, 63); - Assert(e2.T.tType = TINTEGER, coord, 128); - Assert(~e2.Read, coord, 115); - IF e1.T.tType = TLONGREAL THEN - X86.StProc(X86.stUNPK) - ELSE - X86.StProc(X86.stUNPK1) - END - ELSE - Expr(e2); - IntType(e2.T, coord); - Load(e2); - IF e1.T.tType = TLONGREAL THEN - X86.StProc(X86.stPACK) - ELSE - X86.StProc(X86.stPACK1) - END - END - |sysPUT, sysGET: - begcall := X86.current; - Expr(e1); - IntType(e1.T, coord); - Load(e1); - Check(lxComma); - NextCoord(coord); - IF proc = sysGET THEN - X86.PushCall(begcall); - X86.Param; - Designator(e2); - Assert(e2.eType = eVAR, coord, 63); - Assert(~(e2.T.tType IN TSTRUCT), coord, 90); - Assert(~e2.Read, coord, 115); - X86.EndCall; - X86.Load(e2.T.tType); - X86.Save(e2.T.tType) - ELSE - Expr(e2); - Assert(~(e2.T.tType IN TSTRUCT), coord, 90); - IF e2.T.tType = TSTRING THEN - Assert(LenString(e2.Value) = 1, coord, 94) - ELSIF e2.T.tType = TVOID THEN - e2.T := inttype - END; - Load(e2); - X86.Save(e2.T.tType) - END - |sysCODE: - Assert(SCAN.tLex = lxSTRING, coord, 150); - CheckCode(SCAN.Lex, SCAN.count - 1, coord); - X86.Asm(SCAN.Lex); - Next - |sysMOVE: - begcall := X86.current; - Expr(e1); - IntType(e1.T, coord); - Load(e1); - Check(lxComma); - X86.PushCall(begcall); - X86.Param; - NextCoord(coord); - Expr(e1); - IntType(e1.T, coord); - Load(e1); - Check(lxComma); - X86.EndCall; - NextCoord(coord); - Expr(e1); - IntType(e1.T, coord); - Load(e1); - |sysCOPY: - begcall := X86.current; - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Check(lxComma); - X86.PushCall(begcall); - X86.Param; - NextCoord(coord); - Designator(e1); - Assert(e1.eType = eVAR, coord, 63); - Assert(~e1.Read, coord, 115); - Check(lxComma); - X86.EndCall; - NextCoord(coord); - Expr(e1); - IntType(e1.T, coord); - Load(e1); - ELSE - Assert(FALSE, coord2, 132) - END; - Check(lxRRound); - Next; - IF (proc = sysMOVE) OR (proc = sysCOPY) THEN - X86.StProc(X86.sysMOVE) - END -END StProc; + BaseAdr := 400000H + END; + STRINGS.append(lib_path, "Windows32") -PROCEDURE IdentOper; -VAR e1, e2: DECL.EXPRESSION; coord: SCAN.TCoord; ccall: INTEGER; begcall: X86.ASMLINE; s: UTILS.STRCONST; -BEGIN - Coord(coord); - begcall := X86.current; - Designator(e1); - Assert(e1.eType # eCONST, coord, 130); - IF (e1.eType = eVAR) & (e1.T.tType # TPROC) THEN - Check(lxAssign); - Assert(~e1.Read, coord, 115); - NextCoord(coord); - Expr(e2); - Assert(AssComp(e2, e1.T, FALSE), coord, 131); - Load(e2); - IF e1.T.tType = TRECORD THEN - X86.PushConst(e1.T.Size); - X86.PushConst(e1.T.Number); - IF e1.vparam THEN - X86.LocalAdr(e1.id.Offset - 4, DECL.unit.Level - e1.id.Level); - X86.Load(TINTEGER) - ELSIF e1.deref THEN - X86.DerefType(12) - ELSE - X86.PushConst(e1.T.Number) - END - ELSIF e2.T.tType = TARRAY THEN - X86.PushConst(e2.T.Size) - ELSIF (e2.T.tType = TSTRING) & (e1.T.tType = TARRAY) THEN - s := DECL.GetString(e2.Value); - IF s.Len = 1 THEN - X86.Mono(s.Number) - END; - X86.PushConst(MIN(s.Len + 1, e1.T.Len)) - END; - X86.Save(e1.T.tType) - ELSIF e1.eType = ePROC THEN - Assert((e1.id.T.Base.tType = TVOID) OR (e1.id.T.Call = DECL.winapi), coord, 132); - IF e1.id.ParamCount > 0 THEN - Check(lxLRound); - Next; - X86.PushCall(begcall); - Call(e1.id.T.Fields.First(DECL.FIELD)); - X86.EndCall - ELSIF SCAN.tLex = lxLRound THEN - NextCheck(lxRRound); - Next - END; - IF e1.id.Level = 3 THEN - ccall := 0 - ELSIF e1.id.Level > DECL.curBlock.Level THEN - ccall := 1 - ELSE - ccall := 2 - END; - X86.Call(e1.id.Number, FALSE, FALSE, e1.id.T.Call, ccall, e1.id.Level - 3, DECL.curBlock.Level - 3, e1.id.ParamSize, DECL.curBlock.LocalSize) - ELSIF e1.eType IN {eSTPROC, eSYSPROC} THEN - StProc(e1.id.StProc) - ELSIF (e1.eType = eVAR) & (e1.T.tType = TPROC) THEN - IF SCAN.tLex = lxLRound THEN - Next; - Assert((e1.T.Base.tType = TVOID) OR (e1.T.Call = DECL.winapi), coord, 132); - X86.PushCall(begcall); - Call(e1.T.Fields.First(DECL.FIELD)); - X86.EndCall; - X86.CallVar(FALSE, FALSE, e1.T.Call, e1.T.Len, DECL.curBlock.LocalSize) - ELSIF SCAN.tLex = lxAssign THEN - Assert(~e1.Read, coord, 115); - NextCoord(coord); - Expr(e2); - Assert(AssComp(e2, e1.T, FALSE), coord, 131); - Assert(~((e2.eType = ePROC) & (e2.id.Level > 3)), coord, 116); - IF e2.eType = eVAR THEN - X86.Load(TPROC) - END; - X86.Save(TPROC) - ELSE - Assert2(e1.T.Fields.Count = 0, 155); - Assert((e1.T.Base.tType = TVOID) OR (e1.T.Call = DECL.winapi), coord, 132); - X86.CallVar(FALSE, FALSE, e1.T.Call, e1.T.Len, DECL.curBlock.LocalSize) - END - END -END IdentOper; + ELSIF target IN {mConst.Target_iKolibri, mConst.Target_iObject} THEN + STRINGS.append(lib_path, "KolibriOS") -PROCEDURE Operator; -BEGIN - UTILS.UnitLine(DECL.UnitNumber, SCAN.coord.line); - CASE SCAN.tLex OF - |lxIDENT: IdentOper - |lxIF, lxWHILE: IfWhileOper(SCAN.tLex = lxWHILE) - |lxREPEAT: RepeatOper - |lxFOR: ForOper - |lxCASE: CaseOper - ELSE - END -END Operator; + ELSIF target = mConst.Target_iELF32 THEN + STRINGS.append(lib_path, "Linux32") -PROCEDURE OpSeq; -BEGIN - Operator; - WHILE SCAN.tLex = lxSemi DO - Next; - Operator - END -END OpSeq; + ELSIF target = mConst.Target_iELF64 THEN + STRINGS.append(lib_path, "Linux64") -PROCEDURE Start; -VAR SelfName, SelfPath, CName, CExt, FName, Path, StdPath, - Name, Ext, temp, system, stk: UTILS.STRING; - platform, stksize: INTEGER; + ELSIF target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN + STRINGS.append(lib_path, "Windows64") - PROCEDURE getstksize(): INTEGER; - VAR res, i: INTEGER; - BEGIN - res := 0; - i := 0; - WHILE SCAN.Digit(stk[i]) DO - INC(i) END; - IF stk[i] <= 20X THEN - stk[i] := 0X; - res := SCAN.StrToInt(stk) - END; - IF res = 0 THEN - res := 1 - END - RETURN res - END getstksize; - PROCEDURE getver(): INTEGER; - VAR res, i: INTEGER; err: BOOLEAN; + STRINGS.append(lib_path, UTILS.slash); - PROCEDURE hexdgt(c: CHAR): BOOLEAN; - RETURN ("0" <= c) & (c <= "9") OR - ("A" <= c) & (c <= "F") OR - ("a" <= c) & (c <= "f") - END hexdgt; + keys(StackSize, BaseAdr, Version, pic, checking); - PROCEDURE hex(c: CHAR): INTEGER; - VAR res: INTEGER; - BEGIN - IF ("0" <= c) & (c <= "9") THEN - res := ORD(c) - ORD("0") - ELSIF ("A" <= c) & (c <= "F") THEN - res := ORD(c) - ORD("A") + 10 - ELSIF ("a" <= c) & (c <= "f") THEN - res := ORD(c) - ORD("a") + 10 - END - RETURN res - END hex; + ST.compile(path, lib_path, modname, outname, target, Version, StackSize, BaseAdr, pic, checking); + + time := UTILS.GetTickCount() - UTILS.time; + + C.Int(time DIV 100); C.String("."); C.Int2(time MOD 100); C.String(" sec, "); + C.Int(WRITER.counter); C.StringLn(" bytes"); + + UTILS.Exit(0) +END main; - BEGIN - res := 0; - i := 0; - err := stk[i] # "0"; INC(i); - err := err OR (stk[i] # "x"); INC(i); - WHILE ~err & hexdgt(stk[i]) DO - INC(i) - END; - err := err OR (i = 2); - IF stk[i] <= 20X THEN - stk[i] := 0X - ELSE - err := TRUE - END; - i := 2; - WHILE ~err & (stk[i] # 0X) DO - res := LSL(res, 4) + hex(stk[i]); - INC(i) - END; - IF res = 0 THEN - res := 65536 - END - RETURN res - END getver; BEGIN - IF UTILS.ParamCount < 2 THEN - UTILS.ErrMsg(59); - UTILS.HALT(1) - END; - UTILS.ParamStr(SelfName, 0); - UTILS.ParamStr(FName, 1); - UTILS.ParamStr(system, 2); - UTILS.ParamStr(stk, 3); - pExpr := Expr; - pFactor := Factor; - pOpSeq := OpSeq; - UTILS.Split(FName, Path, Name, Ext); - IF Ext # UTILS.Ext THEN - UTILS.ErrMsg(121); - UTILS.HALT(1) - END; - UTILS.Split(SelfName, SelfPath, CName, CExt); - temp := Name; - IF UTILS.streq(system, "kem") THEN - X86.setkem; - platform := 4; - UTILS.concat(temp, ".kex") - ELSIF UTILS.streq(system, "obj") THEN - platform := 6; - UTILS.concat(temp, ".obj") - ELSIF UTILS.streq(system, "elf") THEN - platform := 5 - ELSIF UTILS.streq(system, "kos") THEN - platform := 4; - UTILS.concat(temp, ".kex") - ELSIF UTILS.streq(system, "con") THEN - platform := 3; - UTILS.concat(temp, ".exe") - ELSIF UTILS.streq(system, "gui") THEN - platform := 2; - UTILS.concat(temp, ".exe") - ELSIF UTILS.streq(system, "dll") THEN - platform := 1; - UTILS.concat(temp, ".dll") - ELSE - UTILS.ErrMsg(60); - UTILS.HALT(1) - END; - IF platform IN {1, 2, 3, 4} THEN - stksize := getstksize() - ELSE - stksize := 1 - END; - IF platform = 6 THEN - stksize := getver() - END; - UTILS.concat(SelfPath, "Lib"); - UTILS.concat(SelfPath, UTILS.Slash); - IF platform = 5 THEN - UTILS.concat(SelfPath, "Linux32") - ELSIF platform IN {4, 6} THEN - UTILS.concat(SelfPath, "KolibriOS") - ELSIF platform IN {1, 2, 3} THEN - UTILS.concat(SelfPath, "Windows32") - END; - UTILS.concat(SelfPath, UTILS.Slash); - X86.set_maxstrlen(0); - X86.Init(platform); - X86.Prolog(temp); - DECL.Program(SelfPath, Path, Name, Ext, platform IN {1, 2, 3}, OpSeq, Expr, AssComp, sttypes); - voidtype := sttypes[TVOID]; - inttype := sttypes[TINTEGER]; - booltype := sttypes[TBOOLEAN]; - strtype := sttypes[TSTRING]; - settype := sttypes[TSET]; - realtype := sttypes[TREAL]; - longrealtype := sttypes[TLONGREAL]; - chartype := sttypes[TCHAR]; - niltype := sttypes[TNIL]; - DECL.Compile(platform, stksize); - UTILS.OutString("success"); UTILS.Ln; - UTILS.HALT(0) -END Start; - -BEGIN - Start + main END Compiler. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/DECL.ob07 b/programs/develop/oberon07/Source/DECL.ob07 deleted file mode 100644 index 0804d5c933..0000000000 --- a/programs/develop/oberon07/Source/DECL.ob07 +++ /dev/null @@ -1,1630 +0,0 @@ -(* - Copyright 2016, 2017 Anton Krotov - - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . -*) - -MODULE DECL; - -IMPORT SCAN, UTILS, X86, SYSTEM; - -CONST - - lxEOF = 0; lxINT = -1; lxREAL = -2; lxSTRING = -3; lxIDENT = -4; lxHEX = -5; lxCHX = -6; lxLONGREAL = -7; - lxARRAY = 1; lxBEGIN = 2; lxBY = 3; lxCASE = 4; lxCONST = 5; lxDIV = 6; lxDO = 7; lxELSE = 8; - lxELSIF = 9; lxEND = 10; lxFALSE = 11; lxFOR = 12; lxIF = 13; lxIMPORT = 14; lxIN = 15; lxIS = 16; - lxMOD = 17; lxMODULE = 18; lxNIL = 19; lxOF = 20; lxOR = 21; lxPOINTER = 22; lxPROCEDURE = 23; - lxRECORD = 24; lxREPEAT = 25; lxRETURN = 26; lxTHEN = 27; lxTO = 28; lxTRUE = 29; lxTYPE = 30; - lxUNTIL = 31; lxVAR = 32; lxWHILE = 33; - - lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; lxNot = 55; lxAnd = 56; lxComma = 57; lxSemi = 58; - lxStick = 59; lxLRound = 60; lxLSquare = 61; lxLCurly = 62; lxCaret = 63; lxRRound = 64; lxRSquare = 65; - lxRCurly = 66; lxDot = 67; lxDbl = 68; lxAssign = 69; lxColon = 70; - lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76; - - lxERR0 = 100; lxERR1 = 101; lxERR2 = 102; lxERR3 = 103; lxERR4 = 104; lxERR5 = 105; lxERR6 = 106; - lxERR7 = 107; lxERR8 = 108; lxERR9 = 109; lxERR10 = 110; lxERR11 = 111; lxERR20 = 120; - - IDMOD = 1; IDCONST = 2; IDTYPE = 3; IDVAR = 4; IDPROC = 5; IDSTPROC = 6; IDGUARD = 7; IDPARAM = 8; IDSYSPROC = 9; - - stABS = 1; stODD = 2; stLEN = 3; stLSL = 4; stASR = 5; stROR = 6; stFLOOR = 7; stFLT = 8; - stORD = 9; stCHR = 10; stLONG = 11; stSHORT = 12; stINC = 13; stDEC = 14; stINCL = 15; - stEXCL = 16; stCOPY = 17; stNEW = 18; stASSERT = 19; stPACK = 20; stUNPK = 21; stDISPOSE = 22; - stBITS = 23; stLSR = 24; stLENGTH = 25; stMIN = 26; stMAX = 27; - - sysADR = 101; sysSIZE = 102; sysINF = 103; sysGET = 104; sysPUT = 105; - sysCODE = 106; sysTYPEID = 107; sysMOVE = 108; sysCOPY = 109; - - TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; TNIL = 8; - TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14; - - TNUM = {TINTEGER, TREAL, TLONGREAL}; - TFLOAT = {TREAL, TLONGREAL}; - TSTRUCT = {TARRAY, TRECORD}; - - paramvar* = 1; param* = 2; - - defcall = 0; stdcall = 1; cdecl = 2; winapi* = 3; - - record = 0; union = 1; noalign = 2; - - eVAR = 1; eCONST = 2; eEXP = 3; ePROC = 4; eSTPROC = 5; eSYSPROC = 6; - - IOVER* = lxERR5 - lxERR0; - FOVER* = lxERR7 - lxERR0; - UNDER* = lxERR9 - lxERR0; - -TYPE - - pTYPE* = POINTER TO RECORD (UTILS.rITEM) - tType*, Size*, Len*, Number*, Align, Call*, Rec: INTEGER; - Base*: pTYPE; - Fields*: UTILS.LIST - END; - - IDENT* = POINTER TO rIDENT; - - UNIT* = POINTER TO RECORD (UTILS.rITEM) - Name: SCAN.NODE; - File: UTILS.STRING; - Idents: UTILS.LIST; - Import: UTILS.LIST; - IdentBegin: IDENT; - scanner: SCAN.SCANNER; - Level*: INTEGER; - Closed, typedecl, Std, sys: BOOLEAN - END; - - rIDENT* = RECORD (UTILS.rITEM) - Name*: SCAN.NODE; - T*: pTYPE; - Unit*: UNIT; - Parent*: IDENT; - Proc*: UTILS.ITEM; - Value*: LONGREAL; - coord*: SCAN.TCoord; - Number*, iType*, StProc*, VarSize, ParamSize*, - LocalSize*, Offset*, VarKind*, Level*, ParamCount*: INTEGER; - Export: BOOLEAN - END; - - PTRBASE = POINTER TO RECORD (UTILS.rITEM) - Name: SCAN.NODE; - coord: SCAN.TCoord; - Ptr: pTYPE - END; - - STRITEM = POINTER TO RECORD (UTILS.rITEM) - Str: UTILS.STRING - END; - - FIELD* = POINTER TO RECORD (UTILS.rITEM) - Name: SCAN.NODE; - T*: pTYPE; - Offset*: INTEGER; - ByRef*, Export*: BOOLEAN; - Unit*: UNIT - END; - - EXPRESSION* = RECORD - id*: IDENT; - T*: pTYPE; - eType*: INTEGER; - Value*: LONGREAL; - Read*, vparam*, deref*: BOOLEAN - END; - - opPROC = PROCEDURE; - expPROC = PROCEDURE (VAR e: EXPRESSION); - assPROC = PROCEDURE (e: EXPRESSION; T: pTYPE; param: BOOLEAN): BOOLEAN; - - stTYPES* = ARRAY 11 OF pTYPE; - - Proc* = POINTER TO RECORD (UTILS.rITEM) - used: BOOLEAN; - beg, end: X86.ASMLINE; - Procs*: UTILS.LIST - END; - -VAR - - sttypes: stTYPES; unit*, sys: UNIT; curBlock*: IDENT; - Path, Main, Std, ExtMain: UTILS.STRING; - NamePtrBase: SCAN.NODE; ProgSize*, RecCount, UnitNumber*: INTEGER; - PtrBases, Strings, types, prog, procs: UTILS.LIST; OpSeq: opPROC; Expr: expPROC; - AssComp: assPROC; main, sizefunc, winplatf, Const*: BOOLEAN; - pParseType: PROCEDURE (VAR coord: SCAN.TCoord): pTYPE; - pReadModule: PROCEDURE (Path, Name, Ext: UTILS.STRING): BOOLEAN; - Platform: INTEGER; voidtype: pTYPE; zcoord: SCAN.TCoord; - curproc*: Proc; - -PROCEDURE SetSizeFunc*; -BEGIN - sizefunc := TRUE -END SetSizeFunc; - -PROCEDURE MemErr*(err: BOOLEAN); -BEGIN - IF err THEN - UTILS.MemErr(TRUE) - END -END MemErr; - -PROCEDURE GetString*(adr: LONGREAL): UTILS.STRCONST; -VAR str: UTILS.STRCONST; -BEGIN - SYSTEM.PUT(SYSTEM.ADR(str), FLOOR(adr)) - RETURN str -END GetString; - -PROCEDURE AddString*(str: UTILS.STRING): UTILS.STRCONST; -VAR nov: UTILS.STRCONST; -BEGIN - nov := UTILS.GetStr(Strings, str); - IF nov = NIL THEN - NEW(nov); - MemErr(nov = NIL); - nov.Str := str; - nov.Len := SCAN.count - 1; - nov.Number := X86.NewLabel(); - UTILS.Push(Strings, nov); - X86.String(nov.Number, nov.Len, nov.Str) - END - RETURN nov -END AddString; - -PROCEDURE AddMono*(c: CHAR): UTILS.STRCONST; -VAR nov: UTILS.STRCONST; s: UTILS.STRING; -BEGIN - s[0] := c; - s[1] := 0X; - nov := UTILS.GetStr(Strings, s); - IF nov = NIL THEN - NEW(nov); - MemErr(nov = NIL); - nov.Str := s; - nov.Len := 1; - nov.Number := X86.NewLabel(); - UTILS.Push(Strings, nov); - X86.String(nov.Number, nov.Len, nov.Str) - END - RETURN nov -END AddMono; - -PROCEDURE Coord(VAR coord: SCAN.TCoord); -BEGIN - coord := SCAN.coord -END Coord; - -PROCEDURE GetModule(Name: SCAN.NODE): UNIT; -VAR cur, res: UNIT; -BEGIN - res := NIL; - cur := prog.First(UNIT); - WHILE (cur # NIL) & UTILS.streq(cur.Name.Name, Name.Name) DO - res := cur; - cur := NIL - ELSIF cur # NIL DO - cur := cur.Next(UNIT) - END - RETURN res -END GetModule; - -PROCEDURE Assert*(cond: BOOLEAN; coord: SCAN.TCoord; code: INTEGER); -BEGIN - IF ~cond THEN - UTILS.ErrMsgPos(coord.line, coord.col, code); - UTILS.HALT(1) - END -END Assert; - -PROCEDURE Assert2(cond: BOOLEAN; code: INTEGER); -BEGIN - IF ~cond THEN - Assert(FALSE, SCAN.coord, code) - END -END Assert2; - -PROCEDURE Next*; -VAR coord: SCAN.TCoord; -BEGIN - SCAN.GetLex; - IF (SCAN.tLex > lxERR0) & (SCAN.tLex < lxERR20) THEN - coord.line := SCAN.coord.line; - coord.col := SCAN.coord.col + SCAN.count; - Assert(FALSE, coord, SCAN.tLex - lxERR0) - END; - Assert2(SCAN.tLex # lxEOF, 27) -END Next; - -PROCEDURE NextCoord(VAR coord: SCAN.TCoord); -BEGIN - Next; - coord := SCAN.coord -END NextCoord; - -PROCEDURE Check*(key: INTEGER); -VAR code: INTEGER; -BEGIN - IF SCAN.tLex # key THEN - CASE key OF - |lxMODULE: code := 21 - |lxIDENT: code := 22 - |lxSemi: code := 23 - |lxEND: code := 24 - |lxDot: code := 25 - |lxEQ: code := 35 - |lxRRound: code := 38 - |lxTO: code := 40 - |lxOF: code := 41 - |lxRCurly: code := 51 - |lxLRound: code := 56 - |lxComma: code := 61 - |lxTHEN: code := 98 - |lxRSquare: code := 109 - |lxDO: code := 118 - |lxUNTIL: code := 119 - |lxAssign: code := 120 - |lxRETURN: code := 124 - |lxColon: code := 157 - ELSE - END; - Assert2(FALSE, code) - END -END Check; - -PROCEDURE NextCheck(key: INTEGER); -BEGIN - Next; - Check(key) -END NextCheck; - -PROCEDURE CheckIdent(Name: SCAN.NODE): BOOLEAN; -VAR cur: IDENT; -BEGIN - cur := unit.Idents.Last(IDENT); - WHILE (cur.iType # IDGUARD) & (cur.Name # Name) DO - cur := cur.Prev(IDENT) - END - RETURN cur.iType = IDGUARD -END CheckIdent; - -PROCEDURE Guard; -VAR ident: IDENT; -BEGIN - NEW(ident); - MemErr(ident = NIL); - ident.Name := NIL; - ident.iType := IDGUARD; - ident.T := voidtype; - UTILS.Push(unit.Idents, ident); - INC(unit.Level) -END Guard; - -PROCEDURE PushIdent(Name: SCAN.NODE; coord: SCAN.TCoord; iType: INTEGER; T: pTYPE; u: UNIT; Export: BOOLEAN; StProc: INTEGER); -VAR ident: IDENT; i: INTEGER; -BEGIN - Assert(CheckIdent(Name), coord, 30); - NEW(ident); - MemErr(ident = NIL); - ident.Name := Name; - ident.coord := coord; - IF iType IN {IDPROC, IDMOD} THEN - ident.Number := X86.NewLabel(); - i := X86.NewLabel(); - i := X86.NewLabel(); - i := X86.NewLabel() - END; - ident.iType := iType; - ident.T := T; - ident.Unit := u; - ident.Export := Export; - ident.StProc := StProc; - ident.Level := unit.Level; - UTILS.Push(unit.Idents, ident) -END PushIdent; - -PROCEDURE StTypes; -VAR type: pTYPE; i: INTEGER; -BEGIN - sttypes[0] := NIL; - FOR i := TINTEGER TO TSTRING DO - NEW(type); - MemErr(type = NIL); - type.tType := i; - UTILS.Push(types, type); - sttypes[i] := type - END; - sttypes[TINTEGER].Size := 4; - sttypes[TREAL].Size := 4; - sttypes[TLONGREAL].Size := 8; - sttypes[TBOOLEAN].Size := 1; - sttypes[TCHAR].Size := 1; - sttypes[TSET].Size := 4; - sttypes[TVOID].Size := 0; - sttypes[TSTRING].Size := 0; - sttypes[TNIL].Size := 4; - sttypes[TCARD16].Size := 2; - FOR i := TINTEGER TO TSTRING DO - sttypes[i].Align := sttypes[i].Size - END -END StTypes; - -PROCEDURE PushStProc(Name: UTILS.STRING; StProc: INTEGER); -BEGIN - PushIdent(SCAN.AddNode(Name), zcoord, IDSTPROC, voidtype, NIL, FALSE, StProc) -END PushStProc; - -PROCEDURE PushStType(Name: UTILS.STRING; T: INTEGER); -BEGIN - PushIdent(SCAN.AddNode(Name), zcoord, IDTYPE, sttypes[T], NIL, FALSE, 0) -END PushStType; - -PROCEDURE PushSysProc(Name: UTILS.STRING; StProc: INTEGER); -BEGIN - PushIdent(SCAN.AddNode(Name), zcoord, IDSYSPROC, voidtype, NIL, TRUE, StProc) -END PushSysProc; - -PROCEDURE PushSysType(Name: UTILS.STRING; T: INTEGER); -BEGIN - PushIdent(SCAN.AddNode(Name), zcoord, IDTYPE, sttypes[T], NIL, TRUE, 0) -END PushSysType; - -PROCEDURE StIdent; -BEGIN - Guard; - PushStProc("ABS", stABS); - PushStProc("ASR", stASR); - PushStProc("ASSERT", stASSERT); - PushStType("BOOLEAN", TBOOLEAN); - PushStType("CHAR", TCHAR); - PushStProc("CHR", stCHR); - PushStProc("COPY", stCOPY); - PushStProc("DEC", stDEC); - PushStProc("DISPOSE", stDISPOSE); - PushStProc("EXCL", stEXCL); - PushStProc("FLOOR", stFLOOR); - PushStProc("FLT", stFLT); - PushStProc("INC", stINC); - PushStProc("INCL", stINCL); - PushStType("INTEGER", TINTEGER); - PushStProc("LEN", stLEN); - PushStProc("LSL", stLSL); - PushStProc("LONG", stLONG); - PushStType("LONGREAL", TLONGREAL); - PushStProc("NEW", stNEW); - PushStProc("ODD", stODD); - PushStProc("ORD", stORD); - PushStProc("PACK", stPACK); - PushStType("REAL", TREAL); - PushStProc("ROR", stROR); - PushStType("SET", TSET); - PushStProc("SHORT", stSHORT); - PushStProc("UNPK", stUNPK); - PushStProc("BITS", stBITS); - PushStProc("LSR", stLSR); - PushStProc("LENGTH", stLENGTH); - PushStProc("MIN", stMIN); - PushStProc("MAX", stMAX); - Guard -END StIdent; - -PROCEDURE GetQIdent*(Unit: UNIT; Name: SCAN.NODE): IDENT; -VAR cur, res: IDENT; -BEGIN - res := NIL; - cur := Unit.IdentBegin.Next(IDENT); - WHILE (cur # NIL) & (cur.iType # IDGUARD) DO - IF cur.Name = Name THEN - IF (Unit # unit) & ~cur.Export THEN - res := NIL - ELSE - res := cur - END; - cur := NIL - ELSE - cur := cur.Next(IDENT) - END - END - RETURN res -END GetQIdent; - -PROCEDURE GetIdent*(Name: SCAN.NODE): IDENT; -VAR cur, res: IDENT; -BEGIN - res := NIL; - cur := unit.Idents.Last(IDENT); - WHILE (cur # NIL) & (cur.Name = Name) DO - res := cur; - cur := NIL - ELSIF cur # NIL DO - cur := cur.Prev(IDENT) - END - RETURN res -END GetIdent; - -PROCEDURE Relation*(Op: INTEGER): BOOLEAN; -VAR Res: BOOLEAN; -BEGIN - CASE Op OF - |lxEQ, lxNE, lxLT, lxGT, - lxLE, lxGE, lxIN, lxIS: - Res := TRUE - ELSE - Res := FALSE - END - RETURN Res -END Relation; - -PROCEDURE Arith(a, b: LONGREAL; T: pTYPE; Op: INTEGER; coord: SCAN.TCoord): LONGREAL; -CONST max = SCAN.maxDBL; -VAR res: LONGREAL; -BEGIN - CASE Op OF - |lxPlus: res := a + b - |lxMinus: res := a - b - |lxMult: res := a * b - |lxSlash: - Assert(b # 0.0D0, coord, 46); - res := a / b - |lxDIV: - Assert(~((a = LONG(FLT(SCAN.minINT))) & (b = -1.0D0)), coord, IOVER); - res := LONG(FLT(FLOOR(a) DIV FLOOR(b))) - |lxMOD: - res := LONG(FLT(FLOOR(a) MOD FLOOR(b))) - ELSE - END; - Assert(~UTILS.IsInf(res), coord, FOVER); - CASE T.tType OF - |TINTEGER: Assert((res <= LONG(FLT(SCAN.maxINT))) & (res >= LONG(FLT(SCAN.minINT))), coord, IOVER) - |TREAL: Assert((res <= LONG(SCAN.maxREAL)) & (res >= -LONG(SCAN.maxREAL)), coord, FOVER) - |TLONGREAL: Assert((res <= max) & (res >= -max), coord, FOVER) - ELSE - END; - IF (res = 0.0D0) & (T.tType IN TFLOAT) OR (ABS(res) < LONG(SCAN.minREAL)) & (T.tType = TREAL) THEN - CASE Op OF - |lxPlus: Assert(a = -b, coord, UNDER) - |lxMinus: Assert(a = b, coord, UNDER) - |lxMult: Assert((a = 0.0D0) OR (b = 0.0D0), coord, UNDER) - |lxSlash: Assert((a = 0.0D0), coord, UNDER) - ELSE - END - END - RETURN res -END Arith; - -PROCEDURE strcmp(a, b: LONGREAL; Op: INTEGER): LONGREAL; -VAR sa, sb: UTILS.STRCONST; Res: LONGREAL; -BEGIN - sa := GetString(a); - sb := GetString(b); - CASE Op OF - |lxEQ, lxNE: Res := LONG(FLT(ORD(sa.Str = sb.Str))) - |lxLT, lxGT: Res := LONG(FLT(ORD(sa.Str < sb.Str))) - |lxLE, lxGE: Res := LONG(FLT(ORD(sa.Str <= sb.Str))) - ELSE - END - RETURN Res -END strcmp; - -PROCEDURE Calc*(a, b: LONGREAL; Ta, Tb: pTYPE; Op: INTEGER; coord: SCAN.TCoord; VAR Res: LONGREAL; VAR TRes: pTYPE); -VAR c: LONGREAL; ai, bi: INTEGER; -BEGIN - ai := FLOOR(a); - bi := FLOOR(b); - IF Op # lxIN THEN - Assert(Ta = Tb, coord, 37) - END; - CASE Op OF - |lxPlus, lxMinus, lxMult, lxSlash: - Assert(~((Op = lxSlash) & (Ta.tType = TINTEGER)), coord, 37); - IF Ta.tType IN TNUM THEN - Res := Arith(a, b, Ta, Op, coord) - ELSIF Ta.tType = TSET THEN - CASE Op OF - |lxPlus: Res := LONG(FLT(ORD(BITS(ai) + BITS(bi)))) - |lxMinus: Res := LONG(FLT(ORD(BITS(ai) - BITS(bi)))) - |lxMult: Res := LONG(FLT(ORD(BITS(ai) * BITS(bi)))) - |lxSlash: Res := LONG(FLT(ORD(BITS(ai) / BITS(bi)))) - ELSE - END - ELSE - Assert(FALSE, coord, 37) - END; - TRes := Ta - |lxDIV, lxMOD: - Assert(Ta.tType = TINTEGER, coord, 37); - Assert(bi # 0, coord, 48); - TRes := Ta; - Res := Arith(a, b, Ta, Op, coord) - |lxAnd: - Assert(Ta.tType = TBOOLEAN, coord, 37); - Res := LONG(FLT(ORD((ai # 0) & (bi # 0)))) - |lxOR: - Assert(Ta.tType = TBOOLEAN, coord, 37); - Res := LONG(FLT(ORD((ai # 0) OR (bi # 0)))) - |lxEQ, lxNE: - IF Ta.tType = TSTRING THEN - Res := strcmp(a, b, Op) - ELSE - Res := LONG(FLT(ORD(a = b))) - END; - IF Op = lxNE THEN - Res := LONG(FLT(ORD(Res = 0.0D0))) - END - |lxLT, lxGT: - IF Op = lxGT THEN - c := a; - a := b; - b := c - END; - Assert(Ta.tType IN (TNUM + {TSTRING}), coord, 37); - IF Ta.tType = TSTRING THEN - Res := strcmp(a, b, Op) - ELSE - Res := LONG(FLT(ORD(a < b))) - END - |lxLE, lxGE: - IF Op = lxGE THEN - c := a; - a := b; - b := c - END; - Assert(Ta.tType IN (TNUM + {TSTRING, TSET}), coord, 37); - IF Ta.tType = TSTRING THEN - Res := strcmp(a, b, Op) - ELSIF Ta.tType = TSET THEN - Res := LONG(FLT(ORD(BITS(FLOOR(a)) <= BITS(FLOOR(b))))) - ELSE - Res := LONG(FLT(ORD(a <= b))) - END - |lxIN: - Assert((Ta.tType = TINTEGER) & (Tb.tType = TSET), coord, 37); - Assert(ASR(ai, 5) = 0, coord, 49); - Res := LONG(FLT(ORD(ai IN BITS(bi)))) - ELSE - END; - IF Relation(Op) OR (Op = lxAnd) OR (Op = lxOR) THEN - TRes := sttypes[TBOOLEAN] - END -END Calc; - -PROCEDURE ConstExpr*(VAR Value: LONGREAL; VAR T: pTYPE); -VAR e: EXPRESSION; coord: SCAN.TCoord; -BEGIN - Const := TRUE; - Coord(coord); - sizefunc := FALSE; - Expr(e); - Assert(~sizefunc & (e.eType = eCONST), coord, 62); - Value := e.Value; - T := e.T; - Const := FALSE -END ConstExpr; - -PROCEDURE IdType*(VAR coord: SCAN.TCoord): pTYPE; -VAR id: IDENT; Name: SCAN.NODE; Unit: UNIT; Res: pTYPE; -BEGIN - Res := NIL; - Name := SCAN.id; - id := GetIdent(Name); - IF id = NIL THEN - Coord(coord); - NamePtrBase := Name; - Next - ELSE - IF id.iType = IDTYPE THEN - Coord(coord); - Next; - Res := id.T - ELSIF id.iType = IDMOD THEN - Unit := id.Unit; - NextCheck(lxDot); - NextCheck(lxIDENT); - Name := SCAN.id; - NamePtrBase := Name; - id := GetQIdent(Unit, Name); - IF Unit # unit THEN - Assert2(id # NIL, 42); - Assert2(id.iType = IDTYPE, 77); - Coord(coord); - Next; - Res := id.T - ELSE - IF id = NIL THEN - Assert2((unit.Level = 3) & unit.typedecl, 42); - Coord(coord); - Next; - Res := NIL - ELSE - Assert2(id.iType = IDTYPE, 77); - Coord(coord); - Next; - Res := id.T - END - END - ELSE - Assert2(FALSE, 77) - END - END - RETURN Res -END IdType; - -PROCEDURE FieldOffset(Align, RecSize: INTEGER): INTEGER; -BEGIN - Assert2(RecSize <= SCAN.maxINT - (Align - RecSize MOD Align) MOD Align, 83) - RETURN RecSize + (Align - RecSize MOD Align) MOD Align -END FieldOffset; - -PROCEDURE Dim*(T: pTYPE): INTEGER; -VAR n: INTEGER; -BEGIN - n := 0; - WHILE (T.tType = TARRAY) & (T.Len = 0) DO - INC(n); - T := T.Base - END - RETURN n -END Dim; - -PROCEDURE SetFields(Tr, Tf: pTYPE; Rec: BOOLEAN); -VAR cur: FIELD; -BEGIN - cur := Tr.Fields.First(FIELD); - WHILE cur.T # NIL DO - cur := cur.Next(FIELD) - END; - WHILE cur # NIL DO - cur.T := Tf; - IF Rec THEN - IF Tf.Align > Tr.Align THEN - Tr.Align := Tf.Align - END; - IF Tr.Rec = record THEN - cur.Offset := FieldOffset(Tf.Align, Tr.Size); - Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); - Tr.Size := cur.Offset + Tf.Size - ELSIF Tr.Rec = noalign THEN - cur.Offset := FieldOffset(1, Tr.Size); - Assert2(cur.Offset <= SCAN.maxINT - Tf.Size, 83); - Tr.Size := cur.Offset + Tf.Size - ELSIF Tr.Rec = union THEN - IF Tf.Size > Tr.Size THEN - Tr.Size := Tf.Size - END; - cur.Offset := 0 - END - ELSE - Tr.Len := Tr.Len + 4 * (ORD((Tf.tType = TRECORD) & cur.ByRef) + Dim(Tf) + ORD((Tf.tType = TLONGREAL) & ~cur.ByRef) + 1) - END; - cur := cur.Next(FIELD) - END -END SetFields; - -PROCEDURE GetField*(T: pTYPE; Name: SCAN.NODE): FIELD; -VAR cur, Res: FIELD; -BEGIN - Res := NIL; - cur := T.Fields.First(FIELD); - WHILE (cur # NIL) & (cur.Name = Name) DO - Res := cur; - cur := NIL - ELSIF cur # NIL DO - cur := cur.Next(FIELD) - END - RETURN Res -END GetField; - -PROCEDURE Unique(T: pTYPE; Name: SCAN.NODE): BOOLEAN; -VAR field: FIELD; res: BOOLEAN; -BEGIN - res := TRUE; - WHILE (T # NIL) & res DO - field := GetField(T, Name); - IF field # NIL THEN - IF (field.Unit = unit) OR field.Export THEN - res := FALSE - END - END; - T := T.Base - END - RETURN res -END Unique; - -PROCEDURE notrecurs(id: BOOLEAN; T: pTYPE): BOOLEAN; - RETURN ~(id & (unit.Idents.Last(IDENT).iType = IDTYPE) & (unit.Idents.Last(IDENT).T = T) & - (T.tType IN TSTRUCT)) -END notrecurs; - -PROCEDURE ReadFields(T: pTYPE); -VAR Name: SCAN.NODE; field: FIELD; Tf: pTYPE; coord: SCAN.TCoord; id_T: BOOLEAN; -BEGIN - WHILE SCAN.tLex = lxIDENT DO - Name := SCAN.id; - Assert2(Unique(T, Name), 30); - NEW(field); - MemErr(field = NIL); - UTILS.Push(T.Fields, field); - field.Name := Name; - field.T := NIL; - field.Export := FALSE; - field.Unit := unit; - Next; - IF SCAN.tLex = lxMult THEN - Assert2(unit.Level = 3, 89); - field.Export := TRUE; - Next - END; - IF SCAN.tLex = lxComma THEN - NextCheck(lxIDENT) - ELSIF SCAN.tLex = lxColon THEN - NextCoord(coord); - id_T := SCAN.tLex = lxIDENT; - Tf:= pParseType(coord); - Assert(Tf # NIL, coord, 42); - Assert(notrecurs(id_T, Tf), coord, 96); - SetFields(T, Tf, TRUE); - IF SCAN.tLex = lxSemi THEN - NextCheck(lxIDENT) - ELSE - Assert2(SCAN.tLex = lxEND, 86) - END - ELSE - Assert2(FALSE, 85) - END - END -END ReadFields; - -PROCEDURE OpenBase*(T: pTYPE): pTYPE; -BEGIN - WHILE (T.tType = TARRAY) & (T.Len = 0) DO - T := T.Base - END - RETURN T -END OpenBase; - -PROCEDURE SetVars(T: pTYPE); -VAR cur: IDENT; n: INTEGER; -BEGIN - cur := unit.Idents.Last(IDENT); - WHILE cur.T = NIL DO - cur := cur.Prev(IDENT) - END; - cur := cur.Next(IDENT); - WHILE cur # NIL DO - cur.T := T; - IF(cur.VarKind = paramvar) OR (cur.VarKind = param) & (T.tType IN TSTRUCT) THEN - n := 4 * (1 + Dim(T) + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD))) - ELSE - n := T.Size; - Assert2(n <= SCAN.maxINT - UTILS.Align(n), 93); - n := n + UTILS.Align(n) - END; - IF cur.Level = 3 THEN - cur.Offset := ProgSize; - Assert2(ProgSize <= SCAN.maxINT - n, 93); - ProgSize := ProgSize + n; - Assert2(ProgSize <= SCAN.maxINT - UTILS.Align(ProgSize), 93); - ProgSize := ProgSize + UTILS.Align(ProgSize) - ELSE - IF cur.VarKind = 0 THEN - cur.Offset := curBlock.ParamSize - curBlock.VarSize - n - ELSE - cur.Offset := curBlock.VarSize - 8 + 4 * (cur.Level + ORD((cur.VarKind = paramvar) & (T.tType = TRECORD))) - END - END; - Assert2(curBlock.VarSize <= SCAN.maxINT - n, 93); - curBlock.VarSize := curBlock.VarSize + n; - Assert2(curBlock.VarSize <= SCAN.maxINT - UTILS.Align(curBlock.VarSize), 93); - curBlock.VarSize := curBlock.VarSize + UTILS.Align(curBlock.VarSize); - IF cur.VarKind # 0 THEN - curBlock.ParamSize := curBlock.VarSize - END; - cur := cur.Next(IDENT) - END -END SetVars; - -PROCEDURE CreateType(tType, Len, Size, Number: INTEGER; Base: pTYPE; Fields: BOOLEAN; NewType: pTYPE): pTYPE; -VAR nov: pTYPE; -BEGIN - IF NewType = NIL THEN - NEW(nov); - MemErr(nov = NIL) - ELSE - nov := NewType - END; - UTILS.Push(types, nov); - nov.tType := tType; - nov.Len := Len; - nov.Size := Size; - nov.Base := Base; - nov.Fields := NIL; - nov.Number := Number; - IF Fields THEN - nov.Fields := UTILS.CreateList() - END - RETURN nov -END CreateType; - -PROCEDURE FormalType(VAR coord: SCAN.TCoord): pTYPE; -VAR TA: pTYPE; -BEGIN - IF SCAN.tLex = lxARRAY THEN - NextCheck(lxOF); - Next; - TA := CreateType(TARRAY, 0, 0, 0, FormalType(coord), FALSE, NIL) - ELSE - Check(lxIDENT); - TA := IdType(coord); - Assert(TA # NIL, coord, 42); - END - RETURN TA -END FormalType; - -PROCEDURE Section(T: pTYPE); -VAR Name: SCAN.NODE; ByRef, cont: BOOLEAN; field: FIELD; - Tf: pTYPE; fp: IDENT; coord: SCAN.TCoord; proc: BOOLEAN; -BEGIN - proc := T = NIL; - IF proc THEN - T := curBlock.T - END; - Assert2((SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxVAR), 84); - ByRef := FALSE; - IF SCAN.tLex = lxVAR THEN - ByRef := TRUE; - NextCheck(lxIDENT) - END; - cont := TRUE; - WHILE cont DO - Name := SCAN.id; - Assert2(GetField(T, Name) = NIL, 30); - NEW(field); - MemErr(field = NIL); - UTILS.Push(T.Fields, field); - field.Name := Name; - field.T := NIL; - field.ByRef := ByRef; - IF proc THEN - PushIdent(Name, coord, IDVAR, NIL, NIL, FALSE, 0); - INC(curBlock.ParamCount); - fp := unit.Idents.Last(IDENT); - IF ByRef THEN - fp.VarKind := paramvar - ELSE - fp.VarKind := param - END - END; - Next; - IF SCAN.tLex = lxComma THEN - NextCheck(lxIDENT) - ELSIF SCAN.tLex = lxColon THEN - Next; - Tf := FormalType(coord); - Assert(Dim(Tf) <= X86.ADIM, coord, 110); - SetFields(T, Tf, FALSE); - IF proc THEN - SetVars(Tf) - END; - cont := FALSE - ELSE - Assert2(FALSE, 85) - END - END -END Section; - -PROCEDURE ParamType(T: pTYPE); -VAR break: BOOLEAN; -BEGIN - IF (SCAN.tLex = lxIDENT) OR (SCAN.tLex = lxVAR) THEN - break := FALSE; - REPEAT - Section(T); - IF SCAN.tLex = lxSemi THEN - Next - ELSE - break := TRUE - END - UNTIL break - END -END ParamType; - -PROCEDURE AddPtrBase(Name: SCAN.NODE; coord: SCAN.TCoord; T: pTYPE); -VAR nov: PTRBASE; -BEGIN - NEW(nov); - MemErr(nov = NIL); - nov.Name := Name; - nov.coord := coord; - nov.Ptr := T; - UTILS.Push(PtrBases, nov) -END AddPtrBase; - -PROCEDURE FormalList(T: pTYPE; VAR Res: pTYPE); -VAR coord: SCAN.TCoord; -BEGIN - IF SCAN.tLex = lxLRound THEN - Next; - ParamType(T); - Check(lxRRound); - Next; - IF SCAN.tLex = lxColon THEN - NextCheck(lxIDENT); - Res := IdType(coord); - Assert(Res # NIL, coord, 42); - Assert(~(Res.tType IN TSTRUCT), coord, 82) - END - END -END FormalList; - -PROCEDURE CallFlag(VAR Call: INTEGER): BOOLEAN; -VAR res: BOOLEAN; -BEGIN - res := SCAN.tLex = lxLSquare; - IF res THEN - Next; - IF SCAN.Lex = "cdecl" THEN - Call := cdecl - ELSIF SCAN.Lex = "stdcall" THEN - Call := stdcall - ELSIF SCAN.Lex = "winapi" THEN - Assert2(winplatf, 50); - Call := winapi - ELSE - Assert2(FALSE, 44) - END; - NextCheck(lxRSquare); - Next; - ELSE - Call := defcall - END - RETURN res -END CallFlag; - -PROCEDURE RecFlag(VAR rec: INTEGER): BOOLEAN; -VAR res: BOOLEAN; -BEGIN - res := SCAN.tLex = lxLSquare; - IF res THEN - Next; - IF SCAN.Lex = "union" THEN - rec := union - ELSIF SCAN.Lex = "noalign" THEN - rec := noalign - ELSE - Assert2(FALSE, 103) - END; - NextCheck(lxRSquare); - Next; - ELSE - rec := record - END - RETURN res -END RecFlag; - -PROCEDURE StructType(Comma: BOOLEAN; NewType: pTYPE): pTYPE; -VAR v: LONGREAL; T, nov: pTYPE; coord, coord2: SCAN.TCoord; id_T: BOOLEAN; -BEGIN - CASE SCAN.tLex OF - |lxARRAY, lxComma: - IF SCAN.tLex = lxComma THEN - Assert2(Comma, 39) - END; - NextCoord(coord); - ConstExpr(v, T); - Assert(T.tType = TINTEGER, coord, 52); - Assert(v > 0.0D0, coord, 78); - nov := CreateType(TARRAY, FLOOR(v), 0, 0, NIL, FALSE, NewType); - IF SCAN.tLex = lxComma THEN - nov.Base := StructType(TRUE, NIL) - ELSIF SCAN.tLex = lxOF THEN - NextCoord(coord); - id_T := SCAN.tLex = lxIDENT; - nov.Base := pParseType(coord); - Assert(nov.Base # NIL, coord, 42); - Assert(notrecurs(id_T, nov.Base), coord, 96) - ELSE - Assert2(FALSE, 79) - END; - Assert2(nov.Base.Size <= SCAN.maxINT DIV nov.Len, 83); - nov.Size := nov.Base.Size * nov.Len; - nov.Align := nov.Base.Align - |lxRECORD: - NextCoord(coord); - INC(RecCount); - nov := CreateType(TRECORD, 0, 0, RecCount, NIL, TRUE, NewType); - nov.Align := 1; - IF RecFlag(nov.Rec) THEN - Assert(unit.sys, coord, 111) - END; - Coord(coord); - IF SCAN.tLex = lxLRound THEN - NextCoord(coord2); - Check(lxIDENT); - nov.Base := IdType(coord); - Assert(nov.Base # NIL, coord, 42); - IF (nov.Base.tType = TPOINTER) & (nov.Base.Base.tType = TRECORD) THEN - nov.Base := nov.Base.Base - END; - Assert(nov.Base.tType = TRECORD, coord, 80); - Assert(notrecurs(TRUE, nov.Base), coord, 96); - nov.Size := nov.Base.Size; - nov.Align := nov.Base.Align; - Check(lxRRound); - Next; - Assert(nov.Rec = record, coord, 112); - Assert(nov.Base.Rec = record, coord2, 113) - END; - ReadFields(nov); - Check(lxEND); - nov.Size := X86.Align(nov.Size, nov.Align); - IF nov.Base # NIL THEN - X86.AddRec(nov.Base.Number) - ELSE - X86.AddRec(0) - END; - Next - |lxPOINTER: - NextCheck(lxTO); - NextCoord(coord); - nov := CreateType(TPOINTER, 0, 4, 0, NIL, FALSE, NewType); - nov.Align := 4; - nov.Base := pParseType(coord); - IF nov.Base = NIL THEN - Assert(unit.typedecl, coord, 42); - AddPtrBase(NamePtrBase, coord, nov) - ELSE - Assert(nov.Base.tType = TRECORD, coord, 81) - END - |lxPROCEDURE: - NextCoord(coord); - nov := CreateType(TPROC, 0, 4, 0, voidtype, TRUE, NewType); - IF CallFlag(nov.Call) THEN - Assert(unit.sys, coord, 111) - END; - nov.Align := 4; - FormalList(nov, nov.Base) - ELSE - Assert2(FALSE, 39) - END - RETURN nov -END StructType; - -PROCEDURE ParseType(VAR coord: SCAN.TCoord): pTYPE; -VAR Res: pTYPE; -BEGIN - IF SCAN.tLex = lxIDENT THEN - Res := IdType(coord) - ELSE - Res := StructType(FALSE, NIL) - END - RETURN Res -END ParseType; - -PROCEDURE PopBlock; -VAR cur: IDENT; n: INTEGER; -BEGIN - cur := unit.Idents.Last(IDENT); - n := 0; - WHILE cur.iType # IDGUARD DO - cur := cur.Prev(IDENT); - INC(n) - END; - cur := cur.Prev(IDENT); - INC(n); - unit.Idents.Count := unit.Idents.Count - n; - unit.Idents.Last := cur; - cur.Next := NIL; - DEC(unit.Level) -END PopBlock; - -PROCEDURE LinkPtr; -VAR cur: PTRBASE; id: IDENT; -BEGIN - cur := PtrBases.First(PTRBASE); - WHILE cur # NIL DO - id := GetIdent(cur.Name); - Assert(id # NIL, cur.coord, 42); - Assert(id.T.tType = TRECORD, cur.coord, 81); - cur.Ptr.Base := id.T; - cur := cur.Next(PTRBASE) - END; - UTILS.Clear(PtrBases) -END LinkPtr; - -PROCEDURE addproc; -VAR proc: Proc; -BEGIN - NEW(proc); - MemErr(proc = NIL); - proc.used := FALSE; - proc.Procs := UTILS.CreateList(); - UTILS.Push(procs, proc); - curproc := proc -END addproc; - -PROCEDURE DeclSeq; -VAR Value: LONGREAL; T, NewType: pTYPE; Name: SCAN.NODE; coord: SCAN.TCoord; Call: INTEGER; - Export, func: BOOLEAN; last, id: IDENT; e: EXPRESSION; - - PROCEDURE IdentDef; - BEGIN - Name := SCAN.id; - Coord(coord); - Next; - Export := FALSE; - IF SCAN.tLex = lxMult THEN - Assert2(unit.Level = 3, 89); - Export := TRUE; - Next - END - END IdentDef; - -BEGIN - IF SCAN.tLex = lxCONST THEN - Next; - WHILE SCAN.tLex = lxIDENT DO - IdentDef; - PushIdent(Name, coord, IDCONST, NIL, NIL, Export, 0); - last := unit.Idents.Last(IDENT); - Check(lxEQ); - Next; - ConstExpr(Value, T); - Check(lxSemi); - last.Value := Value; - last.T := T; - Next - END - END; - IF SCAN.tLex = lxTYPE THEN - UTILS.Clear(PtrBases); - unit.typedecl := TRUE; - Next; - WHILE SCAN.tLex = lxIDENT DO - IdentDef; - PushIdent(Name, coord, IDTYPE, NIL, NIL, Export, 0); - last := unit.Idents.Last(IDENT); - Check(lxEQ); - Next; - - IF SCAN.tLex = lxIDENT THEN - last.T := ParseType(coord) - ELSE - NEW(NewType); - MemErr(NewType = NIL); - last.T := NewType; - T := StructType(FALSE, NewType) - END; - - Check(lxSemi); - Next - END - END; - LinkPtr; - unit.typedecl := FALSE; - IF SCAN.tLex = lxVAR THEN - Next; - WHILE SCAN.tLex = lxIDENT DO - IdentDef; - PushIdent(Name, coord, IDVAR, NIL, NIL, Export, 0); - IF SCAN.tLex = lxComma THEN - NextCheck(lxIDENT) - ELSIF SCAN.tLex = lxColon THEN - NextCoord(coord); - T := ParseType(coord); - Assert(T # NIL, coord, 42); - SetVars(T); - Check(lxSemi); - Next - ELSE - Assert2(FALSE, 85) - END - END - END; - WHILE SCAN.tLex = lxPROCEDURE DO - NextCoord(coord); - IF CallFlag(Call) THEN - Assert(unit.Level = 3, coord, 45); - Assert(unit.sys, coord, 111) - END; - Check(lxIDENT); - IdentDef; - PushIdent(Name, coord, IDPROC, CreateType(TPROC, 0, 4, 0, voidtype, TRUE, NIL), NIL, Export, 0); - id := unit.Idents.Last(IDENT); - addproc; - id.Proc := curproc; - IF id.Export & main THEN - IF Platform IN {1, 6} THEN - curproc.used := TRUE; - Assert((Name # SCAN._START) & (Name # SCAN._version), coord, 133) - END; - X86.ProcExport(id.Number, Name, X86.NewLabel()) - END; - id.Parent := curBlock; - curBlock := id; - Guard; - FormalList(NIL, curBlock.T.Base); - id.T.Call := Call; - Check(lxSemi); - Next; - DeclSeq; - id.LocalSize := id.VarSize - id.ParamSize; - X86.Label(X86.NewLabel()); - curproc.beg := X86.current; - X86.ProcBeg(id.Number, id.LocalSize, FALSE); - IF SCAN.tLex = lxBEGIN THEN - Next; - OpSeq - END; - func := curBlock.T.Base.tType # TVOID; - IF func THEN - Check(lxRETURN); - UTILS.UnitLine(UnitNumber, SCAN.coord.line); - NextCoord(coord); - Expr(e); - Assert(AssComp(e, curBlock.T.Base, FALSE), coord, 125); - IF e.eType = eVAR THEN - X86.Load(e.T.tType) - END - ELSE - Assert2(SCAN.tLex # lxRETURN, 123) - END; - Check(lxEND); - NextCheck(lxIDENT); - Assert2(SCAN.id = Name, 87); - NextCheck(lxSemi); - Next; - X86.ProcEnd(id.Number, (id.ParamSize + (id.Level - 3) * 4) * ORD(curBlock.T.Call IN {stdcall, winapi, defcall}), func, curBlock.T.Base.tType IN TFLOAT); - X86.Label(X86.NewLabel()); - curproc.end := X86.current; - PopBlock; - curBlock := curBlock.Parent; - curproc := curBlock.Proc(Proc); - END -END DeclSeq; - -PROCEDURE Rtl(u: UNIT); - - PROCEDURE AddProc(name: UTILS.STRING; num: INTEGER); - VAR id: IDENT; - BEGIN - id := GetQIdent(u, SCAN.AddNode(name)); - id.Proc(Proc).used := TRUE; - IF id = NIL THEN - UTILS.ErrMsg(158); - UTILS.HALT(1) - END; - X86.AddRtlProc(num, id.Number) - END AddProc; - -BEGIN - AddProc("_newrec", X86._newrec); - AddProc("_disprec", X86._disprec); - AddProc("_rset", X86._rset); - AddProc("_inset", X86._inset); - AddProc("_saverec", X86._saverec); - AddProc("_checktype", X86._checktype); - AddProc("_strcmp", X86._strcmp); - AddProc("_lstrcmp", X86._lstrcmp); - AddProc("_rstrcmp", X86._rstrcmp); - AddProc("_savearr", X86._savearr); - AddProc("_arrayidx", X86._arrayidx); - AddProc("_arrayidx1", X86._arrayidx1); - AddProc("_arrayrot", X86._arrayrot); - AddProc("_assrt", X86._assrt); - AddProc("_strcopy", X86._strcopy); - AddProc("_init", X86._init); - AddProc("_close", X86._close); - AddProc("_halt", X86._halt); - AddProc("_length", X86._length); -END Rtl; - -PROCEDURE ImportList; -VAR cond: INTEGER; coord, namecoord: SCAN.TCoord; - name, alias: SCAN.NODE; u, self: UNIT; - FName: UTILS.STRING; - - PROCEDURE AddUnit(newcond: INTEGER); - VAR str: STRITEM; - BEGIN - u := GetModule(name); - IF u = NIL THEN - self := unit; - SCAN.Backup(unit.scanner); - COPY(name.Name, FName); - IF ~((~self.Std & pReadModule(Path, FName, UTILS.Ext)) OR pReadModule(Std, FName, UTILS.Ext)) THEN - IF FName = "SYSTEM" THEN - unit := sys; - self.sys := TRUE - ELSE - Assert(FALSE, namecoord, 32) - END - END; - SCAN.Recover(self.scanner); - u := unit; - unit := self; - UTILS.SetFile(unit.File) - ELSE - Assert(u.Closed, namecoord, 31) - END; - PushIdent(alias, coord, IDMOD, voidtype, u, FALSE, 0); - NEW(str); - MemErr(str = NIL); - str.Str := name.Name; - UTILS.Push(unit.Import, str); - cond := newcond - END AddUnit; - -BEGIN - cond := 0; - WHILE cond # 4 DO - Next; - CASE cond OF - |0: Check(lxIDENT); - name := SCAN.id; - Coord(coord); - Coord(namecoord); - alias := name; - cond := 1 - |1: CASE SCAN.tLex OF - |lxComma: AddUnit(0) - |lxSemi: AddUnit(4); Next - |lxAssign: cond := 2 - ELSE - Assert2(FALSE, 28) - END - |2: Check(lxIDENT); - name := SCAN.id; - Coord(namecoord); - cond := 3 - |3: CASE SCAN.tLex OF - |lxComma: AddUnit(0) - |lxSemi: AddUnit(4); Next - ELSE - Assert2(FALSE, 29) - END - ELSE - END - END -END ImportList; - -PROCEDURE Header(Name: SCAN.NODE); -BEGIN - NEW(unit); - MemErr(unit = NIL); - unit.Idents := UTILS.CreateList(); - unit.Level := 0; - unit.Name := Name; - Guard; Guard; - PushIdent(unit.Name, zcoord, IDMOD, voidtype, unit, FALSE, 0); - Guard; - unit.IdentBegin := unit.Idents.Last(IDENT); - unit.Closed := TRUE -END Header; - -PROCEDURE Pseudo; -VAR temp: UNIT; -BEGIN - temp := unit; - Header(SCAN.AddNode("SYSTEM")); - PushSysProc("ADR", sysADR); - PushSysProc("SIZE", sysSIZE); - PushSysProc("TYPEID", sysTYPEID); - PushSysProc("GET", sysGET); - PushSysProc("PUT", sysPUT); - PushSysProc("CODE", sysCODE); - PushSysProc("MOVE", sysMOVE); - PushSysProc("COPY", sysCOPY); - PushSysProc("INF", sysINF); - PushSysType("CARD16", TCARD16); - sys := unit; - unit := temp -END Pseudo; - -PROCEDURE ReadModule(Path, Name1, Ext: UTILS.STRING): BOOLEAN; -VAR FHandle: INTEGER; name, Name, b: UTILS.STRING; idmod: IDENT; Res, temp: BOOLEAN; coord: SCAN.TCoord; -BEGIN - Res := FALSE; - name := Name1; - Name := Name1; - b := Path; - UTILS.concat(b, Name); - Name := b; - UTILS.concat(Name, Ext); - - IF SCAN.Open(Name, FHandle) THEN - NEW(unit); - MemErr(unit = NIL); - unit.sys := FALSE; - unit.Std := Path = Std; - UTILS.Push(prog, unit); - unit.Idents := UTILS.CreateList(); - unit.Import := UTILS.CreateList(); - NEW(unit.scanner); - MemErr(unit.scanner = NIL); - unit.Closed := FALSE; - unit.Level := 0; - unit.typedecl := FALSE; - COPY(Name, unit.File); - UTILS.SetFile(unit.File); - StIdent; - NextCheck(lxMODULE); - NextCheck(lxIDENT); - Assert2(UTILS.streq(SCAN.id.Name, name), 33); - unit.Name := SCAN.id; - coord := SCAN.coord; - PushIdent(unit.Name, coord, IDMOD, voidtype, unit, FALSE, 0); - idmod := unit.Idents.Last(IDENT); - Guard; - NextCheck(lxSemi); - Next; - IF SCAN.tLex = lxIMPORT THEN - temp := main; - main := FALSE; - ImportList; - main := temp - END; - UTILS.OutString("compiling "); UTILS.OutString(unit.Name.Name); UTILS.Ln; - X86.Module(idmod.Name.Name, idmod.Number); - UnitNumber := idmod.Number; - unit.IdentBegin := unit.Idents.Last(IDENT); - curBlock := idmod; - DeclSeq; - X86.ProcBeg(idmod.Number, 0, TRUE); - IF SCAN.tLex = lxBEGIN THEN - addproc; - curproc.used := TRUE; - Next; - OpSeq - END; - Check(lxEND); - NextCheck(lxIDENT); - Assert2(SCAN.id = unit.Name, 26); - NextCheck(lxDot); - X86.Leave; - unit.Closed := TRUE; - UTILS.Clear(unit.Import); - Res := TRUE - END - RETURN Res -END ReadModule; - -PROCEDURE Program*(StdPath, FilePath, NameFile, ExtFile: UTILS.STRING; windows: BOOLEAN; - OpSeqProc: opPROC; ExprProc: expPROC; AssCompProc: assPROC; VAR stypes: stTYPES); -BEGIN - winplatf := windows; - Path := FilePath; - Main := NameFile; - ExtMain := ExtFile; - Std := StdPath; - OpSeq := OpSeqProc; - Expr := ExprProc; - AssComp := AssCompProc; - prog := UTILS.CreateList(); - PtrBases := UTILS.CreateList(); - types := UTILS.CreateList(); - procs := UTILS.CreateList(); - StTypes; - voidtype := sttypes[TVOID]; - Strings := UTILS.CreateList(); - Pseudo; - stypes := sttypes -END Program; - -PROCEDURE delfirstchar(VAR s: UTILS.STRING); -VAR i: INTEGER; -BEGIN - FOR i := 0 TO LENGTH(s) - 1 DO - s[i] := s[i + 1] - END -END delfirstchar; - -PROCEDURE DelProcs; -VAR cur: Proc; - - PROCEDURE ProcHandling(proc: Proc); - VAR cur: IDENT; p: Proc; - BEGIN - proc.used := TRUE; - cur := proc.Procs.First(IDENT); - WHILE cur # NIL DO - p := cur.Proc(Proc); - IF ~p.used THEN - ProcHandling(p) - END; - cur := cur.Next(IDENT) - END; - END ProcHandling; - -BEGIN - cur := procs.First(Proc); - WHILE cur # NIL DO - IF cur.used THEN - ProcHandling(cur) - END; - cur := cur.Next(Proc) - END; - cur := procs.First(Proc); - WHILE cur # NIL DO - IF ~cur.used THEN - X86.DelProc(cur.beg, cur.end) - END; - cur := cur.Next(Proc) - END -END DelProcs; - -PROCEDURE Compile*(platform, stksize: INTEGER); -VAR full, path, name, ext, temp, path2: UTILS.STRING; -BEGIN - Platform := platform; - main := FALSE; - IF ReadModule(Path, "RTL", UTILS.Ext) OR ReadModule(Std, "RTL", UTILS.Ext) THEN - Rtl(unit) - ELSE - UTILS.ErrMsg(65); - UTILS.HALT(1) - END; - main := TRUE; - IF ~ReadModule(Path, Main, ExtMain) THEN - path2 := Path; - UTILS.ParamStr(full, 0); - UTILS.Split(full, path, name, ext); - IF path[0] # 0X THEN - path[LENGTH(path) - 1] := 0X - END; - IF Path[0] = UTILS.Slash THEN - delfirstchar(Path) - END; - UTILS.concat(path, UTILS.Slash); - full := path; - UTILS.concat(full, Path); - Path := full; - IF (UTILS.OS = "WIN") & (Path[0] = UTILS.Slash) THEN - delfirstchar(Path) - END; - IF ~ReadModule(Path, Main, ExtMain) THEN - UTILS.ErrMsg(64); - UTILS.OutString(path2); - UTILS.OutString(Main); - UTILS.OutString(ExtMain); - UTILS.Ln; - UTILS.HALT(1) - END - END; - temp := Path; - UTILS.concat(temp, Main); - IF platform IN {2, 3} THEN - UTILS.concat(temp, ".exe") - ELSIF platform = 1 THEN - UTILS.concat(temp, ".dll") - ELSIF platform = 4 THEN - UTILS.concat(temp, ".kex") - ELSIF platform = 6 THEN - UTILS.concat(temp, ".obj") - END; - IF platform IN {1, 2, 3, 4} THEN - stksize := stksize * 100000H - END; - DelProcs; - X86.Epilog(ProgSize, temp, stksize) -END Compile; - -BEGIN - pParseType := ParseType; - pReadModule := ReadModule; - zcoord.line := 0; - zcoord.col := 0 -END DECL. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ELF.ob07 b/programs/develop/oberon07/Source/ELF.ob07 index fba6e3c1ba..749ee5632a 100644 --- a/programs/develop/oberon07/Source/ELF.ob07 +++ b/programs/develop/oberon07/Source/ELF.ob07 @@ -1,295 +1,382 @@ -(* - Copyright 2016 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2019, Anton Krotov + All rights reserved. *) MODULE ELF; -IMPORT SYSTEM; +IMPORT BIN, WR := WRITER, CHL := CHUNKLISTS; -CONST size* = 8346; -PROCEDURE [stdcall] data; +CONST + + EI_NIDENT = 16; + ET_EXEC = 2; + ET_DYN = 3; + + EM_386 = 3; + EM_8664 = 3EH; + + ELFCLASS32 = 1; + ELFCLASS64 = 2; + + ELFDATA2LSB = 1; + ELFDATA2MSB = 2; + + PF_X = 1; + PF_W = 2; + PF_R = 4; + + +TYPE + + Elf32_Ehdr = RECORD + + e_ident: ARRAY EI_NIDENT OF BYTE; + + e_type, + e_machine: WCHAR; + + e_version, + e_entry, + e_phoff, + e_shoff, + e_flags: INTEGER; + + e_ehsize, + e_phentsize, + e_phnum, + e_shentsize, + e_shnum, + e_shstrndx: WCHAR + + END; + + + Elf32_Phdr = RECORD + + p_type, + p_offset, + p_vaddr, + p_paddr, + p_filesz, + p_memsz, + p_flags, + p_align: INTEGER + + END; + + FILE = WR.FILE; + + +PROCEDURE align (n, _align: INTEGER): INTEGER; BEGIN - SYSTEM.CODE("7F454C4601010100000000000000000002000300010000004086040834000000"); - SYSTEM.CODE("A41120000000000034002000080028001D001A00060000003400000034800408"); - SYSTEM.CODE("3480040800010000000100000500000004000000030000003401000034810408"); - SYSTEM.CODE("3481040813000000130000000400000001000000010000000000000000800408"); - SYSTEM.CODE("00800408240C1000240C10000500000000100000010000000C0F10000C9F1408"); - SYSTEM.CODE("0C9F1408540110009401900C060000000010000002000000200F1000209F1408"); - SYSTEM.CODE("209F1408D0000000D00000000600000004000000040000004801000048810408"); - SYSTEM.CODE("488104084400000044000000040000000400000051E574640000000000000000"); - SYSTEM.CODE("000000000000000000000000060000000400000052E574640C0F10000C9F1408"); - SYSTEM.CODE("0C9F1408F4000000F400000004000000010000002F6C69622F6C642D6C696E75"); - SYSTEM.CODE("782E736F2E320000040000001000000001000000474E55000000000002000000"); - SYSTEM.CODE("060000000F000000040000001400000003000000474E55006D648AA1A4FF8A62"); - SYSTEM.CODE("6855372198B3905D7B4527570300000005000000040000000700000092005000"); - SYSTEM.CODE("126388F68400000080044030050000000800000013000000AEC44D0F281D8C1C"); - SYSTEM.CODE("4701750FAC4BE3C086F0967C328E750F20CF09FD38F28B1C7C8B730F060204F9"); - SYSTEM.CODE("16EA76FE3CAD390D665561103F7E967C7D1B760F000000000000000000000000"); - SYSTEM.CODE("000000000C0000000000000000000000200000001B0000000000000000000000"); - SYSTEM.CODE("20000000A20000000000000000000000120000006C0000000000000000000000"); - SYSTEM.CODE("12000000360000008C85040800000000120000007900000080A0240804000000"); - SYSTEM.CODE("110018009C0000001C8604080000000012000000460000000C8C140804000000"); - SYSTEM.CODE("11000F00B40000007C8504080000000012000000730000009C85040800000000"); - SYSTEM.CODE("1200000080000000AC85040800000000120000008E00000060A0240804000000"); - SYSTEM.CODE("110018005A000000BC85040800000000120000002F000000CC85040800000000"); - SYSTEM.CODE("1200000095000000FC8504080000000012000000870000000C86040800000000"); - SYSTEM.CODE("120000006600000064A024080400000011001800550000002C86040800000000"); - SYSTEM.CODE("1200000060000000DC8504080000000012000000006C6962646C2E736F2E3200"); - SYSTEM.CODE("5F5F676D6F6E5F73746172745F5F005F4A765F5265676973746572436C617373"); - SYSTEM.CODE("657300646C6F70656E00646C73796D006C6962632E736F2E36005F494F5F7374"); - SYSTEM.CODE("64696E5F75736564006578697400666F70656E006674656C6C00737464696E00"); - SYSTEM.CODE("7072696E746600667365656B007374646F75740066636C6F7365006D616C6C6F"); - SYSTEM.CODE("630073746465727200667772697465006672656164005F5F6C6962635F737461"); - SYSTEM.CODE("72745F6D61696E006672656500474C4942435F322E3100474C4942435F322E30"); - SYSTEM.CODE("0000000000000000020002000300020002000100020002000400020004000500"); - SYSTEM.CODE("020002000200020002000000010002000100000010000000300000001169690D"); - SYSTEM.CODE("00000500B9000000100000001069690D00000300C30000000000000001000200"); - SYSTEM.CODE("3C00000010000000000000001169690D00000400B9000000100000001069690D"); - SYSTEM.CODE("00000200C300000000000000F09F14080601000060A02408050C000064A02408"); - SYSTEM.CODE("0511000080A024080506000000A014080701000004A014080703000008A01408"); - SYSTEM.CODE("070900000CA014080705000010A01408070A000014A01408070B000018A01408"); - SYSTEM.CODE("070D00001CA01408070E000020A014080713000024A014080704000028A01408"); - SYSTEM.CODE("070F00002CA014080710000030A014080707000034A01408071200005589E553"); - SYSTEM.CODE("83EC04E8000000005B81C3CC1A10008B93FCFFFFFF85D27405E81E000000E88D"); - SYSTEM.CODE("010000E878061000585BC9C3FF35F89F1408FF25FC9F140800000000FF2500A0"); - SYSTEM.CODE("14086800000000E9E0FFFFFFFF2504A014086808000000E9D0FFFFFFFF2508A0"); - SYSTEM.CODE("14086810000000E9C0FFFFFFFF250CA014086818000000E9B0FFFFFFFF2510A0"); - SYSTEM.CODE("14086820000000E9A0FFFFFFFF2514A014086828000000E990FFFFFFFF2518A0"); - SYSTEM.CODE("14086830000000E980FFFFFFFF251CA014086838000000E970FFFFFFFF2520A0"); - SYSTEM.CODE("14086840000000E960FFFFFFFF2524A014086848000000E950FFFFFFFF2528A0"); - SYSTEM.CODE("14086850000000E940FFFFFFFF252CA014086858000000E930FFFFFFFF2530A0"); - SYSTEM.CODE("14086860000000E920FFFFFFFF2534A014086868000000E910FFFFFF00000000"); - SYSTEM.CODE("31ED5E89E183E4F050545268B08B140868508B1408515668F4860408E80BFFFF"); - SYSTEM.CODE("FFF490909090909090909090909090905589E55383EC04803D84A0240800753F"); - SYSTEM.CODE("A188A02408BB189F140881EB149F1408C1FB0283EB0139D8731E8DB600000000"); - SYSTEM.CODE("83C001A388A02408FF1485149F1408A188A0240839D872E8C60584A024080183"); - SYSTEM.CODE("C4045B5DC38D7426008DBC27000000005589E583EC18A11C9F140885C07412B8"); - SYSTEM.CODE("0000000085C07409C704241C9F1408FFD0C9C3905589E583E4F0565383EC38C7"); - SYSTEM.CODE("44242CA0A024088B55088B44242C89108344242C048B550C8B44242C89108344"); - SYSTEM.CODE("242C048B55108B44242C89108344242C04BACC8504088B44242C89108344242C"); - SYSTEM.CODE("04BA8C8504088B44242C89108344242C04BA2C8604088B44242C89108344242C"); - SYSTEM.CODE("04A164A0240889C28B44242C89108344242C04A180A0240889C28B44242C8910"); - SYSTEM.CODE("8344242C04A160A0240889C28B44242C89108344242C04BA0C8604088B44242C"); - SYSTEM.CODE("89108344242C04BA7C8504088B44242C89108344242C04BABC8504088B44242C"); - SYSTEM.CODE("89108344242C04BAAC8504088B44242C89108344242C04BAFC8504088B44242C"); - SYSTEM.CODE("89108344242C04BA1C8604088B44242C89108344242C04BA9C8504088B44242C"); - SYSTEM.CODE("89108344242C04BADC8504088B44242C89108344242C048B35B8A02408BBF486"); - SYSTEM.CODE("0408B9A0A02408BA60A01408B8108C140889742410895C240C894C2408895424"); - SYSTEM.CODE("04890424E8B9FAEFFFB80000000083C4385B5E89EC5DC3909090909090909090"); - SYSTEM.CODE("9090909090905589E5575653E85A00000081C39914000083EC1CE8B3F9EFFF8D"); - SYSTEM.CODE("BB18FFFFFF8D8318FFFFFF29C7C1FF0285FF742431F68B4510894424088B450C"); - SYSTEM.CODE("894424048B4508890424FF94B318FFFFFF83C60139FE72DE83C41C5B5E5F5DC3"); - SYSTEM.CODE("8DB6000000005589E55DC38B1C24C3909090909090905589E55383EC04A10C9F"); - SYSTEM.CODE("140883F8FF7413BB0C9F1408669083EB04FFD08B0383F8FF75F483C4045B5DC3"); - SYSTEM.CODE("90905589E55383EC04E8000000005B81C3FC130000E86CFAEFFF595BC9C30300"); - SYSTEM.CODE("00000100020025750A25750A25750A25750A0000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000FFFFFFFF00000000FFFFFFFF000000000000000001000000010000000100"); - SYSTEM.CODE("00003C0000000C0000001C8504080D000000EC8B1408F5FEFF6F8C8104080500"); - SYSTEM.CODE("00003483040806000000F48104080A000000CD0000000B000000100000001500"); - SYSTEM.CODE("00000000000003000000F49F1408020000007000000014000000110000001700"); - SYSTEM.CODE("0000AC840408110000008C84040812000000200000001300000008000000FEFF"); - SYSTEM.CODE("FF6F2C840408FFFFFF6F02000000F0FFFF6F0284040800000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("00000000000000000000209F1408000000000000000062850408728504088285"); - SYSTEM.CODE("040892850408A2850408B2850408C2850408D2850408E2850408F28504080286"); - SYSTEM.CODE("0408128604082286040832860408000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000004743433A20285562756E74"); - SYSTEM.CODE("752F4C696E61726F20342E352E322D387562756E7475342920342E352E320047"); - SYSTEM.CODE("43433A20285562756E74752F4C696E61726F20342E352E322D387562756E7475"); - SYSTEM.CODE("332920342E352E3200002E73796D746162002E737472746162002E7368737472"); - SYSTEM.CODE("746162002E696E74657270002E6E6F74652E4142492D746167002E6E6F74652E"); - SYSTEM.CODE("676E752E6275696C642D6964002E676E752E68617368002E64796E73796D002E"); - SYSTEM.CODE("64796E737472002E676E752E76657273696F6E002E676E752E76657273696F6E"); - SYSTEM.CODE("5F72002E72656C2E64796E002E72656C2E706C74002E696E6974002E74657874"); - SYSTEM.CODE("002E66696E69002E726F64617461002E65685F6672616D65002E63746F727300"); - SYSTEM.CODE("2E64746F7273002E6A6372002E64796E616D6963002E676F74002E676F742E70"); - SYSTEM.CODE("6C74002E64617461002E627373002E636F6D6D656E7400000000000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000000000000000000000000000"); - SYSTEM.CODE("001B000000010000000200000034810408340100001300000000000000000000"); - SYSTEM.CODE("0001000000000000002300000007000000020000004881040848010000200000"); - SYSTEM.CODE("0000000000000000000400000000000000310000000700000002000000688104"); - SYSTEM.CODE("0868010000240000000000000000000000040000000000000044000000F6FFFF"); - SYSTEM.CODE("6F020000008C8104088C01000068000000050000000000000004000000040000"); - SYSTEM.CODE("004E0000000B00000002000000F4810408F40100004001000006000000010000"); - SYSTEM.CODE("0004000000100000005600000003000000020000003483040834030000CD0000"); - SYSTEM.CODE("00000000000000000001000000000000005E000000FFFFFF6F02000000028404"); - SYSTEM.CODE("080204000028000000050000000000000002000000020000006B000000FEFFFF"); - SYSTEM.CODE("6F020000002C8404082C04000060000000060000000200000004000000000000"); - SYSTEM.CODE("007A00000009000000020000008C8404088C0400002000000005000000000000"); - SYSTEM.CODE("000400000008000000830000000900000002000000AC840408AC040000700000"); - SYSTEM.CODE("00050000000C00000004000000080000008C00000001000000060000001C8504"); - SYSTEM.CODE("081C050000300000000000000000000000040000000000000087000000010000"); - SYSTEM.CODE("00060000004C8504084C050000F0000000000000000000000004000000040000"); - SYSTEM.CODE("009200000001000000060000004086040840060000AC05100000000000000000"); - SYSTEM.CODE("001000000000000000980000000100000006000000EC8B1408EC0B10001C0000"); - SYSTEM.CODE("00000000000000000004000000000000009E0000000100000002000000088C14"); - SYSTEM.CODE("08080C10001500000000000000000000000400000000000000A6000000010000"); - SYSTEM.CODE("0002000000208C1408200C100004000000000000000000000004000000000000"); - SYSTEM.CODE("00B000000001000000030000000C9F14080C0F10000800000000000000000000"); - SYSTEM.CODE("000400000000000000B70000000100000003000000149F1408140F1000080000"); - SYSTEM.CODE("0000000000000000000400000000000000BE00000001000000030000001C9F14"); - SYSTEM.CODE("081C0F10000400000000000000000000000400000000000000C3000000060000"); - SYSTEM.CODE("0003000000209F1408200F1000D0000000060000000000000004000000080000"); - SYSTEM.CODE("00CC0000000100000003000000F09F1408F00F10000400000000000000000000"); - SYSTEM.CODE("000400000004000000D10000000100000003000000F49F1408F40F1000440000"); - SYSTEM.CODE("0000000000000000000400000004000000DA000000010000000300000040A014"); - SYSTEM.CODE("08401010002000100000000000000000002000000000000000E0000000080000"); - SYSTEM.CODE("000300000060A02408601020004000800C000000000000000020000000000000"); - SYSTEM.CODE("00E5000000010000003000000000000000601020005400000000000000000000"); - SYSTEM.CODE("00010000000100000011000000030000000000000000000000B4102000EE0000"); - SYSTEM.CODE("0000000000000000000100000000000000010000000200000000000000000000"); - SYSTEM.CODE("002C162000000500001C0000002C000000040000001000000009000000030000"); - SYSTEM.CODE("0000000000000000002C1B2000F9020000000000000000000001000000000000"); - SYSTEM.CODE("0000000000000000000000000000000000000000003481040800000000030001"); - SYSTEM.CODE("0000000000488104080000000003000200000000006881040800000000030003"); - SYSTEM.CODE("00000000008C810408000000000300040000000000F481040800000000030005"); - SYSTEM.CODE("0000000000348304080000000003000600000000000284040800000000030007"); - SYSTEM.CODE("00000000002C8404080000000003000800000000008C84040800000000030009"); - SYSTEM.CODE("0000000000AC8404080000000003000A00000000001C8504080000000003000B"); - SYSTEM.CODE("00000000004C8504080000000003000C0000000000408604080000000003000D"); - SYSTEM.CODE("0000000000EC8B14080000000003000E0000000000088C14080000000003000F"); - SYSTEM.CODE("0000000000208C14080000000003001000000000000C9F140800000000030011"); - SYSTEM.CODE("0000000000149F14080000000003001200000000001C9F140800000000030013"); - SYSTEM.CODE("0000000000209F1408000000000300140000000000F09F140800000000030015"); - SYSTEM.CODE("0000000000F49F140800000000030016000000000040A0140800000000030017"); - SYSTEM.CODE("000000000060A024080000000003001800000000000000000000000000030019"); - SYSTEM.CODE("000100000000000000000000000400F1FF0C0000000C9F140800000000010011"); - SYSTEM.CODE("001A000000149F14080000000001001200280000001C9F140800000000010013"); - SYSTEM.CODE("0035000000708604080000000002000D004B00000084A0240801000000010018"); - SYSTEM.CODE("005A00000088A02408040000000100180068000000D08604080000000002000D"); - SYSTEM.CODE("000100000000000000000000000400F1FF74000000109F140800000000010011"); - SYSTEM.CODE("0081000000208C140800000000010010008F0000001C9F140800000000010013"); - SYSTEM.CODE("009B000000C08B14080000000002000D00B100000000000000000000000400F1"); - SYSTEM.CODE("FFB8000000F49F14080000000001001600CE0000000C9F140800000000000011"); - SYSTEM.CODE("00DF0000000C9F14080000000000001100F2000000209F140800000000010014"); - SYSTEM.CODE("00FB00000040A01408000000002000170006010000B08B14080500000012000D"); - SYSTEM.CODE("0016010000408604080000000012000D001D0100000000000000000000200000"); - SYSTEM.CODE("002C01000000000000000000002000000040010000088C14080400000011000F"); - SYSTEM.CODE("0047010000EC8B14080000000012000E004D0100000000000000000000120000"); - SYSTEM.CODE("006A0100000C8C14080400000011000F00790100007C85040800000000120000"); - SYSTEM.CODE("0089010000A0A024080000800C110018008E01000040A0140800000000100017"); - SYSTEM.CODE("009B0100008C8504080000000012000000AC0100009C85040800000000120000"); - SYSTEM.CODE("00BD010000AC8504080000000012000000CF01000060A0240804000000110018"); - SYSTEM.CODE("00E1010000BC8504080000000012000000F201000044A0140800000000110217"); - SYSTEM.CODE("00FF010000CC850408000000001200000011020000DC85040800000000120000"); - SYSTEM.CODE("0022020000189F140800000000110212002F020000508B14085A00000012000D"); - SYSTEM.CODE("003F02000000000000000000001200000051020000FC85040800000000120000"); - SYSTEM.CODE("006302000060A02408000000001000F1FF6F0200000C86040800000000120000"); - SYSTEM.CODE("008102000060A0140800001000110017008702000064A0240804000000110018"); - SYSTEM.CODE("0098020000A0A0A414000000001000F1FF9D02000080A0240804000000110018"); - SYSTEM.CODE("00AF0200001C8604080000000012000000C002000060A02408000000001000F1"); - SYSTEM.CODE("FFC70200002C8604080000000012000000D7020000B58B14080000000012020D"); - SYSTEM.CODE("00EE020000F48604084D04100012000D00F30200001C8504080000000012000B"); - SYSTEM.CODE("000063727473747566662E63005F5F43544F525F4C4953545F5F005F5F44544F"); - SYSTEM.CODE("525F4C4953545F5F005F5F4A43525F4C4953545F5F005F5F646F5F676C6F6261"); - SYSTEM.CODE("6C5F64746F72735F61757800636F6D706C657465642E363135350064746F725F"); - SYSTEM.CODE("6964782E36313537006672616D655F64756D6D79005F5F43544F525F454E445F"); - SYSTEM.CODE("5F005F5F4652414D455F454E445F5F005F5F4A43525F454E445F5F005F5F646F"); - SYSTEM.CODE("5F676C6F62616C5F63746F72735F6175780070726F672E63005F474C4F42414C"); - SYSTEM.CODE("5F4F46465345545F5441424C455F005F5F696E69745F61727261795F656E6400"); - SYSTEM.CODE("5F5F696E69745F61727261795F7374617274005F44594E414D49430064617461"); - SYSTEM.CODE("5F7374617274005F5F6C6962635F6373755F66696E69005F7374617274005F5F"); - SYSTEM.CODE("676D6F6E5F73746172745F5F005F4A765F5265676973746572436C6173736573"); - SYSTEM.CODE("005F66705F6877005F66696E69005F5F6C6962635F73746172745F6D61696E40"); - SYSTEM.CODE("40474C4942435F322E30005F494F5F737464696E5F7573656400667265654040"); - SYSTEM.CODE("474C4942435F322E300064617461005F5F646174615F737461727400646C7379"); - SYSTEM.CODE("6D4040474C4942435F322E3000667365656B4040474C4942435F322E30006663"); - SYSTEM.CODE("6C6F73654040474C4942435F322E31007374646572724040474C4942435F322E"); - SYSTEM.CODE("3000666F70656E4040474C4942435F322E31005F5F64736F5F68616E646C6500"); - SYSTEM.CODE("646C6F70656E4040474C4942435F322E31006674656C6C4040474C4942435F32"); - SYSTEM.CODE("2E30005F5F44544F525F454E445F5F005F5F6C6962635F6373755F696E697400"); - SYSTEM.CODE("7072696E74664040474C4942435F322E30006677726974654040474C4942435F"); - SYSTEM.CODE("322E30005F5F6273735F7374617274006D616C6C6F634040474C4942435F322E"); - SYSTEM.CODE("3000696461746100737464696E4040474C4942435F322E30005F656E64007374"); - SYSTEM.CODE("646F75744040474C4942435F322E300066726561644040474C4942435F322E30"); - SYSTEM.CODE("005F656461746100657869744040474C4942435F322E30005F5F693638362E67"); - SYSTEM.CODE("65745F70635F7468756E6B2E6278006D61696E005F696E697400"); -END data; + IF n MOD _align # 0 THEN + n := n + _align - (n MOD _align) + END + + RETURN n +END align; + + +PROCEDURE Write16 (file: FILE; w: WCHAR); +BEGIN + WR.Write16LE(file, ORD(w)) +END Write16; + + +PROCEDURE WritePH (file: FILE; ph: Elf32_Phdr); +BEGIN + WR.Write32LE(file, ph.p_type); + WR.Write32LE(file, ph.p_offset); + WR.Write32LE(file, ph.p_vaddr); + WR.Write32LE(file, ph.p_paddr); + WR.Write32LE(file, ph.p_filesz); + WR.Write32LE(file, ph.p_memsz); + WR.Write32LE(file, ph.p_flags); + WR.Write32LE(file, ph.p_align) +END WritePH; + + +PROCEDURE WritePH64 (file: FILE; ph: Elf32_Phdr); +BEGIN + WR.Write32LE(file, ph.p_type); + WR.Write32LE(file, ph.p_flags); + WR.Write64LE(file, ph.p_offset); + WR.Write64LE(file, ph.p_vaddr); + WR.Write64LE(file, ph.p_paddr); + WR.Write64LE(file, ph.p_filesz); + WR.Write64LE(file, ph.p_memsz); + WR.Write64LE(file, ph.p_align) +END WritePH64; + + +PROCEDURE fixup (program: BIN.PROGRAM; text, data, bss: INTEGER; amd64: BOOLEAN); +VAR + reloc: BIN.RELOC; + L, delta: INTEGER; + +BEGIN + reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO + + L := BIN.get32le(program.code, reloc.offset); + delta := 3 - reloc.offset - text - 7 * ORD(amd64); + + CASE reloc.opcode OF + |BIN.PICDATA: BIN.put32le(program.code, reloc.offset, L + data + delta) + |BIN.PICCODE: BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) + |BIN.PICBSS: BIN.put32le(program.code, reloc.offset, L + bss + delta) + END; + + reloc := reloc.next(BIN.RELOC) + END; +END fixup; + + +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; amd64: BOOLEAN); +CONST + interp = 0; + dyn = 1; + header = 2; + text = 3; + data = 4; + bss = 5; + +VAR + ehdr: Elf32_Ehdr; + phdr: ARRAY 16 OF Elf32_Phdr; + + i, LoadAdr, offset, pad, VA: INTEGER; + + SizeOf: RECORD header, code, data, bss: INTEGER END; + + File: FILE; + + str: ARRAY 40 OF CHAR; lstr: INTEGER; + Dyn: ARRAY 350 OF BYTE; + +BEGIN + IF amd64 THEN + str := "/lib64/ld-linux-x86-64.so.2" + ELSE + str := "/lib/ld-linux.so.2" + END; + lstr := LENGTH(str); + + IF amd64 THEN + LoadAdr := 400000H + ELSE + LoadAdr := 08048000H + END; + + SizeOf.code := CHL.Length(program.code); + SizeOf.data := CHL.Length(program.data); + SizeOf.bss := program.bss; + + ehdr.e_ident[0] := 7FH; + ehdr.e_ident[1] := ORD("E"); + ehdr.e_ident[2] := ORD("L"); + ehdr.e_ident[3] := ORD("F"); + IF amd64 THEN + ehdr.e_ident[4] := ELFCLASS64 + ELSE + ehdr.e_ident[4] := ELFCLASS32 + END; + ehdr.e_ident[5] := ELFDATA2LSB; + ehdr.e_ident[6] := 1; + ehdr.e_ident[7] := 3; + FOR i := 8 TO EI_NIDENT - 1 DO + ehdr.e_ident[i] := 0 + END; + + ehdr.e_type := WCHR(ET_EXEC); + ehdr.e_version := 1; + ehdr.e_shoff := 0; + ehdr.e_flags := 0; + ehdr.e_shnum := WCHR(0); + ehdr.e_shstrndx := WCHR(0); + ehdr.e_phnum := WCHR(6); + + IF amd64 THEN + ehdr.e_machine := WCHR(EM_8664); + ehdr.e_phoff := 40H; + ehdr.e_ehsize := WCHR(40H); + ehdr.e_phentsize := WCHR(38H); + ehdr.e_shentsize := WCHR(40H) + ELSE + ehdr.e_machine := WCHR(EM_386); + ehdr.e_phoff := 34H; + ehdr.e_ehsize := WCHR(34H); + ehdr.e_phentsize := WCHR(20H); + ehdr.e_shentsize := WCHR(28H) + END; + + SizeOf.header := ORD(ehdr.e_ehsize) + ORD(ehdr.e_phentsize) * ORD(ehdr.e_phnum); + + phdr[interp].p_type := 3; + phdr[interp].p_offset := SizeOf.header; + phdr[interp].p_vaddr := LoadAdr + phdr[interp].p_offset; + phdr[interp].p_paddr := LoadAdr + phdr[interp].p_offset; + phdr[interp].p_filesz := lstr + 1; + phdr[interp].p_memsz := lstr + 1; + phdr[interp].p_flags := PF_R; + phdr[interp].p_align := 1; + + phdr[dyn].p_type := 2; + phdr[dyn].p_offset := phdr[interp].p_offset + phdr[interp].p_filesz; + phdr[dyn].p_vaddr := LoadAdr + phdr[dyn].p_offset; + phdr[dyn].p_paddr := LoadAdr + phdr[dyn].p_offset; + IF amd64 THEN + phdr[dyn].p_filesz := 0A0H; + phdr[dyn].p_memsz := 0A0H + ELSE + phdr[dyn].p_filesz := 50H; + phdr[dyn].p_memsz := 50H + END; + phdr[dyn].p_flags := PF_R; + phdr[dyn].p_align := 1; + + offset := 0; + + phdr[header].p_type := 1; + phdr[header].p_offset := offset; + phdr[header].p_vaddr := LoadAdr; + phdr[header].p_paddr := LoadAdr; + IF amd64 THEN + phdr[header].p_filesz := 305H; + phdr[header].p_memsz := 305H + ELSE + phdr[header].p_filesz := 1D0H; + phdr[header].p_memsz := 1D0H + END; + phdr[header].p_flags := PF_R + PF_W; + phdr[header].p_align := 1000H; + + offset := offset + phdr[header].p_filesz; + VA := LoadAdr + offset + 1000H; + + phdr[text].p_type := 1; + phdr[text].p_offset := offset; + phdr[text].p_vaddr := VA; + phdr[text].p_paddr := VA; + phdr[text].p_filesz := SizeOf.code; + phdr[text].p_memsz := SizeOf.code; + phdr[text].p_flags := PF_X + PF_R; + phdr[text].p_align := 1000H; + + ehdr.e_entry := phdr[text].p_vaddr; + + offset := offset + phdr[text].p_filesz; + VA := LoadAdr + offset + 2000H; + pad := (16 - VA MOD 16) MOD 16; + + phdr[data].p_type := 1; + phdr[data].p_offset := offset; + phdr[data].p_vaddr := VA; + phdr[data].p_paddr := VA; + phdr[data].p_filesz := SizeOf.data + pad; + phdr[data].p_memsz := SizeOf.data + pad; + phdr[data].p_flags := PF_R + PF_W; + phdr[data].p_align := 1000H; + + offset := offset + phdr[data].p_filesz; + VA := LoadAdr + offset + 3000H; + + phdr[bss].p_type := 1; + phdr[bss].p_offset := offset; + phdr[bss].p_vaddr := VA; + phdr[bss].p_paddr := VA; + phdr[bss].p_filesz := 0; + phdr[bss].p_memsz := SizeOf.bss + 16; + phdr[bss].p_flags := PF_R + PF_W; + phdr[bss].p_align := 1000H; + + fixup(program, phdr[text].p_vaddr, phdr[data].p_vaddr + pad, align(phdr[bss].p_vaddr, 16), amd64); + + File := WR.Create(FileName); + + FOR i := 0 TO EI_NIDENT - 1 DO + WR.WriteByte(File, ehdr.e_ident[i]) + END; + + Write16(File, ehdr.e_type); + Write16(File, ehdr.e_machine); + + WR.Write32LE(File, ehdr.e_version); + IF amd64 THEN + WR.Write64LE(File, ehdr.e_entry); + WR.Write64LE(File, ehdr.e_phoff); + WR.Write64LE(File, ehdr.e_shoff) + ELSE + WR.Write32LE(File, ehdr.e_entry); + WR.Write32LE(File, ehdr.e_phoff); + WR.Write32LE(File, ehdr.e_shoff) + END; + WR.Write32LE(File, ehdr.e_flags); + + Write16(File, ehdr.e_ehsize); + Write16(File, ehdr.e_phentsize); + Write16(File, ehdr.e_phnum); + Write16(File, ehdr.e_shentsize); + Write16(File, ehdr.e_shnum); + Write16(File, ehdr.e_shstrndx); + + IF amd64 THEN + WritePH64(File, phdr[interp]); + WritePH64(File, phdr[dyn]); + WritePH64(File, phdr[header]); + WritePH64(File, phdr[text]); + WritePH64(File, phdr[data]); + WritePH64(File, phdr[bss]) + ELSE + WritePH(File, phdr[interp]); + WritePH(File, phdr[dyn]); + WritePH(File, phdr[header]); + WritePH(File, phdr[text]); + WritePH(File, phdr[data]); + WritePH(File, phdr[bss]) + END; + + FOR i := 0 TO lstr DO + WR.WriteByte(File, ORD(str[i])) + END; + + i := 0; + IF amd64 THEN + BIN.InitArray(Dyn, i, "01000000000000000E000000000000000500000000000000DC02400000000000"); + BIN.InitArray(Dyn, i, "0A00000000000000190000000000000006000000000000004C02400000000000"); + BIN.InitArray(Dyn, i, "0B00000000000000180000000000000007000000000000009402400000000000"); + BIN.InitArray(Dyn, i, "0800000000000000300000000000000009000000000000001800000000000000"); + BIN.InitArray(Dyn, i, "0400000000000000C40240000000000000000000000000000000000000000000"); + BIN.InitArray(Dyn, i, "0000000000000000000000000000000000000000000000000100000012000000"); + BIN.InitArray(Dyn, i, "0000000000000000000000000000000008000000120000000000000000000000"); + BIN.InitArray(Dyn, i, "0000000000000000F50240000000000001000000010000000000000000000000"); + BIN.InitArray(Dyn, i, "FD02400000000000010000000200000000000000000000000100000003000000"); + BIN.InitArray(Dyn, i, "0000000001000000020000000000000000646C6F70656E00646C73796D006C69"); + BIN.InitArray(Dyn, i, "62646C2E736F2E320000000000000000000000000000000000") + ELSE + BIN.InitArray(Dyn, i, "010000000E00000005000000AF8104080A000000190000000600000057810408"); + BIN.InitArray(Dyn, i, "0B00000010000000110000008781040812000000100000001300000008000000"); + BIN.InitArray(Dyn, i, "0400000097810408000000000000000000000000000000000000000000000000"); + BIN.InitArray(Dyn, i, "0100000000000000000000001200000008000000000000000000000012000000"); + BIN.InitArray(Dyn, i, "C881040801010000CC8104080102000001000000030000000000000001000000"); + BIN.InitArray(Dyn, i, "020000000000000000646C6F70656E00646C73796D006C6962646C2E736F2E32"); + BIN.InitArray(Dyn, i, "000000000000000000") + END; + + WR.Write(File, Dyn, i); + + CHL.WriteToFile(File, program.code); + WHILE pad > 0 DO + WR.WriteByte(File, 0); + DEC(pad) + END; + CHL.WriteToFile(File, program.data); + WR.Close(File) +END write; -PROCEDURE get*(): INTEGER; - RETURN SYSTEM.ADR(data) + 3 -END get; END ELF. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/ERRORS.ob07 b/programs/develop/oberon07/Source/ERRORS.ob07 index e8bd328ea5..9d242e62d9 100644 --- a/programs/develop/oberon07/Source/ERRORS.ob07 +++ b/programs/develop/oberon07/Source/ERRORS.ob07 @@ -1,285 +1,171 @@ -(* - Copyright 2016, 2017 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE ERRORS; -IMPORT H := HOST; +IMPORT C := CONSOLE, UTILS; -TYPE - STRING = ARRAY 1024 OF CHAR; +PROCEDURE hintmsg* (name: ARRAY OF CHAR; line, col, hint: INTEGER); +BEGIN + IF hint = 0 THEN + C.String(" hint ("); C.Int(line); C.String(":"); C.Int(col); C.String(")"); + C.String(" variable '"); C.String(name); C.StringLn("' never used") + END +END hintmsg; - CP = ARRAY 256 OF INTEGER; +PROCEDURE errormsg* (fname: ARRAY OF CHAR; line, col, errno: INTEGER); VAR - - cp: CP; - - -PROCEDURE utf8(code: INTEGER; VAR uchar: STRING); -BEGIN - uchar[0] := 0X; - IF code < 80H THEN - uchar[0] := CHR(code); - uchar[1] := 0X - ELSIF code < 800H THEN - uchar[1] := CHR(ROR(LSL(code, 26), 26) + 80H); - uchar[0] := CHR(ASR(code, 6) + 0C0H); - uchar[2] := 0X - ELSIF code < 10000H THEN - uchar[2] := CHR(ROR(LSL(code, 26), 26) + 80H); - code := ASR(code, 6); - uchar[1] := CHR(ROR(LSL(code, 26), 26) + 80H); - uchar[0] := CHR(ASR(code, 6) + 0E0H); - uchar[3] := 0X -(* - ELSIF code < 200000H THEN - ELSIF code < 4000000H THEN - ELSE *) - END -END utf8; - -PROCEDURE InitCP(VAR cp: CP); -VAR i: INTEGER; -BEGIN - FOR i := 0H TO 7FH DO - cp[i] := i - END -END InitCP; - -PROCEDURE Init8(VAR cp: CP; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER); -BEGIN - cp[n] := a; INC(n); - cp[n] := b; INC(n); - cp[n] := c; INC(n); - cp[n] := d; INC(n); - cp[n] := e; INC(n); - cp[n] := f; INC(n); - cp[n] := g; INC(n); - cp[n] := h; INC(n); -END Init8; - -PROCEDURE InitCP866(VAR cp: CP); -VAR n, i: INTEGER; -BEGIN - FOR i := 0410H TO 043FH DO - cp[i - 0410H + 80H] := i - END; - FOR i := 0440H TO 044FH DO - cp[i - 0440H + 0E0H] := i - END; - - n := 0B0H; - Init8(cp, n, 2591H, 2592H, 2593H, 2502H, 2524H, 2561H, 2562H, 2556H); - Init8(cp, n, 2555H, 2563H, 2551H, 2557H, 255DH, 255CH, 255BH, 2510H); - Init8(cp, n, 2514H, 2534H, 252CH, 251CH, 2500H, 253CH, 255EH, 255FH); - Init8(cp, n, 255AH, 2554H, 2569H, 2566H, 2560H, 2550H, 256CH, 2567H); - Init8(cp, n, 2568H, 2564H, 2565H, 2559H, 2558H, 2552H, 2553H, 256BH); - Init8(cp, n, 256AH, 2518H, 250CH, 2588H, 2584H, 258CH, 2590H, 2580H); - - n := 0F0H; - Init8(cp, n, 0401H, 0451H, 0404H, 0454H, 0407H, 0457H, 040EH, 045EH); - Init8(cp, n, 00B0H, 2219H, 00B7H, 221AH, 2116H, 00A4H, 25A0H, 00A0H); - - InitCP(cp) -END InitCP866; - -PROCEDURE concat(VAR L: STRING; R: STRING); -VAR i, n, pos: INTEGER; -BEGIN - n := LENGTH(R); - i := 0; - pos := LENGTH(L); - WHILE (i <= n) & (pos < LEN(L)) DO - L[pos] := R[i]; - INC(pos); - INC(i) - END -END concat; - -PROCEDURE Utf8(VAR str: STRING); -VAR i: INTEGER; in, out, u: STRING; -BEGIN - in := str; - out := ""; - FOR i := 0 TO LENGTH(in) - 1 DO - utf8(cp[ORD(in[i])], u); - concat(out, u) - END; - str := out -END Utf8; - -PROCEDURE ErrorMsg*(code: INTEGER; VAR msg: ARRAY OF CHAR); -VAR str: STRING; -BEGIN - CASE code OF - | 1: str := "®¦¨¤ « áì 'H' ¨«¨ 'X'" - | 2: str := "®¦¨¤ « áì æ¨äà " - | 3: str := "áâப  ­¥ ᮤ¥à¦¨â § ªà뢠î饩 ª ¢ë窨" - | 4: str := "­¥¤®¯ãáâ¨¬ë© á¨¬¢®«" - | 5: str := "楫®ç¨á«¥­­®¥ ¯¥à¥¯®«­¥­¨¥" - | 6: str := "᫨誮¬ ¡®«ì讥 §­ ç¥­¨¥ ᨬ¢®«ì­®© ª®­áâ ­âë" - | 7: str := "¢¥é¥á⢥­­®¥ ¯¥à¥¯®«­¥­¨¥" - | 8: str := "¯¥à¥¯®«­¥­¨¥ ¯®à浪  ¢¥é¥á⢥­­®£® ç¨á« " - | 9: str := "¢¥é¥á⢥­­®¥  ­â¨¯¥à¥¯®«­¥­¨¥" - | 10: str := "᫨誮¬ ¤«¨­­ë© ¨¤¥­â¨ä¨ª â®à" - | 11: str := "᫨誮¬ ¤«¨­­ ï áâப®¢ ï ª®­áâ ­â " - - | 21: str := "®¦¨¤ «®áì 'MODULE'" - | 22: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à" - | 23: str := "®¦¨¤ « áì ';'" - | 24: str := "®¦¨¤ «®áì 'END'" - | 25: str := "®¦¨¤ « áì '.'" - | 26: str := "¨¤¥­â¨ä¨ª â®à ­¥ ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ ¬®¤ã«ï" - | 27: str := "­¥®¦¨¤ ­­ë© ª®­¥æ ä ©« " - | 28: str := "®¦¨¤ « áì ',', ';' ¨«¨ ':='" - | 29: str := "®¦¨¤ « áì ',' ¨«¨ ';'" - | 30: str := "¨¤¥­â¨ä¨ª â®à ¯¥à¥®¯à¥¤¥«¥­" - | 31: str := "横«¨ç¥áª¨© ¨¬¯®àâ" - | 32: str := "¬®¤ã«ì ­¥ ­ ©¤¥­ ¨«¨ ®è¨¡ª  ¤®áâ㯠" - | 33: str := "¨¬ï ¬®¤ã«ï ­¥ ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ ä ©«  ¬®¤ã«ï" - | 34: str := "­¥¯à ¢¨«ì­ë© ä®à¬ â áâப¨ ¬ è¨­­ëå ª®¤®¢" - | 35: str := "®¦¨¤ «®áì '='" - | 36: str := "ᨭ⠪á¨ç¥áª ï ®è¨¡ª  ¢ ¢ëà ¦¥­¨¨" - | 37: str := "®¯¥à æ¨ï ­¥ ¯à¨¬¥­¨¬ " - | 38: str := "®¦¨¤ « áì ')'" - | 39: str := "®¦¨¤ «oáì 'ARRAY', 'RECORD', 'POINTER' ¨«¨ 'PROCEDURE'" - | 40: str := "®¦¨¤ «oáì 'TO'" - | 41: str := "®¦¨¤ «oáì 'OF'" - | 42: str := "­¥®¯à¥¤¥«¥­­ë© ¨¤¥­â¨ä¨ª â®à" - | 43: str := "âॡã¥âáï ¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨«¨ áâப®¢ ï ª®­áâ ­â " - | 44: str := "®¦¨¤ «oáì 'cdecl', 'stdcall' ¨«¨ 'winapi'" - | 45: str := "ä« £ ¢ë§®¢  ­¥¤®¯ã᪠¥âáï ¤«ï «®ª «ì­ëå ¯à®æ¥¤ãà" - | 46: str := "¤¥«¥­¨¥ ­  ­ã«ì" - | 47: str := "âॡã¥âáï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ â¥«ï" - | 48: str := "楫®ç¨á«¥­­®¥ ¤¥«¥­¨¥ ­  ­ã«ì" - | 49: str := "§­ ç¥­¨¥ «¥¢®£® ®¯¥à ­¤  ¢­¥ ¤¨ ¯ §®­  0..31" - | 50: str := "ä« £ [winapi] ¤®áâ㯥­ ⮫쪮 ¤«ï ¯« âä®à¬ë Windows" - | 51: str := "®¦¨¤ « áì '}'" - | 52: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  INTEGER" - | 53: str := "§­ ç¥­¨¥ ¢ëà ¦¥­¨ï ¢­¥ ¤¨ ¯ §®­  0..31" - | 54: str := "«¥¢ ï £à ­¨æ  ¤¨ ¯ §®­  ¡®«ìè¥ ¯à ¢®©" - | 55: str := "âॡã¥âáï ª®­áâ ­â  â¨¯  CHAR" - | 56: str := "®¦¨¤ « áì '('" - | 57: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ç¨á«®¢®£® ⨯ " - - | 59: str := "­¥¤®áâ â®ç­® ¯ à ¬¥â஢" - | 60: str := "­¥¤®¯ãáâ¨¬ë© ¯ à ¬¥âà" - | 61: str := "®¦¨¤ « áì ','" - | 62: str := "âॡã¥âáï ª®­áâ ­â­®¥ ¢ëà ¦¥­¨¥" - | 63: str := "âॡã¥âáï ¯¥à¥¬¥­­ ï" - | 64: str := "ä ©« ­¥ ­ ©¤¥­ ¨«¨ ®è¨¡ª  ¤®áâ㯠" - | 65: str := "¬®¤ã«ì RTL ­¥ ­ ©¤¥­" - | 66: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  REAL ¨«¨ LONGREAL" - | 67: str := "­¥¢®§¬®¦­® ᮧ¤ âì ä ©«, ¢®§¬®¦­® ä ©« ®âªàëâ ¨«¨ ¤¨áª § é¨é¥­ ®â § ¯¨á¨" - | 68: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  CHAR, SET ¨«¨ BOOLEAN" - | 69: str := "­¥¢®§¬®¦­® § ¯¨á âì ä ©«" - | 70: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  LONGREAL" - | 71: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  REAL" - | 72: str := "­¥¤®áâ â®ç­® ¯ ¬ï⨠¤«ï § ¢¥à襭¨ï ª®¬¯¨«ï樨" - | 73: str := "¯à®æ¥¤ãà  ­¥ ¢®§¢à é îé ï १ã«ìâ â ­¥¤®¯ãá⨬  ¢ ¢ëà ¦¥­¨ïå" - | 74: str := "§­ ç¥­¨¥ ¢ëà ¦¥­¨ï ¢­¥ 楫®ç¨á«¥­­®£® ¤¨ ¯ §®­ " - | 75: str := "४ãàᨢ­®¥ ®¯à¥¤¥«¥­¨¥ ª®­áâ ­âë" - | 76: str := "§­ ç¥­¨¥ ¢ëà ¦¥­¨ï ¢­¥ ¤¨ ¯ §®­  0..255" - | 77: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ " - | 78: str := "¤«¨­  ⨯ -¬ áᨢ  ¤®«¦­  ¡ëâì ¡®«ìè¥ ­ã«ï" - | 79: str := "®¦¨¤ «®áì 'OF' ¨«¨ ','" - | 80: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨ ¨«¨ ⨯ -㪠§ â¥«ï" - | 81: str := "¡ §®¢ë© ⨯ ⨯ -㪠§ â¥«ï ¤®«¦¥­ ¡ëâì § ¯¨áìî" - | 82: str := "⨯ १ã«ìâ â  ¯à®æ¥¤ãàë ­¥ ¬®¦¥â ¡ëâì § ¯¨áìî ¨«¨ ¬ áᨢ®¬" - | 83: str := "à §¬¥à ⨯  ᫨誮¬ ¢¥«¨ª" - | 84: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ¨«¨ 'VAR'" - | 85: str := "®¦¨¤ « áì ',' ¨«¨ ':'" - | 86: str := "®¦¨¤ «®áì 'END' ¨«¨ ';'" - | 87: str := "¨¤¥­â¨ä¨ª â®à ­¥ ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ ¯à®æ¥¤ãàë" - - | 89: str := "íªá¯®àâ «®ª «ì­®£® ¨¤¥­â¨ä¨ª â®à  ­¥¤®¯ãá⨬" - | 90: str := "⨯ ARRAY ¨«¨ RECORD ­¥¤®¯ãá⨬" - | 91: str := "âॡã¥âáï ¨¤¥­â¨ä¨ª â®à ¢¥é¥á⢥­­®£® ⨯ " - - | 93: str := "à §¬¥à ¤ ­­ëå ᫨誮¬ ¢¥«¨ª" - | 94: str := "áâப  ¤«¨­ë, ®â«¨ç­®© ®â 1 ­¥¤®¯ãá⨬ " - | 95: str := "§­ ç¥­¨¥ ¢ëà ¦¥­¨ï ¤®«¦­® ¡ëâì ¢ ¤¨ ¯ §®­¥ 0..127" - | 96: str := "­¥¤®¯ãá⨬®¥ ४ãàᨢ­®¥ ®¯à¥¤¥«¥­¨¥ ⨯ " - | 97: str := "­¥¤®áâ â®ç­® ¢¥é¥á⢥­­ëå ॣ¨áâ஢, ã¯à®áâ¨â¥ ¢ëà ¦¥­¨¥" - | 98: str := "®¦¨¤ «®áì 'THEN'" - | 99: str := "¯®«¥ § ¯¨á¨ ­¥ ­ ©¤¥­®" - |100: str := "¬¥âª  ¤ã¡«¨à®¢ ­ " - |101: str := "¨¤¥­â¨ä¨ª â®à ⨯  ­¥¤®¯ãá⨬ ¢ ¢ëà ¦¥­¨ïå" - |102: str := "âॡã¥âáï ¬ áᨢ" - |103: str := "®¦¨¤ «oáì 'union' ¨«¨ 'noalign'" - |104: str := "âॡã¥âáï 㪠§ â¥«ì" - |105: str := "âॡã¥âáï § ¯¨áì" - |106: str := "âॡã¥âáï ¨¤¥­â¨ä¨ª â®à ⨯ -§ ¯¨á¨" - |107: str := "âॡã¥âáï ¨¤¥­â¨ä¨ª â®à ⨯ -㪠§ â¥«ï" - |108: str := "­¥¤®¯ãá⨬ ï ®åà ­  ⨯ " - |109: str := "®¦¨¤ « áì ']'" - |110: str := "à §¬¥à­®áâì ®âªàë⮣® ¬ áᨢ  ᫨誮¬ ¢¥«¨ª " - |111: str := "á¨á⥬­ë¥ ä« £¨ âॡãîâ ¨¬¯®àâ  ¬®¤ã«ï SYSTEM" - |112: str := "à áè¨à¥­¨¥ § ¯¨á¨ ­¥ ¬®¦¥â ¡ëâì [noalign] ¨«¨ [union]" - |113: str := "¡ §®¢ë© ⨯ § ¯¨á¨ ­¥ ¬®¦¥â ¡ëâì [noalign] ¨«¨ [union]" - |114: str := "­¥á®¢¬¥áâ¨¬ë© ¯ à ¬¥âà" - |115: str := "¯¥à¥¬¥­­ ï ¤®áâ㯭  ⮫쪮 ¤«ï ç⥭¨ï" - |116: str := "­¥«ì§ï ¨á¯®«ì§®¢ âì «®ª «ì­ãî ¯à®æ¥¤ãàã" - |117: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  BOOLEAN" - |118: str := "®¦¨¤ «®áì 'DO'" - |119: str := "®¦¨¤ «®áì 'UNTIL'" - |120: str := "®¦¨¤ «®áì ':='" - |121: str := "à áè¨à¥­¨¥ ¨¬¥­¨ ä ©«  £« ¢­®£® ¬®¤ã«ï ¤®«¦­® ¡ëâì 'ob07'" - |122: str := "§­ ç¥­¨¥ ¢ëà ¦¥­¨ï ­¥ ¬®¦¥â ¡ëâì à ¢­ë¬ ­ã«î" - |123: str := "'RETURN' ­¥¤®¯ãá⨬ ¢ ¯à®æ¥¤ãà¥, ­¥ ¢®§¢à é î饩 १ã«ìâ â" - |124: str := "®¦¨¤ «®áì 'RETURN'" - |125: str := "⨯ ¢ëà ¦¥­¨ï ­¥ ᮮ⢥âáâ¢ã¥â ⨯ã १ã«ìâ â  ¯à®æ¥¤ãàë" - |126: str := "âॡã¥âáï ¨¤¥­â¨ä¨ª â®à ¯¥à¥¬¥­­®©" - |127: str := "áç¥â稪 横«  FOR ­¥ ¤®«¦¥­ ¡ëâì ¯ à ¬¥â஬" - |128: str := "⨯ ¯¥à¥¬¥­­®© ¤®«¦¥­ ¡ëâì INTEGER" - |129: str := "¯¥à¥¬¥­­ ï ¤®«¦­  ¡ëâì «®ª «ì­®©" - |130: str := "­¥«ì§ï ¨á¯®«ì§®¢ âì ª®­áâ ­âã" - |131: str := "­¥á®¢¬¥á⨬®áâì ¯® ¯à¨á¢ ¨¢ ­¨î" - |132: str := "¢ë§®¢ ¯à®æ¥¤ãàë-ä㭪樨 ¤®¯ã᪠¥âáï ⮫쪮 ¢ á®áâ ¢¥ ¢ëà ¦¥­¨ï" - |133: str := "¨¤¥­â¨ä¨ª â®àë 'lib_init' ¨ 'version' § à¥§¥à¢¨à®¢ ­ë" - - |138: str := "⨯ ¯¥à¥¬¥­­®© ¤®«¦¥­ ¡ëâì SET" - - |141: str := "âॡã¥âáï áâப  ¨«¨ ᨬ¢®«ì­ë© ¬ áᨢ" - - |143: str := "âॡã¥âáï ᨬ¢®«ì­ë© ¬ áᨢ" - - |145: str := "⨯ ¯¥à¥¬¥­­®© ¤®«¦¥­ ¡ëâì POINTER" - - |149: str := "⨯ ¯¥à¥¬¥­­®© ¤®«¦¥­ ¡ëâì REAL ¨«¨ LONGREAL" - |150: str := "âॡã¥âáï áâப®¢ ï ª®­áâ ­â " - - |155: str := "®¦¨¤ « áì '(' ¨«¨ ':='" - |156: str := "âॡã¥âáï ¢ëà ¦¥­¨¥ ⨯  INTEGER ¨«¨ CHAR" - |157: str := "®¦¨¤ « áì ':'" - |158: str := "­¥ ­ ©¤¥­  ¯à®æ¥¤ãà  ¢ ¬®¤ã«¥ RTL" - |159: str := "­ àã襭¨¥ £à ­¨æ ¬ áᨢ " - |160: str := "®¦¨¤ «áï ¨¤¥­â¨ä¨ª â®à ª®­áâ ­âë" - |161: str := "âॡã¥âáï ª®­áâ ­â  â¨¯  INTEGER" - END; - IF H.OS = "LNX" THEN - Utf8(str) - END; - COPY(str, msg) -END ErrorMsg; + str: ARRAY 80 OF CHAR; BEGIN - InitCP866(cp) + C.Ln; + C.String(" error ("); C.Int(line); C.String(":"); C.Int(col); C.String(") "); + + CASE errno OF + | 1: str := "missing 'H' or 'X'" + | 2: str := "missing scale" + | 3: str := "unclosed string" + | 4: str := "illegal character" + | 5: str := "string too long" + | 6: str := "identifier too long" + | 7: str := "number too long" + | 8..12: str := "number too large" + + | 21: str := "'MODULE' expected" + | 22: str := "identifier expected" + | 23: str := "module name does not match file name" + | 24: str := "';' expected" + | 25: str := "identifier does not match module name" + | 26: str := "'.' expected" + | 27: str := "'END' expected" + | 28: str := "',', ';' or ':=' expected" + | 29: str := "module not found" + | 30: str := "multiply defined identifier" + | 31: str := "recursive import" + | 32: str := "'=' expected" + | 33: str := "')' expected" + | 34: str := "syntax error in expression" + | 35: str := "'}' expected" + | 36: str := "incompatible operand" + | 37: str := "incompatible operands" + | 38: str := "'RETURN' expected" + | 39: str := "integer overflow" + | 40: str := "floating point overflow" + | 41: str := "not enough floating point registers; simplify expression" + | 42: str := "out of range 0..255" + | 43: str := "expression is not an integer" + | 44: str := "out of range 0..MAXSET" + | 45: str := "division by zero" + | 46: str := "integer division by zero" + | 47: str := "'OF' or ',' expected" + | 48: str := "undeclared identifier" + | 49: str := "type expected" + | 50: str := "recursive type definition" + | 51: str := "illegal value of constant" + | 52: str := "not a record type" + | 53: str := "':' expected" + | 54: str := "need to import SYSTEM" + | 55: str := "pointer type not defined" + | 56: str := "out of range 0..MAXSET" + | 57: str := "'TO' expected" + | 58: str := "not a record type" + | 59: str := "this expression cannot be a procedure" + | 60: str := "identifier does not match procedure name" + | 61: str := "illegally marked identifier" + | 62: str := "expression should be constant" + | 63: str := "'stdcall', 'ccall', 'ccall16', 'windows' or 'linux' expected" + | 64: str := "'(' expected" + | 65: str := "',' expected" + | 66: str := "incompatible parameter" + | 67: str := "'OF' expected" + | 68: str := "type expected" + | 69: str := "result type of procedure is not a basic type" + | 70: str := "import not supported" + | 71: str := "']' expected" + | 72: str := "expression is not BOOLEAN" + | 73: str := "not a record" + | 74: str := "undefined record field" + | 75: str := "not an array" + | 76: str := "expression is not an integer" + | 77: str := "not a pointer" + | 78: str := "type guard not allowed" + | 79: str := "not a type" + | 80: str := "not a record type" + | 81: str := "not a pointer type" + | 82: str := "type guard not allowed" + | 83: str := "index out of range" + | 84: str := "dimension too large" + | 85: str := "procedure must have level 0" + | 86: str := "not a procedure" + | 87: str := "incompatible expression (RETURN)" + | 88: str := "'THEN' expected" + | 89: str := "'DO' expected" + | 90: str := "'UNTIL' expected" + | 91: str := "incompatible assignment" + | 92: str := "procedure call of a function" + | 93: str := "not a variable" + | 94: str := "read only variable" + | 95: str := "invalid type of expression (CASE)" + | 96: str := "':=' expected" + | 97: str := "not INTEGER variable" + | 98: str := "illegal value of constant (0)" + | 99: str := "incompatible label" + |100: str := "multiply defined label" + |101: str := "too large parameter of WCHR" + |102: str := "label expected" + |103: str := "illegal value of constant" + |104: str := "type too large" + |105: str := "access to intermediate variables not allowed" + |106: str := "qualified identifier expected" + |107: str := "too large parameter of CHR" + |108: str := "a variable or a procedure expected" + |109: str := "expression should be constant" + |110: str := "'noalign' expected" + |111: str := "record [noalign] cannot have a base type" + |112: str := "record [noalign] cannot be a base type" + |113: str := "result type of procedure should not be REAL" + |114: str := "identifiers 'lib_init' and 'version' are reserved" + |115: str := "recursive constant definition" + |116: str := "procedure too deep nested" + |117: str := "'stdcall64', 'win64', 'systemv', 'windows' or 'linux' expected" + |118: str := "this flag for Windows only" + |119: str := "this flag for Linux only" + |120: str := "too many formal parameters" + END; + C.StringLn(str); + C.String(" file: "); C.StringLn(fname); + UTILS.Exit(1) +END errormsg; + + +PROCEDURE error1* (s1: ARRAY OF CHAR); +BEGIN + C.Ln; + C.StringLn(s1); + UTILS.Exit(1) +END error1; + + +PROCEDURE error3* (s1, s2, s3: ARRAY OF CHAR); +BEGIN + C.Ln; + C.String(s1); C.String(s2); C.StringLn(s3); + UTILS.Exit(1) +END error3; + + +PROCEDURE error5* (s1, s2, s3, s4, s5: ARRAY OF CHAR); +BEGIN + C.Ln; + C.String(s1); C.String(s2); C.String(s3); C.String(s4); C.StringLn(s5); + UTILS.Exit(1) +END error5; + + END ERRORS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/FILES.ob07 b/programs/develop/oberon07/Source/FILES.ob07 new file mode 100644 index 0000000000..23032ca6cc --- /dev/null +++ b/programs/develop/oberon07/Source/FILES.ob07 @@ -0,0 +1,219 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE FILES; + +IMPORT UTILS, C := COLLECTIONS, CONSOLE; + + +TYPE + + FILE* = POINTER TO RECORD (C.ITEM) + + ptr: INTEGER; + + buffer: ARRAY 64*1024 OF BYTE; + count: INTEGER + + END; + +VAR + + files: C.COLLECTION; + + +PROCEDURE copy (src: ARRAY OF BYTE; src_idx: INTEGER; VAR dst: ARRAY OF BYTE; dst_idx: INTEGER; bytes: INTEGER); +BEGIN + WHILE bytes > 0 DO + dst[dst_idx] := src[src_idx]; + INC(dst_idx); + INC(src_idx); + DEC(bytes) + END +END copy; + + +PROCEDURE flush (file: FILE): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF file # NIL THEN + res := UTILS.FileWrite(file.ptr, file.buffer, file.count); + IF res < 0 THEN + res := 0 + END + ELSE + res := 0 + END + + RETURN res +END flush; + + +PROCEDURE NewFile (): FILE; +VAR + file: FILE; + citem: C.ITEM; + +BEGIN + citem := C.pop(files); + IF citem = NIL THEN + NEW(file) + ELSE + file := citem(FILE) + END + + RETURN file +END NewFile; + + +PROCEDURE create* (name: ARRAY OF CHAR): FILE; +VAR + file: FILE; + ptr: INTEGER; + +BEGIN + ptr := UTILS.FileCreate(name); + + IF ptr > 0 THEN + file := NewFile(); + file.ptr := ptr; + file.count := 0 + ELSE + file := NIL + END + + RETURN file +END create; + + +PROCEDURE open* (name: ARRAY OF CHAR): FILE; +VAR + file: FILE; + ptr: INTEGER; + +BEGIN + ptr := UTILS.FileOpen(name); + + IF ptr > 0 THEN + file := NewFile(); + file.ptr := ptr; + file.count := -1 + ELSE + file := NIL + END + + RETURN file +END open; + + +PROCEDURE close* (VAR file: FILE); +VAR + n: INTEGER; + +BEGIN + IF file # NIL THEN + + IF file.count > 0 THEN + n := flush(file) + END; + + file.count := -1; + + UTILS.FileClose(file.ptr); + file.ptr := 0; + + C.push(files, file); + file := NIL + END +END close; + + +PROCEDURE read* (file: FILE; VAR chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF file # NIL THEN + res := UTILS.FileRead(file.ptr, chunk, MAX(MIN(bytes, LEN(chunk)), 0)); + IF res < 0 THEN + res := 0 + END + ELSE + res := 0 + END + + RETURN res +END read; + + +PROCEDURE write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER): INTEGER; +VAR + free, n, k, res, idx: INTEGER; + +BEGIN + idx := 0; + res := 0; + IF (file # NIL) & (file.count >= 0) THEN + + free := LEN(file.buffer) - file.count; + WHILE bytes > 0 DO + n := MIN(free, bytes); + copy(chunk, idx, file.buffer, file.count, n); + INC(res, n); + DEC(free, n); + DEC(bytes, n); + INC(idx, n); + INC(file.count, n); + IF free = 0 THEN + k := flush(file); + IF k # LEN(file.buffer) THEN + bytes := 0; + DEC(res, n) + ELSE + file.count := 0; + free := LEN(file.buffer) + END + END + END + + END + + RETURN res +END write; + + +PROCEDURE WriteByte* (file: FILE; byte: BYTE): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := TRUE; + IF (file # NIL) & (file.count >= 0) THEN + IF file.count = LEN(file.buffer) THEN + IF flush(file) # LEN(file.buffer) THEN + res := FALSE + ELSE + file.buffer[0] := byte; + file.count := 1 + END + ELSE + file.buffer[file.count] := byte; + INC(file.count) + END + ELSE + res := FALSE + END + + RETURN res +END WriteByte; + + +BEGIN + files := C.create() +END FILES. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/KOS.ob07 b/programs/develop/oberon07/Source/KOS.ob07 new file mode 100644 index 0000000000..6d7258a34a --- /dev/null +++ b/programs/develop/oberon07/Source/KOS.ob07 @@ -0,0 +1,218 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE KOS; + +IMPORT BIN, WR := WRITER, LISTS, CHL := CHUNKLISTS; + + +CONST + + HEADER_SIZE = 36; + + SIZE_OF_DWORD = 4; + + +TYPE + + FILE = WR.FILE; + + HEADER = RECORD + + menuet01: ARRAY 9 OF CHAR; + ver, start, size, mem, sp, param, path: INTEGER + + END; + + +PROCEDURE align (n, _align: INTEGER): INTEGER; +BEGIN + IF n MOD _align # 0 THEN + n := n + _align - (n MOD _align) + END + + RETURN n +END align; + + +PROCEDURE Import* (program: BIN.PROGRAM; idata: INTEGER; VAR ImportTable: CHL.INTLIST; VAR len, libcount, size: INTEGER); +VAR + i: INTEGER; + import: BIN.IMPRT; + +BEGIN + libcount := 0; + import := program.imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + IF import.label = 0 THEN + INC(libcount) + END; + import := import.next(BIN.IMPRT) + END; + + len := libcount * 2 + 2; + size := (LISTS.count(program.imp_list) + len + 1) * SIZE_OF_DWORD; + + ImportTable := CHL.CreateIntList(); + FOR i := 0 TO size DIV SIZE_OF_DWORD - 1 DO + CHL.PushInt(ImportTable, 0) + END; + + i := 0; + import := program.imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + + IF import.label = 0 THEN + CHL.SetInt(ImportTable, len, 0); + INC(len); + CHL.SetInt(ImportTable, i, idata + len * SIZE_OF_DWORD); + INC(i); + CHL.SetInt(ImportTable, i, import.nameoffs + size + idata); + INC(i) + ELSE + CHL.SetInt(ImportTable, len, import.nameoffs + size + idata); + import.label := len * SIZE_OF_DWORD; + INC(len) + END; + + import := import.next(BIN.IMPRT) + END; + CHL.SetInt(ImportTable, len, 0); + CHL.SetInt(ImportTable, i, 0); + CHL.SetInt(ImportTable, i + 1, 0); + INC(len); + size := size + CHL.Length(program.import) +END Import; + + +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR); + +CONST + + PARAM_SIZE = 2048; + FileAlignment = 16; + + +VAR + header: HEADER; + + base, text, data, idata, bss: INTEGER; + + reloc: BIN.RELOC; + iproc: BIN.IMPRT; + L: INTEGER; + delta: INTEGER; + + i: INTEGER; + + File: FILE; + + ImportTable: CHL.INTLIST; + ILen, libcount, isize: INTEGER; + + icount, dcount, ccount: INTEGER; + + +BEGIN + base := 0; + + icount := CHL.Length(program.import); + dcount := CHL.Length(program.data); + ccount := CHL.Length(program.code); + + text := base + HEADER_SIZE; + data := align(text + ccount, FileAlignment); + idata := align(data + dcount, FileAlignment); + + Import(program, idata, ImportTable, ILen, libcount, isize); + + bss := align(idata + isize, FileAlignment); + + header.menuet01 := "MENUET01"; + header.ver := 1; + header.start := text; + header.size := idata + isize - base; + header.mem := align(header.size + program.stack + program.bss + PARAM_SIZE * 2 + 4096, FileAlignment); + header.sp := base + header.mem - PARAM_SIZE * 2; + header.param := header.sp; + header.path := header.param + PARAM_SIZE; + + + reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO + + L := BIN.get32le(program.code, reloc.offset); + delta := 3 - reloc.offset - text; + + CASE reloc.opcode OF + + |BIN.RIMP: + iproc := BIN.GetIProc(program, L); + BIN.put32le(program.code, reloc.offset, idata + iproc.label) + + |BIN.RBSS: + BIN.put32le(program.code, reloc.offset, L + bss) + + |BIN.RDATA: + BIN.put32le(program.code, reloc.offset, L + data) + + |BIN.RCODE: + BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text) + + |BIN.PICDATA: + BIN.put32le(program.code, reloc.offset, L + data + delta) + + |BIN.PICCODE: + BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + text + delta) + + |BIN.PICBSS: + BIN.put32le(program.code, reloc.offset, L + bss + delta) + + |BIN.PICIMP: + iproc := BIN.GetIProc(program, L); + BIN.put32le(program.code, reloc.offset, idata + iproc.label + delta) + + |BIN.IMPTAB: + BIN.put32le(program.code, reloc.offset, idata + delta) + + END; + + reloc := reloc.next(BIN.RELOC) + END; + + File := WR.Create(FileName); + + FOR i := 0 TO 7 DO + WR.WriteByte(File, ORD(header.menuet01[i])) + END; + + WR.Write32LE(File, header.ver); + WR.Write32LE(File, header.start); + WR.Write32LE(File, header.size); + WR.Write32LE(File, header.mem); + WR.Write32LE(File, header.sp); + WR.Write32LE(File, header.param); + WR.Write32LE(File, header.path); + + CHL.WriteToFile(File, program.code); + WR.Padding(File, FileAlignment); + + CHL.WriteToFile(File, program.data); + WR.Padding(File, FileAlignment); + + FOR i := 0 TO ILen - 1 DO + WR.Write32LE(File, CHL.GetInt(ImportTable, i)) + END; + + CHL.WriteToFile(File, program.import); + + WR.Close(File) + +END write; + + +END KOS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/LISTS.ob07 b/programs/develop/oberon07/Source/LISTS.ob07 new file mode 100644 index 0000000000..3e3188dc94 --- /dev/null +++ b/programs/develop/oberon07/Source/LISTS.ob07 @@ -0,0 +1,184 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE LISTS; + +IMPORT C := COLLECTIONS; + + +TYPE + + ITEM* = POINTER TO RECORD (C.ITEM) + + prev*, next*: ITEM + + END; + + LIST* = POINTER TO RECORD + + first*, last*: ITEM + + END; + + +PROCEDURE push* (list: LIST; item: ITEM); +BEGIN + ASSERT(list # NIL); + ASSERT(item # NIL); + + IF list.first = NIL THEN + list.first := item; + list.last := item; + item.prev := NIL; + item.next := NIL + ELSE + ASSERT(list.last # NIL); + + item.prev := list.last; + list.last.next := item; + item.next := NIL; + list.last := item + END +END push; + + +PROCEDURE pop* (list: LIST): ITEM; +VAR + last: ITEM; + +BEGIN + ASSERT(list # NIL); + + last := list.last; + + IF last # NIL THEN + IF last = list.first THEN + list.first := NIL; + list.last := NIL + ELSE + list.last := last.prev; + list.last.next := NIL + END; + + last.next := NIL; + last.prev := NIL + END + + RETURN last +END pop; + + +PROCEDURE insert* (list: LIST; cur, nov: ITEM); +VAR + next: ITEM; + +BEGIN + ASSERT(list # NIL); + ASSERT(nov # NIL); + ASSERT(cur # NIL); + + next := cur.next; + + IF next # NIL THEN + next.prev := nov; + nov.next := next; + cur.next := nov; + nov.prev := cur + ELSE + push(list, nov) + END + +END insert; + + +PROCEDURE insertL* (list: LIST; cur, nov: ITEM); +VAR + prev: ITEM; + +BEGIN + ASSERT(list # NIL); + ASSERT(nov # NIL); + ASSERT(cur # NIL); + + prev := cur.prev; + + IF prev # NIL THEN + prev.next := nov; + nov.prev := prev; + cur.prev := nov; + nov.next := cur + ELSE + nov.prev := NIL; + cur.prev := nov; + nov.next := cur; + list.first := nov + END + +END insertL; + + +PROCEDURE delete* (list: LIST; item: ITEM); +VAR + prev, next: ITEM; + +BEGIN + ASSERT(list # NIL); + ASSERT(item # NIL); + + prev := item.prev; + next := item.next; + + IF (next # NIL) & (prev # NIL) THEN + prev.next := next; + next.prev := prev + ELSIF (next = NIL) & (prev = NIL) THEN + list.first := NIL; + list.last := NIL + ELSIF (next = NIL) & (prev # NIL) THEN + prev.next := NIL; + list.last := prev + ELSIF (next # NIL) & (prev = NIL) THEN + next.prev := NIL; + list.first := next + END + +END delete; + + +PROCEDURE count* (list: LIST): INTEGER; +VAR + item: ITEM; + res: INTEGER; + +BEGIN + ASSERT(list # NIL); + res := 0; + + item := list.first; + WHILE item # NIL DO + INC(res); + item := item.next + END + + RETURN res +END count; + + +PROCEDURE create* (list: LIST): LIST; +BEGIN + IF list = NIL THEN + NEW(list) + END; + + list.first := NIL; + list.last := NIL + + RETURN list +END create; + + +END LISTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MACHINE.ob07 b/programs/develop/oberon07/Source/MACHINE.ob07 new file mode 100644 index 0000000000..2e60460f94 --- /dev/null +++ b/programs/develop/oberon07/Source/MACHINE.ob07 @@ -0,0 +1,110 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE MACHINE; + +IMPORT UTILS; + + +CONST + + min32* = -2147483647-1; + max32* = 2147483647; + + +VAR + + target*: + + RECORD + + bit_depth*, + maxInt*, + minInt*, + maxSet*, + maxHex*: INTEGER; + + maxReal*: REAL + + END; + + _64to32*: BOOLEAN; + + +PROCEDURE SetBitDepth* (pBitDepth: INTEGER); +BEGIN + ASSERT(pBitDepth <= UTILS.bit_depth); + ASSERT((pBitDepth = 32) OR (pBitDepth = 64)); + + _64to32 := (UTILS.bit_depth = 64) & (pBitDepth = 32); + + target.bit_depth := pBitDepth; + target.maxSet := pBitDepth - 1; + target.maxHex := pBitDepth DIV 4; + target.minInt := ASR(UTILS.minint, UTILS.bit_depth - pBitDepth); + target.maxInt := ASR(UTILS.maxint, UTILS.bit_depth - pBitDepth); + target.maxReal := 1.9; + PACK(target.maxReal, 1023); +END SetBitDepth; + + +PROCEDURE Byte* (n: INTEGER; idx: INTEGER): BYTE; +BEGIN + WHILE idx > 0 DO + n := ASR(n, 8); + DEC(idx) + END + + RETURN ORD(BITS(n) * {0..7}) +END Byte; + + +PROCEDURE Align* (VAR bytes: INTEGER; align: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + IF bytes MOD align # 0 THEN + res := UTILS.maxint - bytes >= align - (bytes MOD align); + IF res THEN + bytes := bytes + align - (bytes MOD align) + END + ELSE + res := TRUE + END + + RETURN res +END Align; + + +PROCEDURE Int32To64* (value: INTEGER): INTEGER; +BEGIN + IF UTILS.bit_depth = 64 THEN + value := LSL(value, 16); + value := LSL(value, 16); + value := ASR(value, 16); + value := ASR(value, 16) + END + + RETURN value +END Int32To64; + + +PROCEDURE Int64To32* (value: INTEGER): INTEGER; +BEGIN + IF UTILS.bit_depth = 64 THEN + value := LSL(value, 16); + value := LSL(value, 16); + value := LSR(value, 16); + value := LSR(value, 16) + END + + RETURN value +END Int64To32; + + +END MACHINE. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/MSCOFF.ob07 b/programs/develop/oberon07/Source/MSCOFF.ob07 new file mode 100644 index 0000000000..c05c3e4033 --- /dev/null +++ b/programs/develop/oberon07/Source/MSCOFF.ob07 @@ -0,0 +1,316 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE MSCOFF; + +IMPORT BIN, PE32, KOS, WR := WRITER, UTILS, ERRORS, LISTS, CHL := CHUNKLISTS; + + +CONST + + SIZE_OF_DWORD = 4; + + (* SectionHeader.Characteristics *) + + SHC_flat = 040500020H; + SHC_data = 0C0500040H; + SHC_bss = 0C03000C0H; + + +TYPE + + FH = PE32.IMAGE_FILE_HEADER; + + SH = PE32.IMAGE_SECTION_HEADER; + + +PROCEDURE WriteReloc (File: WR.FILE; VirtualAddress, SymbolTableIndex, Type: INTEGER); +BEGIN + WR.Write32LE(File, VirtualAddress); + WR.Write32LE(File, SymbolTableIndex); + WR.Write16LE(File, Type) +END WriteReloc; + + +PROCEDURE Reloc (program: BIN.PROGRAM; File: WR.FILE); +VAR + reloc: BIN.RELOC; + +BEGIN + reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO + + CASE reloc.opcode OF + + |BIN.RIMP, BIN.IMPTAB: + WriteReloc(File, reloc.offset, 4, 6) + + |BIN.RBSS: + WriteReloc(File, reloc.offset, 5, 6) + + |BIN.RDATA: + WriteReloc(File, reloc.offset, 2, 6) + + |BIN.RCODE: + WriteReloc(File, reloc.offset, 1, 6) + + END; + + reloc := reloc.next(BIN.RELOC) + END; +END Reloc; + + +PROCEDURE RelocCount (program: BIN.PROGRAM): INTEGER; +VAR + reloc: BIN.RELOC; + iproc: BIN.IMPRT; + res, L: INTEGER; + +BEGIN + res := 0; + reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO + + INC(res); + + IF reloc.opcode = BIN.RIMP THEN + L := BIN.get32le(program.code, reloc.offset); + iproc := BIN.GetIProc(program, L); + BIN.put32le(program.code, reloc.offset, iproc.label) + END; + + IF reloc.opcode = BIN.RCODE THEN + L := BIN.get32le(program.code, reloc.offset); + BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L)) + END; + + reloc := reloc.next(BIN.RELOC) + END + + RETURN res +END RelocCount; + + +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; ver: INTEGER); +VAR + File: WR.FILE; + exp: BIN.EXPRT; + n, i: INTEGER; + + szversion: PE32.NAME; + + ImportTable: CHL.INTLIST; + ILen, LibCount, isize: INTEGER; + + ExpCount: INTEGER; + + icount, ecount, dcount, ccount: INTEGER; + + FileHeader: FH; + + flat, data, edata, idata, bss: SH; + + + PROCEDURE ICount (ImportTable: CHL.INTLIST; ILen: INTEGER): INTEGER; + VAR + i, res: INTEGER; + + BEGIN + res := 0; + + FOR i := 0 TO ILen - 1 DO + IF CHL.GetInt(ImportTable, i) # 0 THEN + INC(res) + END + END + + RETURN res + END ICount; + + + PROCEDURE SetNumberOfRelocations (VAR section: SH; NumberOfRelocations: INTEGER); + BEGIN + IF NumberOfRelocations >= 65536 THEN + ERRORS.error1("too many relocations") + END; + section.NumberOfRelocations := WCHR(NumberOfRelocations) + END SetNumberOfRelocations; + + +BEGIN + + szversion := "version"; + + ASSERT(LENGTH(szversion) = 7); + + KOS.Import(program, 0, ImportTable, ILen, LibCount, isize); + ExpCount := LISTS.count(program.exp_list); + + icount := CHL.Length(program.import); + dcount := CHL.Length(program.data); + ccount := CHL.Length(program.code); + ecount := CHL.Length(program.export); + + FileHeader.Machine := 014CX; + FileHeader.NumberOfSections := 5X; + FileHeader.TimeDateStamp := UTILS.UnixTime(); + //FileHeader.PointerToSymbolTable := 0; + FileHeader.NumberOfSymbols := 6; + FileHeader.SizeOfOptionalHeader := 0X; + FileHeader.Characteristics := 0184X; + + flat.Name := ".flat"; + flat.VirtualSize := 0; + flat.VirtualAddress := 0; + flat.SizeOfRawData := ccount; + flat.PointerToRawData := ORD(FileHeader.NumberOfSections) * PE32.SIZE_OF_IMAGE_SECTION_HEADER + PE32.SIZE_OF_IMAGE_FILE_HEADER; + //flat.PointerToRelocations := 0; + flat.PointerToLinenumbers := 0; + SetNumberOfRelocations(flat, RelocCount(program)); + flat.NumberOfLinenumbers := 0X; + flat.Characteristics := SHC_flat; + + data.Name := ".data"; + data.VirtualSize := 0; + data.VirtualAddress := 0; + data.SizeOfRawData := dcount; + data.PointerToRawData := flat.PointerToRawData + flat.SizeOfRawData; + data.PointerToRelocations := 0; + data.PointerToLinenumbers := 0; + data.NumberOfRelocations := 0X; + data.NumberOfLinenumbers := 0X; + data.Characteristics := SHC_data; + + edata.Name := ".edata"; + edata.VirtualSize := 0; + edata.VirtualAddress := 0; + edata.SizeOfRawData := ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD + LENGTH(szversion) + 1 + ecount; + edata.PointerToRawData := data.PointerToRawData + data.SizeOfRawData; + //edata.PointerToRelocations := 0; + edata.PointerToLinenumbers := 0; + SetNumberOfRelocations(edata, ExpCount * 2 + 1); + edata.NumberOfLinenumbers := 0X; + edata.Characteristics := SHC_data; + + idata.Name := ".idata"; + idata.VirtualSize := 0; + idata.VirtualAddress := 0; + idata.SizeOfRawData := isize; + idata.PointerToRawData := edata.PointerToRawData + edata.SizeOfRawData; + //idata.PointerToRelocations := 0; + idata.PointerToLinenumbers := 0; + SetNumberOfRelocations(idata, ICount(ImportTable, ILen)); + idata.NumberOfLinenumbers := 0X; + idata.Characteristics := SHC_data; + + bss.Name := ".bss"; + bss.VirtualSize := 0; + bss.VirtualAddress := 0; + bss.SizeOfRawData := program.bss; + bss.PointerToRawData := 0; + bss.PointerToRelocations := 0; + bss.PointerToLinenumbers := 0; + bss.NumberOfRelocations := 0X; + bss.NumberOfLinenumbers := 0X; + bss.Characteristics := SHC_bss; + + flat.PointerToRelocations := idata.PointerToRawData + idata.SizeOfRawData; + edata.PointerToRelocations := flat.PointerToRelocations + ORD(flat.NumberOfRelocations) * 10; + idata.PointerToRelocations := edata.PointerToRelocations + ORD(edata.NumberOfRelocations) * 10; + + FileHeader.PointerToSymbolTable := idata.PointerToRelocations + ORD(idata.NumberOfRelocations) * 10; + + File := WR.Create(FileName); + + PE32.WriteFileHeader(File, FileHeader); + + PE32.WriteSectionHeader(File, flat); + PE32.WriteSectionHeader(File, data); + PE32.WriteSectionHeader(File, edata); + PE32.WriteSectionHeader(File, idata); + PE32.WriteSectionHeader(File, bss); + + CHL.WriteToFile(File, program.code); + CHL.WriteToFile(File, program.data); + + exp := program.exp_list.first(BIN.EXPRT); + WHILE exp # NIL DO + WR.Write32LE(File, exp.nameoffs + edata.SizeOfRawData - ecount); + WR.Write32LE(File, exp.label); + exp := exp.next(BIN.EXPRT) + END; + + WR.Write32LE(File, ((ExpCount + 1) * 2 + 1) * SIZE_OF_DWORD); + WR.Write32LE(File, ver); + + WR.Write32LE(File, 0); + + PE32.WriteName(File, szversion); + CHL.WriteToFile(File, program.export); + + FOR i := 0 TO ILen - 1 DO + WR.Write32LE(File, CHL.GetInt(ImportTable, i)) + END; + + CHL.WriteToFile(File, program.import); + + Reloc(program, File); + + n := 0; + exp := program.exp_list.first(BIN.EXPRT); + WHILE exp # NIL DO + WriteReloc(File, n, 3, 6); + INC(n, 4); + + WriteReloc(File, n, 1, 6); + INC(n, 4); + + exp := exp.next(BIN.EXPRT) + END; + + WriteReloc(File, n, 3, 6); + + i := 0; + WHILE i < LibCount * 2 DO + WriteReloc(File, i * SIZE_OF_DWORD, 4, 6); + INC(i); + WriteReloc(File, i * SIZE_OF_DWORD, 4, 6); + INC(i) + END; + + FOR i := LibCount * 2 TO ILen - 1 DO + IF CHL.GetInt(ImportTable, i) # 0 THEN + WriteReloc(File, i * SIZE_OF_DWORD, 4, 6) + END + END; + + PE32.WriteName(File, "EXPORTS"); + WriteReloc(File, 0, 3, 2); + + PE32.WriteName(File, ".flat"); + WriteReloc(File, 0, 1, 3); + + PE32.WriteName(File, ".data"); + WriteReloc(File, 0, 2, 3); + + PE32.WriteName(File, ".edata"); + WriteReloc(File, 0, 3, 3); + + PE32.WriteName(File, ".idata"); + WriteReloc(File, 0, 4, 3); + + PE32.WriteName(File, ".bss"); + WriteReloc(File, 0, 5, 3); + + WR.Write32LE(File, 4); + + WR.Close(File) +END write; + + +END MSCOFF. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PARS.ob07 b/programs/develop/oberon07/Source/PARS.ob07 new file mode 100644 index 0000000000..136988f316 --- /dev/null +++ b/programs/develop/oberon07/Source/PARS.ob07 @@ -0,0 +1,1166 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE PARS; + +IMPORT PROG, SCAN, ARITH, STRINGS, ERRORS, LISTS, CODE, CONSOLE, PATHS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS; + + +CONST + + eCONST* = 1; eTYPE* = 2; eVAR* = 3; eEXPR* = 4; + eVREC* = 5; ePROC* = 6; eVPAR* = 7; ePARAM* = 8; + eSTPROC* = 9; eSTFUNC* = 10; eSYSFUNC* = 11; eSYSPROC* = 12; + eIMP* = 13; + + +TYPE + + PATH* = PATHS.PATH; + + PARSER* = POINTER TO rPARSER; + + EXPR* = RECORD + + obj*: INTEGER; + type*: PROG.TYPE_; + value*: ARITH.VALUE; + stproc*: INTEGER; + readOnly*: BOOLEAN; + ident*: PROG.IDENT + + END; + + STATPROC = PROCEDURE (parser: PARSER); + EXPRPROC = PROCEDURE (parser: PARSER; VAR e: EXPR); + RETPROC = PROCEDURE (parser: PARSER; e: EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; + + rPARSER = RECORD (C.ITEM) + + fname*: PATH; + path: PATH; + lib_path: PATH; + ext: PATH; + modname: PATH; + scanner: SCAN.SCANNER; + lex*: SCAN.LEX; + sym*: INTEGER; + unit*: PROG.UNIT; + constexp*: BOOLEAN; + main*: BOOLEAN; + + open*: PROCEDURE (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN; + parse*: PROCEDURE (parser: PARSER); + StatSeq*: STATPROC; + expression*: EXPRPROC; + designator*: EXPRPROC; + chkreturn: RETPROC; + + create*: PROCEDURE (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER + + END; + + +VAR + + program*: PROG.PROGRAM; + + parsers: C.COLLECTION; + + +PROCEDURE destroy* (VAR parser: PARSER); +BEGIN + IF parser.scanner # NIL THEN + SCAN.close(parser.scanner) + END; + + C.push(parsers, parser); + parser := NIL +END destroy; + + +PROCEDURE error* (parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); +BEGIN + ERRORS.errormsg(parser.fname, pos.line, pos.col, errno) +END error; + + +PROCEDURE check* (condition: BOOLEAN; parser: PARSER; pos: SCAN.POSITION; errno: INTEGER); +BEGIN + IF ~condition THEN + error(parser, pos, errno) + END +END check; + + +PROCEDURE check1* (condition: BOOLEAN; parser: PARSER; errno: INTEGER); +BEGIN + IF ~condition THEN + error(parser, parser.lex.pos, errno) + END +END check1; + + +PROCEDURE getpos (parser: PARSER; VAR pos: SCAN.POSITION); +BEGIN + pos := parser.lex.pos +END getpos; + + +PROCEDURE Next* (parser: PARSER); +VAR + errno: INTEGER; + +BEGIN + SCAN.Next(parser.scanner, parser.lex); + errno := parser.lex.error; + IF errno # 0 THEN + check1(FALSE, parser, errno) + END; + parser.sym := parser.lex.sym +END Next; + + +PROCEDURE NextPos* (parser: PARSER; VAR pos: SCAN.POSITION); +BEGIN + Next(parser); + pos := parser.lex.pos +END NextPos; + + +PROCEDURE checklex* (parser: PARSER; sym: INTEGER); +VAR + err: INTEGER; + +BEGIN + + IF parser.sym # sym THEN + + CASE sym OF + |SCAN.lxCOMMA: err := 65 + |SCAN.lxRROUND: err := 33 + |SCAN.lxPOINT: err := 26 + |SCAN.lxIDENT: err := 22 + |SCAN.lxRSQUARE: err := 71 + |SCAN.lxRCURLY: err := 35 + |SCAN.lxUNDEF: err := 34 + |SCAN.lxTHEN: err := 88 + |SCAN.lxEND: err := 27 + |SCAN.lxDO: err := 89 + |SCAN.lxUNTIL: err := 90 + |SCAN.lxCOLON: err := 53 + |SCAN.lxOF: err := 67 + |SCAN.lxASSIGN: err := 96 + |SCAN.lxTO: err := 57 + |SCAN.lxLROUND: err := 64 + |SCAN.lxEQ: err := 32 + |SCAN.lxSEMI: err := 24 + |SCAN.lxRETURN: err := 38 + |SCAN.lxMODULE: err := 21 + |SCAN.lxSTRING: err := 66 + END; + + check1(FALSE, parser, err) + END +END checklex; + + +PROCEDURE ExpectSym* (parser: PARSER; sym: INTEGER); +BEGIN + Next(parser); + checklex(parser, sym) +END ExpectSym; + + +PROCEDURE ImportList (parser: PARSER); +VAR + name: SCAN.IDENT; + parser2: PARSER; + pos: SCAN.POSITION; + alias: BOOLEAN; + unit: PROG.UNIT; + ident: PROG.IDENT; + units: PROG.UNITS; + +BEGIN + units := program.units; + + alias := FALSE; + + REPEAT + + ExpectSym(parser, SCAN.lxIDENT); + name := parser.lex.ident; + + getpos(parser, pos); + + IF ~alias THEN + ident := parser.unit.idents.add(parser.unit, name, PROG.idMODULE); + check(ident # NIL, parser, pos, 30) + END; + + Next(parser); + + IF (parser.sym = SCAN.lxCOMMA) OR (parser.sym = SCAN.lxSEMI) THEN + alias := FALSE; + unit := units.get(units, name); + + IF unit # NIL THEN + check(unit.closed, parser, pos, 31) + ELSE + parser2 := parser.create(parser.path, parser.lib_path, + parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); + + IF ~parser2.open(parser2, name.s) THEN + IF parser.path # parser.lib_path THEN + destroy(parser2); + parser2 := parser.create(parser.lib_path, parser.lib_path, + parser.StatSeq, parser.expression, parser.designator, parser.chkreturn); + check(parser2.open(parser2, name.s), parser, pos, 29) + ELSE + check(FALSE, parser, pos, 29) + END + END; + + parser2.parse(parser2); + unit := parser2.unit; + destroy(parser2) + END; + IF unit = program.sysunit THEN + parser.unit.sysimport := TRUE + END; + ident.unit := unit + + ELSIF parser.sym = SCAN.lxASSIGN THEN + alias := TRUE + + ELSE + check1(FALSE, parser, 28) + END + + UNTIL parser.sym = SCAN.lxSEMI; + + Next(parser) + +END ImportList; + + +PROCEDURE QIdent (parser: PARSER; forward: BOOLEAN): PROG.IDENT; +VAR + ident: PROG.IDENT; + unit: PROG.UNIT; + +BEGIN + ASSERT(parser.sym = SCAN.lxIDENT); + + ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); + + IF ~forward THEN + check1(ident # NIL, parser, 48) + END; + + IF (ident # NIL) & (ident.typ = PROG.idMODULE) THEN + unit := ident.unit; + ExpectSym(parser, SCAN.lxPOINT); + ExpectSym(parser, SCAN.lxIDENT); + ident := unit.idents.get(unit, parser.lex.ident, FALSE); + check1((ident # NIL) & ident.export, parser, 48) + END + + RETURN ident +END QIdent; + + +PROCEDURE strcmp* (VAR v: ARITH.VALUE; v2: ARITH.VALUE; operator: INTEGER); +VAR + str: SCAN.LEXSTR; + string1, string2: SCAN.IDENT; + bool: BOOLEAN; + +BEGIN + + IF v.typ = ARITH.tCHAR THEN + ASSERT(v2.typ = ARITH.tSTRING); + ARITH.charToStr(v, str); + string1 := SCAN.enterid(str); + string2 := v2.string(SCAN.IDENT) + END; + + IF v2.typ = ARITH.tCHAR THEN + ASSERT(v.typ = ARITH.tSTRING); + ARITH.charToStr(v2, str); + string2 := SCAN.enterid(str); + string1 := v.string(SCAN.IDENT) + END; + + IF v.typ = v2.typ THEN + string1 := v.string(SCAN.IDENT); + string2 := v2.string(SCAN.IDENT) + END; + + CASE operator OF + |SCAN.lxEQ: bool := string1.s = string2.s + |SCAN.lxNE: bool := string1.s # string2.s + |SCAN.lxLT: bool := string1.s < string2.s + |SCAN.lxGT: bool := string1.s > string2.s + |SCAN.lxLE: bool := string1.s <= string2.s + |SCAN.lxGE: bool := string1.s >= string2.s + END; + + ARITH.setbool(v, bool) + +END strcmp; + + +PROCEDURE ConstExpression* (parser: PARSER; VAR v: ARITH.VALUE); +VAR + e: EXPR; + pos: SCAN.POSITION; + +BEGIN + getpos(parser, pos); + parser.constexp := TRUE; + parser.expression(parser, e); + parser.constexp := FALSE; + check(e.obj = eCONST, parser, pos, 62); + v := e.value +END ConstExpression; + + +PROCEDURE FieldList (parser: PARSER; rec: PROG.TYPE_); +VAR + name: SCAN.IDENT; + export: BOOLEAN; + pos: SCAN.POSITION; + +BEGIN + ASSERT(parser.sym = SCAN.lxIDENT); + + WHILE parser.sym = SCAN.lxIDENT DO + + getpos(parser, pos); + + name := parser.lex.ident; + + Next(parser); + + export := parser.sym = SCAN.lxMUL; + + IF export THEN + check1(parser.unit.scopeLvl = 0, parser, 61); + Next(parser) + END; + + check(rec.fields.add(rec, name, export), parser, pos, 30); + + IF parser.sym = SCAN.lxCOMMA THEN + ExpectSym(parser, SCAN.lxIDENT) + ELSE + checklex(parser, SCAN.lxCOLON) + END + + END + +END FieldList; + + +PROCEDURE FormalParameters (parser: PARSER; type: PROG.TYPE_); +VAR + ident: PROG.IDENT; + + + PROCEDURE FPSection (parser: PARSER; type: PROG.TYPE_); + VAR + ident: PROG.IDENT; + exit: BOOLEAN; + vPar: BOOLEAN; + dim: INTEGER; + t0, t1: PROG.TYPE_; + + BEGIN + vPar := parser.sym = SCAN.lxVAR; + IF vPar THEN + Next(parser) + END; + + checklex(parser, SCAN.lxIDENT); + exit := FALSE; + + WHILE (parser.sym = SCAN.lxIDENT) & ~exit DO + check1(type.params.add(type, parser.lex.ident, vPar), parser, 30); + Next(parser); + IF parser.sym = SCAN.lxCOMMA THEN + ExpectSym(parser, SCAN.lxIDENT) + ELSIF parser.sym = SCAN.lxCOLON THEN + Next(parser); + dim := 0; + WHILE parser.sym = SCAN.lxARRAY DO + INC(dim); + check1(dim <= PROG.MAXARRDIM, parser, 84); + ExpectSym(parser, SCAN.lxOF); + Next(parser) + END; + checklex(parser, SCAN.lxIDENT); + ident := QIdent(parser, FALSE); + check1(ident.typ = PROG.idTYPE, parser, 68); + + t0 := ident.type; + t1 := t0; + + WHILE dim > 0 DO + t1 := program.enterType(program, PROG.tARRAY, -1, 0, parser.unit); + t1.base := t0; + t0 := t1; + DEC(dim) + END; + + type.params.set(type, t1); + Next(parser); + exit := TRUE + ELSE + checklex(parser, SCAN.lxCOLON) + END + END + + END FPSection; + + +BEGIN + IF parser.sym = SCAN.lxLROUND THEN + + Next(parser); + + IF (parser.sym = SCAN.lxVAR) OR (parser.sym = SCAN.lxIDENT) THEN + FPSection(parser, type); + WHILE parser.sym = SCAN.lxSEMI DO + Next(parser); + FPSection(parser, type) + END + END; + + checklex(parser, SCAN.lxRROUND); + Next(parser); + + IF parser.sym = SCAN.lxCOLON THEN + ExpectSym(parser, SCAN.lxIDENT); + ident := QIdent(parser, FALSE); + check1(ident.typ = PROG.idTYPE, parser, 68); + check1((ident.type.typ # PROG.tRECORD) & (ident.type.typ # PROG.tARRAY), parser, 69); + check1( ~(ODD(type.call) & (ident.type.typ = PROG.tREAL)), parser, 113); + type.base := ident.type; + Next(parser) + ELSE + type.base := NIL + END + + END +END FormalParameters; + + +PROCEDURE sysflag (parser: PARSER): INTEGER; +VAR + res: INTEGER; + +BEGIN + IF parser.lex.s = "stdcall" THEN + res := PROG.stdcall + ELSIF parser.lex.s = "stdcall64" THEN + res := PROG.stdcall64 + ELSIF parser.lex.s = "ccall" THEN + res := PROG.ccall + ELSIF parser.lex.s = "ccall16" THEN + res := PROG.ccall16 + ELSIF parser.lex.s = "win64" THEN + res := PROG.win64 + ELSIF parser.lex.s = "systemv" THEN + res := PROG.systemv + ELSIF parser.lex.s = "windows" THEN + IF program.target.sys IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN + res := PROG.stdcall + ELSIF program.target.sys IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64} THEN + res := PROG.win64 + ELSE + check1(FALSE, parser, 118) + END + ELSIF parser.lex.s = "linux" THEN + IF program.target.sys = mConst.Target_iELF32 THEN + res := PROG.ccall16 + ELSIF program.target.sys = mConst.Target_iELF64 THEN + res := PROG.systemv + ELSE + check1(FALSE, parser, 119) + END + ELSIF parser.lex.s = "noalign" THEN + res := PROG.noalign + ELSE + res := 0 + END + + RETURN res +END sysflag; + + +PROCEDURE procflag (parser: PARSER; VAR import: CODE.IMPORT_PROC; isProc: BOOLEAN): INTEGER; +VAR + call: INTEGER; + dll, proc: SCAN.LEXSTR; + pos: SCAN.POSITION; + +BEGIN + + import := NIL; + + IF parser.sym = SCAN.lxLSQUARE THEN + getpos(parser, pos); + check1(parser.unit.sysimport, parser, 54); + Next(parser); + call := sysflag(parser); + IF program.target.bit_depth = 64 THEN + check1(call IN PROG.callconv64, parser, 117) + ELSIF program.target.bit_depth = 32 THEN + check1(call IN PROG.callconv32, parser, 63) + END; + Next(parser); + IF parser.sym = SCAN.lxMINUS THEN + Next(parser); + INC(call) + END; + IF ~isProc THEN + checklex(parser, SCAN.lxRSQUARE) + END; + IF parser.sym = SCAN.lxCOMMA THEN + ExpectSym(parser, SCAN.lxSTRING); + dll := parser.lex.s; + ExpectSym(parser, SCAN.lxCOMMA); + ExpectSym(parser, SCAN.lxSTRING); + proc := parser.lex.s; + Next(parser); + import := CODE.AddImp(dll, proc) + END; + checklex(parser, SCAN.lxRSQUARE); + Next(parser) + ELSE + IF program.target.bit_depth = 32 THEN + call := PROG.default + ELSIF program.target.bit_depth = 64 THEN + call := PROG.default64 + END + END; + + IF import # NIL THEN + check(~(program.target.sys IN {mConst.Target_iELF32, mConst.Target_iELF64}), parser, pos, 70) + END + + RETURN call +END procflag; + + +PROCEDURE type (parser: PARSER; VAR t: PROG.TYPE_; flags: SET); +CONST + comma = 0; + closed = 1; + forward = 2; + +VAR + arrLen: ARITH.VALUE; + typeSize: ARITH.VALUE; + ident: PROG.IDENT; + unit: PROG.UNIT; + pos, pos2: SCAN.POSITION; + fieldType: PROG.TYPE_; + baseIdent: SCAN.IDENT; + a, b: INTEGER; + RecFlag: INTEGER; + import: CODE.IMPORT_PROC; + +BEGIN + unit := parser.unit; + t := NIL; + + IF parser.sym = SCAN.lxIDENT THEN + ident := QIdent(parser, forward IN flags); + + IF ident # NIL THEN + check1(ident.typ = PROG.idTYPE, parser, 49); + t := ident.type; + check1(t # NIL, parser, 50); + IF closed IN flags THEN + check1(t.closed, parser, 50) + END + END; + + Next(parser) + + ELSIF (parser.sym = SCAN.lxARRAY) OR ((parser.sym = SCAN.lxCOMMA) & (comma IN flags)) THEN + + IF parser.sym = SCAN.lxARRAY THEN + getpos(parser, pos2) + END; + NextPos(parser, pos); + + ConstExpression(parser, arrLen); + + check(arrLen.typ = ARITH.tINTEGER, parser, pos, 43); + check(ARITH.check(arrLen), parser, pos, 39); + check(ARITH.getInt(arrLen) > 0, parser, pos, 51); + + t := program.enterType(program, PROG.tARRAY, -1, ARITH.getInt(arrLen), unit); + + IF parser.sym = SCAN.lxCOMMA THEN + type(parser, t.base, {comma, closed}) + ELSIF parser.sym = SCAN.lxOF THEN + Next(parser); + type(parser, t.base, {closed}) + ELSE + check1(FALSE, parser, 47) + END; + + t.align := t.base.align; + + a := t.length; + b := t.base.size; + check(ARITH.mulInt(a, b), parser, pos2, 104); + check(ARITH.setInt(typeSize, a), parser, pos2, 104); + t.size := a; + + t.closed := TRUE + + ELSIF parser.sym = SCAN.lxRECORD THEN + getpos(parser, pos2); + Next(parser); + + t := program.enterType(program, PROG.tRECORD, 0, 0, unit); + t.align := 1; + + IF parser.sym = SCAN.lxLSQUARE THEN + check1(parser.unit.sysimport, parser, 54); + Next(parser); + RecFlag := sysflag(parser); + IF RecFlag = PROG.noalign THEN + t.noalign := TRUE + ELSE + check1(FALSE, parser, 110) + END; + + ExpectSym(parser, SCAN.lxRSQUARE); + Next(parser) + END; + + IF parser.sym = SCAN.lxLROUND THEN + check1(~t.noalign, parser, 111); + ExpectSym(parser, SCAN.lxIDENT); + getpos(parser, pos); + + type(parser, t.base, {closed}); + + check(t.base.typ IN {PROG.tRECORD, PROG.tPOINTER}, parser, pos, 52); + + IF t.base.typ = PROG.tPOINTER THEN + t.base := t.base.base; + check(t.base # NIL, parser, pos, 55) + END; + + check(~t.base.noalign, parser, pos, 112); + + checklex(parser, SCAN.lxRROUND); + Next(parser); + + t.size := t.base.size; + IF t.base.align > t.align THEN + t.align := t.base.align + END + ELSE + t.base := program.stTypes.tANYREC + END; + + WHILE parser.sym = SCAN.lxIDENT DO + FieldList(parser, t); + + ASSERT(parser.sym = SCAN.lxCOLON); + Next(parser); + + type(parser, fieldType, {closed}); + check(t.fields.set(t, fieldType), parser, pos2, 104); + + IF (fieldType.align > t.align) & ~t.noalign THEN + t.align := fieldType.align + END; + + IF parser.sym = SCAN.lxSEMI THEN + ExpectSym(parser, SCAN.lxIDENT) + ELSE + checklex(parser, SCAN.lxEND) + END + END; + + t.closed := TRUE; + + CODE.AddRec(t.base.num); + + IF ~t.noalign THEN + check(MACHINE.Align(t.size, t.align), parser, pos2, 104); + check(ARITH.setInt(typeSize, t.size), parser, pos2, 104) + END; + + checklex(parser, SCAN.lxEND); + Next(parser) + + ELSIF parser.sym = SCAN.lxPOINTER THEN + ExpectSym(parser, SCAN.lxTO); + Next(parser); + + t := program.enterType(program, PROG.tPOINTER, program.target.adr, 0, unit); + t.align := program.target.adr; + + getpos(parser, pos); + + IF parser.sym = SCAN.lxIDENT THEN + baseIdent := parser.lex.ident + END; + + type(parser, t.base, {forward}); + + IF t.base # NIL THEN + check(t.base.typ = PROG.tRECORD, parser, pos, 58) + ELSE + unit.pointers.add(unit, t, baseIdent, pos) + END + + ELSIF parser.sym = SCAN.lxPROCEDURE THEN + NextPos(parser, pos); + t := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); + t.align := program.target.adr; + t.call := procflag(parser, import, FALSE); + FormalParameters(parser, t) + ELSE + check1(FALSE, parser, 49) + END + +END type; + + +PROCEDURE IdentDef (parser: PARSER; typ: INTEGER; VAR name: SCAN.IDENT): PROG.IDENT; +VAR + ident: PROG.IDENT; + pos: SCAN.POSITION; + +BEGIN + ASSERT(parser.sym = SCAN.lxIDENT); + + name := parser.lex.ident; + getpos(parser, pos); + ident := parser.unit.idents.add(parser.unit, name, typ); + check(ident # NIL, parser, pos, 30); + ident.pos := pos; + Next(parser); + + IF parser.sym = SCAN.lxMUL THEN + check1(ident.global, parser, 61); + ident.export := TRUE; + Next(parser) + END + + RETURN ident +END IdentDef; + + +PROCEDURE ConstTypeDeclaration (parser: PARSER; const: BOOLEAN); +VAR + ident: PROG.IDENT; + name: SCAN.IDENT; + pos: SCAN.POSITION; + +BEGIN + IF const THEN + ident := IdentDef(parser, PROG.idNONE, name) + ELSE + ident := IdentDef(parser, PROG.idTYPE, name) + END; + + checklex(parser, SCAN.lxEQ); + NextPos(parser, pos); + + IF const THEN + ConstExpression(parser, ident.value); + IF ident.value.typ = ARITH.tINTEGER THEN + check(ARITH.check(ident.value), parser, pos, 39) + ELSIF ident.value.typ = ARITH.tREAL THEN + check(ARITH.check(ident.value), parser, pos, 40) + END; + ident.typ := PROG.idCONST; + ident.type := program.getType(program, ident.value.typ) + ELSE + type(parser, ident.type, {}) + END; + + checklex(parser, SCAN.lxSEMI); + Next(parser) + +END ConstTypeDeclaration; + + +PROCEDURE VarDeclaration (parser: PARSER); +VAR + ident: PROG.IDENT; + name: SCAN.IDENT; + t: PROG.TYPE_; + +BEGIN + + REPEAT + ident := IdentDef(parser, PROG.idVAR, name); + + IF parser.sym = SCAN.lxCOMMA THEN + ExpectSym(parser, SCAN.lxIDENT) + ELSIF parser.sym = SCAN.lxCOLON THEN + Next(parser); + type(parser, t, {}); + parser.unit.setvars(parser.unit, t); + checklex(parser, SCAN.lxSEMI); + Next(parser) + ELSE + checklex(parser, SCAN.lxCOLON) + END + + UNTIL parser.sym # SCAN.lxIDENT + +END VarDeclaration; + + +PROCEDURE DeclarationSequence (parser: PARSER): BOOLEAN; +VAR + ptr: PROG.FRWPTR; + endmod: BOOLEAN; + + + PROCEDURE ProcDeclaration (parser: PARSER): BOOLEAN; + VAR + proc: PROG.IDENT; + endname, + name: SCAN.IDENT; + param: LISTS.ITEM; + unit: PROG.UNIT; + ident: PROG.IDENT; + e: EXPR; + pos: SCAN.POSITION; + label: INTEGER; + enter: CODE.COMMAND; + call: INTEGER; + t: PROG.TYPE_; + import: CODE.IMPORT_PROC; + endmod, b: BOOLEAN; + fparams: SET; + variables: LISTS.LIST; + int, flt: INTEGER; + + BEGIN + endmod := FALSE; + + unit := parser.unit; + + call := procflag(parser, import, TRUE); + + getpos(parser, pos); + checklex(parser, SCAN.lxIDENT); + + IF import # NIL THEN + proc := IdentDef(parser, PROG.idIMP, name); + proc.import := import; + program.procs.last(PROG.PROC).import := import + ELSE + proc := IdentDef(parser, PROG.idPROC, name) + END; + + check(unit.scope.open(unit, proc.proc), parser, pos, 116); + + proc.type := program.enterType(program, PROG.tPROCEDURE, program.target.adr, 0, unit); + t := proc.type; + t.align := program.target.adr; + t.call := call; + + FormalParameters(parser, t); + + IF call IN {PROG.systemv, PROG._systemv} THEN + check(t.params.size <= PROG.MAXSYSVPARAM, parser, pos, 120) + END; + + param := t.params.first; + WHILE param # NIL DO + ident := unit.idents.add(unit, param(PROG.PARAM).name, PROG.idPARAM); + ASSERT(ident # NIL); + ident.type := param(PROG.PARAM).type; + ident.offset := param(PROG.PARAM).offset; + IF param(PROG.PARAM).vPar THEN + ident.typ := PROG.idVPAR + END; + param := param.next + END; + + checklex(parser, SCAN.lxSEMI); + Next(parser); + + IF import = NIL THEN + + label := CODE.NewLabel(); + proc.proc.label := label; + + IF parser.main & proc.export & program.dll THEN + IF program.obj THEN + check((proc.name.s # "lib_init") & (proc.name.s # "version"), parser, pos, 114) + END; + CODE.AddExp(label, proc.name.s); + proc.proc.used := TRUE + END; + + b := DeclarationSequence(parser); + + program.locsize := 0; + IF call IN {PROG._win64, PROG.win64} THEN + fparams := proc.type.params.getfparams(proc.type, 3, int, flt); + enter := CODE.Enter(label, LSL(ORD(fparams), 5) + MIN(proc.type.params.size, 4)) + ELSIF call IN {PROG._systemv, PROG.systemv} THEN + fparams := proc.type.params.getfparams(proc.type, PROG.MAXSYSVPARAM - 1, int, flt); + enter := CODE.Enter(label, -(LSL(ORD(fparams), 5) + proc.type.params.size)) + ELSE + enter := CODE.Enter(label, 0) + END; + proc.proc.enter := enter; + + IF parser.sym = SCAN.lxBEGIN THEN + Next(parser); + parser.StatSeq(parser) + END; + + IF t.base # NIL THEN + checklex(parser, SCAN.lxRETURN); + NextPos(parser, pos); + parser.expression(parser, e); + check(parser.chkreturn(parser, e, t.base, pos), parser, pos, 87) + END; + + proc.proc.leave := CODE.Leave(t.base # NIL, (t.base # NIL) & (t.base.typ = PROG.tREAL), + t.params.size * ORD((t.call IN PROG.callee_clean_up) OR (t.call IN {PROG.systemv, PROG._systemv}))); + enter.param2 := program.locsize; + checklex(parser, SCAN.lxEND) + END; + + IF parser.sym = SCAN.lxEND THEN + ExpectSym(parser, SCAN.lxIDENT); + getpos(parser, pos); + endname := parser.lex.ident; + IF import = NIL THEN + check(endname = name, parser, pos, 60); + ExpectSym(parser, SCAN.lxSEMI); + Next(parser) + ELSE + IF endname = parser.unit.name THEN + ExpectSym(parser, SCAN.lxPOINT); + Next(parser); + endmod := TRUE + ELSIF endname = name THEN + ExpectSym(parser, SCAN.lxSEMI); + Next(parser) + ELSE + check(FALSE, parser, pos, 60) + END + END + END; + + IF import = NIL THEN + variables := LISTS.create(NIL); + ELSE + variables := NIL + END; + + unit.scope.close(unit, variables); + + IF import = NIL THEN + enter.variables := variables + END + + RETURN endmod + END ProcDeclaration; + + +BEGIN + IF parser.sym = SCAN.lxCONST THEN + Next(parser); + WHILE parser.sym = SCAN.lxIDENT DO + ConstTypeDeclaration(parser, TRUE) + END + END; + + IF parser.sym = SCAN.lxTYPE THEN + Next(parser); + WHILE parser.sym = SCAN.lxIDENT DO + ConstTypeDeclaration(parser, FALSE) + END + END; + + ptr := parser.unit.pointers.link(parser.unit); + IF ptr # NIL THEN + IF ptr.notRecord THEN + error(parser, ptr.pos, 58) + ELSE + error(parser, ptr.pos, 48) + END + END; + + IF parser.sym = SCAN.lxVAR THEN + Next(parser); + IF parser.sym = SCAN.lxIDENT THEN + VarDeclaration(parser) + END + END; + + endmod := FALSE; + WHILE ~endmod & (parser.sym = SCAN.lxPROCEDURE) DO + Next(parser); + endmod := ProcDeclaration(parser) + END + + RETURN endmod +END DeclarationSequence; + + +PROCEDURE parse (parser: PARSER); +VAR + unit: PROG.UNIT; + label: INTEGER; + name: INTEGER; + endmod: BOOLEAN; + +BEGIN + ASSERT(parser # NIL); + ASSERT(parser.scanner # NIL); + + ExpectSym(parser, SCAN.lxMODULE); + ExpectSym(parser, SCAN.lxIDENT); + + IF ~parser.main THEN + check1(parser.lex.s = parser.modname, parser, 23) + END; + + unit := program.units.create(program.units, parser.lex.ident); + + parser.unit := unit; + + ExpectSym(parser, SCAN.lxSEMI); + + Next(parser); + IF parser.sym = SCAN.lxIMPORT THEN + ImportList(parser) + END; + + CONSOLE.String("compiling "); CONSOLE.String(unit.name.s); + IF parser.unit.sysimport THEN + CONSOLE.String(" (SYSTEM)") + END; + CONSOLE.Ln; + + label := CODE.NewLabel(); + CODE.AddJmpCmd(CODE.opJMP, label); + + name := CODE.putstr(unit.name.s); + + CODE.SetErrLabel; + CODE.AddCmd(CODE.opSADR, name); + CODE.AddCmd(CODE.opPARAM, 1); + CODE.AddCmd0(CODE.opERR); + + endmod := DeclarationSequence(parser); + + CODE.SetLabel(label); + + IF ~endmod THEN + + IF parser.sym = SCAN.lxBEGIN THEN + Next(parser); + parser.StatSeq(parser) + END; + + checklex(parser, SCAN.lxEND); + + ExpectSym(parser, SCAN.lxIDENT); + check1(parser.lex.s = unit.name.s, parser, 25); + ExpectSym(parser, SCAN.lxPOINT) + + END; + + unit.close(unit) + +END parse; + + +PROCEDURE open (parser: PARSER; modname: ARRAY OF CHAR): BOOLEAN; +BEGIN + ASSERT(parser # NIL); + + STRINGS.append(parser.fname, modname); + STRINGS.append(parser.fname, parser.ext); + STRINGS.append(parser.modname, modname); + + parser.scanner := SCAN.open(parser.fname) + + RETURN parser.scanner # NIL +END open; + + +PROCEDURE NewParser (): PARSER; +VAR + pars: PARSER; + citem: C.ITEM; + +BEGIN + citem := C.pop(parsers); + IF citem = NIL THEN + NEW(pars) + ELSE + pars := citem(PARSER) + END + + RETURN pars +END NewParser; + + +PROCEDURE create* (path, lib_path: PATH; StatSeq: STATPROC; expression, designator: EXPRPROC; chkreturn: RETPROC): PARSER; +VAR + parser: PARSER; + +BEGIN + parser := NewParser(); + + parser.path := path; + parser.lib_path := lib_path; + parser.ext := mConst.FILE_EXT; + parser.fname := path; + parser.modname := ""; + parser.scanner := NIL; + parser.unit := NIL; + parser.constexp := FALSE; + parser.main := FALSE; + + parser.open := open; + parser.parse := parse; + parser.StatSeq := StatSeq; + parser.expression := expression; + parser.designator := designator; + parser.chkreturn := chkreturn; + parser.create := create + + RETURN parser +END create; + + +PROCEDURE init* (bit_depth, sys: INTEGER); +BEGIN + program := PROG.create(bit_depth, sys); + parsers := C.create() +END init; + + +END PARS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PATHS.ob07 b/programs/develop/oberon07/Source/PATHS.ob07 new file mode 100644 index 0000000000..4a86cfdd52 --- /dev/null +++ b/programs/develop/oberon07/Source/PATHS.ob07 @@ -0,0 +1,109 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE PATHS; + +IMPORT STRINGS, UTILS; + + +CONST + + slash = UTILS.slash; + + PATHLEN = 2048; + + +TYPE + + PATH* = ARRAY PATHLEN OF CHAR; + + +PROCEDURE split* (fname: ARRAY OF CHAR; VAR path, name, ext: ARRAY OF CHAR); +VAR + pos1, pos2, len: INTEGER; + +BEGIN + len := LENGTH(fname); + pos1 := len - 1; + pos2 := len - 1; + STRINGS.search(fname, pos1, slash, FALSE); + STRINGS.search(fname, pos2, ".", FALSE); + + path := fname; + path[pos1 + 1] := 0X; + + IF (pos2 = -1) OR (pos2 < pos1) THEN + pos2 := len + END; + + INC(pos1); + + STRINGS.copy(fname, name, pos1, 0, pos2 - pos1); + name[pos2 - pos1] := 0X; + STRINGS.copy(fname, ext, pos2, 0, len - pos2); + ext[len - pos2] := 0X; + +END split; + + +PROCEDURE RelPath* (absolute, relative: ARRAY OF CHAR; VAR res: ARRAY OF CHAR); +VAR + i, j: INTEGER; + error: BOOLEAN; + +BEGIN + COPY(absolute, res); + i := LENGTH(res) - 1; + WHILE (i >= 0) & (res[i] # slash) DO + DEC(i) + END; + + INC(i); + res[i] := 0X; + + error := FALSE; + j := 0; + WHILE ~error & (relative[j] # 0X) DO + IF (relative[j] = ".") & (relative[j + 1] = ".") & (relative[j + 2] = slash) & (i > 0) & (res[i - 1] = slash) THEN + DEC(i, 2); + WHILE (i >= 0) & (res[i] # slash) DO + DEC(i) + END; + IF i < 0 THEN + error := TRUE + ELSE + INC(i); + INC(j, 3) + END + ELSE + res[i] := relative[j]; + INC(i); + INC(j) + END + END; + + IF error THEN + COPY(relative, res) + ELSE + res[i] := 0X + END + +END RelPath; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN UTILS.isRelative(path) +END isRelative; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +BEGIN + UTILS.GetCurrentDirectory(path) +END GetCurrentDirectory; + + +END PATHS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PE32.ob07 b/programs/develop/oberon07/Source/PE32.ob07 new file mode 100644 index 0000000000..18a77bb664 --- /dev/null +++ b/programs/develop/oberon07/Source/PE32.ob07 @@ -0,0 +1,733 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE PE32; + +IMPORT BIN, LISTS, UTILS, WR := WRITER, mConst := CONSTANTS, CHL := CHUNKLISTS; + + +CONST + + SIZE_OF_DWORD = 4; + SIZE_OF_WORD = 2; + + SIZE_OF_IMAGE_EXPORT_DIRECTORY = 40; + + IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16; + + IMAGE_SIZEOF_SHORT_NAME = 8; + + SIZE_OF_IMAGE_FILE_HEADER* = 20; + + SIZE_OF_IMAGE_SECTION_HEADER* = 40; + + (* SectionHeader.Characteristics *) + + SHC_text = 060000020H; + SHC_data = 0C0000040H; + SHC_bss = 0C00000C0H; + + SectionAlignment = 1000H; + FileAlignment = 200H; + + +TYPE + + WORD = WCHAR; + DWORD = INTEGER; + + NAME* = ARRAY IMAGE_SIZEOF_SHORT_NAME OF CHAR; + + + IMAGE_DATA_DIRECTORY = RECORD + + VirtualAddress: DWORD; + Size: DWORD + + END; + + + IMAGE_OPTIONAL_HEADER = RECORD + + Magic: WORD; + MajorLinkerVersion: BYTE; + MinorLinkerVersion: BYTE; + SizeOfCode: DWORD; + SizeOfInitializedData: DWORD; + SizeOfUninitializedData: DWORD; + AddressOfEntryPoint: DWORD; + BaseOfCode: DWORD; + BaseOfData: DWORD; + ImageBase: DWORD; + SectionAlignment: DWORD; + FileAlignment: DWORD; + MajorOperatingSystemVersion: WORD; + MinorOperatingSystemVersion: WORD; + MajorImageVersion: WORD; + MinorImageVersion: WORD; + MajorSubsystemVersion: WORD; + MinorSubsystemVersion: WORD; + Win32VersionValue: DWORD; + SizeOfImage: DWORD; + SizeOfHeaders: DWORD; + CheckSum: DWORD; + Subsystem: WORD; + DllCharacteristics: WORD; + SizeOfStackReserve: DWORD; + SizeOfStackCommit: DWORD; + SizeOfHeapReserve: DWORD; + SizeOfHeapCommit: DWORD; + LoaderFlags: DWORD; + NumberOfRvaAndSizes: DWORD; + + DataDirectory: ARRAY IMAGE_NUMBEROF_DIRECTORY_ENTRIES OF IMAGE_DATA_DIRECTORY + + END; + + + IMAGE_FILE_HEADER* = RECORD + + Machine*: WORD; + NumberOfSections*: WORD; + TimeDateStamp*: DWORD; + PointerToSymbolTable*: DWORD; + NumberOfSymbols*: DWORD; + SizeOfOptionalHeader*: WORD; + Characteristics*: WORD + + END; + + + IMAGE_NT_HEADERS = RECORD + + Signature: ARRAY 4 OF BYTE; + FileHeader: IMAGE_FILE_HEADER; + OptionalHeader: IMAGE_OPTIONAL_HEADER + + END; + + + IMAGE_SECTION_HEADER* = RECORD + + Name*: NAME; + + VirtualSize*, + VirtualAddress*, + SizeOfRawData*, + PointerToRawData*, + PointerToRelocations*, + PointerToLinenumbers*: DWORD; + + NumberOfRelocations*, + NumberOfLinenumbers*: WORD; + + Characteristics*: DWORD + + END; + + + IMAGE_EXPORT_DIRECTORY = RECORD + + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: WORD; + MinorVersion: WORD; + Name, + Base, + NumberOfFunctions, + NumberOfNames, + AddressOfFunctions, + AddressOfNames, + AddressOfNameOrdinals: DWORD + + END; + + + VIRTUAL_ADDR = RECORD + + Code, Data, Bss, Import: INTEGER + + END; + + + FILE = WR.FILE; + + +VAR + + msdos: ARRAY 128 OF BYTE; + PEHeader: IMAGE_NT_HEADERS; + SectionHeaders: ARRAY 16 OF IMAGE_SECTION_HEADER; + Relocations: LISTS.LIST; + bit64: BOOLEAN; + libcnt: INTEGER; + + +PROCEDURE SIZE (): INTEGER; + RETURN SIZE_OF_DWORD * (ORD(bit64) + 1) +END SIZE; + + +PROCEDURE Export (program: BIN.PROGRAM; DataRVA: INTEGER; VAR ExportDir: IMAGE_EXPORT_DIRECTORY): INTEGER; +BEGIN + + ExportDir.Characteristics := 0; + ExportDir.TimeDateStamp := PEHeader.FileHeader.TimeDateStamp; + ExportDir.MajorVersion := 0X; + ExportDir.MinorVersion := 0X; + ExportDir.Name := program.modname + DataRVA; + ExportDir.Base := 0; + ExportDir.NumberOfFunctions := LISTS.count(program.exp_list); + ExportDir.NumberOfNames := ExportDir.NumberOfFunctions; + ExportDir.AddressOfFunctions := SIZE_OF_IMAGE_EXPORT_DIRECTORY; + ExportDir.AddressOfNames := ExportDir.AddressOfFunctions + ExportDir.NumberOfFunctions * SIZE_OF_DWORD; + ExportDir.AddressOfNameOrdinals := ExportDir.AddressOfNames + ExportDir.NumberOfFunctions * SIZE_OF_DWORD + + RETURN SIZE_OF_IMAGE_EXPORT_DIRECTORY + ExportDir.NumberOfFunctions * (2 * SIZE_OF_DWORD + SIZE_OF_WORD) +END Export; + + +PROCEDURE align (n, _align: INTEGER): INTEGER; +BEGIN + IF n MOD _align # 0 THEN + n := n + _align - (n MOD _align) + END + + RETURN n +END align; + + +PROCEDURE GetProcCount (lib: BIN.IMPRT): INTEGER; +VAR + import: BIN.IMPRT; + res: INTEGER; + +BEGIN + res := 0; + import := lib.next(BIN.IMPRT); + WHILE (import # NIL) & (import.label # 0) DO + INC(res); + import := import.next(BIN.IMPRT) + END + + RETURN res +END GetProcCount; + + +PROCEDURE GetImportSize (imp_list: LISTS.LIST): INTEGER; +VAR + import: BIN.IMPRT; + proccnt: INTEGER; + procoffs: INTEGER; + OriginalCurrentThunk, + CurrentThunk: INTEGER; + +BEGIN + libcnt := 0; + proccnt := 0; + import := imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + IF import.label = 0 THEN + INC(libcnt) + ELSE + INC(proccnt) + END; + import := import.next(BIN.IMPRT) + END; + + procoffs := 0; + + import := imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + IF import.label = 0 THEN + import.OriginalFirstThunk := procoffs; + import.FirstThunk := procoffs + (GetProcCount(import) + 1); + OriginalCurrentThunk := import.OriginalFirstThunk; + CurrentThunk := import.FirstThunk; + procoffs := procoffs + (GetProcCount(import) + 1) * 2 + ELSE + import.OriginalFirstThunk := OriginalCurrentThunk; + import.FirstThunk := CurrentThunk; + INC(OriginalCurrentThunk); + INC(CurrentThunk) + END; + import := import.next(BIN.IMPRT) + END + + RETURN (libcnt + 1) * 5 * SIZE_OF_DWORD + (proccnt + libcnt) * 2 * SIZE() +END GetImportSize; + + +PROCEDURE fixup (program: BIN.PROGRAM; Address: VIRTUAL_ADDR); +VAR + reloc: BIN.RELOC; + iproc: BIN.IMPRT; + L: INTEGER; + delta: INTEGER; + AdrImp: INTEGER; + +BEGIN + AdrImp := Address.Import + (libcnt + 1) * 5 * SIZE_OF_DWORD; + + reloc := program.rel_list.first(BIN.RELOC); + WHILE reloc # NIL DO + + L := BIN.get32le(program.code, reloc.offset); + delta := 3 - reloc.offset - Address.Code - 7 * ORD(bit64); + + CASE reloc.opcode OF + + |BIN.PICDATA: + BIN.put32le(program.code, reloc.offset, L + Address.Data + delta) + + |BIN.PICCODE: + BIN.put32le(program.code, reloc.offset, BIN.GetLabel(program, L) + Address.Code + delta) + + |BIN.PICBSS: + BIN.put32le(program.code, reloc.offset, L + Address.Bss + delta) + + |BIN.PICIMP: + iproc := BIN.GetIProc(program, L); + BIN.put32le(program.code, reloc.offset, iproc.FirstThunk * SIZE() + AdrImp + delta) + + END; + + reloc := reloc.next(BIN.RELOC) + END +END fixup; + + +PROCEDURE WriteWord (file: FILE; w: WORD); +BEGIN + WR.Write16LE(file, ORD(w)) +END WriteWord; + + +PROCEDURE WriteName* (File: FILE; name: NAME); +VAR + i, nameLen: INTEGER; + +BEGIN + nameLen := LENGTH(name); + + FOR i := 0 TO nameLen - 1 DO + WR.WriteByte(File, ORD(name[i])) + END; + + i := LEN(name) - nameLen; + WHILE i > 0 DO + WR.WriteByte(File, 0); + DEC(i) + END + +END WriteName; + + +PROCEDURE WriteSectionHeader* (file: FILE; h: IMAGE_SECTION_HEADER); +VAR + i, nameLen: INTEGER; + +BEGIN + nameLen := LENGTH(h.Name); + + FOR i := 0 TO nameLen - 1 DO + WR.WriteByte(file, ORD(h.Name[i])) + END; + + i := LEN(h.Name) - nameLen; + WHILE i > 0 DO + WR.WriteByte(file, 0); + DEC(i) + END; + + WR.Write32LE(file, h.VirtualSize); + WR.Write32LE(file, h.VirtualAddress); + WR.Write32LE(file, h.SizeOfRawData); + WR.Write32LE(file, h.PointerToRawData); + WR.Write32LE(file, h.PointerToRelocations); + WR.Write32LE(file, h.PointerToLinenumbers); + + WriteWord(file, h.NumberOfRelocations); + WriteWord(file, h.NumberOfLinenumbers); + + WR.Write32LE(file, h.Characteristics) +END WriteSectionHeader; + + +PROCEDURE WriteFileHeader* (file: FILE; h: IMAGE_FILE_HEADER); +BEGIN + WriteWord(file, h.Machine); + WriteWord(file, h.NumberOfSections); + + WR.Write32LE(file, h.TimeDateStamp); + WR.Write32LE(file, h.PointerToSymbolTable); + WR.Write32LE(file, h.NumberOfSymbols); + + WriteWord(file, h.SizeOfOptionalHeader); + WriteWord(file, h.Characteristics) +END WriteFileHeader; + + +PROCEDURE write* (program: BIN.PROGRAM; FileName: ARRAY OF CHAR; BaseAddress: INTEGER; console, dll, amd64: BOOLEAN); +VAR + i, n: INTEGER; + + Size: RECORD + + Code, Data, Bss, Stack, Import, Reloc, Export: INTEGER + + END; + + Address: VIRTUAL_ADDR; + + File: FILE; + + import: BIN.IMPRT; + ImportTable: CHL.INTLIST; + + ExportDir: IMAGE_EXPORT_DIRECTORY; + export: BIN.EXPRT; + + + PROCEDURE WriteExportDir (file: FILE; e: IMAGE_EXPORT_DIRECTORY); + BEGIN + WR.Write32LE(file, e.Characteristics); + WR.Write32LE(file, e.TimeDateStamp); + + WriteWord(file, e.MajorVersion); + WriteWord(file, e.MinorVersion); + + WR.Write32LE(file, e.Name); + WR.Write32LE(file, e.Base); + WR.Write32LE(file, e.NumberOfFunctions); + WR.Write32LE(file, e.NumberOfNames); + WR.Write32LE(file, e.AddressOfFunctions); + WR.Write32LE(file, e.AddressOfNames); + WR.Write32LE(file, e.AddressOfNameOrdinals) + END WriteExportDir; + + + PROCEDURE WriteOptHeader (file: FILE; h: IMAGE_OPTIONAL_HEADER); + VAR + i: INTEGER; + + BEGIN + + WriteWord(file, h.Magic); + + WR.WriteByte(file, h.MajorLinkerVersion); + WR.WriteByte(file, h.MinorLinkerVersion); + + WR.Write32LE(file, h.SizeOfCode); + WR.Write32LE(file, h.SizeOfInitializedData); + WR.Write32LE(file, h.SizeOfUninitializedData); + WR.Write32LE(file, h.AddressOfEntryPoint); + WR.Write32LE(file, h.BaseOfCode); + + IF bit64 THEN + WR.Write64LE(file, h.ImageBase) + ELSE + WR.Write32LE(file, h.BaseOfData); + WR.Write32LE(file, h.ImageBase) + END; + + WR.Write32LE(file, h.SectionAlignment); + WR.Write32LE(file, h.FileAlignment); + + WriteWord(file, h.MajorOperatingSystemVersion); + WriteWord(file, h.MinorOperatingSystemVersion); + WriteWord(file, h.MajorImageVersion); + WriteWord(file, h.MinorImageVersion); + WriteWord(file, h.MajorSubsystemVersion); + WriteWord(file, h.MinorSubsystemVersion); + + WR.Write32LE(file, h.Win32VersionValue); + WR.Write32LE(file, h.SizeOfImage); + WR.Write32LE(file, h.SizeOfHeaders); + WR.Write32LE(file, h.CheckSum); + + WriteWord(file, h.Subsystem); + WriteWord(file, h.DllCharacteristics); + + IF bit64 THEN + WR.Write64LE(file, h.SizeOfStackReserve); + WR.Write64LE(file, h.SizeOfStackCommit); + WR.Write64LE(file, h.SizeOfHeapReserve); + WR.Write64LE(file, h.SizeOfHeapCommit) + ELSE + WR.Write32LE(file, h.SizeOfStackReserve); + WR.Write32LE(file, h.SizeOfStackCommit); + WR.Write32LE(file, h.SizeOfHeapReserve); + WR.Write32LE(file, h.SizeOfHeapCommit) + END; + + WR.Write32LE(file, h.LoaderFlags); + WR.Write32LE(file, h.NumberOfRvaAndSizes); + + FOR i := 0 TO LEN(h.DataDirectory) - 1 DO + WR.Write32LE(file, h.DataDirectory[i].VirtualAddress); + WR.Write32LE(file, h.DataDirectory[i].Size) + END + + END WriteOptHeader; + + + PROCEDURE WritePEHeader (file: FILE; h: IMAGE_NT_HEADERS); + BEGIN + WR.Write(file, h.Signature, LEN(h.Signature)); + WriteFileHeader(file, h.FileHeader); + WriteOptHeader(file, h.OptionalHeader) + END WritePEHeader; + + + PROCEDURE InitSection (VAR section: IMAGE_SECTION_HEADER; Name: NAME; Characteristics: DWORD); + BEGIN + section.Name := Name; + section.PointerToRelocations := 0; + section.PointerToLinenumbers := 0; + section.NumberOfRelocations := 0X; + section.NumberOfLinenumbers := 0X; + section.Characteristics := Characteristics + END InitSection; + + +BEGIN + bit64 := amd64; + Relocations := LISTS.create(NIL); + + Size.Code := CHL.Length(program.code); + Size.Data := CHL.Length(program.data); + Size.Bss := program.bss; + Size.Stack := program.stack; + + PEHeader.Signature[0] := 50H; + PEHeader.Signature[1] := 45H; + PEHeader.Signature[2] := 0; + PEHeader.Signature[3] := 0; + + IF amd64 THEN + PEHeader.FileHeader.Machine := 08664X + ELSE + PEHeader.FileHeader.Machine := 014CX + END; + + PEHeader.FileHeader.NumberOfSections := WCHR(4 + ORD(dll)); + + PEHeader.FileHeader.TimeDateStamp := UTILS.UnixTime(); + PEHeader.FileHeader.PointerToSymbolTable := 0H; + PEHeader.FileHeader.NumberOfSymbols := 0H; + PEHeader.FileHeader.SizeOfOptionalHeader := WCHR(0E0H + 10H * ORD(amd64)); + PEHeader.FileHeader.Characteristics := WCHR(010EH + (20H - 100H) * ORD(amd64) + 2000H * ORD(dll)); + + PEHeader.OptionalHeader.Magic := WCHR(010BH + 100H * ORD(amd64)); + PEHeader.OptionalHeader.MajorLinkerVersion := mConst.vMajor; + PEHeader.OptionalHeader.MinorLinkerVersion := mConst.vMinor; + PEHeader.OptionalHeader.SizeOfCode := align(Size.Code, FileAlignment); + PEHeader.OptionalHeader.SizeOfInitializedData := 0; + PEHeader.OptionalHeader.SizeOfUninitializedData := 0; + PEHeader.OptionalHeader.AddressOfEntryPoint := SectionAlignment; + PEHeader.OptionalHeader.BaseOfCode := SectionAlignment; + PEHeader.OptionalHeader.BaseOfData := PEHeader.OptionalHeader.BaseOfCode + align(Size.Code, SectionAlignment); + PEHeader.OptionalHeader.ImageBase := BaseAddress; + PEHeader.OptionalHeader.SectionAlignment := SectionAlignment; + PEHeader.OptionalHeader.FileAlignment := FileAlignment; + PEHeader.OptionalHeader.MajorOperatingSystemVersion := 1X; + PEHeader.OptionalHeader.MinorOperatingSystemVersion := 0X; + PEHeader.OptionalHeader.MajorImageVersion := 0X; + PEHeader.OptionalHeader.MinorImageVersion := 0X; + PEHeader.OptionalHeader.MajorSubsystemVersion := 4X; + PEHeader.OptionalHeader.MinorSubsystemVersion := 0X; + PEHeader.OptionalHeader.Win32VersionValue := 0H; + PEHeader.OptionalHeader.SizeOfImage := SectionAlignment; + PEHeader.OptionalHeader.SizeOfHeaders := 400H; + PEHeader.OptionalHeader.CheckSum := 0; + PEHeader.OptionalHeader.Subsystem := WCHR((2 + ORD(console)) * ORD(~dll)); + PEHeader.OptionalHeader.DllCharacteristics := 0040X; + PEHeader.OptionalHeader.SizeOfStackReserve := Size.Stack; + PEHeader.OptionalHeader.SizeOfStackCommit := Size.Stack DIV 16; + PEHeader.OptionalHeader.SizeOfHeapReserve := 100000H; + PEHeader.OptionalHeader.SizeOfHeapCommit := 10000H; + PEHeader.OptionalHeader.LoaderFlags := 0; + PEHeader.OptionalHeader.NumberOfRvaAndSizes := IMAGE_NUMBEROF_DIRECTORY_ENTRIES; + + InitSection(SectionHeaders[0], ".text", SHC_text); + SectionHeaders[0].VirtualSize := Size.Code; + SectionHeaders[0].VirtualAddress := 1000H; + SectionHeaders[0].SizeOfRawData := align(Size.Code, FileAlignment); + SectionHeaders[0].PointerToRawData := PEHeader.OptionalHeader.SizeOfHeaders; + + InitSection(SectionHeaders[1], ".data", SHC_data); + SectionHeaders[1].VirtualSize := Size.Data; + SectionHeaders[1].VirtualAddress := align(SectionHeaders[0].VirtualAddress + SectionHeaders[0].VirtualSize, SectionAlignment); + SectionHeaders[1].SizeOfRawData := align(Size.Data, FileAlignment); + SectionHeaders[1].PointerToRawData := SectionHeaders[0].PointerToRawData + SectionHeaders[0].SizeOfRawData; + + InitSection(SectionHeaders[2], ".bss", SHC_bss); + SectionHeaders[2].VirtualSize := Size.Bss; + SectionHeaders[2].VirtualAddress := align(SectionHeaders[1].VirtualAddress + SectionHeaders[1].VirtualSize, SectionAlignment); + SectionHeaders[2].SizeOfRawData := 0; + SectionHeaders[2].PointerToRawData := SectionHeaders[1].PointerToRawData + SectionHeaders[1].SizeOfRawData; + + Size.Import := GetImportSize(program.imp_list); + + InitSection(SectionHeaders[3], ".idata", SHC_data); + SectionHeaders[3].VirtualSize := Size.Import + CHL.Length(program.import); + SectionHeaders[3].VirtualAddress := align(SectionHeaders[2].VirtualAddress + SectionHeaders[2].VirtualSize, SectionAlignment); + SectionHeaders[3].SizeOfRawData := align(SectionHeaders[3].VirtualSize, FileAlignment); + SectionHeaders[3].PointerToRawData := SectionHeaders[2].PointerToRawData + SectionHeaders[2].SizeOfRawData; + + Address.Code := SectionHeaders[0].VirtualAddress + PEHeader.OptionalHeader.ImageBase; + Address.Data := SectionHeaders[1].VirtualAddress + PEHeader.OptionalHeader.ImageBase; + Address.Bss := SectionHeaders[2].VirtualAddress + PEHeader.OptionalHeader.ImageBase; + Address.Import := SectionHeaders[3].VirtualAddress + PEHeader.OptionalHeader.ImageBase; + + fixup(program, Address); + + IF dll THEN + Size.Export := Export(program, SectionHeaders[1].VirtualAddress, ExportDir); + + InitSection(SectionHeaders[4], ".edata", SHC_data); + SectionHeaders[4].VirtualSize := Size.Export + CHL.Length(program.export); + SectionHeaders[4].VirtualAddress := align(SectionHeaders[3].VirtualAddress + SectionHeaders[3].VirtualSize, SectionAlignment); + SectionHeaders[4].SizeOfRawData := align(SectionHeaders[4].VirtualSize, FileAlignment); + SectionHeaders[4].PointerToRawData := SectionHeaders[3].PointerToRawData + SectionHeaders[3].SizeOfRawData; + END; + + FOR i := 0 TO IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1 DO + PEHeader.OptionalHeader.DataDirectory[i].VirtualAddress := 0; + PEHeader.OptionalHeader.DataDirectory[i].Size := 0 + END; + + IF dll THEN + PEHeader.OptionalHeader.DataDirectory[0].VirtualAddress := SectionHeaders[4].VirtualAddress; + PEHeader.OptionalHeader.DataDirectory[0].Size := SectionHeaders[4].VirtualSize + END; + + PEHeader.OptionalHeader.DataDirectory[1].VirtualAddress := SectionHeaders[3].VirtualAddress; + PEHeader.OptionalHeader.DataDirectory[1].Size := SectionHeaders[3].VirtualSize; + + FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO + INC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[i].SizeOfRawData) + END; + + DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[0].SizeOfRawData); + DEC(PEHeader.OptionalHeader.SizeOfInitializedData, SectionHeaders[2].SizeOfRawData); + + PEHeader.OptionalHeader.SizeOfUninitializedData := align(SectionHeaders[2].VirtualSize, FileAlignment); + + FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO + INC(PEHeader.OptionalHeader.SizeOfImage, align(SectionHeaders[i].VirtualSize, SectionAlignment)) + END; + + n := 0; + BIN.InitArray(msdos, n, "4D5A80000100000004001000FFFF000040010000000000004000000000000000"); + BIN.InitArray(msdos, n, "0000000000000000000000000000000000000000000000000000000080000000"); + BIN.InitArray(msdos, n, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F"); + BIN.InitArray(msdos, n, "742062652072756E20696E20444F53206D6F64652E0D0A240000000000000000"); + + File := WR.Create(FileName); + + WR.Write(File, msdos, LEN(msdos)); + + WritePEHeader(File, PEHeader); + + FOR i := 0 TO ORD(PEHeader.FileHeader.NumberOfSections) - 1 DO + WriteSectionHeader(File, SectionHeaders[i]) + END; + + WR.Padding(File, FileAlignment); + + CHL.WriteToFile(File, program.code); + WR.Padding(File, FileAlignment); + + CHL.WriteToFile(File, program.data); + WR.Padding(File, FileAlignment); + + n := (libcnt + 1) * 5; + ImportTable := CHL.CreateIntList(); + + FOR i := 0 TO (Size.Import - n * SIZE_OF_DWORD) DIV SIZE() + n - 1 DO + CHL.PushInt(ImportTable, 0) + END; + + i := 0; + import := program.imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + IF import.label = 0 THEN + CHL.SetInt(ImportTable, i + 0, import.OriginalFirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); + CHL.SetInt(ImportTable, i + 1, 0); + CHL.SetInt(ImportTable, i + 2, 0); + CHL.SetInt(ImportTable, i + 3, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress); + CHL.SetInt(ImportTable, i + 4, import.FirstThunk * SIZE() + SectionHeaders[3].VirtualAddress + n * SIZE_OF_DWORD); + i := i + 5 + END; + import := import.next(BIN.IMPRT) + END; + + CHL.SetInt(ImportTable, i + 0, 0); + CHL.SetInt(ImportTable, i + 1, 0); + CHL.SetInt(ImportTable, i + 2, 0); + CHL.SetInt(ImportTable, i + 3, 0); + CHL.SetInt(ImportTable, i + 4, 0); + + import := program.imp_list.first(BIN.IMPRT); + WHILE import # NIL DO + IF import.label # 0 THEN + CHL.SetInt(ImportTable, import.OriginalFirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2); + CHL.SetInt(ImportTable, import.FirstThunk + n, import.nameoffs + Size.Import + SectionHeaders[3].VirtualAddress - 2) + END; + import := import.next(BIN.IMPRT) + END; + + FOR i := 0 TO n - 1 DO + WR.Write32LE(File, CHL.GetInt(ImportTable, i)) + END; + + FOR i := n TO CHL.Length(ImportTable) - 1 DO + IF amd64 THEN + WR.Write64LE(File, CHL.GetInt(ImportTable, i)) + ELSE + WR.Write32LE(File, CHL.GetInt(ImportTable, i)) + END + END; + + CHL.WriteToFile(File, program.import); + WR.Padding(File, FileAlignment); + + IF dll THEN + + INC(ExportDir.AddressOfFunctions, SectionHeaders[4].VirtualAddress); + INC(ExportDir.AddressOfNames, SectionHeaders[4].VirtualAddress); + INC(ExportDir.AddressOfNameOrdinals, SectionHeaders[4].VirtualAddress); + + WriteExportDir(File, ExportDir); + + export := program.exp_list.first(BIN.EXPRT); + WHILE export # NIL DO + WR.Write32LE(File, export.label + SectionHeaders[0].VirtualAddress); + export := export.next(BIN.EXPRT) + END; + + export := program.exp_list.first(BIN.EXPRT); + WHILE export # NIL DO + WR.Write32LE(File, export.nameoffs + Size.Export + SectionHeaders[4].VirtualAddress); + export := export.next(BIN.EXPRT) + END; + + FOR i := 0 TO ExportDir.NumberOfFunctions - 1 DO + WriteWord(File, WCHR(i)) + END; + + CHL.WriteToFile(File, program.export); + WR.Padding(File, FileAlignment) + END; + + WR.Close(File) +END write; + + +END PE32. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/PROG.ob07 b/programs/develop/oberon07/Source/PROG.ob07 new file mode 100644 index 0000000000..d08a984a0c --- /dev/null +++ b/programs/develop/oberon07/Source/PROG.ob07 @@ -0,0 +1,1311 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE PROG; + +IMPORT SCAN, LISTS, ARITH, ERRORS, MACHINE, C := COLLECTIONS, mConst := CONSTANTS, CODE, UTILS; + + +CONST + + MAXARRDIM* = 5; + MAXSCOPE = 16; + MAXSYSVPARAM* = 26; + + idNONE* = 0; idGUARD = 1; idMODULE* = 2; idCONST* = 3; + idTYPE* = 4; idSTFUNC* = 5; idSTPROC* = 6; idVAR* = 7; + idPROC* = 8; idVPAR* = 9; idPARAM* = 10; idSYSFUNC* = 11; + idSYSPROC* = 12; idIMP* = 13; + + tINTEGER* = 1; tBYTE* = 2; tCHAR* = 3; tSET* = 4; + tBOOLEAN* = 5; tREAL* = 6; tARRAY* = 7; tRECORD* = 8; + tPOINTER* = 9; tPROCEDURE* = 10; tSTRING* = 11; tNIL* = 12; + tCARD16* = 13; tCARD32* = 14; tANYREC* = 15; tWCHAR* = 16; + + BASICTYPES* = {tINTEGER, tBYTE, tCHAR, tSET, tBOOLEAN, tREAL, tCARD16, tCARD32, tWCHAR}; + + stABS* = 1; stASR* = 2; stCHR* = 3; stFLOOR* = 4; + stFLT* = 5; stLEN* = 6; stLSL* = 7; stODD* = 8; + stORD* = 9; stROR* = 10; stASSERT* = 11; stDEC* = 12; + stEXCL* = 13; stINC* = 14; stINCL* = 15; stNEW* = 16; + stPACK* = 17; stUNPK* = 18; sysADR* = 19; sysSIZE* = 20; + sysGET* = 21; sysPUT* = 22; + + stDISPOSE* = 23; stLSR* = 24; stBITS* = 25; sysCODE* = 26; + sysMOVE* = 27; stLENGTH* = 28; stMIN* = 29; stMAX* = 30; + sysSADR* = 31; sysTYPEID* = 32; sysCOPY* = 33; sysINF* = 34; + sysPUT8* = 35; sysPUT16* = 36; stCOPY* = 37; stWCHR* = 38; + sysWSADR* = 39; sysPUT32* = 40; + + default* = 2; + stdcall* = 4; _stdcall* = stdcall + 1; + ccall* = 6; _ccall* = ccall + 1; + ccall16* = 8; _ccall16* = ccall16 + 1; + win64* = 10; _win64* = win64 + 1; + stdcall64* = 12; _stdcall64* = stdcall64 + 1; + default64* = 14; + systemv* = 16; _systemv* = systemv + 1; + + noalign* = 20; + + callee_clean_up* = {default, stdcall, _stdcall, default64, stdcall64, _stdcall64}; + caller_clean_up* = {ccall, ccall16, win64, systemv, _ccall, _ccall16, _win64, _systemv}; + callconv32* = {default, stdcall, ccall, ccall16, _stdcall, _ccall, _ccall16}; + callconv64* = {default64, win64, stdcall64, systemv, _win64, _stdcall64, _systemv}; + + STACK_FRAME = 2; + + +TYPE + + IDENT* = POINTER TO rIDENT; + + UNIT* = POINTER TO rUNIT; + + PROGRAM* = POINTER TO rPROGRAM; + + TYPE_* = POINTER TO rTYPE_; + + FRWPTR* = POINTER TO RECORD (LISTS.ITEM) + + type: TYPE_; + baseIdent: SCAN.IDENT; + linked: BOOLEAN; + + pos*: SCAN.POSITION; + notRecord*: BOOLEAN + + END; + + IDENTS = POINTER TO RECORD (LISTS.LIST) + + add*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; + get*: PROCEDURE (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT + + END; + + PROC* = POINTER TO RECORD (LISTS.ITEM) + + label*: INTEGER; + used*: BOOLEAN; + processed*: BOOLEAN; + import*: LISTS.ITEM; + using*: LISTS.LIST; + enter*, + leave*: LISTS.ITEM + + END; + + USED_PROC = POINTER TO RECORD (LISTS.ITEM) + + proc: PROC + + END; + + rUNIT = RECORD (LISTS.ITEM) + + program*: PROGRAM; + name*: SCAN.IDENT; + idents*: IDENTS; + frwPointers: LISTS.LIST; + gscope: IDENT; + closed*: BOOLEAN; + scopeLvl*: INTEGER; + sysimport*: BOOLEAN; + + scopes*: ARRAY MAXSCOPE OF PROC; + + scope*: RECORD + + open*: PROCEDURE (unit: UNIT; proc: PROC): BOOLEAN; + close*: PROCEDURE (unit: UNIT; variables: LISTS.LIST) + + END; + + close*: PROCEDURE (unit: UNIT); + setvars*: PROCEDURE (unit: UNIT; type: TYPE_); + + pointers*: RECORD + + add*: PROCEDURE (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); + link*: PROCEDURE (unit: UNIT): FRWPTR + + END + + END; + + FIELD* = POINTER TO rFIELD; + + PARAM* = POINTER TO rPARAM; + + FIELDS = POINTER TO RECORD (LISTS.LIST) + + add*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; + get*: PROCEDURE (rec: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; + set*: PROCEDURE (rec: TYPE_; type: TYPE_): BOOLEAN + + END; + + PARAMS = POINTER TO RECORD (LISTS.LIST) + + size*: INTEGER; + + add*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; + get*: PROCEDURE (proc: TYPE_; name: SCAN.IDENT): PARAM; + set*: PROCEDURE (proc: TYPE_; type: TYPE_); + getfparams*: PROCEDURE (proc: TYPE_; maxparam: INTEGER; VAR int, flt: INTEGER): SET + + END; + + rTYPE_ = RECORD (LISTS.ITEM) + + typ*: INTEGER; + size*: INTEGER; + length*: INTEGER; + align*: INTEGER; + base*: TYPE_; + fields*: FIELDS; + params*: PARAMS; + unit*: UNIT; + closed*: BOOLEAN; + num*: INTEGER; + call*: INTEGER; + import*: BOOLEAN; + noalign*: BOOLEAN + + END; + + rFIELD = RECORD (LISTS.ITEM) + + type*: TYPE_; + name*: SCAN.IDENT; + export*: BOOLEAN; + offset*: INTEGER + + END; + + rPARAM = RECORD (LISTS.ITEM) + + name*: SCAN.IDENT; + type*: TYPE_; + vPar*: BOOLEAN; + offset*: INTEGER + + END; + + rIDENT = RECORD (LISTS.ITEM) + + name*: SCAN.IDENT; + typ*: INTEGER; + export*: BOOLEAN; + import*: LISTS.ITEM; + unit*: UNIT; + value*: ARITH.VALUE; + type*: TYPE_; + stproc*: INTEGER; + global*: BOOLEAN; + scopeLvl*: INTEGER; + offset*: INTEGER; + proc*: PROC; + pos*: SCAN.POSITION + + END; + + UNITS* = POINTER TO RECORD (LISTS.LIST) + + program: PROGRAM; + + create*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT; + get*: PROCEDURE (units: UNITS; name: SCAN.IDENT): UNIT + + END; + + rPROGRAM = RECORD + + recCount: INTEGER; + units*: UNITS; + types*: LISTS.LIST; + sysunit*: UNIT; + rtl*: UNIT; + bss*: INTEGER; + locsize*: INTEGER; + + procs*: LISTS.LIST; + dll*: BOOLEAN; + obj*: BOOLEAN; + + stTypes*: RECORD + + tINTEGER*, tBYTE*, tCHAR*, tWCHAR*, tSET*, tBOOLEAN*, tREAL*, tSTRING*, tNIL*, + tCARD16*, tCARD32*, tANYREC*: TYPE_ + + END; + + target*: RECORD + + bit_depth*: INTEGER; + word*: INTEGER; + adr*: INTEGER; + sys*: INTEGER + + END; + + enterType*: PROCEDURE (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; + getType*: PROCEDURE (program: PROGRAM; typ: INTEGER): TYPE_ + + END; + + DELIMPORT = PROCEDURE (import: LISTS.ITEM); + + +VAR + + idents: C.COLLECTION; + + +PROCEDURE NewIdent (): IDENT; +VAR + ident: IDENT; + citem: C.ITEM; + +BEGIN + citem := C.pop(idents); + IF citem = NIL THEN + NEW(ident) + ELSE + ident := citem(IDENT) + END + + RETURN ident +END NewIdent; + + +PROCEDURE getOffset* (program: PROGRAM; varIdent: IDENT): INTEGER; +VAR + word: INTEGER; + size: INTEGER; + +BEGIN + IF varIdent.offset = -1 THEN + IF varIdent.global THEN + IF MACHINE.Align(program.bss, varIdent.type.align) THEN + IF UTILS.maxint - program.bss >= varIdent.type.size THEN + varIdent.offset := program.bss; + INC(program.bss, varIdent.type.size) + END + END + ELSE + word := program.target.word; + size := varIdent.type.size; + IF MACHINE.Align(size, word) THEN + size := size DIV word; + IF UTILS.maxint - program.locsize >= size THEN + INC(program.locsize, size); + varIdent.offset := program.locsize; + END + END + END + END + + RETURN varIdent.offset +END getOffset; + + +PROCEDURE close (unit: UNIT); +VAR + ident, prev: IDENT; + offset: INTEGER; + +BEGIN + ident := unit.idents.last(IDENT); + WHILE (ident # NIL) & (ident.typ # idGUARD) DO + IF (ident.typ = idVAR) & (ident.offset = -1) THEN + ERRORS.hintmsg(ident.name.s, ident.pos.line, ident.pos.col, 0); + IF ident.export THEN + offset := getOffset(unit.program, ident) + END + END; + ident := ident.prev(IDENT) + END; + + ident := unit.idents.last(IDENT); + WHILE ident # NIL DO + prev := ident.prev(IDENT); + IF ~ident.export THEN + LISTS.delete(unit.idents, ident); + C.push(idents, ident) + END; + ident := prev + END; + + unit.closed := TRUE +END close; + + +PROCEDURE unique (unit: UNIT; ident: SCAN.IDENT): BOOLEAN; +VAR + item: IDENT; + +BEGIN + ASSERT(ident # NIL); + + item := unit.idents.last(IDENT); + WHILE (item.typ # idGUARD) & (item.name # ident) DO + item := item.prev(IDENT) + END + + RETURN item.typ = idGUARD +END unique; + + +PROCEDURE addIdent (unit: UNIT; ident: SCAN.IDENT; typ: INTEGER): IDENT; +VAR + item: IDENT; + res: BOOLEAN; + proc: PROC; + procs: LISTS.LIST; + +BEGIN + ASSERT(unit # NIL); + ASSERT(ident # NIL); + + res := unique(unit, ident); + + IF res THEN + item := NewIdent(); + + item.name := ident; + item.typ := typ; + item.unit := NIL; + item.export := FALSE; + item.import := NIL; + item.type := NIL; + item.value.typ := 0; + item.stproc := 0; + + item.global := unit.scopeLvl = 0; + item.scopeLvl := unit.scopeLvl; + item.offset := -1; + + IF item.typ IN {idPROC, idIMP} THEN + NEW(proc); + proc.import := NIL; + proc.label := 0; + proc.used := FALSE; + proc.processed := FALSE; + proc.using := LISTS.create(NIL); + procs := unit.program.procs; + LISTS.push(procs, proc); + item.proc := proc + END; + + LISTS.push(unit.idents, item) + ELSE + item := NIL + END + + RETURN item +END addIdent; + + +PROCEDURE UseProc* (unit: UNIT; call_proc: PROC); +VAR + procs: LISTS.LIST; + cur: LISTS.ITEM; + proc: USED_PROC; + +BEGIN + IF unit.scopeLvl = 0 THEN + call_proc.used := TRUE + ELSE + procs := unit.scopes[unit.scopeLvl].using; + + cur := procs.first; + WHILE (cur # NIL) & (cur(USED_PROC).proc # call_proc) DO + cur := cur.next + END; + + IF cur = NIL THEN + NEW(proc); + proc.proc := call_proc; + LISTS.push(procs, proc) + END + END +END UseProc; + + +PROCEDURE setvars (unit: UNIT; type: TYPE_); +VAR + item: IDENT; + +BEGIN + ASSERT(type # NIL); + + item := unit.idents.last(IDENT); + WHILE (item # NIL) & (item.typ = idVAR) & (item.type = NIL) DO + item.type := type; + item := item.prev(IDENT) + END +END setvars; + + +PROCEDURE getIdent (unit: UNIT; ident: SCAN.IDENT; currentScope: BOOLEAN): IDENT; +VAR + item: IDENT; + +BEGIN + ASSERT(ident # NIL); + + item := unit.idents.last(IDENT); + + ASSERT(item # NIL); + + IF currentScope THEN + WHILE (item.name # ident) & (item.typ # idGUARD) DO + item := item.prev(IDENT) + END; + IF item.name # ident THEN + item := NIL + END + ELSE + WHILE (item # NIL) & (item.name # ident) DO + item := item.prev(IDENT) + END + END + + RETURN item +END getIdent; + + +PROCEDURE openScope (unit: UNIT; proc: PROC): BOOLEAN; +VAR + item: IDENT; + res: BOOLEAN; + +BEGIN + INC(unit.scopeLvl); + + res := unit.scopeLvl < MAXSCOPE; + + IF res THEN + + unit.scopes[unit.scopeLvl] := proc; + + NEW(item); + item := NewIdent(); + + item.name := NIL; + item.typ := idGUARD; + + LISTS.push(unit.idents, item) + END + + RETURN res +END openScope; + + +PROCEDURE closeScope (unit: UNIT; variables: LISTS.LIST); +VAR + item: IDENT; + del: IDENT; + lvar: CODE.LOCALVAR; + +BEGIN + item := unit.idents.last(IDENT); + + WHILE (item # NIL) & (item.typ # idGUARD) DO + del := item; + item := item.prev(IDENT); + IF (del.typ = idVAR) & (del.offset = -1) THEN + ERRORS.hintmsg(del.name.s, del.pos.line, del.pos.col, 0) + END; + IF (variables # NIL) & (del.typ IN {idVAR, idPARAM}) & (del.offset # -1) THEN + IF del.type.typ IN BASICTYPES - {tREAL} + {tPOINTER, tPROCEDURE} THEN + lvar := CODE.NewVar(); + lvar.offset := del.offset; + lvar.size := del.type.size; + IF del.typ = idVAR THEN + lvar.offset := -lvar.offset + END; + LISTS.push(variables, lvar) + END + END; + LISTS.delete(unit.idents, del); + C.push(idents, del) + END; + + IF (item # NIL) & (item.typ = idGUARD) THEN + LISTS.delete(unit.idents, item); + C.push(idents, item) + END; + + DEC(unit.scopeLvl) + +END closeScope; + + +PROCEDURE frwptr (unit: UNIT; type: TYPE_; baseIdent: SCAN.IDENT; pos: SCAN.POSITION); +VAR + newptr: FRWPTR; + +BEGIN + ASSERT(unit # NIL); + ASSERT(type # NIL); + ASSERT(baseIdent # NIL); + + NEW(newptr); + + newptr.type := type; + newptr.baseIdent := baseIdent; + newptr.pos := pos; + newptr.linked := FALSE; + newptr.notRecord := FALSE; + + LISTS.push(unit.frwPointers, newptr) +END frwptr; + + +PROCEDURE linkptr (unit: UNIT): FRWPTR; +VAR + item: FRWPTR; + ident: IDENT; + res: FRWPTR; + +BEGIN + res := NIL; + item := unit.frwPointers.last(FRWPTR); + + WHILE (item # NIL) & ~item.linked & (res = NIL) DO + ident := unit.idents.get(unit, item.baseIdent, TRUE); + + IF (ident # NIL) THEN + IF (ident.typ = idTYPE) & (ident.type.typ = tRECORD) THEN + item.type.base := ident.type; + item.linked := TRUE + ELSE + item.notRecord := TRUE; + res := item + END + ELSE + item.notRecord := FALSE; + res := item + END; + + item := item.prev(FRWPTR) + END + + RETURN res +END linkptr; + + +PROCEDURE isTypeEq* (t1, t2: TYPE_): BOOLEAN; +VAR + res: BOOLEAN; + param1, param2: LISTS.ITEM; + +BEGIN + IF t1 = t2 THEN + res := TRUE + ELSIF (t1 = NIL) OR (t2 = NIL) THEN + res := FALSE + ELSIF (t1.typ = tPROCEDURE) & (t2.typ = tPROCEDURE) THEN + + param1 := t1.params.first; + param2 := t2.params.first; + + res := (t1.call = t2.call) & ((param1 # NIL) = (param2 # NIL)); + + WHILE res & (param1 # NIL) & (param2 # NIL) DO + res := (param1(PARAM).vPar = param2(PARAM).vPar) & isTypeEq(param1(PARAM).type, param2(PARAM).type); + param1 := param1.next; + param2 := param2.next; + res := res & ((param1 # NIL) = (param2 # NIL)) + END; + + res := res & isTypeEq(t1.base, t2.base) + + ELSIF (t1.typ = tARRAY) & (t2.typ = tARRAY) THEN + res := (t1.length = 0) & (t2.length = 0) & isTypeEq(t1.base, t2.base) + ELSE + res := FALSE + END + + RETURN res +END isTypeEq; + + +PROCEDURE isBaseOf* (t0, t1: TYPE_): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := ((t0.typ = tPOINTER) & (t1.typ = tPOINTER)) OR ((t0.typ = tRECORD) & (t1.typ = tRECORD)); + + IF (t0.typ = tPOINTER) & (t1.typ = tPOINTER) THEN + t0 := t0.base; + t1 := t1.base + END; + + WHILE res & (t1 # NIL) & (t1 # t0) DO + t1 := t1.base + END + + RETURN res & (t1 = t0) +END isBaseOf; + + +PROCEDURE isOpenArray* (t: TYPE_): BOOLEAN; + RETURN (t.typ = tARRAY) & (t.length = 0) +END isOpenArray; + + +PROCEDURE getunit (units: UNITS; name: SCAN.IDENT): UNIT; +VAR + item: UNIT; + +BEGIN + ASSERT(name # NIL); + + item := units.first(UNIT); + + WHILE (item # NIL) & (item.name # name) DO + item := item.next(UNIT) + END; + + IF (item = NIL) & (name.s = "SYSTEM") THEN + item := units.program.sysunit + END + + RETURN item +END getunit; + + +PROCEDURE enterStTypes (unit: UNIT; program: PROGRAM); +VAR + ident: IDENT; + stName: SCAN.IDENT; + +BEGIN + + stName := SCAN.enterid("INTEGER"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tINTEGER; + + stName := SCAN.enterid("BYTE"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tBYTE; + + stName := SCAN.enterid("CHAR"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tCHAR; + + stName := SCAN.enterid("WCHAR"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tWCHAR; + + stName := SCAN.enterid("SET"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tSET; + + stName := SCAN.enterid("BOOLEAN"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tBOOLEAN; + + stName := SCAN.enterid("REAL"); + ident := addIdent(unit, stName, idTYPE); + ident.type := program.stTypes.tREAL; + +END enterStTypes; + + +PROCEDURE enterStProcs (unit: UNIT); + + + PROCEDURE EnterProc (unit: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); + VAR + ident: IDENT; + BEGIN + ident := addIdent(unit, SCAN.enterid(name), idtyp); + ident.stproc := proc + END EnterProc; + + +BEGIN + EnterProc(unit, "ASSERT", idSTPROC, stASSERT); + EnterProc(unit, "DEC", idSTPROC, stDEC); + EnterProc(unit, "EXCL", idSTPROC, stEXCL); + EnterProc(unit, "INC", idSTPROC, stINC); + EnterProc(unit, "INCL", idSTPROC, stINCL); + EnterProc(unit, "NEW", idSTPROC, stNEW); + EnterProc(unit, "PACK", idSTPROC, stPACK); + EnterProc(unit, "UNPK", idSTPROC, stUNPK); + EnterProc(unit, "DISPOSE", idSTPROC, stDISPOSE); + EnterProc(unit, "COPY", idSTPROC, stCOPY); + + EnterProc(unit, "ABS", idSTFUNC, stABS); + EnterProc(unit, "ASR", idSTFUNC, stASR); + EnterProc(unit, "CHR", idSTFUNC, stCHR); + EnterProc(unit, "WCHR", idSTFUNC, stWCHR); + EnterProc(unit, "FLOOR", idSTFUNC, stFLOOR); + EnterProc(unit, "FLT", idSTFUNC, stFLT); + EnterProc(unit, "LEN", idSTFUNC, stLEN); + EnterProc(unit, "LSL", idSTFUNC, stLSL); + EnterProc(unit, "ODD", idSTFUNC, stODD); + EnterProc(unit, "ORD", idSTFUNC, stORD); + EnterProc(unit, "ROR", idSTFUNC, stROR); + EnterProc(unit, "BITS", idSTFUNC, stBITS); + EnterProc(unit, "LSR", idSTFUNC, stLSR); + EnterProc(unit, "LENGTH", idSTFUNC, stLENGTH); + EnterProc(unit, "MIN", idSTFUNC, stMIN); + EnterProc(unit, "MAX", idSTFUNC, stMAX); +END enterStProcs; + + +PROCEDURE newunit (units: UNITS; name: SCAN.IDENT): UNIT; +VAR + unit: UNIT; + idents: IDENTS; + +BEGIN + ASSERT(units # NIL); + ASSERT(name # NIL); + + NEW(unit); + + NEW(idents); + ASSERT(LISTS.create(idents) = idents); + + idents.add := addIdent; + idents.get := getIdent; + + unit.program := units.program; + unit.name := name; + unit.closed := FALSE; + unit.idents := idents; + unit.frwPointers := LISTS.create(NIL); + + unit.scope.open := openScope; + unit.scope.close := closeScope; + unit.close := close; + unit.setvars := setvars; + unit.pointers.add := frwptr; + unit.pointers.link := linkptr; + + ASSERT(unit.scope.open(unit, NIL)); + + enterStTypes(unit, units.program); + enterStProcs(unit); + + ASSERT(unit.scope.open(unit, NIL)); + + unit.gscope := unit.idents.last(IDENT); + + LISTS.push(units, unit); + + unit.scopeLvl := 0; + unit.scopes[0] := NIL; + + unit.sysimport := FALSE; + + IF unit.name.s = mConst.RTL_NAME THEN + unit.program.rtl := unit + END + + RETURN unit +END newunit; + + +PROCEDURE getField (self: TYPE_; name: SCAN.IDENT; unit: UNIT): FIELD; +VAR + field: FIELD; + +BEGIN + ASSERT(self # NIL); + ASSERT(name # NIL); + ASSERT(unit # NIL); + + field := NIL; + WHILE (self # NIL) & (field = NIL) DO + + field := self.fields.first(FIELD); + + WHILE (field # NIL) & (field.name # name) DO + field := field.next(FIELD) + END; + + IF field = NIL THEN + self := self.base + END + + END; + + IF (field # NIL) & (self.unit # unit) & ~field.export THEN + field := NIL + END + + RETURN field +END getField; + + +PROCEDURE addField (self: TYPE_; name: SCAN.IDENT; export: BOOLEAN): BOOLEAN; +VAR + field: FIELD; + res: BOOLEAN; + +BEGIN + ASSERT(name # NIL); + + res := getField(self, name, self.unit) = NIL; + + IF res THEN + NEW(field); + + field.name := name; + field.export := export; + field.type := NIL; + field.offset := self.size; + + LISTS.push(self.fields, field) + END + + RETURN res +END addField; + + +PROCEDURE setFields (self: TYPE_; type: TYPE_): BOOLEAN; +VAR + item: FIELD; + res: BOOLEAN; + +BEGIN + ASSERT(type # NIL); + + item := self.fields.first(FIELD); + + WHILE (item # NIL) & (item.type # NIL) DO + item := item.next(FIELD) + END; + + res := TRUE; + + WHILE res & (item # NIL) & (item.type = NIL) DO + item.type := type; + IF ~self.noalign THEN + res := MACHINE.Align(self.size, type.align) + ELSE + res := TRUE + END; + item.offset := self.size; + res := res & (UTILS.maxint - self.size >= type.size); + IF res THEN + INC(self.size, type.size) + END; + item := item.next(FIELD) + END + + RETURN res +END setFields; + + +PROCEDURE getParam (self: TYPE_; name: SCAN.IDENT): PARAM; +VAR + item: PARAM; + +BEGIN + ASSERT(name # NIL); + + item := self.params.first(PARAM); + + WHILE (item # NIL) & (item.name # name) DO + item := item.next(PARAM) + END + + RETURN item +END getParam; + + +PROCEDURE addParam (self: TYPE_; name: SCAN.IDENT; vPar: BOOLEAN): BOOLEAN; +VAR + param: PARAM; + res: BOOLEAN; + +BEGIN + ASSERT(name # NIL); + + res := self.params.get(self, name) = NIL; + + IF res THEN + NEW(param); + + param.name := name; + param.type := NIL; + param.vPar := vPar; + + LISTS.push(self.params, param) + END + + RETURN res +END addParam; + + +PROCEDURE Dim* (t: TYPE_): INTEGER; +VAR + res: INTEGER; + +BEGIN + res := 0; + WHILE isOpenArray(t) DO + t := t.base; + INC(res) + END + RETURN res +END Dim; + + +PROCEDURE OpenBase* (t: TYPE_): TYPE_; +BEGIN + WHILE isOpenArray(t) DO t := t.base END + RETURN t +END OpenBase; + + +PROCEDURE getFloatParamsPos (self: TYPE_; maxoffs: INTEGER; VAR int, flt: INTEGER): SET; +VAR + res: SET; + param: PARAM; + +BEGIN + res := {}; + int := 0; + flt := 0; + param := self.params.first(PARAM); + WHILE (param # NIL) & (param.offset <= maxoffs + STACK_FRAME) DO + IF ~param.vPar & (param.type.typ = tREAL) THEN + INCL(res, param.offset - STACK_FRAME); + INC(flt) + END; + param := param.next(PARAM) + END; + + int := self.params.size - flt + + RETURN res +END getFloatParamsPos; + + +PROCEDURE setParams (self: TYPE_; type: TYPE_); +VAR + item: LISTS.ITEM; + param: PARAM; + word, size: INTEGER; + +BEGIN + ASSERT(type # NIL); + + word := MACHINE.target.bit_depth DIV 8; + + item := self.params.first; + + WHILE (item # NIL) & (item(PARAM).type # NIL) DO + item := item.next + END; + + WHILE (item # NIL) & (item(PARAM).type = NIL) DO + param := item(PARAM); + param.type := type; + IF param.vPar THEN + IF type.typ = tRECORD THEN + size := 2 + ELSIF isOpenArray(type) THEN + size := Dim(type) + 1 + ELSE + size := 1 + END; + param.offset := self.params.size + ORD(type.typ = tRECORD) + Dim(type) + STACK_FRAME; + INC(self.params.size, size) + ELSE + IF type.typ IN {tRECORD, tARRAY} THEN + IF isOpenArray(type) THEN + size := Dim(type) + 1 + ELSE + size := 1 + END + ELSE + size := type.size; + ASSERT(MACHINE.Align(size, word)); + size := size DIV word + END; + param.offset := self.params.size + Dim(type) + STACK_FRAME; + INC(self.params.size, size) + END; + + item := item.next + END + +END setParams; + + +PROCEDURE enterType (program: PROGRAM; typ, size, length: INTEGER; unit: UNIT): TYPE_; +VAR + t: TYPE_; + fields: FIELDS; + params: PARAMS; + +BEGIN + NEW(t); + + NEW(fields); + ASSERT(LISTS.create(fields) = fields); + + NEW(params); + ASSERT(LISTS.create(params) = params); + + t.typ := typ; + t.size := size; + t.length := length; + t.align := 0; + t.base := NIL; + t.fields := fields; + t.params := params; + t.unit := unit; + t.num := 0; + IF program.target.bit_depth = 32 THEN + t.call := default + ELSIF program.target.bit_depth = 64 THEN + t.call := default64 + END; + t.import := FALSE; + t.noalign := FALSE; + + t.fields.add := addField; + t.fields.get := getField; + t.fields.set := setFields; + + t.params.add := addParam; + t.params.get := getParam; + t.params.getfparams := getFloatParamsPos; + t.params.set := setParams; + t.params.size := 0; + + IF typ IN {tARRAY, tRECORD} THEN + t.closed := FALSE; + IF typ = tRECORD THEN + INC(program.recCount); + t.num := program.recCount + END + ELSE + t.closed := TRUE + END; + + LISTS.push(program.types, t) + + RETURN t +END enterType; + + +PROCEDURE getType (program: PROGRAM; typ: INTEGER): TYPE_; +VAR + res: TYPE_; + +BEGIN + + IF typ = ARITH.tINTEGER THEN + res := program.stTypes.tINTEGER + ELSIF typ = ARITH.tREAL THEN + res := program.stTypes.tREAL + ELSIF typ = ARITH.tSET THEN + res := program.stTypes.tSET + ELSIF typ = ARITH.tBOOLEAN THEN + res := program.stTypes.tBOOLEAN + ELSIF typ = ARITH.tCHAR THEN + res := program.stTypes.tCHAR + ELSIF typ = ARITH.tWCHAR THEN + res := program.stTypes.tWCHAR + ELSIF typ = ARITH.tSTRING THEN + res := program.stTypes.tSTRING + ELSE + res := NIL + END; + + ASSERT(res # NIL) + + RETURN res +END getType; + + +PROCEDURE createSysUnit (program: PROGRAM); +VAR + ident: IDENT; + unit: UNIT; + + + PROCEDURE EnterProc (sys: UNIT; name: SCAN.LEXSTR; idtyp, proc: INTEGER); + VAR + ident: IDENT; + BEGIN + ident := addIdent(sys, SCAN.enterid(name), idtyp); + ident.stproc := proc; + ident.export := TRUE + END EnterProc; + + +BEGIN + unit := program.units.create(program.units, SCAN.enterid("$SYSTEM")); + + EnterProc(unit, "ADR", idSYSFUNC, sysADR); + EnterProc(unit, "SIZE", idSYSFUNC, sysSIZE); + EnterProc(unit, "SADR", idSYSFUNC, sysSADR); + EnterProc(unit, "WSADR", idSYSFUNC, sysWSADR); + EnterProc(unit, "TYPEID", idSYSFUNC, sysTYPEID); + EnterProc(unit, "INF", idSYSFUNC, sysINF); + + EnterProc(unit, "GET", idSYSPROC, sysGET); + EnterProc(unit, "PUT", idSYSPROC, sysPUT); + EnterProc(unit, "PUT8", idSYSPROC, sysPUT8); + EnterProc(unit, "PUT16", idSYSPROC, sysPUT16); + EnterProc(unit, "PUT32", idSYSPROC, sysPUT32); + EnterProc(unit, "CODE", idSYSPROC, sysCODE); + EnterProc(unit, "MOVE", idSYSPROC, sysMOVE); + EnterProc(unit, "COPY", idSYSPROC, sysCOPY); + + ident := addIdent(unit, SCAN.enterid("CARD16"), idTYPE); + ident.type := program.stTypes.tCARD16; + ident.export := TRUE; + + ident := addIdent(unit, SCAN.enterid("CARD32"), idTYPE); + ident.type := program.stTypes.tCARD32; + ident.export := TRUE; + + unit.close(unit); + + program.sysunit := unit +END createSysUnit; + + +PROCEDURE DelUnused* (program: PROGRAM; DelImport: DELIMPORT); +VAR + proc: PROC; + flag: BOOLEAN; + + + PROCEDURE process (proc: PROC); + VAR + used_proc: LISTS.ITEM; + + BEGIN + proc.processed := TRUE; + + used_proc := proc.using.first; + WHILE used_proc # NIL DO + used_proc(USED_PROC).proc.used := TRUE; + used_proc := used_proc.next + END + + END process; + + +BEGIN + + REPEAT + + flag := FALSE; + proc := program.procs.first(PROC); + + WHILE proc # NIL DO + IF proc.used & ~proc.processed THEN + process(proc); + flag := TRUE + END; + proc := proc.next(PROC) + END + + UNTIL ~flag; + + proc := program.procs.first(PROC); + + WHILE proc # NIL DO + IF ~proc.used THEN + IF proc.import = NIL THEN + CODE.delete2(proc.enter, proc.leave) + ELSE + DelImport(proc.import) + END + END; + proc := proc.next(PROC) + END + +END DelUnused; + + +PROCEDURE create* (bit_depth, sys: INTEGER): PROGRAM; +VAR + program: PROGRAM; + units: UNITS; + +BEGIN + idents := C.create(); + + MACHINE.SetBitDepth(bit_depth); + NEW(program); + NEW(units); + ASSERT(LISTS.create(units) = units); + + program.target.bit_depth := bit_depth; + program.target.word := bit_depth DIV 8; + program.target.adr := bit_depth DIV 8; + program.target.sys := sys; + + program.recCount := -1; + program.bss := 0; + + program.units := units; + program.types := LISTS.create(NIL); + + program.procs := LISTS.create(NIL); + + program.enterType := enterType; + program.getType := getType; + + program.stTypes.tINTEGER := enterType(program, tINTEGER, program.target.word, 0, NIL); + program.stTypes.tBYTE := enterType(program, tBYTE, 1, 0, NIL); + program.stTypes.tCHAR := enterType(program, tCHAR, 1, 0, NIL); + program.stTypes.tWCHAR := enterType(program, tWCHAR, 2, 0, NIL); + program.stTypes.tSET := enterType(program, tSET, program.target.word, 0, NIL); + program.stTypes.tBOOLEAN := enterType(program, tBOOLEAN, 1, 0, NIL); + program.stTypes.tREAL := enterType(program, tREAL, 8, 0, NIL); + program.stTypes.tSTRING := enterType(program, tSTRING, program.target.word, 0, NIL); + program.stTypes.tNIL := enterType(program, tNIL, program.target.word, 0, NIL); + program.stTypes.tCARD16 := enterType(program, tCARD16, 2, 0, NIL); + program.stTypes.tCARD32 := enterType(program, tCARD32, 4, 0, NIL); + program.stTypes.tANYREC := enterType(program, tRECORD, 0, 0, NIL); + program.stTypes.tANYREC.closed := TRUE; + + program.stTypes.tINTEGER.align := program.stTypes.tINTEGER.size; + program.stTypes.tBYTE.align := 1; + program.stTypes.tCHAR.align := program.stTypes.tCHAR.size; + program.stTypes.tWCHAR.align := program.stTypes.tWCHAR.size; + program.stTypes.tSET.align := program.stTypes.tSET.size; + program.stTypes.tBOOLEAN.align := program.stTypes.tBOOLEAN.size; + program.stTypes.tREAL.align := program.stTypes.tREAL.size; + program.stTypes.tCARD16.align := program.stTypes.tCARD16.size; + program.stTypes.tCARD32.align := program.stTypes.tCARD32.size; + + units.program := program; + + units.create := newunit; + units.get := getunit; + + program.dll := FALSE; + program.obj := FALSE; + + createSysUnit(program) + + RETURN program +END create; + + +END PROG. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/REG.ob07 b/programs/develop/oberon07/Source/REG.ob07 new file mode 100644 index 0000000000..1f448d833b --- /dev/null +++ b/programs/develop/oberon07/Source/REG.ob07 @@ -0,0 +1,434 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE REG; + + +CONST + + N = 16; + + R0* = 0; R1* = 1; R2* = 2; + R8* = 8; R9* = 9; R10* = 10; R11* = 11; + + NVR = 32; + + +TYPE + + OP1 = PROCEDURE (arg: INTEGER); + OP2 = PROCEDURE (arg1, arg2: INTEGER); + OP3 = PROCEDURE (arg1, arg2, arg3: INTEGER); + + REGS* = POINTER TO RECORD + + regs*: SET; + stk*: ARRAY N OF INTEGER; + top*: INTEGER; + pushed*: INTEGER; + + vregs*: SET; + offs: ARRAY NVR OF INTEGER; + size: ARRAY NVR OF INTEGER; + + push, pop: OP1; + mov, xch: OP2; + load, save: OP3 + + END; + + +PROCEDURE push (R: REGS); +VAR + i, reg: INTEGER; + +BEGIN + reg := R.stk[0]; + INCL(R.regs, reg); + R.push(reg); + FOR i := 0 TO R.top - 1 DO + R.stk[i] := R.stk[i + 1] + END; + DEC(R.top); + INC(R.pushed) +END push; + + +PROCEDURE pop (R: REGS; reg: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := R.top + 1 TO 1 BY -1 DO + R.stk[i] := R.stk[i - 1] + END; + R.stk[0] := reg; + EXCL(R.regs, reg); + R.pop(reg); + INC(R.top); + DEC(R.pushed) +END pop; + + +PROCEDURE InStk (R: REGS; reg: INTEGER): INTEGER; +VAR + i, n: INTEGER; + +BEGIN + i := 0; + n := R.top; + WHILE (i <= n) & (R.stk[i] # reg) DO + INC(i) + END; + + IF i > n THEN + i := -1 + END + + RETURN i +END InStk; + + +PROCEDURE GetFreeReg (R: REGS): INTEGER; +VAR + i: INTEGER; + +BEGIN + i := 0; + WHILE (i < N) & ~(i IN R.regs) DO + INC(i) + END; + + IF i = N THEN + i := -1 + END + + RETURN i +END GetFreeReg; + + +PROCEDURE Put (R: REGS; reg: INTEGER); +BEGIN + EXCL(R.regs, reg); + INC(R.top); + R.stk[R.top] := reg +END Put; + + +PROCEDURE PopAnyReg (R: REGS): INTEGER; +VAR + reg: INTEGER; + +BEGIN + reg := GetFreeReg(R); + ASSERT(reg # -1); + ASSERT(R.top < LEN(R.stk) - 1); + ASSERT(R.pushed > 0); + pop(R, reg) + + RETURN reg +END PopAnyReg; + + +PROCEDURE GetAnyReg* (R: REGS): INTEGER; +VAR + reg: INTEGER; + +BEGIN + reg := GetFreeReg(R); + IF reg = -1 THEN + ASSERT(R.top >= 0); + reg := R.stk[0]; + push(R) + END; + + Put(R, reg) + + RETURN reg +END GetAnyReg; + + +PROCEDURE GetReg* (R: REGS; reg: INTEGER): BOOLEAN; +VAR + free, n: INTEGER; + res: BOOLEAN; + + + PROCEDURE exch (R: REGS; reg1, reg2: INTEGER); + VAR + n1, n2: INTEGER; + + BEGIN + n1 := InStk(R, reg1); + n2 := InStk(R, reg2); + R.stk[n1] := reg2; + R.stk[n2] := reg1; + R.xch(reg1, reg2) + END exch; + + +BEGIN + IF reg IN R.regs THEN + Put(R, reg); + res := TRUE + ELSE + n := InStk(R, reg); + IF n # -1 THEN + free := GetFreeReg(R); + IF free # -1 THEN + Put(R, free); + exch(R, reg, free) + ELSE + push(R); + free := GetFreeReg(R); + ASSERT(free # -1); + Put(R, free); + IF free # reg THEN + exch(R, reg, free) + END + END; + res := TRUE + ELSE + res := FALSE + END + END + + RETURN res +END GetReg; + + +PROCEDURE Exchange* (R: REGS; reg1, reg2: INTEGER): BOOLEAN; +VAR + n1, n2: INTEGER; + res: BOOLEAN; + +BEGIN + res := FALSE; + + IF reg1 # reg2 THEN + n1 := InStk(R, reg1); + n2 := InStk(R, reg2); + + IF (n1 # -1) & (n2 # -1) THEN + R.stk[n1] := reg2; + R.stk[n2] := reg1; + R.xch(reg2, reg1); + res := TRUE + ELSIF (n1 # -1) & (reg2 IN R.regs) THEN + R.stk[n1] := reg2; + INCL(R.regs, reg1); + EXCL(R.regs, reg2); + R.mov(reg2, reg1); + res := TRUE + ELSIF (n2 # -1) & (reg1 IN R.regs) THEN + R.stk[n2] := reg1; + EXCL(R.regs, reg1); + INCL(R.regs, reg2); + R.mov(reg1, reg2); + res := TRUE + END + ELSE + res := TRUE + END + + RETURN res +END Exchange; + + +PROCEDURE Drop* (R: REGS); +BEGIN + INCL(R.regs, R.stk[R.top]); + DEC(R.top) +END Drop; + + +PROCEDURE BinOp* (R: REGS; VAR reg1, reg2: INTEGER); +BEGIN + IF R.top > 0 THEN + reg1 := R.stk[R.top - 1]; + reg2 := R.stk[R.top] + ELSIF R.top = 0 THEN + reg1 := PopAnyReg(R); + reg2 := R.stk[R.top] + ELSIF R.top < 0 THEN + reg2 := PopAnyReg(R); + reg1 := PopAnyReg(R) + END +END BinOp; + + +PROCEDURE UnOp* (R: REGS; VAR reg: INTEGER); +BEGIN + IF R.top >= 0 THEN + reg := R.stk[R.top] + ELSE + reg := PopAnyReg(R) + END +END UnOp; + + +PROCEDURE PushAll* (R: REGS); +BEGIN + WHILE R.top >= 0 DO + push(R) + END +END PushAll; + + +PROCEDURE Lock* (R: REGS; reg, offs, size: INTEGER); +BEGIN + ASSERT(reg IN R.vregs); + ASSERT(offs # 0); + R.offs[reg] := offs; + IF size = 0 THEN + size := 8 + END; + R.size[reg] := size +END Lock; + + +PROCEDURE Release* (R: REGS; reg: INTEGER); +BEGIN + ASSERT(reg IN R.vregs); + R.offs[reg] := 0 +END Release; + + +PROCEDURE Load* (R: REGS; reg: INTEGER); +VAR + offs: INTEGER; + +BEGIN + ASSERT(reg IN R.vregs); + offs := R.offs[reg]; + IF offs # 0 THEN + R.load(reg, offs, R.size[reg]) + END +END Load; + + +PROCEDURE Save* (R: REGS; reg: INTEGER); +VAR + offs: INTEGER; + +BEGIN + ASSERT(reg IN R.vregs); + offs := R.offs[reg]; + IF offs # 0 THEN + R.save(reg, offs, R.size[reg]) + END +END Save; + + +PROCEDURE Store* (R: REGS); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO NVR - 1 DO + IF i IN R.vregs THEN + Save(R, i) + END + END +END Store; + + +PROCEDURE Restore* (R: REGS); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO NVR - 1 DO + IF i IN R.vregs THEN + Load(R, i) + END + END +END Restore; + + +PROCEDURE Reset* (R: REGS); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO NVR - 1 DO + IF i IN R.vregs THEN + R.offs[i] := 0 + END + END +END Reset; + + +PROCEDURE GetVarReg* (R: REGS; offs: INTEGER): INTEGER; +VAR + i, res: INTEGER; + +BEGIN + res := -1; + i := 0; + WHILE i < NVR DO + IF (i IN R.vregs) & (R.offs[i] = offs) THEN + res := i; + i := NVR + END; + INC(i) + END + + RETURN res +END GetVarReg; + + +PROCEDURE GetAnyVarReg* (R: REGS): INTEGER; +VAR + i, res: INTEGER; + +BEGIN + res := -1; + i := 0; + WHILE i < NVR DO + IF (i IN R.vregs) & (R.offs[i] = 0) THEN + res := i; + i := NVR + END; + INC(i) + END + + RETURN res +END GetAnyVarReg; + + +PROCEDURE Create* (push, pop: OP1; mov, xch: OP2; load, save: OP3; regs, vregs: SET): REGS; +VAR + R: REGS; + i: INTEGER; + +BEGIN + NEW(R); + + R.regs := regs; + R.pushed := 0; + R.top := -1; + + R.push := push; + R.pop := pop; + R.mov := mov; + R.xch := xch; + R.load := load; + R.save := save; + + R.vregs := vregs; + + FOR i := 0 TO NVR - 1 DO + R.offs[i] := 0; + R.size[i] := 0 + END + + RETURN R +END Create; + + +END REG. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/SCAN.ob07 b/programs/develop/oberon07/Source/SCAN.ob07 index 7acc2c3216..ab771009a3 100644 --- a/programs/develop/oberon07/Source/SCAN.ob07 +++ b/programs/develop/oberon07/Source/SCAN.ob07 @@ -1,699 +1,723 @@ -(* - Copyright 2016 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2018, Anton Krotov + All rights reserved. *) MODULE SCAN; -IMPORT UTILS, sys := SYSTEM; +IMPORT TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, C := COLLECTIONS; + CONST - Tab = 8; - maxINT* = 7FFFFFFFH; - minINT* = 80000000H; - maxREAL* = 3.39E38; - maxDBL* = 1.69D308; - minREAL* = 1.41E-45; - IDLENGTH = 255; - STRLENGTH* = 256; + LEXLEN = 1024; - lxEOF = 0; lxINT = -1; lxREAL = -2; lxSTRING = -3; lxIDENT = -4; lxHEX = -5; lxCHX = -6; lxLONGREAL = -7; - lxARRAY = 1; lxBEGIN = 2; lxBY = 3; lxCASE = 4; lxCONST = 5; lxDIV = 6; lxDO = 7; lxELSE = 8; - lxELSIF = 9; lxEND = 10; lxFALSE = 11; lxFOR = 12; lxIF = 13; lxIMPORT = 14; lxIN = 15; lxIS = 16; - lxMOD = 17; lxMODULE = 18; lxNIL = 19; lxOF = 20; lxOR = 21; lxPOINTER = 22; lxPROCEDURE = 23; - lxRECORD = 24; lxREPEAT = 25; lxRETURN = 26; lxTHEN = 27; lxTO = 28; lxTRUE = 29; lxTYPE = 30; - lxUNTIL = 31; lxVAR = 32; lxWHILE = 33; + lxUNDEF* = 0; lxIDENT* = 1; lxINTEGER* = 2; lxHEX* = 3; + lxCHAR* = 4; lxFLOAT* = 5; lxSTRING* = 6; lxCOMMENT* = 7; + lxEOF* = 8; - lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; lxNot = 55; lxAnd = 56; lxComma = 57; lxSemi = 58; - lxStick = 59; lxLRound = 60; lxLSquare = 61; lxLCurly = 62; lxCaret = 63; lxRRound = 64; lxRSquare = 65; - lxRCurly = 66; lxDot = 67; lxDbl = 68; lxAssign = 69; lxColon = 70; - lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76; + lxKW = 101; + + lxARRAY* = 101; lxBEGIN* = 102; lxBY* = 103; lxCASE* = 104; + lxCONST* = 105; lxDIV* = 106; lxDO* = 107; lxELSE* = 108; + lxELSIF* = 109; lxEND* = 110; lxFALSE* = 111; lxFOR* = 112; + lxIF* = 113; lxIMPORT* = 114; lxIN* = 115; lxIS* = 116; + lxMOD* = 117; lxMODULE* = 118; lxNIL* = 119; lxOF* = 120; + lxOR* = 121; lxPOINTER* = 122; lxPROCEDURE* = 123; lxRECORD* = 124; + lxREPEAT* = 125; lxRETURN* = 126; lxTHEN* = 127; lxTO* = 128; + lxTRUE* = 129; lxTYPE* = 130; lxUNTIL* = 131; lxVAR* = 132; + lxWHILE* = 133; + + lxPLUS* = 201; lxMINUS* = 202; lxMUL* = 203; lxSLASH* = 204; + lxNOT* = 205; lxAND* = 206; lxPOINT* = 207; lxCOMMA* = 208; + lxSEMI* = 209; lxBAR* = 210; lxLROUND* = 211; lxLSQUARE* = 212; + lxLCURLY* = 213; lxCARET* = 214; lxEQ* = 215; lxNE* = 216; + lxLT* = 217; lxGT* = 218; lxCOLON* = 219; lxRROUND* = 220; + lxRSQUARE* = 221; lxRCURLY* = 222; lxLE* = 223; lxGE* = 224; + lxASSIGN* = 225; lxRANGE* = 226; + + lxERROR01 = -1; lxERROR02 = -2; lxERROR03 = -3; lxERROR04 = -4; + lxERROR05 = -5; lxERROR06 = -6; lxERROR07 = -7; lxERROR08 = -8; + lxERROR09 = -9; lxERROR10 = -10; lxERROR11 = -11; lxERROR12 = -12; - lxERR0 = 100; lxERR1 = 101; lxERR2 = 102; lxERR3 = 103; lxERR4 = 104; lxERR5 = 105; lxERR6 = 106; - lxERR7 = 107; lxERR8 = 108; lxERR9 = 109; lxERR10 = 110; lxERR11 = 111; lxERR20 = 120; TYPE - TCoord* = RECORD line*, col*: INTEGER END; + LEXSTR* = ARRAY LEXLEN OF CHAR; - NODE* = POINTER TO RECORD - Left, Right: NODE; - tLex: INTEGER; - Name*: UTILS.STRING - END; + IDENT* = POINTER TO RECORD (AVL.DATA) + + s*: LEXSTR; + offset*, offsetW*: INTEGER + + END; + + POSITION* = RECORD + + line*, col*: INTEGER + + END; + + LEX* = RECORD + + s*: LEXSTR; + length*: INTEGER; + sym*: INTEGER; + pos*: POSITION; + ident*: IDENT; + string*: IDENT; + value*: ARITH.VALUE; + error*: INTEGER; + + over: BOOLEAN + + END; + + SCANNER* = POINTER TO RECORD (C.ITEM) + + text: TEXTDRV.TEXT; + range: BOOLEAN + + END; + + KEYWORD = ARRAY 10 OF CHAR; - SCANNER* = POINTER TO RECORD - File, ccol, cline, count, tLex, vINT: INTEGER; - coord: TCoord; - ch, vCHX: CHAR; - Lex: UTILS.STRING; - vFLT: LONGREAL; - id: NODE; - buf, bufpos: INTEGER; - CR, UTF8: BOOLEAN - END; VAR - Lex*: UTILS.STRING; File, ccol, cline, count*, tLex*, vINT*: INTEGER; - coord*: TCoord; - vFLT*: LONGREAL; id*: NODE; ch, vCHX*: CHAR; - buf, bufpos: INTEGER; CR, UTF8: BOOLEAN; - Nodes: ARRAY 256 OF NODE; - _START*, _version*: NODE; + vocabulary: RECORD -PROCEDURE AddNode*(Name: UTILS.STRING): NODE; -VAR cur, res: NODE; + KW: ARRAY 33 OF KEYWORD; - PROCEDURE NewNode(Right: BOOLEAN); - BEGIN - NEW(res); - UTILS.MemErr(res = NIL); - res.Name := Name; - res.tLex := lxIDENT; - res.Left := NIL; - res.Right := NIL; - IF Right THEN - cur.Right := res - ELSE - cur.Left := res + delimiters: ARRAY 256 OF BOOLEAN; + + idents: AVL.NODE; + ident: IDENT + + END; + + scanners: C.COLLECTION; + + +PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER; + RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s) +END nodecmp; + + +PROCEDURE key (VAR lex: LEX); +VAR + L, R, M: INTEGER; + +BEGIN + L := 0; + R := LEN(vocabulary.KW) - 1; + M := (L + R) DIV 2; + + WHILE L # M DO + IF lex.s > vocabulary.KW[M] THEN + L := M; + M := (L + R) DIV 2 + ELSIF lex.s < vocabulary.KW[M] THEN + R := M; + M := (L + R) DIV 2 + ELSE + lex.sym := lxKW + M; + L := M; + R := M + END + END; + + IF L # R THEN + IF lex.s = vocabulary.KW[L] THEN + lex.sym := lxKW + L + END; + + IF lex.s = vocabulary.KW[R] THEN + lex.sym := lxKW + R + END END - END NewNode; + +END key; + + +PROCEDURE enterid* (s: LEXSTR): IDENT; +VAR + newnode: BOOLEAN; + node: AVL.NODE; BEGIN - res := NIL; - cur := Nodes[ORD(Name[0])]; - REPEAT - IF Name > cur.Name THEN - IF cur.Right # NIL THEN - cur := cur.Right - ELSE - NewNode(TRUE) - END - ELSIF Name < cur.Name THEN - IF cur.Left # NIL THEN - cur := cur.Left - ELSE - NewNode(FALSE) - END - ELSE - res := cur + vocabulary.ident.s := s; + vocabulary.idents := AVL.insert(vocabulary.idents, vocabulary.ident, nodecmp, newnode, node); + + IF newnode THEN + NEW(vocabulary.ident); + vocabulary.ident.offset := -1; + vocabulary.ident.offsetW := -1 END - UNTIL res # NIL - RETURN res -END AddNode; -PROCEDURE Backup*(scanner: SCANNER); -BEGIN - scanner.File := File; - scanner.ccol := ccol; - scanner.cline := cline; - scanner.ch := ch; - scanner.Lex := Lex; - scanner.count := count; - scanner.coord := coord; - scanner.tLex := tLex; - scanner.vINT := vINT; - scanner.vFLT := vFLT; - scanner.vCHX := vCHX; - scanner.buf := buf; - scanner.bufpos := bufpos; - scanner.CR := CR; - scanner.UTF8 := UTF8 -END Backup; + RETURN node.data(IDENT) +END enterid; -PROCEDURE Recover*(scanner: SCANNER); -BEGIN - File := scanner.File; - ccol := scanner.ccol; - cline := scanner.cline; - ch := scanner.ch; - Lex := scanner.Lex; - count := scanner.count; - coord := scanner.coord; - tLex := scanner.tLex; - vINT := scanner.vINT; - vFLT := scanner.vFLT; - vCHX := scanner.vCHX; - buf := scanner.buf; - bufpos := scanner.bufpos; - CR := scanner.CR; - UTF8 := scanner.UTF8 -END Recover; -PROCEDURE Next; -VAR cr: BOOLEAN; +PROCEDURE putchar (VAR lex: LEX; c: CHAR); BEGIN - cr := FALSE; - sys.GET(bufpos, ch); - INC(ccol); - CASE ch OF - |0AX: IF ~CR THEN INC(cline) END; ccol := 0 - |0DX: INC(cline); ccol := 0; cr := TRUE - |09X: DEC(ccol); ccol := (ccol DIV Tab) * Tab + Tab - |80X..0BFX: IF UTF8 THEN DEC(ccol) END - ELSE - END; - CR := cr; - INC(bufpos) + IF lex.length < LEXLEN - 1 THEN + lex.s[lex.length] := c; + INC(lex.length); + lex.s[lex.length] := 0X + ELSE + lex.over := TRUE + END +END putchar; + + +PROCEDURE ident (text: TEXTDRV.TEXT; VAR lex: LEX); +VAR + c: CHAR; + +BEGIN + c := text.peak(text); + ASSERT(S.letter(c)); + + WHILE S.letter(c) OR S.digit(c) DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text) + END; + + IF lex.over THEN + lex.sym := lxERROR06 + ELSE + lex.sym := lxIDENT; + key(lex) + END; + + IF lex.sym = lxIDENT THEN + lex.ident := enterid(lex.s) + END + +END ident; + + +PROCEDURE number (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); +VAR + c: CHAR; + hex: BOOLEAN; + error: INTEGER; + +BEGIN + c := text.peak(text); + ASSERT(S.digit(c)); + + error := 0; + + range := FALSE; + + lex.sym := lxINTEGER; + hex := FALSE; + + WHILE S.digit(c) DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text) + END; + + WHILE S.hexdigit(c) DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text); + hex := TRUE + END; + + IF c = "H" THEN + putchar(lex, c); + text.nextc(text); + lex.sym := lxHEX + + ELSIF c = "X" THEN + putchar(lex, c); + text.nextc(text); + lex.sym := lxCHAR + + ELSIF c = "." THEN + + IF hex THEN + lex.sym := lxERROR01 + ELSE + + text.nextc(text); + c := text.peak(text); + + IF c # "." THEN + putchar(lex, "."); + lex.sym := lxFLOAT + ELSE + lex.sym := lxINTEGER; + range := TRUE + END; + + WHILE S.digit(c) DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text) + END; + + IF c = "E" THEN + + putchar(lex, c); + text.nextc(text); + c := text.peak(text); + IF (c = "+") OR (c = "-") THEN + putchar(lex, c); + text.nextc(text); + c := text.peak(text) + END; + + IF S.digit(c) THEN + WHILE S.digit(c) DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text) + END + ELSE + lex.sym := lxERROR02 + END + + END + + END + + ELSE + + IF hex THEN + lex.sym := lxERROR01 + END + + END; + + IF lex.over & (lex.sym >= 0) THEN + lex.sym := lxERROR07 + END; + + IF lex.sym = lxINTEGER THEN + ARITH.iconv(lex.s, lex.value, error) + ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN + ARITH.hconv(lex.s, lex.value, error) + ELSIF lex.sym = lxFLOAT THEN + ARITH.fconv(lex.s, lex.value, error) + END; + + CASE error OF + |0: + |1: lex.sym := lxERROR08 + |2: lex.sym := lxERROR09 + |3: lex.sym := lxERROR10 + |4: lex.sym := lxERROR11 + |5: lex.sym := lxERROR12 + END + +END number; + + +PROCEDURE string (text: TEXTDRV.TEXT; VAR lex: LEX); +VAR + c, c1: CHAR; + n: INTEGER; + quot: CHAR; + +BEGIN + quot := text.peak(text); + + ASSERT((quot = '"') OR (quot = "'")); + + text.nextc(text); + c := text.peak(text); + c1 := c; + n := 0; + + WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO + putchar(lex, c); + text.nextc(text); + c := text.peak(text); + INC(n) + END; + + IF c = quot THEN + text.nextc(text); + IF lex.over THEN + lex.sym := lxERROR05 + ELSE + IF n # 1 THEN + lex.sym := lxSTRING + ELSE + lex.sym := lxCHAR; + ARITH.setChar(lex.value, ORD(c1)) + END + END + ELSE + lex.sym := lxERROR03 + END; + + IF lex.sym = lxSTRING THEN + lex.string := enterid(lex.s); + lex.value.typ := ARITH.tSTRING; + lex.value.string := lex.string + END + +END string; + + +PROCEDURE comment (text: TEXTDRV.TEXT); +VAR + c: CHAR; + cond, depth: INTEGER; + +BEGIN + cond := 0; + depth := 1; + + REPEAT + + c := text.peak(text); + text.nextc(text); + + IF c = "*" THEN + IF cond = 1 THEN + cond := 0; + INC(depth) + ELSE + cond := 2 + END + ELSIF c = ")" THEN + IF cond = 2 THEN + DEC(depth) + END; + cond := 0 + ELSIF c = "(" THEN + cond := 1 + ELSE + cond := 0 + END + + UNTIL (depth = 0) OR text.eof + +END comment; + + +PROCEDURE delimiter (text: TEXTDRV.TEXT; VAR lex: LEX; VAR range: BOOLEAN); +VAR + c: CHAR; + +BEGIN + c := text.peak(text); + + IF range THEN + ASSERT(c = ".") + END; + + putchar(lex, c); + text.nextc(text); + + CASE c OF + |"+": + lex.sym := lxPLUS + + |"-": + lex.sym := lxMINUS + + |"*": + lex.sym := lxMUL + + |"/": + lex.sym := lxSLASH; + + IF text.peak(text) = "/" THEN + lex.sym := lxCOMMENT; + REPEAT + text.nextc(text) + UNTIL text.eol OR text.eof + END + + |"~": + lex.sym := lxNOT + + |"&": + lex.sym := lxAND + + |".": + IF range THEN + + putchar(lex, "."); + lex.sym := lxRANGE; + range := FALSE; + DEC(lex.pos.col) + + ELSE + + lex.sym := lxPOINT; + c := text.peak(text); + + IF c = "." THEN + lex.sym := lxRANGE; + putchar(lex, c); + text.nextc(text) + END + + END + + |",": + lex.sym := lxCOMMA + + |";": + lex.sym := lxSEMI + + |"|": + lex.sym := lxBAR + + |"(": + lex.sym := lxLROUND; + c := text.peak(text); + + IF c = "*" THEN + lex.sym := lxCOMMENT; + putchar(lex, c); + text.nextc(text); + comment(text) + END + + |"[": + lex.sym := lxLSQUARE + + |"{": + lex.sym := lxLCURLY + + |"^": + lex.sym := lxCARET + + |"=": + lex.sym := lxEQ + + |"#": + lex.sym := lxNE + + |"<": + lex.sym := lxLT; + c := text.peak(text); + + IF c = "=" THEN + lex.sym := lxLE; + putchar(lex, c); + text.nextc(text) + END + + |">": + lex.sym := lxGT; + c := text.peak(text); + + IF c = "=" THEN + lex.sym := lxGE; + putchar(lex, c); + text.nextc(text) + END + + |":": + lex.sym := lxCOLON; + c := text.peak(text); + + IF c = "=" THEN + lex.sym := lxASSIGN; + putchar(lex, c); + text.nextc(text) + END + + |")": + lex.sym := lxRROUND + + |"]": + lex.sym := lxRSQUARE + + |"}": + lex.sym := lxRCURLY + + END + +END delimiter; + + +PROCEDURE Next* (scanner: SCANNER; VAR lex: LEX); +VAR + c: CHAR; + text: TEXTDRV.TEXT; + +BEGIN + text := scanner.text; + + REPEAT + + c := text.peak(text); + + WHILE S.space(c) DO + text.nextc(text); + c := text.peak(text) + END; + + lex.s[0] := 0X; + lex.length := 0; + lex.sym := lxUNDEF; + lex.pos.line := text.line; + lex.pos.col := text.col; + lex.ident := NIL; + lex.over := FALSE; + + IF S.letter(c) THEN + ident(text, lex) + ELSIF S.digit(c) THEN + number(text, lex, scanner.range) + ELSIF (c = '"') OR (c = "'") THEN + string(text, lex) + ELSIF vocabulary.delimiters[ORD(c)] THEN + delimiter(text, lex, scanner.range) + ELSIF c = 0X THEN + lex.sym := lxEOF; + IF text.eof THEN + INC(lex.pos.col) + END + ELSE + putchar(lex, c); + text.nextc(text); + lex.sym := lxERROR04 + END; + + IF lex.sym < 0 THEN + lex.error := -lex.sym + ELSE + lex.error := 0 + END + + UNTIL lex.sym # lxCOMMENT + END Next; -PROCEDURE Open*(FName: ARRAY OF CHAR; VAR FHandle: INTEGER): BOOLEAN; -VAR n, size: INTEGER; c: CHAR; + +PROCEDURE NewScanner (): SCANNER; +VAR + scan: SCANNER; + citem: C.ITEM; + BEGIN - File := UTILS.OpenF(FName); - FHandle := File; - IF File # 0 THEN - CR := FALSE; - UTF8 := FALSE; - ccol := 0; - cline := 1; - ch := 0X; - size := UTILS.FileSize(File); - buf := UTILS.GetMem(size + 1024); - UTILS.MemErr(buf = 0); - sys.PUT(buf + size, 0X); - n := UTILS.Read(File, buf, size); - UTILS.CloseF(File); - bufpos := buf; - sys.GET(buf, c); - IF c = 0EFX THEN - sys.GET(buf + 1, c); - IF c = 0BBX THEN - sys.GET(buf + 2, c); - IF c = 0BFX THEN - INC(bufpos, 3); - UTF8 := TRUE - END - END - END; - Next - END - RETURN (File # 0) & (n = size) -END Open; - -PROCEDURE Space(ch: CHAR): BOOLEAN; - RETURN (ch <= 20X) & (ch > 0X) -END Space; - -PROCEDURE Letter(ch: CHAR): BOOLEAN; - RETURN (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") OR (ch = "_") -END Letter; - -PROCEDURE Digit*(ch: CHAR): BOOLEAN; - RETURN (ch >= "0") & (ch <= "9") -END Digit; - -PROCEDURE HexDigit*(ch: CHAR): BOOLEAN; - RETURN (ch >= "A") & (ch <= "F") OR (ch >= "0") & (ch <= "9") -END HexDigit; - -PROCEDURE PutChar(ch: CHAR); -BEGIN - Lex[count] := ch; - IF ch # 0X THEN - INC(count) - END -END PutChar; - -PROCEDURE PutNext(ch: CHAR); -BEGIN - PutChar(ch); - Next -END PutNext; - -PROCEDURE Ident; -BEGIN - tLex := lxIDENT; - WHILE Letter(ch) OR Digit(ch) DO - PutNext(ch) - END; - PutChar(0X); - IF count > IDLENGTH THEN - tLex := lxERR10 - END -END Ident; - -PROCEDURE hex*(ch: CHAR): INTEGER; -VAR Res: INTEGER; -BEGIN - Res := ORD(ch); - CASE ch OF - |"0".."9": DEC(Res, ORD("0")) - |"A".."F": DEC(Res, ORD("A") - 10) - ELSE - END - RETURN Res -END hex; - -PROCEDURE StrToInt16(str: UTILS.STRING): INTEGER; -VAR i, res, n: INTEGER; flag: BOOLEAN; -BEGIN - res := 0; - i := 0; - n := 0; - WHILE str[i] = "0" DO - INC(i) - END; - flag := TRUE; - WHILE flag & (str[i] # "X") & (str[i] # "H") DO - INC(n); - IF n > 8 THEN - tLex := lxERR5; - flag := FALSE + citem := C.pop(scanners); + IF citem = NIL THEN + NEW(scan) ELSE - res := LSL(res, 4) + hex(str[i]); - INC(i) + scan := citem(SCANNER) END - END - RETURN res -END StrToInt16; -PROCEDURE StrToChx(str: UTILS.STRING): CHAR; -VAR res: INTEGER; -BEGIN - res := StrToInt16(str); - IF (res < 0) OR (res > 0FFH) THEN - tLex := lxERR6; - res := 0 - END - RETURN CHR(res) -END StrToChx; + RETURN scan +END NewScanner; + + +PROCEDURE open* (name: ARRAY OF CHAR): SCANNER; +VAR + scanner: SCANNER; + text: TEXTDRV.TEXT; -PROCEDURE StrToInt*(str: UTILS.STRING): INTEGER; -VAR i, res: INTEGER; flag: BOOLEAN; BEGIN - res := 0; - i := 0; - flag := TRUE; - WHILE flag & (str[i] # 0X) DO - IF res > maxINT DIV 10 THEN - tLex := lxERR5; - flag := FALSE; - res := 0 + text := TEXTDRV.create(); + IF text.open(text, name) THEN + scanner := NewScanner(); + scanner.text := text; + scanner.range := FALSE ELSE - res := res * 10; - IF res > maxINT - (ORD(str[i]) - ORD("0")) THEN - tLex := lxERR5; - flag := FALSE; - res := 0 - ELSE - res := res + (ORD(str[i]) - ORD("0")); - INC(i) - END + scanner := NIL; + TEXTDRV.destroy(text) END - END - RETURN res -END StrToInt; -PROCEDURE StrToFloat(str: UTILS.STRING): LONGREAL; -VAR i, scale: INTEGER; res, m, d: LONGREAL; minus, nez: BOOLEAN; + RETURN scanner +END open; - PROCEDURE Error(e: INTEGER; VAR cont: BOOLEAN); - BEGIN - tLex := e; - res := 0.0D0; - cont := FALSE - END Error; - - PROCEDURE Inf(VAR cont: BOOLEAN; VAR i: INTEGER); - BEGIN - IF UTILS.IsInf(res) THEN - Error(lxERR7, cont) - END; - INC(i) - END Inf; - - PROCEDURE part1(): BOOLEAN; - VAR cont: BOOLEAN; - BEGIN - res := 0.0D0; - i := 0; - d := 1.0D0; - nez := FALSE; - cont := TRUE; - WHILE cont & Digit(str[i]) DO - nez := nez OR (str[i] # "0"); - res := res * 10.0D0 + LONG(FLT(ORD(str[i]) - ORD("0"))); - Inf(cont, i) - END - RETURN cont - END part1; - - PROCEDURE part2(): BOOLEAN; - VAR cont: BOOLEAN; - BEGIN - INC(i); - cont := TRUE; - WHILE cont & Digit(str[i]) DO - nez := nez OR (str[i] # "0"); - d := d / 10.0D0; - res := res + LONG(FLT(ORD(str[i]) - ORD("0"))) * d; - Inf(cont, i) - END - RETURN cont - END part2; - - PROCEDURE part3(): BOOLEAN; - VAR cont: BOOLEAN; - BEGIN - cont := TRUE; - IF str[i] = 0X THEN - IF res > LONG(maxREAL) THEN - Error(lxERR7, cont) - ELSIF nez & ((res = 0.0D0) OR (res < LONG(minREAL)) & (tLex = lxREAL)) THEN - Error(lxERR9, cont) - END - END - RETURN cont - END part3; - - PROCEDURE part4(): BOOLEAN; - VAR cont: BOOLEAN; - BEGIN - IF str[i] = "D" THEN - tLex := lxLONGREAL - END; - INC(i); - m := 10.0D0; - minus := FALSE; - IF str[i] = "+" THEN - INC(i) - ELSIF str[i] = "-" THEN - minus := TRUE; - INC(i); - m := 0.1D0 - END; - scale := 0; - cont := TRUE; - WHILE cont & Digit(str[i]) DO - IF scale > maxINT DIV 10 THEN - Error(lxERR8, cont) - ELSE - scale := scale * 10; - IF scale > maxINT - (ORD(str[i]) - ORD("0")) THEN - Error(lxERR8, cont) - ELSE - scale := scale + (ORD(str[i]) - ORD("0")); - INC(i) - END - END - END - RETURN cont - END part4; - - PROCEDURE part5(): BOOLEAN; - VAR cont: BOOLEAN; i: INTEGER; - BEGIN - cont := TRUE; - IF scale = maxINT THEN - Error(lxERR8, cont) - END; - i := 1; - WHILE cont & (i <= scale) DO - res := res * m; - Inf(cont, i) - END; - IF cont & (nez & (res = 0.0D0) OR (res > 0.0D0) & (res < LONG(minREAL)) & (tLex = lxREAL)) THEN - Error(lxERR9, cont) - ELSIF cont & (tLex = lxREAL) & (res > LONG(maxREAL)) THEN - Error(lxERR7, cont) - END - RETURN cont - END part5; +PROCEDURE close* (VAR scanner: SCANNER); BEGIN - IF part1() & part2() & part3() & part4() & part5() THEN END - RETURN res -END StrToFloat; - -PROCEDURE Number; -VAR nextchr: CHAR; -BEGIN - tLex := lxINT; - WHILE Digit(ch) DO - PutNext(ch) - END; - IF ch = "H" THEN - tLex := lxHEX - ELSIF ch = "X" THEN - tLex := lxCHX - END; - IF tLex # lxINT THEN - PutNext(ch) - ELSE - WHILE HexDigit(ch) DO - tLex := lxHEX; - PutNext(ch) - END; - IF tLex = lxHEX THEN - IF ch = "H" THEN - PutNext(ch) - ELSIF ch = "X" THEN - tLex := lxCHX; - PutNext(ch) - ELSE - tLex := lxERR1 - END - ELSIF ch = "." THEN - sys.GET(bufpos, nextchr); - IF nextchr # "." THEN - tLex := lxREAL; - PutNext(ch); - WHILE Digit(ch) DO - PutNext(ch) + IF scanner # NIL THEN + IF scanner.text # NIL THEN + TEXTDRV.destroy(scanner.text) END; - IF (ch = "E") OR (ch = "D") THEN - PutNext(ch); - IF (ch = "+") OR (ch = "-") THEN - PutNext(ch) - END; - IF ~Digit(ch) THEN - tLex := lxERR2 - ELSE - WHILE Digit(ch) DO - PutNext(ch) - END - END - END - END + + C.push(scanners, scanner); + scanner := NIL END - END; - PutChar(0X) -END Number; +END close; -PROCEDURE Delim(ch: CHAR): INTEGER; -VAR Res: INTEGER; -BEGIN - CASE ch OF - |"+": Res := lxPlus - |"-": Res := lxMinus - |"*": Res := lxMult - |"/": Res := lxSlash - |"~": Res := lxNot - |"&": Res := lxAnd - |",": Res := lxComma - |";": Res := lxSemi - |"|": Res := lxStick - |"[": Res := lxLSquare - |"{": Res := lxLCurly - |"^": Res := lxCaret - |"=": Res := lxEQ - |"#": Res := lxNE - |")": Res := lxRRound - |"]": Res := lxRSquare - |"}": Res := lxRCurly - |">": Res := lxGT - |"<": Res := lxLT - |":": Res := lxColon - ELSE - END - RETURN Res -END Delim; -PROCEDURE Comment; -VAR c, level: INTEGER; cont: BOOLEAN; -BEGIN - c := 1; - level := 1; - cont := TRUE; - WHILE cont & (level > 0) DO - Next; - CASE ch OF - |"(": c := 2 - |")": IF c = 3 THEN DEC(level) END; c := 1 - |"*": IF c = 2 THEN INC(level); c := 1 ELSE c := 3 END - |0X : cont := FALSE - ELSE - c := 1 - END; - END; - IF cont THEN - Next - END -END Comment; +PROCEDURE init; +VAR + i: INTEGER; + delim: ARRAY 23 OF CHAR; -PROCEDURE GetLex*; -BEGIN - WHILE Space(ch) DO - Next - END; - coord.col := ccol; - coord.line := cline; - count := 0; - CASE ch OF - |"A".."Z", "a".."z", "_": - Ident; - id := AddNode(Lex); - tLex := id.tLex; - |"0".."9": - Number; - CASE tLex OF - |lxINT: vINT := StrToInt(Lex) - |lxHEX: vINT := StrToInt16(Lex) - |lxCHX: vCHX := StrToChx(Lex) - |lxREAL: vFLT := StrToFloat(Lex) - ELSE - END - |22X: - tLex := lxSTRING; - Next; - WHILE (ch # 22X) & (ch >= 20X) DO - PutNext(ch) - END; - IF ch = 22X THEN - Next - ELSE - tLex := lxERR3 - END; - PutChar(0X); - INC(count); - IF count > STRLENGTH THEN - tLex := lxERR11 - END - |"/": - tLex := Delim(ch); - PutNext(ch); - IF ch = "/" THEN - WHILE (ch >= 20X) OR (ch = 9X) DO - PutNext(ch) - END; - GetLex - END; - PutChar(0X) - |">", "<", ":": - tLex := Delim(ch); - PutNext(ch); - IF ch = "=" THEN - CASE tLex OF - |lxLT: tLex := lxLE - |lxGT: tLex := lxGE - |lxColon: tLex := lxAssign - ELSE - END; - PutNext(ch) - END; - PutChar(0X) - |".": - tLex := lxDot; - PutNext(ch); - IF ch = "." THEN - tLex := lxDbl; - PutNext(ch) - END; - PutChar(0X) - |"(": - tLex := lxLRound; - PutNext(ch); - IF ch = "*" THEN - Comment; - GetLex - END; - PutChar(0X) - |"+", "-", "*", "~", "&", ",", ";", "|", - "[", "{", "^", "=", "#", ")", "]", "}": - tLex := Delim(ch); - PutChar(ch); - PutNext(0X) - |0X: - tLex := lxEOF; - PutChar(0X) - ELSE - tLex := lxERR4 - END -END GetLex; - -PROCEDURE AddNodeKey(Name: UTILS.STRING; key: INTEGER); -VAR node: NODE; -BEGIN - node := AddNode(Name); - node.tLex := key -END AddNodeKey; - -PROCEDURE Init; -VAR i: INTEGER; node: NODE; -BEGIN - FOR i := 0 TO LEN(Nodes) - 1 DO - NEW(node); - UTILS.MemErr(node = NIL); - sys.PUT(sys.ADR(node.Name), i); - node.Left := NIL; - node.Right := NIL; - node.tLex := lxIDENT; - Nodes[i] := node - END; - _START := AddNode("lib_init"); - _version := AddNode("version"); - AddNodeKey("MOD", lxMOD); - AddNodeKey("ELSE", lxELSE); - AddNodeKey("RETURN", lxRETURN); - AddNodeKey("CASE", lxCASE); - AddNodeKey("IF", lxIF); - AddNodeKey("POINTER", lxPOINTER); - AddNodeKey("TYPE", lxTYPE); - AddNodeKey("BEGIN", lxBEGIN); - AddNodeKey("DIV", lxDIV); - AddNodeKey("FALSE", lxFALSE); - AddNodeKey("IN", lxIN); - AddNodeKey("NIL", lxNIL); - AddNodeKey("RECORD", lxRECORD); - AddNodeKey("TO", lxTO); - AddNodeKey("VAR", lxVAR); - AddNodeKey("ARRAY", lxARRAY); - AddNodeKey("DO", lxDO); - AddNodeKey("END", lxEND); - AddNodeKey("IS", lxIS); - AddNodeKey("OF", lxOF); - AddNodeKey("PROCEDURE", lxPROCEDURE); - AddNodeKey("THEN", lxTHEN); - AddNodeKey("WHILE", lxWHILE); - AddNodeKey("BY", lxBY); - AddNodeKey("CONST", lxCONST); - AddNodeKey("ELSIF", lxELSIF); - AddNodeKey("IMPORT", lxIMPORT); - AddNodeKey("MODULE", lxMODULE); - AddNodeKey("OR", lxOR); - AddNodeKey("REPEAT", lxREPEAT); - AddNodeKey("TRUE", lxTRUE); - AddNodeKey("UNTIL", lxUNTIL); - AddNodeKey("FOR", lxFOR) -END Init; + PROCEDURE enterkw (VAR i: INTEGER; kw: KEYWORD); + BEGIN + vocabulary.KW[i] := kw; + INC(i) + END enterkw; BEGIN - Init + scanners := C.create(); + + FOR i := 0 TO 255 DO + vocabulary.delimiters[i] := FALSE + END; + + delim := "+-*/~&.,;|([{^=#<>:)]}"; + + FOR i := 0 TO LEN(delim) - 2 DO + vocabulary.delimiters[ORD(delim[i])] := TRUE + END; + + i := 0; + enterkw(i, "ARRAY"); + enterkw(i, "BEGIN"); + enterkw(i, "BY"); + enterkw(i, "CASE"); + enterkw(i, "CONST"); + enterkw(i, "DIV"); + enterkw(i, "DO"); + enterkw(i, "ELSE"); + enterkw(i, "ELSIF"); + enterkw(i, "END"); + enterkw(i, "FALSE"); + enterkw(i, "FOR"); + enterkw(i, "IF"); + enterkw(i, "IMPORT"); + enterkw(i, "IN"); + enterkw(i, "IS"); + enterkw(i, "MOD"); + enterkw(i, "MODULE"); + enterkw(i, "NIL"); + enterkw(i, "OF"); + enterkw(i, "OR"); + enterkw(i, "POINTER"); + enterkw(i, "PROCEDURE"); + enterkw(i, "RECORD"); + enterkw(i, "REPEAT"); + enterkw(i, "RETURN"); + enterkw(i, "THEN"); + enterkw(i, "TO"); + enterkw(i, "TRUE"); + enterkw(i, "TYPE"); + enterkw(i, "UNTIL"); + enterkw(i, "VAR"); + enterkw(i, "WHILE"); + + NEW(vocabulary.ident); + vocabulary.ident.s := ""; + vocabulary.ident.offset := -1; + vocabulary.ident.offsetW := -1; + vocabulary.idents := NIL +END init; + + +BEGIN + init END SCAN. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/STATEMENTS.ob07 b/programs/develop/oberon07/Source/STATEMENTS.ob07 new file mode 100644 index 0000000000..e279c8b53b --- /dev/null +++ b/programs/develop/oberon07/Source/STATEMENTS.ob07 @@ -0,0 +1,3297 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. +*) + +MODULE STATEMENTS; + +IMPORT + + PARS, PROG, SCAN, ARITH, STRINGS, LISTS, CODE, X86, AMD64, + ERRORS, MACHINE, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS; + + +CONST + + eCONST = PARS.eCONST; eTYPE = PARS.eTYPE; eVAR = PARS.eVAR; + eEXPR = PARS.eEXPR; eVREC = PARS.eVREC; ePROC = PARS.ePROC; + eVPAR = PARS.eVPAR; ePARAM = PARS.ePARAM; eSTPROC = PARS.eSTPROC; + eSTFUNC = PARS.eSTFUNC; eSYSFUNC = PARS.eSYSFUNC; eSYSPROC = PARS.eSYSPROC; + eIMP = PARS.eIMP; + + errASSERT = 1; errPTR = 2; errDIV = 3; errPROC = 4; + errGUARD = 5; errIDX = 6; errCASE = 7; errCOPY = 8; + errCHR = 9; errWCHR = 10; errBYTE = 11; + + chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5; + + chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE}; + + +TYPE + + isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN; + + RANGE = RECORD + + a, b: INTEGER + + END; + + CASE_LABEL = POINTER TO rCASE_LABEL; + + rCASE_LABEL = RECORD (AVL.DATA) + + range: RANGE; + + variant, self: INTEGER; + + type: PROG.TYPE_; + + prev: CASE_LABEL + + END; + + CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM) + + label: INTEGER; + cmd: CODE.COMMAND; + processed: BOOLEAN + + END; + + +VAR + + begcall, endcall: CODE.COMMAND; + + checking: SET; + + CaseLabels, CaseVar: C.COLLECTION; + + CaseVariants: LISTS.LIST; + + +PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN; + RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC} +END isExpr; + + +PROCEDURE isVar (e: PARS.EXPR): BOOLEAN; + RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC} +END isVar; + + +PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tBOOLEAN) +END isBoolean; + + +PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tINTEGER) +END isInteger; + + +PROCEDURE isByte (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tBYTE) +END isByte; + + +PROCEDURE isInt (e: PARS.EXPR): BOOLEAN; + RETURN isByte(e) OR isInteger(e) +END isInt; + + +PROCEDURE isReal (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tREAL) +END isReal; + + +PROCEDURE isSet (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tSET) +END isSet; + + +PROCEDURE isString (e: PARS.EXPR): BOOLEAN; + RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR}) +END isString; + + +PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN; + RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR}) +END isStringW; + + +PROCEDURE isChar (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tCHAR) +END isChar; + + +PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tCHAR) +END isCharArray; + + +PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tWCHAR) +END isCharW; + + +PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ = PROG.tWCHAR) +END isCharArrayW; + + +PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) & (e.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) +END isCharArrayX; + + +PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER) +END isPtr; + + +PROCEDURE isRec (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tRECORD) +END isRec; + + +PROCEDURE isArr (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tARRAY) +END isArr; + + +PROCEDURE isProc (e: PARS.EXPR): BOOLEAN; + RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP}) +END isProc; + + +PROCEDURE isNil (e: PARS.EXPR): BOOLEAN; + RETURN e.type.typ = PROG.tNIL +END isNil; + + +PROCEDURE getpos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); +BEGIN + pos := parser.lex.pos +END getpos; + + +PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: SCAN.POSITION); +BEGIN + PARS.NextPos(parser, pos) +END NextPos; + + +PROCEDURE strlen (e: PARS.EXPR): INTEGER; +VAR + res: INTEGER; + +BEGIN + ASSERT(isString(e)); + IF e.type.typ = PROG.tCHAR THEN + res := 1 + ELSE + res := LENGTH(e.value.string(SCAN.IDENT).s) + END + RETURN res +END strlen; + + +PROCEDURE _length (s: ARRAY OF CHAR): INTEGER; +VAR + i, res: INTEGER; + +BEGIN + i := 0; + res := 0; + WHILE (i < LEN(s)) & (s[i] # 0X) DO + IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN + INC(res) + END; + INC(i) + END + + RETURN res +END _length; + + +PROCEDURE utf8strlen (e: PARS.EXPR): INTEGER; +VAR + res: INTEGER; + +BEGIN + ASSERT(isStringW(e)); + IF e.type.typ IN {PROG.tCHAR, PROG.tWCHAR} THEN + res := 1 + ELSE + res := _length(e.value.string(SCAN.IDENT).s) + END + RETURN res +END utf8strlen; + + +PROCEDURE StrToWChar (s: ARRAY OF CHAR): INTEGER; +VAR + res: ARRAY 2 OF WCHAR; + +BEGIN + ASSERT(STRINGS.Utf8To16(s, res) = 1) + RETURN ORD(res[0]) +END StrToWChar; + + +PROCEDURE isStringW1 (e: PARS.EXPR): BOOLEAN; + RETURN (e.obj = eCONST) & isString(e) & (utf8strlen(e) = 1) & (strlen(e) > 1) +END isStringW1; + + +PROCEDURE assigncomp (e: PARS.EXPR; t: PROG.TYPE_): BOOLEAN; +VAR + res: BOOLEAN; + + + PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; + RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & + ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & + PROG.isTypeEq(src.base, dst.base) + END arrcomp; + + +BEGIN + IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN + IF arrcomp(e.type, t) THEN + res := TRUE + ELSIF isInt(e) & (t.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN + IF (e.obj = eCONST) & (t.typ = PROG.tBYTE) THEN + res := ARITH.range(e.value, 0, 255) + ELSE + res := TRUE + END + ELSIF isSet(e) & (t.typ = PROG.tSET) THEN + res := TRUE + ELSIF isBoolean(e) & (t.typ = PROG.tBOOLEAN) THEN + res := TRUE + ELSIF isReal(e) & (t.typ = PROG.tREAL) THEN + res := TRUE + ELSIF isChar(e) & (t.typ = PROG.tCHAR) THEN + res := TRUE + ELSIF (e.obj = eCONST) & isChar(e) & (t.typ = PROG.tWCHAR) THEN + res := TRUE + ELSIF isStringW1(e) & (t.typ = PROG.tWCHAR) THEN + res := TRUE + ELSIF isCharW(e) & (t.typ = PROG.tWCHAR) THEN + res := TRUE + ELSIF PROG.isBaseOf(t, e.type) THEN + res := TRUE + ELSIF ~PROG.isOpenArray(t) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(t, e.type) THEN + res := TRUE + ELSIF isNil(e) & (t.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN + res := TRUE + ELSIF isString(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tCHAR) & (t.length > strlen(e))) THEN + res := TRUE + ELSIF isStringW(e) & ((t.typ = PROG.tARRAY) & (t.base.typ = PROG.tWCHAR) & (t.length > utf8strlen(e))) THEN + res := TRUE + ELSE + res := FALSE + END + ELSE + res := FALSE + END + RETURN res +END assigncomp; + + +PROCEDURE String (e: PARS.EXPR): INTEGER; +VAR + offset: INTEGER; + string: SCAN.IDENT; + +BEGIN + IF strlen(e) # 1 THEN + string := e.value.string(SCAN.IDENT); + IF string.offset = -1 THEN + string.offset := CODE.putstr(string.s); + END; + offset := string.offset + ELSE + offset := CODE.putstr1(ARITH.Int(e.value)) + END + + RETURN offset +END String; + + +PROCEDURE StringW (e: PARS.EXPR): INTEGER; +VAR + offset: INTEGER; + string: SCAN.IDENT; + +BEGIN + IF utf8strlen(e) # 1 THEN + string := e.value.string(SCAN.IDENT); + IF string.offsetW = -1 THEN + string.offsetW := CODE.putstrW(string.s); + END; + offset := string.offsetW + ELSE + IF e.type.typ IN {PROG.tWCHAR, PROG.tCHAR} THEN + offset := CODE.putstrW1(ARITH.Int(e.value)) + ELSE (* e.type.typ = PROG.tSTRING *) + string := e.value.string(SCAN.IDENT); + IF string.offsetW = -1 THEN + string.offsetW := CODE.putstrW(string.s); + END; + offset := string.offsetW + END + END + + RETURN offset +END StringW; + + +PROCEDURE CheckRange (range, line, errno: INTEGER); +VAR + label: INTEGER; + +BEGIN + label := CODE.NewLabel(); + CODE.AddCmd2(CODE.opCHKIDX, label, range); + CODE.OnError(line, errno); + CODE.SetLabel(label) +END CheckRange; + + +PROCEDURE assign (e: PARS.EXPR; VarType: PROG.TYPE_; line: INTEGER): BOOLEAN; +VAR + res: BOOLEAN; + label: INTEGER; + + + PROCEDURE arrcomp (src, dst: PROG.TYPE_): BOOLEAN; + RETURN (dst.typ = PROG.tARRAY) & PROG.isOpenArray(src) & + ~PROG.isOpenArray(src.base) & ~PROG.isOpenArray(dst.base) & + PROG.isTypeEq(src.base, dst.base) + END arrcomp; + + +BEGIN + IF isExpr(e) OR (e.obj IN {ePROC, eIMP}) THEN + res := TRUE; + IF arrcomp(e.type, VarType) THEN + + IF ~PROG.isOpenArray(VarType) THEN + CODE.AddCmd(CODE.opCONST, VarType.length) + END; + CODE.AddCmd(CODE.opCOPYA, VarType.base.size); + label := CODE.NewLabel(); + CODE.AddJmpCmd(CODE.opJE, label); + CODE.OnError(line, errCOPY); + CODE.SetLabel(label) + + ELSIF isInt(e) & (VarType.typ IN {PROG.tBYTE, PROG.tINTEGER}) THEN + IF VarType.typ = PROG.tINTEGER THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSAVE) + END + ELSE + IF e.obj = eCONST THEN + res := ARITH.range(e.value, 0, 255); + IF res THEN + CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) + END + ELSE + IF chkBYTE IN checking THEN + label := CODE.NewLabel(); + CODE.AddCmd2(CODE.opCHKBYTE, label, 0); + CODE.OnError(line, errBYTE); + CODE.SetLabel(label) + END; + CODE.AddCmd0(CODE.opSAVE8) + END + END + ELSIF isSet(e) & (VarType.typ = PROG.tSET) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSAVE) + END + ELSIF isBoolean(e) & (VarType.typ = PROG.tBOOLEAN) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSBOOLC, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSBOOL) + END + ELSIF isReal(e) & (VarType.typ = PROG.tREAL) THEN + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)) + END; + CODE.savef + ELSIF isChar(e) & (VarType.typ = PROG.tCHAR) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSAVE8C, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSAVE8) + END + ELSIF (e.obj = eCONST) & isChar(e) & (VarType.typ = PROG.tWCHAR) THEN + CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) + ELSIF isStringW1(e) & (VarType.typ = PROG.tWCHAR) THEN + CODE.AddCmd(CODE.opSAVE16C, StrToWChar(e.value.string(SCAN.IDENT).s)) + ELSIF isCharW(e) & (VarType.typ = PROG.tWCHAR) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSAVE16C, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSAVE16) + END + ELSIF PROG.isBaseOf(VarType, e.type) THEN + IF VarType.typ = PROG.tPOINTER THEN + CODE.AddCmd0(CODE.opSAVE) + ELSE + CODE.AddCmd(CODE.opCOPY, VarType.size) + END + ELSIF (e.type.typ = PROG.tCARD32) & (VarType.typ = PROG.tCARD32) THEN + CODE.AddCmd0(CODE.opSAVE32) + ELSIF (e.type.typ = PROG.tCARD16) & (VarType.typ = PROG.tCARD16) THEN + CODE.AddCmd0(CODE.opSAVE16) + ELSIF ~PROG.isOpenArray(VarType) & ~PROG.isOpenArray(e.type) & PROG.isTypeEq(VarType, e.type) THEN + IF e.obj = ePROC THEN + CODE.AssignProc(e.ident.proc.label) + ELSIF e.obj = eIMP THEN + CODE.AssignImpProc(e.ident.import) + ELSE + IF VarType.typ = PROG.tPROCEDURE THEN + CODE.AddCmd0(CODE.opSAVE) + ELSE + CODE.AddCmd(CODE.opCOPY, VarType.size) + END + END + ELSIF isNil(e) & (VarType.typ IN {PROG.tPOINTER, PROG.tPROCEDURE}) THEN + CODE.AddCmd(CODE.opSAVEC, 0) + ELSIF isString(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tCHAR) & (VarType.length > strlen(e))) THEN + CODE.saves(String(e), strlen(e) + 1) + ELSIF isStringW(e) & ((VarType.typ = PROG.tARRAY) & (VarType.base.typ = PROG.tWCHAR) & (VarType.length > utf8strlen(e))) THEN + CODE.saves(StringW(e), (utf8strlen(e) + 1) * 2) + ELSE + res := FALSE + END + ELSE + res := FALSE + END + RETURN res +END assign; + + +PROCEDURE LoadConst (e: PARS.EXPR); +BEGIN + CODE.AddCmd(CODE.opCONST, ARITH.Int(e.value)) +END LoadConst; + + +PROCEDURE paramcomp (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR; p: PROG.PARAM); + + PROCEDURE arrcomp (e: PARS.EXPR; p: PROG.PARAM): BOOLEAN; + VAR + t1, t2: PROG.TYPE_; + + BEGIN + t1 := p.type; + t2 := e.type; + WHILE (t2.typ = PROG.tARRAY) & PROG.isOpenArray(t1) DO + t1 := t1.base; + t2 := t2.base + END + + RETURN PROG.isTypeEq(t1, t2) + END arrcomp; + + + PROCEDURE ArrLen (t: PROG.TYPE_; n: INTEGER): INTEGER; + VAR + res: INTEGER; + BEGIN + REPEAT + res := t.length; + t := t.base; + DEC(n) + UNTIL (n < 0) OR (t.typ # PROG.tARRAY); + ASSERT(n < 0) + RETURN res + END ArrLen; + + + PROCEDURE OpenArray (t, t2: PROG.TYPE_); + VAR + n: INTEGER; + d1, d2: INTEGER; + BEGIN + IF t.length # 0 THEN + CODE.AddCmd(CODE.opPARAM, 1); + n := PROG.Dim(t2) - 1; + WHILE n >= 0 DO + CODE.AddCmd(CODE.opCONST, ArrLen(t, n)); + CODE.AddCmd(CODE.opPARAM, 1); + DEC(n) + END + ELSE + d1 := PROG.Dim(t); + d2 := PROG.Dim(t2); + IF d1 # d2 THEN + n := d2 - d1; + WHILE d2 > d1 DO + CODE.AddCmd(CODE.opCONST, ArrLen(t, d2 - 1)); + DEC(d2) + END; + d2 := PROG.Dim(t2); + WHILE n > 0 DO + CODE.AddCmd(CODE.opROT, d2); + DEC(n) + END + END; + CODE.AddCmd(CODE.opPARAM, PROG.Dim(t2) + 1) + END + END OpenArray; + + +BEGIN + IF p.vPar THEN + + PARS.check(isVar(e), parser, pos, 93); + IF p.type.typ = PROG.tRECORD THEN + PARS.check(PROG.isBaseOf(p.type, e.type), parser, pos, 66); + IF e.obj = eVREC THEN + IF e.ident # NIL THEN + CODE.AddCmd(CODE.opVADR, e.ident.offset - 1) + ELSE + CODE.AddCmd0(CODE.opPUSHT) + END + ELSE + CODE.AddCmd(CODE.opCONST, e.type.num) + END; + CODE.AddCmd(CODE.opPARAM, 2) + ELSIF PROG.isOpenArray(p.type) THEN + PARS.check(arrcomp(e, p), parser, pos, 66); + OpenArray(e.type, p.type) + ELSE + PARS.check(PROG.isTypeEq(e.type, p.type), parser, pos, 66); + CODE.AddCmd(CODE.opPARAM, 1) + END; + PARS.check(~e.readOnly, parser, pos, 94) + + ELSE + PARS.check(isExpr(e) OR isProc(e), parser, pos, 66); + IF PROG.isOpenArray(p.type) THEN + IF e.type.typ = PROG.tARRAY THEN + PARS.check(arrcomp(e, p), parser, pos, 66); + OpenArray(e.type, p.type) + ELSIF isString(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tCHAR) THEN + CODE.AddCmd(CODE.opSADR, String(e)); + CODE.AddCmd(CODE.opPARAM, 1); + CODE.AddCmd(CODE.opCONST, strlen(e) + 1); + CODE.AddCmd(CODE.opPARAM, 1) + ELSIF isStringW(e) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ = PROG.tWCHAR) THEN + CODE.AddCmd(CODE.opSADR, StringW(e)); + CODE.AddCmd(CODE.opPARAM, 1); + CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); + CODE.AddCmd(CODE.opPARAM, 1) + ELSE + PARS.error(parser, pos, 66) + END + ELSE + PARS.check(~PROG.isOpenArray(e.type), parser, pos, 66); + PARS.check(assigncomp(e, p.type), parser, pos, 66); + IF e.obj = eCONST THEN + IF e.type.typ = PROG.tREAL THEN + CODE.Float(ARITH.Float(e.value)); + CODE.pushf + ELSIF e.type.typ = PROG.tNIL THEN + CODE.AddCmd(CODE.opCONST, 0); + CODE.AddCmd(CODE.opPARAM, 1) + ELSIF isStringW1(e) & (p.type.typ = PROG.tWCHAR) THEN + CODE.AddCmd(CODE.opCONST, StrToWChar(e.value.string(SCAN.IDENT).s)); + CODE.AddCmd(CODE.opPARAM, 1) + ELSIF (e.type.typ = PROG.tSTRING) OR + (e.type.typ IN {PROG.tCHAR, PROG.tWCHAR}) & (p.type.typ = PROG.tARRAY) & (p.type.base.typ IN {PROG.tCHAR, PROG.tWCHAR}) THEN + CODE.SetMinDataSize(p.type.size); + IF p.type.base.typ = PROG.tCHAR THEN + CODE.AddCmd(CODE.opSADR, String(e)) + ELSE (* WCHAR *) + CODE.AddCmd(CODE.opSADR, StringW(e)) + END; + CODE.AddCmd(CODE.opPARAM, 1) + ELSE + LoadConst(e); + CODE.AddCmd(CODE.opPARAM, 1) + END + ELSIF e.obj = ePROC THEN + PARS.check(e.ident.global, parser, pos, 85); + CODE.PushProc(e.ident.proc.label); + CODE.AddCmd(CODE.opPARAM, 1) + ELSIF e.obj = eIMP THEN + CODE.PushImpProc(e.ident.import); + CODE.AddCmd(CODE.opPARAM, 1) + ELSIF isExpr(e) & (e.type.typ = PROG.tREAL) THEN + CODE.pushf + ELSE + IF (p.type.typ = PROG.tBYTE) & (e.type.typ = PROG.tINTEGER) & (chkBYTE IN checking) THEN + CheckRange(256, pos.line, errBYTE) + END; + CODE.AddCmd(CODE.opPARAM, 1) + END + END + + END +END paramcomp; + + +PROCEDURE stProc (parser: PARS.PARSER; VAR e: PARS.EXPR); +VAR + e2: PARS.EXPR; + pos: SCAN.POSITION; + proc: INTEGER; + label: INTEGER; + n, i: INTEGER; + code: ARITH.VALUE; + e1: PARS.EXPR; + wchar: BOOLEAN; + cmd1, + cmd2: CODE.COMMAND; + + + PROCEDURE varparam (parser: PARS.PARSER; pos: SCAN.POSITION; isfunc: isXXX; readOnly: BOOLEAN; VAR e: PARS.EXPR); + BEGIN + parser.designator(parser, e); + PARS.check(isVar(e), parser, pos, 93); + PARS.check(isfunc(e), parser, pos, 66); + IF readOnly THEN + PARS.check(~e.readOnly, parser, pos, 94) + END + END varparam; + + + PROCEDURE shift_minmax (proc: INTEGER): CHAR; + VAR + res: CHAR; + BEGIN + CASE proc OF + |PROG.stASR: res := "A" + |PROG.stLSL: res := "L" + |PROG.stROR: res := "O" + |PROG.stLSR: res := "R" + |PROG.stMIN: res := "m" + |PROG.stMAX: res := "x" + END + RETURN res + END shift_minmax; + + +BEGIN + ASSERT(e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC}); + + getpos(parser, pos); + proc := e.stproc; + + IF e.obj IN {eSYSPROC, eSYSFUNC} THEN + IF parser.unit.scopeLvl > 0 THEN + parser.unit.scopes[parser.unit.scopeLvl].enter(CODE.COMMAND).allocReg := FALSE + END + END; + + IF e.obj IN {eSTPROC, eSYSPROC} THEN + + CASE proc OF + |PROG.stASSERT: + parser.expression(parser, e); + PARS.check(isBoolean(e), parser, pos, 66); + IF e.obj = eCONST THEN + IF ~ARITH.getBool(e.value) THEN + CODE.OnError(pos.line, errASSERT) + END + ELSE + label := CODE.NewLabel(); + CODE.AddJmpCmd(CODE.opJE, label); + CODE.OnError(pos.line, errASSERT); + CODE.SetLabel(label) + END + + |PROG.stINC, PROG.stDEC: + CODE.pushBegEnd(begcall, endcall); + varparam(parser, pos, isInt, TRUE, e); + IF e.type.typ = PROG.tINTEGER THEN + IF parser.sym = SCAN.lxCOMMA THEN + NextPos(parser, pos); + CODE.setlast(begcall); + parser.expression(parser, e2); + CODE.setlast(endcall.prev(CODE.COMMAND)); + PARS.check(isInt(e2), parser, pos, 66); + IF e2.obj = eCONST THEN + CODE.AddCmd(CODE.opINCC + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) + ELSE + CODE.AddCmd0(CODE.opINC + ORD(proc = PROG.stDEC)) + END + ELSE + CODE.AddCmd0(CODE.opINC1 + ORD(proc = PROG.stDEC)) + END + ELSE (* e.type.typ = PROG.tBYTE *) + IF parser.sym = SCAN.lxCOMMA THEN + NextPos(parser, pos); + CODE.setlast(begcall); + parser.expression(parser, e2); + CODE.setlast(endcall.prev(CODE.COMMAND)); + PARS.check(isInt(e2), parser, pos, 66); + IF e2.obj = eCONST THEN + CODE.AddCmd(CODE.opINCCB + ORD(proc = PROG.stDEC), ARITH.Int(e2.value)) + ELSE + CODE.AddCmd0(CODE.opINCB + ORD(proc = PROG.stDEC)) + END + ELSE + CODE.AddCmd0(CODE.opINC1B + ORD(proc = PROG.stDEC)) + END + END; + CODE.popBegEnd(begcall, endcall) + + |PROG.stINCL, PROG.stEXCL: + CODE.pushBegEnd(begcall, endcall); + varparam(parser, pos, isSet, TRUE, e); + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + CODE.setlast(begcall); + parser.expression(parser, e2); + CODE.setlast(endcall.prev(CODE.COMMAND)); + PARS.check(isInt(e2), parser, pos, 66); + IF e2.obj = eCONST THEN + PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 56); + CODE.AddCmd(CODE.opINCLC + ORD(proc = PROG.stEXCL), ARITH.Int(e2.value)) + ELSE + CODE.AddCmd0(CODE.opINCL + ORD(proc = PROG.stEXCL)) + END; + CODE.popBegEnd(begcall, endcall) + + |PROG.stNEW: + varparam(parser, pos, isPtr, TRUE, e); + CODE.New(e.type.base.size, e.type.base.num) + + |PROG.stDISPOSE: + varparam(parser, pos, isPtr, TRUE, e); + CODE.AddCmd0(CODE.opDISP) + + |PROG.stPACK: + varparam(parser, pos, isReal, TRUE, e); + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + parser.expression(parser, e2); + PARS.check(isInt(e2), parser, pos, 66); + IF e2.obj = eCONST THEN + CODE.AddCmd(CODE.opPACKC, ARITH.Int(e2.value)) + ELSE + CODE.AddCmd0(CODE.opPACK) + END + + |PROG.stUNPK: + varparam(parser, pos, isReal, TRUE, e); + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + varparam(parser, pos, isInteger, TRUE, e2); + CODE.AddCmd0(CODE.opUNPK) + + |PROG.stCOPY: + parser.expression(parser, e); + IF isString(e) OR isCharArray(e) THEN + wchar := FALSE + ELSIF isStringW(e) OR isCharArrayW(e) THEN + wchar := TRUE + ELSE + PARS.check(FALSE, parser, pos, 66) + END; + + IF isCharArrayX(e) & ~PROG.isOpenArray(e.type) THEN + CODE.AddCmd(CODE.opCONST, e.type.length) + END; + + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + + IF wchar THEN + varparam(parser, pos, isCharArrayW, TRUE, e1) + ELSE + IF e.obj = eCONST THEN + varparam(parser, pos, isCharArrayX, TRUE, e1) + ELSE + varparam(parser, pos, isCharArray, TRUE, e1) + END; + + wchar := e1.type.base.typ = PROG.tWCHAR + END; + + IF ~PROG.isOpenArray(e1.type) THEN + CODE.AddCmd(CODE.opCONST, e1.type.length) + END; + + IF e.obj = eCONST THEN + IF wchar THEN + CODE.AddCmd(CODE.opSADR, StringW(e)); + CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1) + ELSE + CODE.AddCmd(CODE.opSADR, String(e)); + CODE.AddCmd(CODE.opCONST, strlen(e) + 1) + END; + CODE.AddCmd(CODE.opCOPYS2, e1.type.base.size) + ELSE + CODE.AddCmd(CODE.opCOPYS, e1.type.base.size) + END + + |PROG.sysGET: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + LoadConst(e) + END; + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + parser.designator(parser, e2); + PARS.check(isVar(e2), parser, pos, 93); + PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); + CODE.SysGet(e2.type.size) + + |PROG.sysPUT, PROG.sysPUT8, PROG.sysPUT16, PROG.sysPUT32: + CODE.pushBegEnd(begcall, endcall); + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + LoadConst(e) + END; + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + CODE.setlast(begcall); + parser.expression(parser, e2); + PARS.check(isExpr(e2), parser, pos, 66); + + IF proc = PROG.sysPUT THEN + PARS.check((e2.type.typ IN PROG.BASICTYPES) OR (e2.type.typ = PROG.tPOINTER) OR (e2.type.typ = PROG.tPROCEDURE), parser, pos, 66); + IF e2.obj = eCONST THEN + IF e2.type.typ = PROG.tREAL THEN + CODE.setlast(endcall.prev(CODE.COMMAND)); + CODE.Float(ARITH.Float(e2.value)); + CODE.savef + ELSE + LoadConst(e2); + CODE.setlast(endcall.prev(CODE.COMMAND)); + CODE.SysPut(e2.type.size) + END + ELSE + CODE.setlast(endcall.prev(CODE.COMMAND)); + IF e2.type.typ = PROG.tREAL THEN + CODE.savef + ELSIF e2.type.typ = PROG.tBYTE THEN + CODE.SysPut(PARS.program.stTypes.tINTEGER.size) + ELSE + CODE.SysPut(e2.type.size) + END + END + + ELSIF (proc = PROG.sysPUT8) OR (proc = PROG.sysPUT16) OR (proc = PROG.sysPUT32) THEN + PARS.check(e2.type.typ IN {PROG.tINTEGER, PROG.tBYTE, PROG.tCHAR, PROG.tWCHAR, PROG.tCARD16, PROG.tCARD32}, parser, pos, 66); + IF e2.obj = eCONST THEN + LoadConst(e2) + END; + CODE.setlast(endcall.prev(CODE.COMMAND)); + IF proc = PROG.sysPUT8 THEN + CODE.SysPut(1) + ELSIF proc = PROG.sysPUT16 THEN + CODE.SysPut(2) + ELSIF proc = PROG.sysPUT32 THEN + CODE.SysPut(4) + END + + END; + CODE.popBegEnd(begcall, endcall) + + |PROG.sysMOVE: + FOR i := 1 TO 2 DO + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + LoadConst(e) + END; + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos) + END; + + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + LoadConst(e) + END; + CODE.AddCmd0(CODE.opMOVE) + + |PROG.sysCOPY: + FOR i := 1 TO 2 DO + parser.designator(parser, e); + PARS.check(isVar(e), parser, pos, 93); + n := PROG.Dim(e.type); + WHILE n > 0 DO + CODE.drop; + DEC(n) + END; + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos) + END; + + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + LoadConst(e) + END; + CODE.AddCmd0(CODE.opMOVE) + + |PROG.sysCODE: + REPEAT + getpos(parser, pos); + PARS.ConstExpression(parser, code); + PARS.check(code.typ = ARITH.tINTEGER, parser, pos, 43); + PARS.check(ARITH.range(code, 0, 255), parser, pos, 42); + IF parser.sym = SCAN.lxCOMMA THEN + PARS.Next(parser) + ELSE + PARS.checklex(parser, SCAN.lxRROUND) + END; + CODE.AddCmd(CODE.opCODE, ARITH.getInt(code)) + UNTIL parser.sym = SCAN.lxRROUND + + END; + + e.obj := eEXPR; + e.type := NIL + + ELSIF e.obj IN {eSTFUNC, eSYSFUNC} THEN + + CASE e.stproc OF + |PROG.stABS: + parser.expression(parser, e); + PARS.check(isInt(e) OR isReal(e), parser, pos, 66); + IF e.obj = eCONST THEN + PARS.check(ARITH.abs(e.value), parser, pos, 39) + ELSE + CODE.abs(isReal(e)) + END + + |PROG.stASR, PROG.stLSL, PROG.stROR, PROG.stLSR, PROG.stMIN, PROG.stMAX: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + PARS.checklex(parser, SCAN.lxCOMMA); + NextPos(parser, pos); + parser.expression(parser, e2); + PARS.check(isInt(e2), parser, pos, 66); + e.type := PARS.program.stTypes.tINTEGER; + IF (e.obj = eCONST) & (e2.obj = eCONST) THEN + ASSERT(ARITH.opInt(e.value, e2.value, shift_minmax(proc))) + ELSE + IF e.obj = eCONST THEN + CODE.shift_minmax1(shift_minmax(proc), ARITH.Int(e.value)) + ELSIF e2.obj = eCONST THEN + CODE.shift_minmax2(shift_minmax(proc), ARITH.Int(e2.value)) + ELSE + CODE.shift_minmax(shift_minmax(proc)) + END; + e.obj := eEXPR + END + + |PROG.stCHR: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + e.type := PARS.program.stTypes.tCHAR; + IF e.obj = eCONST THEN + ARITH.setChar(e.value, ARITH.getInt(e.value)); + PARS.check(ARITH.check(e.value), parser, pos, 107) + ELSE + IF chkCHR IN checking THEN + CheckRange(256, pos.line, errCHR) + ELSE + CODE.AddCmd0(CODE.opCHR) + END + END + + |PROG.stWCHR: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + e.type := PARS.program.stTypes.tWCHAR; + IF e.obj = eCONST THEN + ARITH.setWChar(e.value, ARITH.getInt(e.value)); + PARS.check(ARITH.check(e.value), parser, pos, 101) + ELSE + IF chkWCHR IN checking THEN + CheckRange(65536, pos.line, errWCHR) + ELSE + CODE.AddCmd0(CODE.opWCHR) + END + END + + |PROG.stFLOOR: + parser.expression(parser, e); + PARS.check(isReal(e), parser, pos, 66); + e.type := PARS.program.stTypes.tINTEGER; + IF e.obj = eCONST THEN + PARS.check(ARITH.floor(e.value), parser, pos, 39) + ELSE + CODE.floor + END + + |PROG.stFLT: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + e.type := PARS.program.stTypes.tREAL; + IF e.obj = eCONST THEN + ARITH.flt(e.value) + ELSE + PARS.check(CODE.flt(), parser, pos, 41) + END + + |PROG.stLEN: + cmd1 := CODE.getlast(); + varparam(parser, pos, isArr, FALSE, e); + IF e.type.length > 0 THEN + cmd2 := CODE.getlast(); + CODE.delete2(cmd1.next, cmd2); + CODE.setlast(cmd1); + ASSERT(ARITH.setInt(e.value, e.type.length)); + e.obj := eCONST + ELSE + CODE.len(PROG.Dim(e.type)) + END; + e.type := PARS.program.stTypes.tINTEGER + + |PROG.stLENGTH: + parser.expression(parser, e); + IF isCharArray(e) THEN + IF e.type.length > 0 THEN + CODE.AddCmd(CODE.opCONST, e.type.length) + END; + CODE.AddCmd0(CODE.opLENGTH) + ELSIF isCharArrayW(e) THEN + IF e.type.length > 0 THEN + CODE.AddCmd(CODE.opCONST, e.type.length) + END; + CODE.AddCmd0(CODE.opLENGTHW) + ELSE + PARS.check(FALSE, parser, pos, 66); + END; + e.type := PARS.program.stTypes.tINTEGER + + |PROG.stODD: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + e.type := PARS.program.stTypes.tBOOLEAN; + IF e.obj = eCONST THEN + ARITH.odd(e.value) + ELSE + CODE.odd + END + + |PROG.stORD: + parser.expression(parser, e); + PARS.check(isChar(e) OR isBoolean(e) OR isSet(e) OR isCharW(e) OR isStringW1(e), parser, pos, 66); + IF e.obj = eCONST THEN + IF isStringW1(e) THEN + ASSERT(ARITH.setInt(e.value, StrToWChar(e.value.string(SCAN.IDENT).s))) + ELSE + ARITH.ord(e.value) + END + ELSE + IF isBoolean(e) THEN + CODE.ord + END + END; + e.type := PARS.program.stTypes.tINTEGER + + |PROG.stBITS: + parser.expression(parser, e); + PARS.check(isInt(e), parser, pos, 66); + IF e.obj = eCONST THEN + ARITH.bits(e.value) + END; + e.type := PARS.program.stTypes.tSET + + |PROG.sysADR: + parser.designator(parser, e); + IF isVar(e) THEN + n := PROG.Dim(e.type); + WHILE n > 0 DO + CODE.drop; + DEC(n) + END + ELSIF e.obj = ePROC THEN + CODE.PushProc(e.ident.proc.label) + ELSIF e.obj = eIMP THEN + CODE.PushImpProc(e.ident.import) + ELSE + PARS.check(FALSE, parser, pos, 108) + END; + e.type := PARS.program.stTypes.tINTEGER + + |PROG.sysSADR: + parser.expression(parser, e); + PARS.check(isString(e), parser, pos, 66); + CODE.AddCmd(CODE.opSADR, String(e)); + e.type := PARS.program.stTypes.tINTEGER; + e.obj := eEXPR + + |PROG.sysWSADR: + parser.expression(parser, e); + PARS.check(isStringW(e), parser, pos, 66); + CODE.AddCmd(CODE.opSADR, StringW(e)); + e.type := PARS.program.stTypes.tINTEGER; + e.obj := eEXPR + + |PROG.sysTYPEID: + parser.expression(parser, e); + PARS.check(e.obj = eTYPE, parser, pos, 68); + IF e.type.typ = PROG.tRECORD THEN + ASSERT(ARITH.setInt(e.value, e.type.num)) + ELSIF e.type.typ = PROG.tPOINTER THEN + ASSERT(ARITH.setInt(e.value, e.type.base.num)) + ELSE + PARS.check(FALSE, parser, pos, 52) + END; + e.obj := eCONST; + e.type := PARS.program.stTypes.tINTEGER + + |PROG.sysINF: + PARS.check(CODE.inf(), parser, pos, 41); + e.obj := eEXPR; + e.type := PARS.program.stTypes.tREAL + + |PROG.sysSIZE: + parser.expression(parser, e); + PARS.check(e.obj = eTYPE, parser, pos, 68); + ASSERT(ARITH.setInt(e.value, e.type.size)); + e.obj := eCONST; + e.type := PARS.program.stTypes.tINTEGER + + END + + END; + + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser); + + IF e.obj # eCONST THEN + e.obj := eEXPR + END + +END stProc; + + +PROCEDURE ActualParameters (parser: PARS.PARSER; VAR e: PARS.EXPR); +VAR + proc: PROG.TYPE_; + param: LISTS.ITEM; + e1: PARS.EXPR; + pos: SCAN.POSITION; + +BEGIN + ASSERT(parser.sym = SCAN.lxLROUND); + + IF (e.obj IN {ePROC, eIMP}) OR isExpr(e) THEN + proc := e.type; + PARS.check1(proc.typ = PROG.tPROCEDURE, parser, 86); + PARS.Next(parser); + + param := proc.params.first; + WHILE param # NIL DO + getpos(parser, pos); + + CODE.setlast(begcall); + + IF param(PROG.PARAM).vPar THEN + parser.designator(parser, e1) + ELSE + parser.expression(parser, e1) + END; + paramcomp(parser, pos, e1, param(PROG.PARAM)); + param := param.next; + IF param # NIL THEN + PARS.checklex(parser, SCAN.lxCOMMA); + PARS.Next(parser) + END + END; + + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser); + + e.obj := eEXPR; + e.type := proc.base + + ELSIF e.obj IN {eSTPROC, eSTFUNC, eSYSPROC, eSYSFUNC} THEN + PARS.Next(parser); + stProc(parser, e) + ELSE + PARS.check1(FALSE, parser, 86) + END + +END ActualParameters; + + +PROCEDURE qualident (parser: PARS.PARSER; VAR e: PARS.EXPR); +VAR + ident: PROG.IDENT; + import: BOOLEAN; + pos: SCAN.POSITION; + +BEGIN + PARS.checklex(parser, SCAN.lxIDENT); + getpos(parser, pos); + import := FALSE; + ident := parser.unit.idents.get(parser.unit, parser.lex.ident, FALSE); + PARS.check1(ident # NIL, parser, 48); + IF ident.typ = PROG.idMODULE THEN + PARS.ExpectSym(parser, SCAN.lxPOINT); + PARS.ExpectSym(parser, SCAN.lxIDENT); + ident := ident.unit.idents.get(ident.unit, parser.lex.ident, FALSE); + PARS.check1((ident # NIL) & ident.export, parser, 48); + import := TRUE + END; + PARS.Next(parser); + + e.readOnly := FALSE; + e.ident := ident; + + CASE ident.typ OF + |PROG.idCONST: + e.obj := eCONST; + e.type := ident.type; + e.value := ident.value + |PROG.idTYPE: + e.obj := eTYPE; + e.type := ident.type + |PROG.idVAR: + e.obj := eVAR; + e.type := ident.type; + e.readOnly := import + |PROG.idPROC: + e.obj := ePROC; + e.type := ident.type + |PROG.idIMP: + e.obj := eIMP; + e.type := ident.type + |PROG.idVPAR: + e.type := ident.type; + IF e.type.typ = PROG.tRECORD THEN + e.obj := eVREC + ELSE + e.obj := eVPAR + END + |PROG.idPARAM: + e.obj := ePARAM; + e.type := ident.type; + e.readOnly := (e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) + |PROG.idSTPROC: + e.obj := eSTPROC; + e.stproc := ident.stproc + |PROG.idSTFUNC: + e.obj := eSTFUNC; + e.stproc := ident.stproc + |PROG.idSYSPROC: + e.obj := eSYSPROC; + e.stproc := ident.stproc + |PROG.idSYSFUNC: + PARS.check(~parser.constexp, parser, pos, 109); + e.obj := eSYSFUNC; + e.stproc := ident.stproc + |PROG.idNONE: + PARS.check(FALSE, parser, pos, 115) + END; + + IF isVar(e) THEN + PARS.check(e.ident.global OR (e.ident.scopeLvl = parser.unit.scopeLvl), parser, pos, 105) + END + +END qualident; + + +PROCEDURE deref (pos: SCAN.POSITION; e: PARS.EXPR; load: BOOLEAN; error: INTEGER); +VAR + label: INTEGER; + +BEGIN + IF load THEN + CODE.load(e.type.size) + END; + + IF chkPTR IN checking THEN + label := CODE.NewLabel(); + CODE.AddJmpCmd(CODE.opJNZ, label); + CODE.OnError(pos.line, error); + CODE.SetLabel(label) + END +END deref; + + +PROCEDURE designator (parser: PARS.PARSER; VAR e: PARS.EXPR); +VAR + field: PROG.FIELD; + pos: SCAN.POSITION; + t, idx: PARS.EXPR; + + + PROCEDURE LoadAdr (e: PARS.EXPR); + VAR + offset: INTEGER; + + PROCEDURE OpenArray (e: PARS.EXPR); + VAR + offset, n: INTEGER; + BEGIN + offset := e.ident.offset; + n := PROG.Dim(e.type); + WHILE n >= 0 DO + CODE.AddCmd(CODE.opVADR, offset); + DEC(offset); + DEC(n) + END + END OpenArray; + + + BEGIN + IF e.obj = eVAR THEN + offset := PROG.getOffset(PARS.program, e.ident); + IF e.ident.global THEN + CODE.AddCmd(CODE.opGADR, offset) + ELSE + CODE.AddCmd(CODE.opLADR, -offset) + END + ELSIF e.obj = ePARAM THEN + IF (e.type.typ = PROG.tRECORD) OR ((e.type.typ = PROG.tARRAY) & (e.type.length > 0)) THEN + CODE.AddCmd(CODE.opVADR, e.ident.offset) + ELSIF PROG.isOpenArray(e.type) THEN + OpenArray(e) + ELSE + CODE.AddCmd(CODE.opLADR, e.ident.offset) + END + ELSIF e.obj IN {eVPAR, eVREC} THEN + IF PROG.isOpenArray(e.type) THEN + OpenArray(e) + ELSE + CODE.AddCmd(CODE.opVADR, e.ident.offset) + END + END + END LoadAdr; + + + PROCEDURE OpenIdx (parser: PARS.PARSER; pos: SCAN.POSITION; e: PARS.EXPR); + VAR + label: INTEGER; + type: PROG.TYPE_; + n, offset, k: INTEGER; + + BEGIN + + IF chkIDX IN checking THEN + label := CODE.NewLabel(); + CODE.AddCmd2(CODE.opCHKIDX2, label, 0); + CODE.OnError(pos.line, errIDX); + CODE.SetLabel(label) + ELSE + CODE.AddCmd(CODE.opCHKIDX2, -1) + END; + + type := PROG.OpenBase(e.type); + IF type.size # 1 THEN + CODE.AddCmd(CODE.opMULC, type.size) + END; + n := PROG.Dim(e.type) - 1; + k := n; + WHILE n > 0 DO + CODE.AddCmd0(CODE.opMUL); + DEC(n) + END; + CODE.AddCmd0(CODE.opADD); + offset := e.ident.offset - 1; + n := k; + WHILE n > 0 DO + CODE.AddCmd(CODE.opVADR, offset); + DEC(offset); + DEC(n) + END + END OpenIdx; + + +BEGIN + qualident(parser, e); + + IF e.obj IN {ePROC, eIMP} THEN + PROG.UseProc(parser.unit, e.ident.proc) + END; + + IF isVar(e) THEN + LoadAdr(e) + END; + + WHILE parser.sym = SCAN.lxPOINT DO + getpos(parser, pos); + PARS.check1(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, 73); + IF e.type.typ = PROG.tPOINTER THEN + deref(pos, e, TRUE, errPTR) + END; + PARS.ExpectSym(parser, SCAN.lxIDENT); + IF e.type.typ = PROG.tPOINTER THEN + e.type := e.type.base; + e.readOnly := FALSE + END; + field := e.type.fields.get(e.type, parser.lex.ident, parser.unit); + PARS.check1(field # NIL, parser, 74); + e.type := field.type; + IF e.obj = eVREC THEN + e.obj := eVPAR + END; + IF field.offset # 0 THEN + CODE.AddCmd(CODE.opADDR, field.offset) + END; + PARS.Next(parser); + e.ident := NIL + + ELSIF parser.sym = SCAN.lxLSQUARE DO + + REPEAT + + PARS.check1(isArr(e), parser, 75); + NextPos(parser, pos); + parser.expression(parser, idx); + PARS.check(isInt(idx), parser, pos, 76); + + IF idx.obj = eCONST THEN + IF e.type.length > 0 THEN + PARS.check(ARITH.range(idx.value, 0, e.type.length - 1), parser, pos, 83); + IF ARITH.Int(idx.value) > 0 THEN + CODE.AddCmd(CODE.opADDR, ARITH.Int(idx.value) * e.type.base.size) + END + ELSE + PARS.check(ARITH.range(idx.value, 0, MACHINE.target.maxInt), parser, pos, 83); + LoadConst(idx); + OpenIdx(parser, pos, e) + END + ELSE + IF e.type.length > 0 THEN + IF chkIDX IN checking THEN + CheckRange(e.type.length, pos.line, errIDX) + END; + IF e.type.base.size # 1 THEN + CODE.AddCmd(CODE.opMULC, e.type.base.size) + END; + CODE.AddCmd0(CODE.opADD) + ELSE + OpenIdx(parser, pos, e) + END + END; + + e.type := e.type.base + + UNTIL parser.sym # SCAN.lxCOMMA; + + PARS.checklex(parser, SCAN.lxRSQUARE); + PARS.Next(parser); + e.ident := NIL + + ELSIF parser.sym = SCAN.lxCARET DO + getpos(parser, pos); + PARS.check1(isPtr(e), parser, 77); + deref(pos, e, TRUE, errPTR); + e.type := e.type.base; + e.readOnly := FALSE; + PARS.Next(parser); + e.ident := NIL; + e.obj := eVREC + + ELSIF (parser.sym = SCAN.lxLROUND) & isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}) DO + + IF e.type.typ = PROG.tRECORD THEN + PARS.check1(e.obj = eVREC, parser, 78) + END; + NextPos(parser, pos); + qualident(parser, t); + PARS.check(t.obj = eTYPE, parser, pos, 79); + + IF e.type.typ = PROG.tRECORD THEN + PARS.check(t.type.typ = PROG.tRECORD, parser, pos, 80); + IF chkGUARD IN checking THEN + IF e.ident = NIL THEN + CODE.TypeGuard(CODE.opTYPEGD, t.type.num, pos.line, errGUARD) + ELSE + CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); + CODE.TypeGuard(CODE.opTYPEGR, t.type.num, pos.line, errGUARD) + END + END; + ELSE + PARS.check(t.type.typ = PROG.tPOINTER, parser, pos, 81); + IF chkGUARD IN checking THEN + CODE.TypeGuard(CODE.opTYPEGP, t.type.base.num, pos.line, errGUARD) + END + END; + + PARS.check(PROG.isBaseOf(e.type, t.type), parser, pos, 82); + + e.type := t.type; + + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser) + + END + +END designator; + + +PROCEDURE ProcCall (e: PARS.EXPR; procType: PROG.TYPE_; isfloat: BOOLEAN; VAR fregs: INTEGER; parser: PARS.PARSER; pos: SCAN.POSITION; CallStat: BOOLEAN); +VAR + cconv: INTEGER; + params: INTEGER; + callconv: INTEGER; + fparams: INTEGER; + int, flt: INTEGER; + stk_par: INTEGER; + +BEGIN + cconv := procType.call; + params := procType.params.size; + + IF cconv IN {PROG._win64, PROG.win64} THEN + callconv := CODE.call_win64; + fparams := LSL(ORD(procType.params.getfparams(procType, 3, int, flt)), 5) + MIN(params, 4) + ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN + callconv := CODE.call_sysv; + fparams := LSL(ORD(procType.params.getfparams(procType, PROG.MAXSYSVPARAM - 1, int, flt)), 5) + params; + stk_par := MAX(0, int - 6) + MAX(0, flt - 8) + ELSE + callconv := CODE.call_stack; + fparams := 0 + END; + CODE.setlast(begcall); + fregs := CODE.precall(isfloat); + + IF cconv IN {PROG._ccall16, PROG.ccall16} THEN + CODE.AddCmd(CODE.opALIGN16, params) + ELSIF cconv IN {PROG._win64, PROG.win64} THEN + CODE.AddCmd(CODE.opWIN64ALIGN16, params) + ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN + CODE.AddCmd(CODE.opSYSVALIGN16, params + stk_par) + END; + CODE.setlast(endcall.prev(CODE.COMMAND)); + + IF e.obj = eIMP THEN + CODE.CallImp(e.ident.import, callconv, fparams) + ELSIF e.obj = ePROC THEN + CODE.Call(e.ident.proc.label, callconv, fparams) + ELSIF isExpr(e) THEN + deref(pos, e, CallStat, errPROC); + CODE.CallP(callconv, fparams) + END; + + IF cconv IN {PROG._ccall16, PROG.ccall16} THEN + CODE.AddCmd(CODE.opCLEANUP, params); + CODE.AddCmd0(CODE.opPOPSP) + ELSIF cconv IN {PROG._win64, PROG.win64} THEN + CODE.AddCmd(CODE.opCLEANUP, MAX(params + params MOD 2, 4) + 1); + CODE.AddCmd0(CODE.opPOPSP) + ELSIF cconv IN {PROG._systemv, PROG.systemv} THEN + CODE.AddCmd(CODE.opCLEANUP, params + stk_par); + CODE.AddCmd0(CODE.opPOPSP) + ELSIF cconv IN {PROG._ccall, PROG.ccall} THEN + CODE.AddCmd(CODE.opCLEANUP, params) + END; + + IF ~CallStat THEN + IF isfloat THEN + PARS.check(CODE.resf(fregs), parser, pos, 41) + ELSE + CODE.res(fregs) + END + END +END ProcCall; + + +PROCEDURE expression (parser: PARS.PARSER; VAR e: PARS.EXPR); +VAR + pos, pos0, pos1: SCAN.POSITION; + + op: INTEGER; + e1: PARS.EXPR; + constant: BOOLEAN; + operator: ARITH.RELATION; + error: INTEGER; + + + PROCEDURE relation (sym: INTEGER): BOOLEAN; + RETURN (sym = SCAN.lxEQ) OR (sym = SCAN.lxNE) OR + (sym = SCAN.lxLT) OR (sym = SCAN.lxLE) OR + (sym = SCAN.lxGT) OR (sym = SCAN.lxGE) OR + (sym = SCAN.lxIN) OR (sym = SCAN.lxIS) + END relation; + + + PROCEDURE AddOperator (sym: INTEGER): BOOLEAN; + RETURN (sym = SCAN.lxPLUS) OR (sym = SCAN.lxMINUS) OR + (sym = SCAN.lxOR) + END AddOperator; + + + PROCEDURE MulOperator (sym: INTEGER): BOOLEAN; + RETURN (sym = SCAN.lxMUL) OR (sym = SCAN.lxSLASH) OR + (sym = SCAN.lxDIV) OR (sym = SCAN.lxMOD) OR + (sym = SCAN.lxAND) + END MulOperator; + + + PROCEDURE element (parser: PARS.PARSER; VAR e: PARS.EXPR); + VAR + e1, e2: PARS.EXPR; + pos: SCAN.POSITION; + range: BOOLEAN; + + BEGIN + range := FALSE; + getpos(parser, pos); + expression(parser, e1); + PARS.check(isInt(e1), parser, pos, 76); + + IF e1.obj = eCONST THEN + PARS.check(ARITH.range(e1.value, 0, MACHINE.target.maxSet), parser, pos, 44) + END; + + range := parser.sym = SCAN.lxRANGE; + + IF range THEN + NextPos(parser, pos); + expression(parser, e2); + PARS.check(isInt(e2), parser, pos, 76); + + IF e2.obj = eCONST THEN + PARS.check(ARITH.range(e2.value, 0, MACHINE.target.maxSet), parser, pos, 44) + END + ELSE + IF e1.obj = eCONST THEN + e2 := e1 + END + END; + + e.type := PARS.program.stTypes.tSET; + + IF (e1.obj = eCONST) & (e2.obj = eCONST) THEN + ARITH.constrSet(e.value, e1.value, e2.value); + e.obj := eCONST + ELSE + IF range THEN + IF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opRSETL, ARITH.Int(e1.value)) + ELSIF e2.obj = eCONST THEN + CODE.AddCmd(CODE.opRSETR, ARITH.Int(e2.value)) + ELSE + CODE.AddCmd0(CODE.opRSET) + END + ELSE + CODE.AddCmd0(CODE.opRSET1) + END; + e.obj := eEXPR + END + + END element; + + + PROCEDURE set (parser: PARS.PARSER; VAR e: PARS.EXPR); + VAR + e1: PARS.EXPR; + + BEGIN + ASSERT(parser.sym = SCAN.lxLCURLY); + + e.obj := eCONST; + e.type := PARS.program.stTypes.tSET; + ARITH.emptySet(e.value); + + PARS.Next(parser); + IF parser.sym # SCAN.lxRCURLY THEN + element(parser, e1); + + IF e1.obj = eCONST THEN + ARITH.opSet(e.value, e1.value, "+") + ELSE + e.obj := eEXPR + END; + + WHILE parser.sym = SCAN.lxCOMMA DO + PARS.Next(parser); + element(parser, e1); + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + ARITH.opSet(e.value, e1.value, "+") + ELSE + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opADDSL, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opADDSR, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opADDS) + END; + e.obj := eEXPR + END + END; + PARS.checklex(parser, SCAN.lxRCURLY) + END; + PARS.Next(parser); + END set; + + + PROCEDURE factor (parser: PARS.PARSER; VAR e: PARS.EXPR); + VAR + sym: INTEGER; + pos: SCAN.POSITION; + e1: PARS.EXPR; + isfloat: BOOLEAN; + fregs: INTEGER; + + + PROCEDURE LoadVar (e: PARS.EXPR; parser: PARS.PARSER; pos: SCAN.POSITION); + BEGIN + IF ~(e.type.typ IN {PROG.tRECORD, PROG.tARRAY}) THEN + IF e.type.typ = PROG.tREAL THEN + PARS.check(CODE.loadf(), parser, pos, 41) + ELSE + CODE.load(e.type.size) + END + END + END LoadVar; + + + BEGIN + sym := parser.sym; + + IF (sym = SCAN.lxINTEGER) OR (sym = SCAN.lxHEX) OR (sym = SCAN.lxFLOAT) OR (sym = SCAN.lxCHAR) OR (sym = SCAN.lxSTRING) THEN + e.obj := eCONST; + e.value := parser.lex.value; + e.type := PARS.program.getType(PARS.program, e.value.typ); + PARS.Next(parser) + + ELSIF sym = SCAN.lxNIL THEN + e.obj := eCONST; + e.type := PARS.program.stTypes.tNIL; + PARS.Next(parser) + + ELSIF (sym = SCAN.lxTRUE) OR (sym = SCAN.lxFALSE) THEN + e.obj := eCONST; + ARITH.setbool(e.value, sym = SCAN.lxTRUE); + e.type := PARS.program.stTypes.tBOOLEAN; + PARS.Next(parser) + + ELSIF sym = SCAN.lxLCURLY THEN + set(parser, e) + + ELSIF sym = SCAN.lxIDENT THEN + getpos(parser, pos); + + CODE.pushBegEnd(begcall, endcall); + + designator(parser, e); + IF isVar(e) THEN + LoadVar(e, parser, pos) + END; + IF parser.sym = SCAN.lxLROUND THEN + e1 := e; + ActualParameters(parser, e); + PARS.check(e.type # NIL, parser, pos, 59); + isfloat := e.type.typ = PROG.tREAL; + IF e1.obj IN {ePROC, eIMP} THEN + ProcCall(e1, e1.ident.type, isfloat, fregs, parser, pos, FALSE) + ELSIF isExpr(e1) THEN + ProcCall(e1, e1.type, isfloat, fregs, parser, pos, FALSE) + END + END; + CODE.popBegEnd(begcall, endcall) + + ELSIF sym = SCAN.lxLROUND THEN + PARS.Next(parser); + expression(parser, e); + PARS.checklex(parser, SCAN.lxRROUND); + PARS.Next(parser); + IF isExpr(e) & (e.obj # eCONST) THEN + e.obj := eEXPR + END + + ELSIF sym = SCAN.lxNOT THEN + NextPos(parser, pos); + factor(parser, e); + PARS.check(isBoolean(e), parser, pos, 72); + IF e.obj # eCONST THEN + CODE.not; + e.obj := eEXPR + ELSE + ASSERT(ARITH.neg(e.value)) + END + + ELSE + PARS.check1(FALSE, parser, 34) + END + END factor; + + + PROCEDURE term (parser: PARS.PARSER; VAR e: PARS.EXPR); + VAR + pos: SCAN.POSITION; + op: INTEGER; + e1: PARS.EXPR; + + label: INTEGER; + label1: INTEGER; + + BEGIN + factor(parser, e); + label := -1; + + WHILE MulOperator(parser.sym) DO + op := parser.sym; + getpos(parser, pos); + PARS.Next(parser); + + IF op = SCAN.lxAND THEN + IF ~parser.constexp THEN + + IF label = -1 THEN + label := CODE.NewLabel() + END; + + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) + END; + CODE.AddJmpCmd(CODE.opJZ, label); + CODE.drop + END + END; + + factor(parser, e1); + + CASE op OF + |SCAN.lxMUL: + PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + + CASE e.value.typ OF + |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, "*"), parser, pos, 39) + |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "*"), parser, pos, 40) + |ARITH.tSET: ARITH.opSet(e.value, e1.value, "*") + END + + ELSE + IF isInt(e) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opMULC, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opMULC, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opMUL) + END + ELSIF isReal(e) THEN + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.Float(ARITH.Float(e1.value)) + END; + CODE.fbinop(CODE.opMULF) + ELSIF isSet(e) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opMULSC, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opMULSC, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opMULS) + END + END; + e.obj := eEXPR + END + + |SCAN.lxSLASH: + PARS.check(isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); + IF (e1.obj = eCONST) & isReal(e1) THEN + PARS.check(~ARITH.isZero(e1.value), parser, pos, 45) + END; + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + + CASE e.value.typ OF + |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, "/"), parser, pos, 40) + |ARITH.tSET: ARITH.opSet(e.value, e1.value, "/") + END + + ELSE + IF isReal(e) THEN + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)); + CODE.fbinop(CODE.opDIVFI) + ELSIF e1.obj = eCONST THEN + CODE.Float(ARITH.Float(e1.value)); + CODE.fbinop(CODE.opDIVF) + ELSE + CODE.fbinop(CODE.opDIVF) + END + ELSIF isSet(e) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opDIVSC, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opDIVS) + END + END; + e.obj := eEXPR + END + + |SCAN.lxDIV, SCAN.lxMOD: + PARS.check(isInt(e) & isInt(e1), parser, pos, 37); + IF e1.obj = eCONST THEN + PARS.check(~ARITH.isZero(e1.value), parser, pos, 46) + END; + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + + IF op = SCAN.lxDIV THEN + PARS.check(ARITH.opInt(e.value, e1.value, "D"), parser, pos, 39) + ELSE + ASSERT(ARITH.opInt(e.value, e1.value, "M")) + END + + ELSE + IF e1.obj # eCONST THEN + label1 := CODE.NewLabel(); + CODE.AddJmpCmd(CODE.opJNZ, label1) + END; + IF e.obj = eCONST THEN + CODE.OnError(pos.line, errDIV); + CODE.SetLabel(label1); + CODE.AddCmd(CODE.opDIVL + ORD(op = SCAN.lxMOD), ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opDIVR + ORD(op = SCAN.lxMOD), ARITH.Int(e1.value)) + ELSE + CODE.OnError(pos.line, errDIV); + CODE.SetLabel(label1); + CODE.AddCmd0(CODE.opDIV + ORD(op = SCAN.lxMOD)) + END; + e.obj := eEXPR + END + + |SCAN.lxAND: + PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); + + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + ARITH.opBoolean(e.value, e1.value, "&") + ELSE + e.obj := eEXPR; + IF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) + END + END + + END + END; + + IF label # -1 THEN + CODE.SetLabel(label) + END + END term; + + + PROCEDURE SimpleExpression (parser: PARS.PARSER; VAR e: PARS.EXPR); + VAR + pos: SCAN.POSITION; + op: INTEGER; + e1: PARS.EXPR; + + plus, minus: BOOLEAN; + + label: INTEGER; + + BEGIN + plus := parser.sym = SCAN.lxPLUS; + minus := parser.sym = SCAN.lxMINUS; + + IF plus OR minus THEN + getpos(parser, pos); + PARS.Next(parser) + END; + + term(parser, e); + + IF plus OR minus THEN + PARS.check(isInt(e) OR isReal(e) OR isSet(e), parser, pos, 36); + + IF minus & (e.obj = eCONST) THEN + PARS.check(ARITH.neg(e.value), parser, pos, 39) + END; + + IF e.obj # eCONST THEN + IF minus THEN + IF isInt(e) THEN + CODE.AddCmd0(CODE.opUMINUS) + ELSIF isReal(e) THEN + CODE.AddCmd0(CODE.opUMINF) + ELSIF isSet(e) THEN + CODE.AddCmd0(CODE.opUMINS) + END + END; + e.obj := eEXPR + END + END; + + label := -1; + + WHILE AddOperator(parser.sym) DO + + op := parser.sym; + getpos(parser, pos); + PARS.Next(parser); + + IF op = SCAN.lxOR THEN + + IF ~parser.constexp THEN + + IF label = -1 THEN + label := CODE.NewLabel() + END; + + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e.value))) + END; + CODE.AddJmpCmd(CODE.opJNZ, label); + CODE.drop + END + + END; + + term(parser, e1); + + CASE op OF + |SCAN.lxPLUS, SCAN.lxMINUS: + + IF op = SCAN.lxPLUS THEN + op := ORD("+") + ELSE + op := ORD("-") + END; + + PARS.check(isInt(e) & isInt(e1) OR isReal(e) & isReal(e1) OR isSet(e) & isSet(e1), parser, pos, 37); + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + + CASE e.value.typ OF + |ARITH.tINTEGER: PARS.check(ARITH.opInt(e.value, e1.value, CHR(op)), parser, pos, 39) + |ARITH.tREAL: PARS.check(ARITH.opFloat(e.value, e1.value, CHR(op)), parser, pos, 40) + |ARITH.tSET: ARITH.opSet(e.value, e1.value, CHR(op)) + END + + ELSE + IF isInt(e) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opADDL + ORD(op = ORD("-")), ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opADDR + ORD(op = ORD("-")), ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opADD + ORD(op = ORD("-"))) + END + ELSIF isReal(e) THEN + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)); + CODE.fbinop(CODE.opADDFI + ORD(op = ORD("-"))) + ELSIF e1.obj = eCONST THEN + CODE.Float(ARITH.Float(e1.value)); + CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) + ELSE + CODE.fbinop(CODE.opADDF + ORD(op = ORD("-"))) + END + ELSIF isSet(e) THEN + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opADDSL + ORD(op = ORD("-")), ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opADDSR + ORD(op = ORD("-")), ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opADDS + ORD(op = ORD("-"))) + END + END; + e.obj := eEXPR + END + + |SCAN.lxOR: + PARS.check(isBoolean(e) & isBoolean(e1), parser, pos, 37); + + IF (e.obj = eCONST) & (e1.obj = eCONST) THEN + ARITH.opBoolean(e.value, e1.value, "|") + ELSE + e.obj := eEXPR; + IF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opCONST, ORD(ARITH.getBool(e1.value))) + END + END + + END + END; + + IF label # -1 THEN + CODE.SetLabel(label) + END + + END SimpleExpression; + + + PROCEDURE cmpcode (op: INTEGER): INTEGER; + VAR + res: INTEGER; + BEGIN + CASE op OF + |SCAN.lxEQ: res := 0 + |SCAN.lxNE: res := 1 + |SCAN.lxLT: res := 2 + |SCAN.lxLE: res := 3 + |SCAN.lxGT: res := 4 + |SCAN.lxGE: res := 5 + END + + RETURN res + END cmpcode; + + + PROCEDURE BoolCmp (eq, val: BOOLEAN); + BEGIN + IF eq = val THEN + CODE.AddCmd0(CODE.opNER) + ELSE + CODE.AddCmd0(CODE.opEQR) + END + END BoolCmp; + + + PROCEDURE strcmp (VAR e, e1: PARS.EXPR; op: INTEGER): BOOLEAN; + VAR + res: BOOLEAN; + + BEGIN + + res := TRUE; + + IF isString(e) & isCharArray(e1) THEN + CODE.AddCmd(CODE.opSADR, String(e)); + CODE.AddCmd(CODE.opCONST, strlen(e) + 1); + CODE.AddCmd0(CODE.opEQS2 + cmpcode(op)) + + ELSIF isString(e) & isCharArrayW(e1) THEN + CODE.AddCmd(CODE.opSADR, StringW(e)); + CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); + CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) + + ELSIF isStringW(e) & isCharArrayW(e1) THEN + CODE.AddCmd(CODE.opSADR, StringW(e)); + CODE.AddCmd(CODE.opCONST, utf8strlen(e) + 1); + CODE.AddCmd0(CODE.opEQSW2 + cmpcode(op)) + + ELSIF isCharArray(e) & isString(e1) THEN + CODE.AddCmd(CODE.opSADR, String(e1)); + CODE.AddCmd(CODE.opCONST, strlen(e1) + 1); + CODE.AddCmd0(CODE.opEQS + cmpcode(op)) + + ELSIF isCharArrayW(e) & isString(e1) THEN + CODE.AddCmd(CODE.opSADR, StringW(e1)); + CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); + CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + + ELSIF isCharArrayW(e) & isStringW(e1) THEN + CODE.AddCmd(CODE.opSADR, StringW(e1)); + CODE.AddCmd(CODE.opCONST, utf8strlen(e1) + 1); + CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + + ELSIF isCharArrayW(e) & isCharArrayW(e1) THEN + CODE.AddCmd0(CODE.opEQSW + cmpcode(op)) + + ELSIF isCharArray(e) & isCharArray(e1) THEN + CODE.AddCmd0(CODE.opEQS + cmpcode(op)) + + ELSIF isString(e) & isString(e1) THEN + PARS.strcmp(e.value, e1.value, op) + + ELSE + res := FALSE + + END + + RETURN res + END strcmp; + + +BEGIN + getpos(parser, pos0); + SimpleExpression(parser, e); + IF relation(parser.sym) THEN + IF (isCharArray(e) OR isCharArrayW(e)) & (e.type.length # 0) THEN + CODE.AddCmd(CODE.opCONST, e.type.length) + END; + op := parser.sym; + getpos(parser, pos); + PARS.Next(parser); + + pos1 := parser.lex.pos; + SimpleExpression(parser, e1); + + IF (isCharArray(e1) OR isCharArrayW(e1)) & (e1.type.length # 0) THEN + CODE.AddCmd(CODE.opCONST, e1.type.length) + END; + + constant := (e.obj = eCONST) & (e1.obj = eCONST); + + CASE op OF + |SCAN.lxEQ: operator := "=" + |SCAN.lxNE: operator := "#" + |SCAN.lxLT: operator := "<" + |SCAN.lxLE: operator := "<=" + |SCAN.lxGT: operator := ">" + |SCAN.lxGE: operator := ">=" + |SCAN.lxIN: operator := "IN" + |SCAN.lxIS: operator := "" + END; + + error := 0; + + CASE op OF + |SCAN.lxEQ, SCAN.lxNE: + + IF isInt(e) & isInt(e1) OR isSet(e) & isSet(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR + isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR + isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR + isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) OR + isPtr(e) & isPtr(e1) & (PROG.isBaseOf(e.type, e1.type) OR PROG.isBaseOf(e1.type, e.type)) THEN + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + END + END + + ELSIF isStringW1(e) & isCharW(e1) THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) + + ELSIF isStringW1(e1) & isCharW(e) THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s)) + + ELSIF isBoolean(e) & isBoolean(e1) THEN + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + BoolCmp(op = SCAN.lxEQ, ARITH.Int(e.value) # 0) + ELSIF e1.obj = eCONST THEN + BoolCmp(op = SCAN.lxEQ, ARITH.Int(e1.value) # 0) + ELSE + IF op = SCAN.lxEQ THEN + CODE.AddCmd0(CODE.opEQB) + ELSE + CODE.AddCmd0(CODE.opNEB) + END + END + END + + ELSIF isReal(e) & isReal(e1) THEN + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)); + CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) + ELSIF e1.obj = eCONST THEN + CODE.Float(ARITH.Float(e1.value)); + CODE.fcmp(CODE.opEQF + cmpcode(op)) + ELSE + CODE.fcmp(CODE.opEQF + cmpcode(op)) + END + END + + ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN + IF ~strcmp(e, e1, op) THEN + PARS.error(parser, pos, 37) + END + + ELSIF isPtr(e) & isNil(e1) OR isNil(e) & isPtr(e1) THEN + CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + + ELSIF isProc(e) & isNil(e1) THEN + IF e.obj IN {ePROC, eIMP} THEN + PARS.check(e.ident.global, parser, pos0, 85); + constant := TRUE; + e.obj := eCONST; + ARITH.setbool(e.value, op = SCAN.lxNE) + ELSE + CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + END + + ELSIF isNil(e) & isProc(e1) THEN + IF e1.obj IN {ePROC, eIMP} THEN + PARS.check(e1.ident.global, parser, pos1, 85); + constant := TRUE; + e.obj := eCONST; + ARITH.setbool(e.value, op = SCAN.lxNE) + ELSE + CODE.AddCmd0(CODE.opEQ + cmpcode(op) + 6) + END + + ELSIF isProc(e) & isProc(e1) & PROG.isTypeEq(e.type, e1.type) THEN + IF e.obj = ePROC THEN + PARS.check(e.ident.global, parser, pos0, 85) + END; + IF e1.obj = ePROC THEN + PARS.check(e1.ident.global, parser, pos1, 85) + END; + IF (e.obj IN {ePROC, eIMP}) & (e1.obj IN {ePROC, eIMP}) THEN + constant := TRUE; + e.obj := eCONST; + IF op = SCAN.lxEQ THEN + ARITH.setbool(e.value, e.ident = e1.ident) + ELSE + ARITH.setbool(e.value, e.ident # e1.ident) + END + ELSIF e.obj = ePROC THEN + CODE.ProcCmp(e.ident.proc.label, cmpcode(op) = 0) + ELSIF e1.obj = ePROC THEN + CODE.ProcCmp(e1.ident.proc.label, cmpcode(op) = 0) + ELSIF e.obj = eIMP THEN + CODE.ProcImpCmp(e.ident.import, cmpcode(op) = 0) + ELSIF e1.obj = eIMP THEN + CODE.ProcImpCmp(e1.ident.import, cmpcode(op) = 0) + ELSE + CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + END + + ELSIF isNil(e) & isNil(e1) THEN + constant := TRUE; + e.obj := eCONST; + ARITH.setbool(e.value, op = SCAN.lxEQ) + + ELSE + PARS.error(parser, pos, 37) + END + + |SCAN.lxLT, SCAN.lxLE, SCAN.lxGT, SCAN.lxGE: + IF isInt(e) & isInt(e1) OR isChar(e) & isChar(e1) OR isCharW(e) & isCharW(e1) OR + isCharW(e) & isChar(e1) & (e1.obj = eCONST) OR isCharW(e1) & isChar(e) & (e.obj = eCONST) OR + isCharW(e1) & (e1.obj = eCONST) & isChar(e) & (e.obj = eCONST) OR + isCharW(e) & (e.obj = eCONST) & isChar(e1) & (e1.obj = eCONST) THEN + + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opEQ + cmpcode(op)) + END + END + + ELSIF isStringW1(e) & isCharW(e1) THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 6, StrToWChar(e.value.string(SCAN.IDENT).s)) + + ELSIF isStringW1(e1) & isCharW(e) THEN + CODE.AddCmd(CODE.opEQ + cmpcode(op) + 12, StrToWChar(e1.value.string(SCAN.IDENT).s)) + + ELSIF isReal(e) & isReal(e1) THEN + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + CODE.Float(ARITH.Float(e.value)); + CODE.fcmp(CODE.opEQF + cmpcode(op) + 6) + ELSIF e1.obj = eCONST THEN + CODE.Float(ARITH.Float(e1.value)); + CODE.fcmp(CODE.opEQF + cmpcode(op)) + ELSE + CODE.fcmp(CODE.opEQF + cmpcode(op)) + END + END + + ELSIF (isStringW(e) OR isCharArrayX(e)) & (isStringW(e1) OR isCharArrayX(e1)) THEN + IF ~strcmp(e, e1, op) THEN + PARS.error(parser, pos, 37) + END + + ELSE + PARS.error(parser, pos, 37) + END + + |SCAN.lxIN: + PARS.check(isInt(e) & isSet(e1), parser, pos, 37); + IF e.obj = eCONST THEN + PARS.check(ARITH.range(e.value, 0, MACHINE.target.maxSet), parser, pos0, 56) + END; + IF constant THEN + ARITH.relation(e.value, e1.value, operator, error) + ELSE + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opINL, ARITH.Int(e.value)) + ELSIF e1.obj = eCONST THEN + CODE.AddCmd(CODE.opINR, ARITH.Int(e1.value)) + ELSE + CODE.AddCmd0(CODE.opIN) + END + END + + |SCAN.lxIS: + PARS.check(isExpr(e) & (e.type.typ IN {PROG.tRECORD, PROG.tPOINTER}), parser, pos, 73); + IF e.type.typ = PROG.tRECORD THEN + PARS.check(e.obj = eVREC, parser, pos0, 78) + END; + PARS.check(e1.obj = eTYPE, parser, pos1, 79); + + IF e.type.typ = PROG.tRECORD THEN + PARS.check(e1.type.typ = PROG.tRECORD, parser, pos1, 80); + IF e.ident = NIL THEN + CODE.TypeCheck(e1.type.num) + ELSE + CODE.AddCmd(CODE.opVADR, e.ident.offset - 1); + CODE.TypeCheckRec(e1.type.num) + END + ELSE + PARS.check(e1.type.typ = PROG.tPOINTER, parser, pos1, 81); + CODE.TypeCheck(e1.type.base.num) + END; + + PARS.check(PROG.isBaseOf(e.type, e1.type), parser, pos1, 82) + + END; + + ASSERT(error = 0); + + e.type := PARS.program.stTypes.tBOOLEAN; + + IF ~constant THEN + e.obj := eEXPR + END + + END +END expression; + + +PROCEDURE ElementaryStatement (parser: PARS.PARSER); +VAR + e, e1: PARS.EXPR; + pos: SCAN.POSITION; + line: INTEGER; + call: BOOLEAN; + fregs: INTEGER; + +BEGIN + getpos(parser, pos); + + CODE.pushBegEnd(begcall, endcall); + + designator(parser, e); + + IF parser.sym = SCAN.lxASSIGN THEN + line := parser.lex.pos.line; + PARS.check(isVar(e), parser, pos, 93); + PARS.check(~e.readOnly, parser, pos, 94); + + CODE.setlast(begcall); + + NextPos(parser, pos); + expression(parser, e1); + + CODE.setlast(endcall.prev(CODE.COMMAND)); + + PARS.check(assign(e1, e.type, line), parser, pos, 91); + IF e1.obj = ePROC THEN + PARS.check(e1.ident.global, parser, pos, 85) + END; + call := FALSE + ELSIF parser.sym = SCAN.lxEQ THEN + PARS.check1(FALSE, parser, 96) + ELSIF parser.sym = SCAN.lxLROUND THEN + e1 := e; + ActualParameters(parser, e1); + PARS.check((e1.type = NIL) OR ODD(e.type.call), parser, pos, 92); + call := TRUE + ELSE + PARS.check(isProc(e), parser, pos, 86); + PARS.check((e.type.base = NIL) OR ODD(e.type.call), parser, pos, 92); + PARS.check1(e.type.params.first = NIL, parser, 64); + call := TRUE + END; + + IF call THEN + IF e.obj IN {ePROC, eIMP} THEN + ProcCall(e, e.ident.type, FALSE, fregs, parser, pos, TRUE) + ELSIF isExpr(e) THEN + ProcCall(e, e.type, FALSE, fregs, parser, pos, TRUE) + END + END; + + CODE.popBegEnd(begcall, endcall) +END ElementaryStatement; + + +PROCEDURE IfStatement (parser: PARS.PARSER; if: BOOLEAN); +VAR + e: PARS.EXPR; + pos: SCAN.POSITION; + + label, L: INTEGER; + +BEGIN + L := CODE.NewLabel(); + + IF ~if THEN + CODE.AddCmd0(CODE.opLOOP); + CODE.SetLabel(L) + END; + + REPEAT + NextPos(parser, pos); + + label := CODE.NewLabel(); + + expression(parser, e); + PARS.check(isBoolean(e), parser, pos, 72); + + IF e.obj = eCONST THEN + IF ~ARITH.getBool(e.value) THEN + CODE.AddJmpCmd(CODE.opJMP, label) + END + ELSE + CODE.AddJmpCmd(CODE.opJNE, label) + END; + + IF if THEN + PARS.checklex(parser, SCAN.lxTHEN) + ELSE + PARS.checklex(parser, SCAN.lxDO) + END; + + PARS.Next(parser); + parser.StatSeq(parser); + + CODE.AddJmpCmd(CODE.opJMP, L); + CODE.SetLabel(label) + + UNTIL parser.sym # SCAN.lxELSIF; + + IF if THEN + IF parser.sym = SCAN.lxELSE THEN + PARS.Next(parser); + parser.StatSeq(parser) + END; + CODE.SetLabel(L) + END; + + PARS.checklex(parser, SCAN.lxEND); + + IF ~if THEN + CODE.AddCmd0(CODE.opENDLOOP) + END; + + PARS.Next(parser) +END IfStatement; + + +PROCEDURE RepeatStatement (parser: PARS.PARSER); +VAR + e: PARS.EXPR; + pos: SCAN.POSITION; + label: INTEGER; + +BEGIN + CODE.AddCmd0(CODE.opLOOP); + + label := CODE.NewLabel(); + CODE.SetLabel(label); + + PARS.Next(parser); + parser.StatSeq(parser); + PARS.checklex(parser, SCAN.lxUNTIL); + NextPos(parser, pos); + expression(parser, e); + PARS.check(isBoolean(e), parser, pos, 72); + + IF e.obj = eCONST THEN + IF ~ARITH.getBool(e.value) THEN + CODE.AddJmpCmd(CODE.opJMP, label) + END + ELSE + CODE.AddJmpCmd(CODE.opJNE, label) + END; + + CODE.AddCmd0(CODE.opENDLOOP) +END RepeatStatement; + + +PROCEDURE LabelCmp (a, b: AVL.DATA): INTEGER; +VAR + La, Ra, Lb, Rb, res: INTEGER; + +BEGIN + La := a(CASE_LABEL).range.a; + Ra := a(CASE_LABEL).range.b; + Lb := b(CASE_LABEL).range.a; + Rb := b(CASE_LABEL).range.b; + IF (Ra < Lb) OR (La > Rb) THEN + res := ORD(La > Lb) - ORD(La < Lb) + ELSE + res := 0 + END + + RETURN res +END LabelCmp; + + +PROCEDURE DestroyLabel (VAR label: AVL.DATA); +BEGIN + C.push(CaseLabels, label); + label := NIL +END DestroyLabel; + + +PROCEDURE NewVariant (label: INTEGER; cmd: CODE.COMMAND): CASE_VARIANT; +VAR + res: CASE_VARIANT; + citem: C.ITEM; + +BEGIN + citem := C.pop(CaseVar); + IF citem = NIL THEN + NEW(res) + ELSE + res := citem(CASE_VARIANT) + END; + + res.label := label; + res.cmd := cmd; + res.processed := FALSE + + RETURN res +END NewVariant; + + +PROCEDURE CaseStatement (parser: PARS.PARSER); +VAR + e: PARS.EXPR; + pos: SCAN.POSITION; + + + PROCEDURE isRecPtr (caseExpr: PARS.EXPR): BOOLEAN; + RETURN isRec(caseExpr) OR isPtr(caseExpr) + END isRecPtr; + + + PROCEDURE Label (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR type: PROG.TYPE_): INTEGER; + VAR + a: INTEGER; + label: PARS.EXPR; + pos: SCAN.POSITION; + value: ARITH.VALUE; + + BEGIN + getpos(parser, pos); + type := NIL; + + IF isChar(caseExpr) THEN + PARS.ConstExpression(parser, value); + PARS.check(value.typ = ARITH.tCHAR, parser, pos, 99); + a := ARITH.getInt(value) + ELSIF isCharW(caseExpr) THEN + PARS.ConstExpression(parser, value); + IF (value.typ = ARITH.tSTRING) & (_length(value.string(SCAN.IDENT).s) = 1) & (LENGTH(value.string(SCAN.IDENT).s) > 1) THEN + ASSERT(ARITH.setInt(value, StrToWChar(value.string(SCAN.IDENT).s))) + ELSE + PARS.check(value.typ IN {ARITH.tWCHAR, ARITH.tCHAR}, parser, pos, 99) + END; + a := ARITH.getInt(value) + ELSIF isInt(caseExpr) THEN + PARS.ConstExpression(parser, value); + PARS.check(value.typ = ARITH.tINTEGER, parser, pos, 99); + a := ARITH.getInt(value) + ELSIF isRecPtr(caseExpr) THEN + qualident(parser, label); + PARS.check(label.obj = eTYPE, parser, pos, 79); + PARS.check(PROG.isBaseOf(caseExpr.type, label.type), parser, pos, 99); + IF isRec(caseExpr) THEN + a := label.type.num + ELSE + a := label.type.base.num + END; + type := label.type + END + + RETURN a + END Label; + + + PROCEDURE CheckType (node: AVL.NODE; type: PROG.TYPE_; parser: PARS.PARSER; pos: SCAN.POSITION); + BEGIN + IF node # NIL THEN + PARS.check(~(PROG.isBaseOf(node.data(CASE_LABEL).type, type) OR PROG.isBaseOf(type, node.data(CASE_LABEL).type)), parser, pos, 100); + CheckType(node.left, type, parser, pos); + CheckType(node.right, type, parser, pos) + END + END CheckType; + + + PROCEDURE LabelRange (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE; + VAR + label: CASE_LABEL; + citem: C.ITEM; + pos, pos1: SCAN.POSITION; + node: AVL.NODE; + newnode: BOOLEAN; + range: RANGE; + + BEGIN + citem := C.pop(CaseLabels); + IF citem = NIL THEN + NEW(label) + ELSE + label := citem(CASE_LABEL) + END; + + label.variant := variant; + label.self := CODE.NewLabel(); + + getpos(parser, pos1); + range.a := Label(parser, caseExpr, label.type); + + IF parser.sym = SCAN.lxRANGE THEN + PARS.check1(~isRecPtr(caseExpr), parser, 53); + NextPos(parser, pos); + range.b := Label(parser, caseExpr, label.type); + PARS.check(range.a <= range.b, parser, pos, 103) + ELSE + range.b := range.a + END; + + label.range := range; + + IF isRecPtr(caseExpr) THEN + CheckType(tree, label.type, parser, pos1) + END; + tree := AVL.insert(tree, label, LabelCmp, newnode, node); + PARS.check(newnode, parser, pos1, 100) + + RETURN node + + END LabelRange; + + + PROCEDURE CaseLabelList (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; variant: INTEGER): AVL.NODE; + VAR + exit: BOOLEAN; + res: AVL.NODE; + + BEGIN + exit := FALSE; + REPEAT + res := LabelRange(parser, caseExpr, tree, variant); + IF parser.sym = SCAN.lxCOMMA THEN + PARS.check1(~isRecPtr(caseExpr), parser, 53); + PARS.Next(parser) + ELSE + exit := TRUE + END + UNTIL exit + + RETURN res + END CaseLabelList; + + + PROCEDURE case (parser: PARS.PARSER; caseExpr: PARS.EXPR; VAR tree: AVL.NODE; end: INTEGER); + VAR + sym: INTEGER; + t: PROG.TYPE_; + variant: INTEGER; + node: AVL.NODE; + last: CODE.COMMAND; + + BEGIN + sym := parser.sym; + IF sym # SCAN.lxBAR THEN + variant := CODE.NewLabel(); + node := CaseLabelList(parser, caseExpr, tree, variant); + PARS.checklex(parser, SCAN.lxCOLON); + PARS.Next(parser); + IF isRecPtr(caseExpr) THEN + t := caseExpr.type; + caseExpr.ident.type := node.data(CASE_LABEL).type + END; + + last := CODE.getlast(); + CODE.SetLabel(variant); + + IF ~isRecPtr(caseExpr) THEN + LISTS.push(CaseVariants, NewVariant(variant, last)) + END; + + parser.StatSeq(parser); + CODE.AddJmpCmd(CODE.opJMP, end); + + IF isRecPtr(caseExpr) THEN + caseExpr.ident.type := t + END + END + END case; + + + PROCEDURE Table (node: AVL.NODE; else: INTEGER); + VAR + L, R: INTEGER; + range: RANGE; + left, right: AVL.NODE; + last: CODE.COMMAND; + v: CASE_VARIANT; + + BEGIN + IF node # NIL THEN + + range := node.data(CASE_LABEL).range; + + left := node.left; + IF left # NIL THEN + L := left.data(CASE_LABEL).self + ELSE + L := else + END; + + right := node.right; + IF right # NIL THEN + R := right.data(CASE_LABEL).self + ELSE + R := else + END; + + last := CODE.getlast(); + + v := CaseVariants.last(CASE_VARIANT); + WHILE (v # NIL) & (v.label # 0) & (v.label # node.data(CASE_LABEL).variant) DO + v := v.prev(CASE_VARIANT) + END; + + ASSERT((v # NIL) & (v.label # 0)); + CODE.setlast(v.cmd); + + CODE.SetLabel(node.data(CASE_LABEL).self); + CODE.case(range.a, range.b, L, R); + IF v.processed THEN + CODE.AddJmpCmd(CODE.opJMP, node.data(CASE_LABEL).variant) + END; + v.processed := TRUE; + + CODE.setlast(last); + + Table(left, else); + Table(right, else) + END + END Table; + + + PROCEDURE TableT (node: AVL.NODE); + BEGIN + IF node # NIL THEN + CODE.caset(node.data(CASE_LABEL).range.a, node.data(CASE_LABEL).variant); + + TableT(node.left); + TableT(node.right) + END + END TableT; + + + PROCEDURE ParseCase (parser: PARS.PARSER; e: PARS.EXPR; pos: SCAN.POSITION); + VAR + table, end, else: INTEGER; + tree: AVL.NODE; + item: LISTS.ITEM; + + BEGIN + LISTS.push(CaseVariants, NewVariant(0, NIL)); + end := CODE.NewLabel(); + else := CODE.NewLabel(); + table := CODE.NewLabel(); + CODE.AddCmd(CODE.opSWITCH, ORD(isRecPtr(e))); + CODE.AddJmpCmd(CODE.opJMP, table); + + tree := NIL; + + case(parser, e, tree, end); + WHILE parser.sym = SCAN.lxBAR DO + PARS.Next(parser); + case(parser, e, tree, end) + END; + + CODE.SetLabel(else); + IF parser.sym = SCAN.lxELSE THEN + PARS.Next(parser); + parser.StatSeq(parser); + CODE.AddJmpCmd(CODE.opJMP, end) + ELSE + CODE.OnError(pos.line, errCASE) + END; + + PARS.checklex(parser, SCAN.lxEND); + PARS.Next(parser); + + IF isRecPtr(e) THEN + CODE.SetLabel(table); + TableT(tree); + CODE.AddJmpCmd(CODE.opJMP, else) + ELSE + tree.data(CASE_LABEL).self := table; + Table(tree, else) + END; + + AVL.destroy(tree, DestroyLabel); + CODE.SetLabel(end); + CODE.AddCmd0(CODE.opENDSW); + + REPEAT + item := LISTS.pop(CaseVariants); + C.push(CaseVar, item) + UNTIL item(CASE_VARIANT).cmd = NIL + + END ParseCase; + + +BEGIN + NextPos(parser, pos); + expression(parser, e); + PARS.check(isInt(e) OR isChar(e) OR isCharW(e) OR isPtr(e) OR isRec(e), parser, pos, 95); + IF isRecPtr(e) THEN + PARS.check(isVar(e), parser, pos, 93); + PARS.check(e.ident # NIL, parser, pos, 106) + END; + IF isRec(e) THEN + PARS.check(e.obj = eVREC, parser, pos, 78) + END; + + IF e.obj = eCONST THEN + LoadConst(e) + ELSIF isRec(e) THEN + CODE.drop; + CODE.AddCmd(CODE.opLADR, e.ident.offset - 1); + CODE.load(PARS.program.target.word) + ELSIF isPtr(e) THEN + deref(pos, e, FALSE, errPTR); + CODE.AddCmd(CODE.opSUBR, PARS.program.target.word); + CODE.load(PARS.program.target.word) + END; + + PARS.checklex(parser, SCAN.lxOF); + PARS.Next(parser); + ParseCase(parser, e, pos) +END CaseStatement; + + +PROCEDURE ForStatement (parser: PARS.PARSER); +VAR + e: PARS.EXPR; + pos: SCAN.POSITION; + step: ARITH.VALUE; + st: INTEGER; + ident: PROG.IDENT; + offset: INTEGER; + L1, L2: INTEGER; + +BEGIN + CODE.AddCmd0(CODE.opLOOP); + + L1 := CODE.NewLabel(); + L2 := CODE.NewLabel(); + + PARS.ExpectSym(parser, SCAN.lxIDENT); + ident := parser.unit.idents.get(parser.unit, parser.lex.ident, TRUE); + PARS.check1(ident # NIL, parser, 48); + PARS.check1(ident.typ = PROG.idVAR, parser, 93); + PARS.check1(ident.type.typ = PROG.tINTEGER, parser, 97); + PARS.ExpectSym(parser, SCAN.lxASSIGN); + NextPos(parser, pos); + expression(parser, e); + PARS.check(isInt(e), parser, pos, 76); + + offset := PROG.getOffset(PARS.program, ident); + + IF ident.global THEN + CODE.AddCmd(CODE.opGADR, offset) + ELSE + CODE.AddCmd(CODE.opLADR, -offset) + END; + + IF e.obj = eCONST THEN + CODE.AddCmd(CODE.opSAVEC, ARITH.Int(e.value)) + ELSE + CODE.AddCmd0(CODE.opSAVE) + END; + + CODE.SetLabel(L1); + + IF ident.global THEN + CODE.AddCmd(CODE.opGADR, offset) + ELSE + CODE.AddCmd(CODE.opLADR, -offset) + END; + CODE.load(ident.type.size); + + PARS.checklex(parser, SCAN.lxTO); + NextPos(parser, pos); + expression(parser, e); + PARS.check(isInt(e), parser, pos, 76); + + IF parser.sym = SCAN.lxBY THEN + NextPos(parser, pos); + PARS.ConstExpression(parser, step); + PARS.check(step.typ = ARITH.tINTEGER, parser, pos, 76); + st := ARITH.getInt(step); + PARS.check(st # 0, parser, pos, 98) + ELSE + st := 1 + END; + + IF e.obj = eCONST THEN + IF st > 0 THEN + CODE.AddCmd(CODE.opLER, ARITH.Int(e.value)) + ELSE + CODE.AddCmd(CODE.opGER, ARITH.Int(e.value)) + END + ELSE + IF st > 0 THEN + CODE.AddCmd0(CODE.opLE) + ELSE + CODE.AddCmd0(CODE.opGE) + END + END; + + CODE.AddJmpCmd(CODE.opJNE, L2); + + PARS.checklex(parser, SCAN.lxDO); + PARS.Next(parser); + parser.StatSeq(parser); + + IF ident.global THEN + CODE.AddCmd(CODE.opGADR, offset) + ELSE + CODE.AddCmd(CODE.opLADR, -offset) + END; + + IF st = 1 THEN + CODE.AddCmd0(CODE.opINC1) + ELSIF st = -1 THEN + CODE.AddCmd0(CODE.opDEC1) + ELSE + IF st > 0 THEN + CODE.AddCmd(CODE.opINCC, st) + ELSE + CODE.AddCmd(CODE.opDECC, -st) + END + END; + + CODE.AddJmpCmd(CODE.opJMP, L1); + + PARS.checklex(parser, SCAN.lxEND); + PARS.Next(parser); + + CODE.SetLabel(L2); + + CODE.AddCmd0(CODE.opENDLOOP) + +END ForStatement; + + +PROCEDURE statement (parser: PARS.PARSER); +VAR + sym: INTEGER; + +BEGIN + sym := parser.sym; + + IF sym = SCAN.lxIDENT THEN + ElementaryStatement(parser) + ELSIF sym = SCAN.lxIF THEN + IfStatement(parser, TRUE) + ELSIF sym = SCAN.lxWHILE THEN + IfStatement(parser, FALSE) + ELSIF sym = SCAN.lxREPEAT THEN + RepeatStatement(parser) + ELSIF sym = SCAN.lxCASE THEN + CaseStatement(parser) + ELSIF sym = SCAN.lxFOR THEN + ForStatement(parser) + END +END statement; + + +PROCEDURE StatSeq (parser: PARS.PARSER); +BEGIN + statement(parser); + WHILE parser.sym = SCAN.lxSEMI DO + PARS.Next(parser); + statement(parser) + END +END StatSeq; + + +PROCEDURE chkreturn (parser: PARS.PARSER; e: PARS.EXPR; t: PROG.TYPE_; pos: SCAN.POSITION): BOOLEAN; +VAR + res: BOOLEAN; + +BEGIN + res := assigncomp(e, t); + IF res THEN + IF e.obj = eCONST THEN + IF e.type.typ = PROG.tREAL THEN + CODE.Float(ARITH.Float(e.value)) + ELSIF e.type.typ = PROG.tNIL THEN + CODE.AddCmd(CODE.opCONST, 0) + ELSE + LoadConst(e) + END + ELSIF (e.type.typ = PROG.tINTEGER) & (t.typ = PROG.tBYTE) & (chkBYTE IN checking) THEN + CheckRange(256, pos.line, errBYTE) + ELSIF e.obj = ePROC THEN + PARS.check(e.ident.global, parser, pos, 85); + CODE.PushProc(e.ident.proc.label) + ELSIF e.obj = eIMP THEN + CODE.PushImpProc(e.ident.import) + END; + + IF e.type.typ = PROG.tREAL THEN + CODE.retf + END + END + + RETURN res +END chkreturn; + + +PROCEDURE setrtl; +VAR + rtl: PROG.UNIT; + + + PROCEDURE getproc (rtl: PROG.UNIT; name: SCAN.LEXSTR; idx: INTEGER); + VAR + id: PROG.IDENT; + + BEGIN + id := rtl.idents.get(rtl, SCAN.enterid(name), FALSE); + + IF (id # NIL) & (id.import # NIL) THEN + CODE.codes.rtl[idx] := -id.import(CODE.IMPORT_PROC).label; + id.proc.used := TRUE + ELSIF (id # NIL) & (id.proc # NIL) THEN + CODE.codes.rtl[idx] := id.proc.label; + id.proc.used := TRUE + ELSE + ERRORS.error5("procedure ", mConst.RTL_NAME, ".", name, " not found") + END + END getproc; + + +BEGIN + rtl := PARS.program.rtl; + ASSERT(rtl # NIL); + + getproc(rtl, "_move", CODE._move); + getproc(rtl, "_move2", CODE._move2); + getproc(rtl, "_set", CODE._set); + getproc(rtl, "_set2", CODE._set2); + getproc(rtl, "_div", CODE._div); + getproc(rtl, "_mod", CODE._mod); + getproc(rtl, "_div2", CODE._div2); + getproc(rtl, "_mod2", CODE._mod2); + getproc(rtl, "_arrcpy", CODE._arrcpy); + getproc(rtl, "_rot", CODE._rot); + getproc(rtl, "_new", CODE._new); + getproc(rtl, "_dispose", CODE._dispose); + getproc(rtl, "_strcmp", CODE._strcmp); + getproc(rtl, "_error", CODE._error); + getproc(rtl, "_is", CODE._is); + getproc(rtl, "_isrec", CODE._isrec); + getproc(rtl, "_guard", CODE._guard); + getproc(rtl, "_guardrec", CODE._guardrec); + getproc(rtl, "_length", CODE._length); + getproc(rtl, "_init", CODE._init); + getproc(rtl, "_dllentry", CODE._dllentry); + getproc(rtl, "_strcpy", CODE._strcpy); + getproc(rtl, "_exit", CODE._exit); + getproc(rtl, "_strcpy2", CODE._strcpy2); + getproc(rtl, "_lengthw", CODE._lengthw); + getproc(rtl, "_strcmp2", CODE._strcmp2); + getproc(rtl, "_strcmpw", CODE._strcmpw); + getproc(rtl, "_strcmpw2", CODE._strcmpw2); + +END setrtl; + + +PROCEDURE compile* (path, lib_path, modname, outname: PARS.PATH; target, version, stack, base: INTEGER; pic: BOOLEAN; chk: SET); +VAR + parser: PARS.PARSER; + ext: PARS.PATH; + amd64: BOOLEAN; + +BEGIN + amd64 := target IN {mConst.Target_iConsole64, mConst.Target_iGUI64, mConst.Target_iDLL64, mConst.Target_iELF64}; + ext := mConst.FILE_EXT; + CaseLabels := C.create(); + CaseVar := C.create(); + + CaseVariants := LISTS.create(NIL); + LISTS.push(CaseVariants, NewVariant(0, NIL)); + + checking := chk; + + IF amd64 THEN + CODE.init(6, CODE.little_endian) + ELSE + CODE.init(8, CODE.little_endian) + END; + + parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); + IF parser.open(parser, mConst.RTL_NAME) THEN + parser.parse(parser); + PARS.destroy(parser) + ELSE + PARS.destroy(parser); + parser := PARS.create(lib_path, lib_path, StatSeq, expression, designator, chkreturn); + IF parser.open(parser, mConst.RTL_NAME) THEN + parser.parse(parser); + PARS.destroy(parser) + ELSE + ERRORS.error5("file ", lib_path, mConst.RTL_NAME, mConst.FILE_EXT, " not found") + END + END; + + parser := PARS.create(path, lib_path, StatSeq, expression, designator, chkreturn); + parser.main := TRUE; + + IF parser.open(parser, modname) THEN + parser.parse(parser) + ELSE + ERRORS.error5("file ", path, modname, mConst.FILE_EXT, " not found") + END; + + PARS.destroy(parser); + + IF PARS.program.bss > mConst.MAX_GLOBAL_SIZE THEN + ERRORS.error1("size of global variables is too large") + END; + + setrtl; + + PROG.DelUnused(PARS.program, CODE.DelImport); + + CODE.codes.bss := PARS.program.bss; + IF amd64 THEN + AMD64.CodeGen(CODE.codes, outname, target, stack, base) + ELSE + X86.CodeGen(CODE.codes, outname, target, stack, base, version, pic) + END +END compile; + + +END STATEMENTS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/STRINGS.ob07 b/programs/develop/oberon07/Source/STRINGS.ob07 new file mode 100644 index 0000000000..3533c3d51f --- /dev/null +++ b/programs/develop/oberon07/Source/STRINGS.ob07 @@ -0,0 +1,291 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE STRINGS; + +IMPORT UTILS; + + +PROCEDURE append* (VAR s1: ARRAY OF CHAR; s2: ARRAY OF CHAR); +VAR + n1, n2, i, j: INTEGER; +BEGIN + n1 := LENGTH(s1); + n2 := LENGTH(s2); + + ASSERT(n1 + n2 < LEN(s1)); + + i := 0; + j := n1; + WHILE i < n2 DO + s1[j] := s2[i]; + INC(i); + INC(j) + END; + + s1[j] := 0X + +END append; + + +PROCEDURE reverse* (VAR s: ARRAY OF CHAR); +VAR + i, j: INTEGER; + a, b: CHAR; + +BEGIN + + i := 0; + j := LENGTH(s) - 1; + + WHILE i < j DO + a := s[i]; + b := s[j]; + s[i] := b; + s[j] := a; + INC(i); + DEC(j) + END +END reverse; + + +PROCEDURE IntToStr* (x: INTEGER; VAR str: ARRAY OF CHAR); +VAR + i, a: INTEGER; + minus: BOOLEAN; + +BEGIN + IF x = UTILS.minint THEN + IF UTILS.bit_depth = 32 THEN + COPY("-2147483648", str) + ELSIF UTILS.bit_depth = 64 THEN + COPY("-9223372036854775808", str) + END + + ELSE + + minus := x < 0; + IF minus THEN + x := -x + END; + i := 0; + a := 0; + REPEAT + str[i] := CHR(x MOD 10 + ORD("0")); + x := x DIV 10; + INC(i) + UNTIL x = 0; + + IF minus THEN + str[i] := "-"; + INC(i) + END; + + str[i] := 0X; + reverse(str) + + END +END IntToStr; + + +PROCEDURE copy* (src: ARRAY OF CHAR; VAR dst: ARRAY OF CHAR; spos, dpos, count: INTEGER); +BEGIN + WHILE count > 0 DO + dst[dpos] := src[spos]; + INC(spos); + INC(dpos); + DEC(count) + END +END copy; + + +PROCEDURE search* (s: ARRAY OF CHAR; VAR pos: INTEGER; c: CHAR; forward: BOOLEAN); +VAR + length: INTEGER; + +BEGIN + length := LENGTH(s); + + IF (0 <= pos) & (pos < length) THEN + IF forward THEN + WHILE (pos < length) & (s[pos] # c) DO + INC(pos) + END; + IF pos = length THEN + pos := -1 + END + ELSE + WHILE (pos >= 0) & (s[pos] # c) DO + DEC(pos) + END + END + ELSE + pos := -1 + END +END search; + + +PROCEDURE letter* (c: CHAR): BOOLEAN; + RETURN ("a" <= c) & (c <= "z") OR ("A" <= c) & (c <= "Z") OR (c = "_") +END letter; + + +PROCEDURE digit* (c: CHAR): BOOLEAN; + RETURN ("0" <= c) & (c <= "9") +END digit; + + +PROCEDURE hexdigit* (c: CHAR): BOOLEAN; + RETURN ("0" <= c) & (c <= "9") OR ("A" <= c) & (c <= "F") +END hexdigit; + + +PROCEDURE space* (c: CHAR): BOOLEAN; + RETURN (0X < c) & (c <= 20X) +END space; + + +PROCEDURE StrToInt* (str: ARRAY OF CHAR; VAR x: INTEGER): BOOLEAN; +VAR + i, k: INTEGER; + res: BOOLEAN; + +BEGIN + res := TRUE; + i := 0; + x := 0; + k := LENGTH(str); + WHILE i < k DO + IF digit(str[i]) THEN + x := x * 10 + ORD(str[i]) - ORD("0") + ELSE + i := k; + res := FALSE + END; + INC(i) + END + + RETURN res +END StrToInt; + + +PROCEDURE CheckVer (str: ARRAY OF CHAR): BOOLEAN; +VAR + i, k: INTEGER; + res: BOOLEAN; + +BEGIN + k := LENGTH(str); + res := k < LEN(str); + + IF res & digit(str[0]) THEN + i := 0; + WHILE (i < k) & digit(str[i]) DO + INC(i) + END; + IF (i < k) & (str[i] = ".") THEN + INC(i); + IF i < k THEN + WHILE (i < k) & digit(str[i]) DO + INC(i) + END + ELSE + res := FALSE + END + ELSE + res := FALSE + END; + + res := res & (i = k) + ELSE + res := FALSE + END + + RETURN res +END CheckVer; + + +PROCEDURE StrToVer* (str: ARRAY OF CHAR; VAR major, minor: INTEGER): BOOLEAN; +VAR + i: INTEGER; + res: BOOLEAN; + +BEGIN + res := CheckVer(str); + + IF res THEN + i := 0; + minor := 0; + major := 0; + WHILE digit(str[i]) DO + major := major * 10 + ORD(str[i]) - ORD("0"); + INC(i) + END; + INC(i); + WHILE digit(str[i]) DO + minor := minor * 10 + ORD(str[i]) - ORD("0"); + INC(i) + END + END + + RETURN res +END StrToVer; + + +PROCEDURE Utf8To16* (src: ARRAY OF CHAR; VAR dst: ARRAY OF WCHAR): INTEGER; +VAR + i, j, u, srclen, dstlen: INTEGER; + c: CHAR; + +BEGIN + srclen := LEN(src); + dstlen := LEN(dst); + i := 0; + j := 0; + WHILE (i < srclen) & (j < dstlen) & (src[i] # 0X) DO + c := src[i]; + CASE c OF + |00X..7FX: + u := ORD(c) + + |0C1X..0DFX: + u := LSL(ORD(c) - 0C0H, 6); + IF i + 1 < srclen THEN + u := u + ROR(LSL(ORD(src[i + 1]), 26), 26); + INC(i) + END + + |0E1X..0EFX: + u := LSL(ORD(c) - 0E0H, 12); + IF i + 1 < srclen THEN + u := u + ROR(LSL(ORD(src[i + 1]), 26), 20); + INC(i) + END; + IF i + 1 < srclen THEN + u := u + ROR(LSL(ORD(src[i + 1]), 26), 26); + INC(i) + END +(* + |0F1X..0F7X: + |0F9X..0FBX: + |0FDX: + *) + ELSE + END; + INC(i); + dst[j] := WCHR(u); + INC(j) + END; + IF j < dstlen THEN + dst[j] := WCHR(0) + END + + RETURN j +END Utf8To16; + + +END STRINGS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/TEXTDRV.ob07 b/programs/develop/oberon07/Source/TEXTDRV.ob07 new file mode 100644 index 0000000000..0e6a6369d6 --- /dev/null +++ b/programs/develop/oberon07/Source/TEXTDRV.ob07 @@ -0,0 +1,209 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE TEXTDRV; + +IMPORT FILES, C := COLLECTIONS; + + +CONST + + CR = 0DX; LF = 0AX; + + CHUNK = 1024 * 256; + + +TYPE + + TEXT* = POINTER TO RECORD (C.ITEM) + + chunk: ARRAY CHUNK OF BYTE; + pos, size: INTEGER; + file: FILES.FILE; + utf8: BOOLEAN; + CR: BOOLEAN; + + line*, col*: INTEGER; + eof*: BOOLEAN; + eol*: BOOLEAN; + + open*: PROCEDURE (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; + peak*: PROCEDURE (text: TEXT): CHAR; + nextc*: PROCEDURE (text: TEXT) + + END; + + +VAR + + texts: C.COLLECTION; + + +PROCEDURE reset (text: TEXT); +BEGIN + text.chunk[0] := 0; + text.pos := 0; + text.size := 0; + text.file := NIL; + text.utf8 := FALSE; + text.CR := FALSE; + text.line := 1; + text.col := 1; + text.eof := FALSE; + text.eol := FALSE +END reset; + + +PROCEDURE peak (text: TEXT): CHAR; + RETURN CHR(text.chunk[text.pos]) +END peak; + + +PROCEDURE load (text: TEXT); +BEGIN + IF ~text.eof THEN + text.size := FILES.read(text.file, text.chunk, LEN(text.chunk)); + text.pos := 0; + IF text.size = 0 THEN + text.eof := TRUE; + text.chunk[0] := 0 + END + END +END load; + + +PROCEDURE next (text: TEXT); +VAR + c: CHAR; +BEGIN + IF text.pos < text.size - 1 THEN + INC(text.pos) + ELSE + load(text) + END; + + IF ~text.eof THEN + + c := peak(text); + + IF c = CR THEN + INC(text.line); + text.col := 0; + text.eol := TRUE; + text.CR := TRUE + ELSIF c = LF THEN + IF ~text.CR THEN + INC(text.line); + text.col := 0; + text.eol := TRUE + ELSE + text.eol := FALSE + END; + text.CR := FALSE + ELSE + text.eol := FALSE; + IF text.utf8 THEN + IF (c < 80X) OR (c > 0BFX) THEN + INC(text.col) + END + ELSE + INC(text.col) + END; + text.CR := FALSE + END + + END + +END next; + + +PROCEDURE init (text: TEXT); +BEGIN + + IF (text.pos = 0) & (text.size >= 3) THEN + IF (text.chunk[0] = 0EFH) & + (text.chunk[1] = 0BBH) & + (text.chunk[2] = 0BFH) THEN + text.pos := 3; + text.utf8 := TRUE + END + END; + + IF text.size = 0 THEN + text.chunk[0] := 0; + text.size := 1; + text.eof := FALSE + END; + + text.line := 1; + text.col := 1 + +END init; + + +PROCEDURE open (text: TEXT; name: ARRAY OF CHAR): BOOLEAN; +BEGIN + ASSERT(text # NIL); + + reset(text); + text.file := FILES.open(name); + IF text.file # NIL THEN + load(text); + init(text) + END + + RETURN text.file # NIL +END open; + + +PROCEDURE NewText (): TEXT; +VAR + text: TEXT; + citem: C.ITEM; + +BEGIN + citem := C.pop(texts); + IF citem = NIL THEN + NEW(text) + ELSE + text := citem(TEXT) + END + + RETURN text +END NewText; + + +PROCEDURE create* (): TEXT; +VAR + text: TEXT; +BEGIN + text := NewText(); + reset(text); + text.open := open; + text.peak := peak; + text.nextc := next + + RETURN text +END create; + + +PROCEDURE destroy* (VAR text: TEXT); +BEGIN + IF text # NIL THEN + IF text.file # NIL THEN + FILES.close(text.file) + END; + + C.push(texts, text); + text := NIL + END +END destroy; + + +BEGIN + texts := C.create() +END TEXTDRV. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/UNIXTIME.ob07 b/programs/develop/oberon07/Source/UNIXTIME.ob07 new file mode 100644 index 0000000000..be1979b63b --- /dev/null +++ b/programs/develop/oberon07/Source/UNIXTIME.ob07 @@ -0,0 +1,69 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE UNIXTIME; + + +VAR + + days: ARRAY 12, 31, 2 OF INTEGER; + + +PROCEDURE init; +VAR + i, j, k, n0, n1: INTEGER; +BEGIN + + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + days[i, j, 0] := 0; + days[i, j, 1] := 0; + END + END; + + days[ 1, 28, 0] := -1; + + FOR k := 0 TO 1 DO + days[ 1, 29, k] := -1; + days[ 1, 30, k] := -1; + days[ 3, 30, k] := -1; + days[ 5, 30, k] := -1; + days[ 8, 30, k] := -1; + days[10, 30, k] := -1; + END; + + n0 := 0; + n1 := 0; + FOR i := 0 TO 11 DO + FOR j := 0 TO 30 DO + IF days[i, j, 0] = 0 THEN + days[i, j, 0] := n0; + INC(n0) + END; + IF days[i, j, 1] = 0 THEN + days[i, j, 1] := n1; + INC(n1) + END + END + END + +END init; + + +PROCEDURE time* (year, month, day, hour, min, sec: INTEGER): INTEGER; +VAR + d, s: INTEGER; +BEGIN + d := (year - 1970) * 365 + days[month - 1, day - 1, ORD(year DIV 4 = 0)] + (year - 1969) DIV 4; + s := d * 86400 + hour * 3600 + min * 60 + sec + RETURN s +END time; + + +BEGIN + init +END UNIXTIME. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/UTILS.ob07 b/programs/develop/oberon07/Source/UTILS.ob07 index 62ab03efec..8f0766b766 100644 --- a/programs/develop/oberon07/Source/UTILS.ob07 +++ b/programs/develop/oberon07/Source/UTILS.ob07 @@ -1,418 +1,120 @@ -(* - Copyright 2016, 2017 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE UTILS; -IMPORT sys := SYSTEM, H := HOST, ERRORS; +IMPORT HOST, UNIXTIME; + CONST - OS* = H.OS; - Slash* = H.Slash; - Ext* = ".ob07"; - MAX_PATH = 1024; - MAX_PARAM = 1024; - Date* = 1509580800; (* 2017-11-02 *) + slash* = HOST.slash; -TYPE + bit_depth* = HOST.bit_depth; + maxint* = HOST.maxint; + minint* = HOST.minint; + + OS = HOST.OS; - STRING* = ARRAY MAX_PATH OF CHAR; - - ITEM* = POINTER TO rITEM; - - rITEM* = RECORD - Next*, Prev*: ITEM - END; - - LIST* = POINTER TO RECORD - First*, Last*: ITEM; - Count*: INTEGER - END; - - STRCONST* = POINTER TO RECORD (rITEM) - Str*: STRING; - Len*, Number*: INTEGER - END; VAR - Params: ARRAY MAX_PARAM, 2 OF INTEGER; - ParamCount*, Line*, Unit*: INTEGER; - FileName: STRING; + time*: INTEGER; -PROCEDURE SetFile*(F: STRING); + eol*: ARRAY 3 OF CHAR; + + maxreal*: REAL; + + +PROCEDURE FileRead* (F: INTEGER; VAR Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; + RETURN HOST.FileRead(F, Buffer, bytes) +END FileRead; + + +PROCEDURE FileWrite* (F: INTEGER; Buffer: ARRAY OF BYTE; bytes: INTEGER): INTEGER; + RETURN HOST.FileWrite(F, Buffer, bytes) +END FileWrite; + + +PROCEDURE FileCreate* (FName: ARRAY OF CHAR): INTEGER; + RETURN HOST.FileCreate(FName) +END FileCreate; + + +PROCEDURE FileClose* (F: INTEGER); BEGIN - FileName := F -END SetFile; + HOST.FileClose(F) +END FileClose; -PROCEDURE IsInf*(x: LONGREAL): BOOLEAN; - RETURN ABS(x) = sys.INF(LONGREAL) -END IsInf; -PROCEDURE GetChar(adr: INTEGER): CHAR; -VAR res: CHAR; +PROCEDURE FileOpen* (FName: ARRAY OF CHAR): INTEGER; + RETURN HOST.FileOpen(FName) +END FileOpen; + + +PROCEDURE GetArg* (i: INTEGER; VAR str: ARRAY OF CHAR); BEGIN - sys.GET(adr, res) - RETURN res -END GetChar; + HOST.GetArg(i, str) +END GetArg; -PROCEDURE ParamParse(count: INTEGER); -VAR c: CHAR; cond, p: INTEGER; - PROCEDURE ChangeCond(A, B, C: INTEGER); - BEGIN - cond := C; - CASE c OF - |0X: cond := 6 - |1X..20X: cond := A - |22X: cond := B +PROCEDURE Exit* (code: INTEGER); +BEGIN + HOST.ExitProcess(code) +END Exit; + + +PROCEDURE GetTickCount* (): INTEGER; + RETURN HOST.GetTickCount() +END GetTickCount; + + +PROCEDURE OutChar* (c: CHAR); +BEGIN + HOST.OutChar(c) +END OutChar; + + +PROCEDURE splitf* (x: REAL; VAR a, b: INTEGER): INTEGER; + RETURN HOST.splitf(x, a, b) +END splitf; + + +PROCEDURE isRelative* (path: ARRAY OF CHAR): BOOLEAN; + RETURN HOST.isRelative(path) +END isRelative; + + +PROCEDURE GetCurrentDirectory* (VAR path: ARRAY OF CHAR); +BEGIN + HOST.GetCurrentDirectory(path) +END GetCurrentDirectory; + + +PROCEDURE UnixTime* (): INTEGER; +VAR + year, month, day, hour, min, sec: INTEGER; + res: INTEGER; + +BEGIN + IF OS = "LINUX" THEN + res := HOST.UnixTime() ELSE + HOST.now(year, month, day, hour, min, sec); + res := UNIXTIME.time(year, month, day, hour, min, sec) END - END ChangeCond; + + RETURN res +END UnixTime; + BEGIN - p := H.GetCommandLine(); - cond := 0; - WHILE (count < MAX_PARAM) & (cond # 6) DO - c := GetChar(p); - CASE cond OF - |0: ChangeCond(0, 4, 1); IF cond = 1 THEN Params[count, 0] := p END - |4: ChangeCond(5, 0, 5); IF cond = 5 THEN Params[count, 0] := p END - |1: ChangeCond(0, 3, 1); IF cond IN {0, 6} THEN Params[count, 1] := p - 1; INC(count) END - |3, 5: ChangeCond(cond, 1, cond); IF cond = 6 THEN Params[count, 1] := p - 1; INC(count) END - ELSE - END; - INC(p) - END; - ParamCount := count - 1 -END ParamParse; - -PROCEDURE ParamStr*(VAR str: ARRAY OF CHAR; n: INTEGER); -VAR i, j, len: INTEGER; c: CHAR; -BEGIN - j := 0; - IF n <= ParamCount THEN - len := LEN(str) - 1; - i := Params[n, 0]; - WHILE (j < len) & (i <= Params[n, 1]) DO - c := GetChar(i); - IF c # 22X THEN - str[j] := c; - INC(j) - END; - INC(i) - END - END; - str[j] := 0X -END ParamStr; - -PROCEDURE GetMem*(n: INTEGER): INTEGER; - RETURN H.malloc(n) -END GetMem; - -PROCEDURE CloseF*(F: INTEGER); -BEGIN - H.CloseFile(F) -END CloseF; - -PROCEDURE Read*(F, Buffer, Count: INTEGER): INTEGER; - RETURN H.FileRW(F, Buffer, Count, FALSE) -END Read; - -PROCEDURE Write*(F, Buffer, Count: INTEGER): INTEGER; - RETURN H.FileRW(F, Buffer, Count, TRUE) -END Write; - -PROCEDURE FileSize*(F: INTEGER): INTEGER; - RETURN H.FileSize(F) -END FileSize; - -PROCEDURE CharC*(x: CHAR); -VAR str: ARRAY 2 OF CHAR; -BEGIN - str[0] := x; - str[1] := 0X; - H.OutString(str) -END CharC; - -PROCEDURE Int*(x: INTEGER); -VAR i: INTEGER; buf: ARRAY 11 OF INTEGER; -BEGIN - i := 0; - REPEAT - buf[i] := x MOD 10; - x := x DIV 10; - INC(i) - UNTIL x = 0; - REPEAT - DEC(i); - CharC(CHR(buf[i] + ORD("0"))) - UNTIL i = 0 -END Int; - -PROCEDURE Ln*; -BEGIN - CharC(0DX); - CharC(0AX) -END Ln; - -PROCEDURE OutString*(str: ARRAY OF CHAR); -BEGIN - H.OutString(str) -END OutString; - -PROCEDURE ErrMsg*(code: INTEGER); -VAR str: ARRAY 1024 OF CHAR; -BEGIN - ERRORS.ErrorMsg(code, str); - OutString("error: ("); Int(code); OutString(") "); OutString(str); Ln -END ErrMsg; - -PROCEDURE ErrMsgPos*(line, col, code: INTEGER); -VAR s: STRING; -BEGIN - ErrMsg(code); - OutString("file: "); OutString(FileName); Ln; - OutString("line: "); Int(line); Ln; - OutString("pos: "); Int(col); Ln; -END ErrMsgPos; - -PROCEDURE UnitLine*(newUnit, newLine: INTEGER); -BEGIN - Unit := newUnit; - Line := newLine -END UnitLine; - -PROCEDURE Align*(n: INTEGER): INTEGER; - RETURN (4 - n MOD 4) MOD 4 -END Align; - -PROCEDURE CAP(x: CHAR): CHAR; -BEGIN - IF (x >= "a") & (x <= "z") THEN - x := CHR(ORD(x) - 32) - END - RETURN x -END CAP; - -PROCEDURE streq*(a, b: ARRAY OF CHAR): BOOLEAN; -VAR i: INTEGER; -BEGIN - i := -1; - REPEAT - INC(i) - UNTIL (CAP(a[i]) # CAP(b[i])) OR (a[i] = 0X) OR (b[i] = 0X) - RETURN a[i] = b[i] -END streq; - -PROCEDURE concat*(VAR L: STRING; R: STRING); -VAR i, n, pos: INTEGER; -BEGIN - n := LENGTH(R); - i := 0; - pos := LENGTH(L); - WHILE (i <= n) & (pos < LEN(L)) DO - L[pos] := R[i]; - INC(pos); - INC(i) - END -END concat; - -PROCEDURE GetStr*(this: LIST; str: STRING): STRCONST; -VAR res: STRCONST; -BEGIN - res := this.First(STRCONST); - WHILE (res # NIL) & (res.Str # str) DO - res := res.Next(STRCONST) - END - RETURN res -END GetStr; - -PROCEDURE Push*(this: LIST; item: ITEM); -BEGIN - IF this.Count = 0 THEN - this.First := item; - item.Prev := NIL - ELSE - this.Last.Next := item; - item.Prev := this.Last - END; - INC(this.Count); - this.Last := item; - item.Next := NIL -END Push; - -PROCEDURE Insert*(this: LIST; item, prev: ITEM); -BEGIN - IF prev # this.Last THEN - item.Next := prev.Next; - item.Prev := prev; - prev.Next := item; - item.Next.Prev := item; - INC(this.Count) - ELSE - Push(this, item) - END -END Insert; - -PROCEDURE Clear*(this: LIST); -BEGIN - this.First := NIL; - this.Last := NIL; - this.Count := 0 -END Clear; - -PROCEDURE Revers(VAR str: STRING); -VAR a, b: INTEGER; c: CHAR; -BEGIN - a := 0; - b := LENGTH(str) - 1; - WHILE a < b DO - c := str[a]; - str[a] := str[b]; - str[b] := c; - INC(a); - DEC(b) - END -END Revers; - -PROCEDURE Split*(FName: STRING; VAR Path, Name, Ext: STRING); -VAR i, j, k: INTEGER; -BEGIN - i := LENGTH(FName) - 1; - j := 0; - WHILE (i >= 0) & (FName[i] # Slash) DO - Name[j] := FName[i]; - DEC(i); - INC(j) - END; - Name[j] := 0X; - Revers(Name); - j := 0; - k := LENGTH(Name) - 1; - WHILE (k >= 0) & (Name[k] # ".") DO - Ext[j] := Name[k]; - DEC(k); - INC(j) - END; - IF k >= 0 THEN - Name[k] := 0X; - Ext[j] := "."; - INC(j) - ELSE - j := 0 - END; - Ext[j] := 0X; - Revers(Ext); - FOR j := 0 TO i DO - Path[j] := FName[j] - END; - Path[i + 1] := 0X -END Split; - -PROCEDURE LinuxParam; -VAR p, i, str: INTEGER; c: CHAR; -BEGIN - p := H.GetCommandLine(); - sys.GET(p, ParamCount); - sys.GET(p + 4, p); - FOR i := 0 TO ParamCount - 1 DO - sys.GET(p + i * 4, str); - Params[i, 0] := str; - REPEAT - sys.GET(str, c); - INC(str) - UNTIL c = 0X; - Params[i, 1] := str - 1 - END; - DEC(ParamCount) -END LinuxParam; - -PROCEDURE Time*; -VAR sec, dsec: INTEGER; -BEGIN - OutString("elapsed time "); - H.Time(sec, dsec); - sec := sec - H.sec; - dsec := dsec - H.dsec; - dsec := dsec + sec * 100; - Int(dsec DIV 100); CharC("."); - dsec := dsec MOD 100; - IF dsec < 10 THEN - Int(0) - END; - Int(dsec); OutString(" sec"); Ln -END Time; - -PROCEDURE HALT*(n: INTEGER); -BEGIN - Time; - H.ExitProcess(n) -END HALT; - -PROCEDURE MemErr*(err: BOOLEAN); -BEGIN - IF err THEN - ErrMsg(72); - HALT(1) - END -END MemErr; - -PROCEDURE CreateList*(): LIST; -VAR nov: LIST; -BEGIN - NEW(nov); - MemErr(nov = NIL) - RETURN nov -END CreateList; - -PROCEDURE CreateF*(FName: ARRAY OF CHAR): INTEGER; - RETURN H.CreateFile(FName) -END CreateF; - -PROCEDURE OpenF*(FName: ARRAY OF CHAR(*; Mode: INTEGER*)): INTEGER; - RETURN H.OpenFile(FName) -END OpenF; - -PROCEDURE Init; -VAR p: INTEGER; - - PROCEDURE last(VAR p: INTEGER); - BEGIN - WHILE GetChar(p) # 0X DO INC(p) END; - DEC(p) - END last; - -BEGIN - H.init; - IF OS = "WIN" THEN - ParamParse(0) - ELSIF OS = "KOS" THEN - ParamParse(1); - Params[0, 0] := H.GetName(); - Params[0, 1] := Params[0, 0]; - last(Params[0, 1]) - ELSIF OS = "LNX" THEN - LinuxParam - END -END Init; - -BEGIN - Init + time := GetTickCount(); + COPY(HOST.eol, eol); + maxreal := 1.9; + PACK(maxreal, 1023) END UTILS. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/WRITER.ob07 b/programs/develop/oberon07/Source/WRITER.ob07 new file mode 100644 index 0000000000..92f90fe513 --- /dev/null +++ b/programs/develop/oberon07/Source/WRITER.ob07 @@ -0,0 +1,111 @@ +(* + BSD 2-Clause License + + Copyright (c) 2018, Anton Krotov + All rights reserved. +*) + +MODULE WRITER; + +IMPORT FILES, ERRORS, MACHINE; + + +TYPE + + FILE* = FILES.FILE; + + +VAR + + counter*: INTEGER; + + +PROCEDURE align (n, _align: INTEGER): INTEGER; +BEGIN + IF n MOD _align # 0 THEN + n := n + _align - (n MOD _align) + END + + RETURN n +END align; + + +PROCEDURE WriteByte* (file: FILE; n: BYTE); +BEGIN + IF FILES.WriteByte(file, n) THEN + INC(counter) + ELSE + ERRORS.error1("writing file error") + END +END WriteByte; + + +PROCEDURE Write* (file: FILE; chunk: ARRAY OF BYTE; bytes: INTEGER); +VAR + n: INTEGER; + +BEGIN + n := FILES.write(file, chunk, bytes); + IF n # bytes THEN + ERRORS.error1("writing file error") + END; + INC(counter, n) +END Write; + + +PROCEDURE Write64LE* (file: FILE; n: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 7 DO + WriteByte(file, MACHINE.Byte(n, i)) + END +END Write64LE; + + +PROCEDURE Write32LE* (file: FILE; n: INTEGER); +VAR + i: INTEGER; + +BEGIN + FOR i := 0 TO 3 DO + WriteByte(file, MACHINE.Byte(n, i)) + END +END Write32LE; + + +PROCEDURE Write16LE* (file: FILE; n: INTEGER); +BEGIN + WriteByte(file, MACHINE.Byte(n, 0)); + WriteByte(file, MACHINE.Byte(n, 1)) +END Write16LE; + + +PROCEDURE Padding* (file: FILE; FileAlignment: INTEGER); +VAR + i: INTEGER; + +BEGIN + i := align(counter, FileAlignment) - counter; + WHILE i > 0 DO + WriteByte(file, 0); + DEC(i) + END +END Padding; + + +PROCEDURE Create* (FileName: ARRAY OF CHAR): FILE; +BEGIN + counter := 0 + RETURN FILES.create(FileName) +END Create; + + +PROCEDURE Close* (VAR file: FILE); +BEGIN + FILES.close(file) +END Close; + + +END WRITER. \ No newline at end of file diff --git a/programs/develop/oberon07/Source/X86.ob07 b/programs/develop/oberon07/Source/X86.ob07 index 8313e2e7ee..88711d6488 100644 --- a/programs/develop/oberon07/Source/X86.ob07 +++ b/programs/develop/oberon07/Source/X86.ob07 @@ -1,2004 +1,2406 @@ -(* - Copyright 2016, 2017, 2018 Anton Krotov +(* + BSD 2-Clause License - This file is part of Compiler. - - Compiler is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or - (at your option) any later version. - - Compiler is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with Compiler. If not, see . + Copyright (c) 2018, 2019, Anton Krotov + All rights reserved. *) MODULE X86; -IMPORT UTILS, sys := SYSTEM, SCAN, ELF; +IMPORT CODE, REG, UTILS, LISTS, BIN, PE32, KOS, MSCOFF, ELF, mConst := CONSTANTS, MACHINE, CHL := CHUNKLISTS, PATHS; + CONST - ADIM* = 5; + eax = REG.R0; ecx = REG.R1; edx = REG.R2; - lxPlus = 51; lxMinus = 52; lxMult = 53; lxSlash = 54; - lxEQ = 71; lxNE = 72; lxLT = 73; lxGT = 74; lxLE = 75; lxGE = 76; + al = eax; cl = ecx; dl = edx; ah = 4; - TINTEGER = 1; TREAL = 2; TLONGREAL = 3; TCHAR = 4; TSET = 5; TBOOLEAN = 6; TVOID = 7; - TNIL = 8; TCARD16 = 9; TSTRING = 10; TARRAY = 11; TRECORD = 12; TPOINTER = 13; TPROC = 14; + ax = eax; cx = ecx; dx = edx; - stABS* = 1; stODD* = 2; stLEN* = 3; stLSL* = 4; stASR* = 5; stROR* = 6; stFLOOR* = 7; - stFLT* = 8; stORD* = 9; stCHR* = 10; stLONG* = 11; stSHORT* = 12; stINC* = 13; - stDEC* = 14; stINCL* = 15; stEXCL* = 16; stCOPY* = 17; stNEW* = 18; stASSERT* = 19; - stPACK* = 20; stUNPK* = 21; stDISPOSE* = 22; stFABS* = 23; stINC1* = 24; - stDEC1* = 25; stASSERT1* = 26; stUNPK1* = 27; stPACK1* = 28; stLSR* = 29; - stLENGTH* = 30; stMIN* = 31; stMAX* = 32; + esp = 4; + ebp = 5; - sysMOVE* = 108; + sete = 94H; setne = 95H; setl = 9CH; setge = 9DH; setle = 9EH; setg = 9FH; setc = 92H; setnc = 93H; - JMP* = 0E9X; CALL = 0E8X; - JE = 84X; JNE = 85X; JLE = 8EX; JGE = 8DX; JG = 8FX; JL = 8CX; + je = 84H; jne = 85H; jl = 8CH; jge = 8DH; jle = 8EH; jg = 8FH; jb = 82H; jnb = 83H; - JCMD = 1; LCMD = 2; GCMD = 3; OCMD = 4; ECMD = 5; - PUSHEAX = 6; PUSHECX = 7; PUSHEDX = 8; POPEAX = 9; POPECX = 10; POPEDX = 11; - ICMP1 = 13; ICMP2 = 14; - defcall = 0; stdcall = 1; cdecl = 2; winapi = 3; + CODECHUNK = 8; - _rset* = 0; _inset* = 1; _saverec* = 2; _length* = 3; _checktype* = 4; _strcmp* = 5; - _lstrcmp* = 6; _rstrcmp* = 7; _savearr* = 8; _newrec* = 9; _disprec* = 10; _arrayidx* = 11; - _arrayrot* = 12; _assrt* = 13; _strcopy* = 14; _arrayidx1* = 15; _init* = 16; _close* = 17; _halt* = 18; - ASSRT = 19; hInstance = 20; SELFNAME = 21; RTABLE = 22;LoadLibrary = 23; GetProcAddress = 24; - Exports = 25; szSTART = 26; START = 27; szversion = 28; _floor = 29; HALT = 30; - - FREGS = 8; TYPE - ASMLINE* = POINTER TO RECORD (UTILS.rITEM) - cmd, clen, varadr, adr, tcmd, codeadr: INTEGER; short: BOOLEAN - END; + COMMAND = CODE.COMMAND; - TFLT = ARRAY 2 OF INTEGER; - TIDX* = ARRAY ADIM OF INTEGER; + ANYCODE = POINTER TO RECORD (LISTS.ITEM) - SECTIONNAME = ARRAY 8 OF CHAR; + offset: INTEGER - SECTION = RECORD - name: SECTIONNAME; - size, adr, sizealign, OAPfile, reserved6, reserved7, reserved8, attrflags: INTEGER - END; - - HEADER = RECORD - msdos: ARRAY 180 OF CHAR; - typecomp, seccount: sys.CARD16; - time, reserved1, reserved2: INTEGER; - PEoptsize, infflags, PEfile, compver: sys.CARD16; - codesize, datasize, initdatasize, startadr, - codeadr, rdataadr, loadadr, secalign, filealign, - oldestver, version, oldestverNT, reserved3, - filesize, headersize, dllcrc: INTEGER; - UI, reserved4: sys.CARD16; - stksize, stkalloc, heapsize, heapalloc, reserved5, structcount: INTEGER; - structs: ARRAY 16 OF RECORD adr, size: INTEGER END; - sections: ARRAY 3 OF SECTION - END; - - COFFHEADER = RECORD - Machine: sys.CARD16; - NumberOfSections: sys.CARD16; - TimeDateStamp, - PointerToSymbolTable, - NumberOfSymbols: INTEGER; - SizeOfOptionalHeader, - Characteristics: sys.CARD16; - text, data, bss: SECTION - END; - - KOSHEADER = RECORD - menuet01: ARRAY 8 OF CHAR; - ver, start, size, mem, sp, param, path: INTEGER - END; - - ETABLE = RECORD - reserved1, time, reserved2, dllnameoffset, firstnum, adrcount, - namecount, arradroffset, arrnameptroffset, arrnumoffset: INTEGER; - arradr, arrnameptr: ARRAY 10000H OF INTEGER; - arrnum: ARRAY 10000H OF sys.CARD16; - text: ARRAY 1000000 OF CHAR; - textlen, size: INTEGER - END; - - RELOC = RECORD - Page, Size: INTEGER; - reloc: ARRAY 1024 OF sys.CARD16 - END; - -VAR asmlist: UTILS.LIST; start: ASMLINE; dll, con, gui, kos, elf, obj, kem: BOOLEAN; - Lcount, reccount, topstk: INTEGER; recarray: ARRAY 2048 OF INTEGER; current*: ASMLINE; - callstk: ARRAY 1024, 2 OF ASMLINE; OutFile: UTILS.STRING; - Code: ARRAY 4000000 OF CHAR; ccount: INTEGER; Data: ARRAY 1000000 OF CHAR; dcount: INTEGER; - Labels: ARRAY 200000 OF INTEGER; rdata: ARRAY 400H OF INTEGER; Header: HEADER; etable: ETABLE; - ExecName: UTILS.STRING; LoadAdr: INTEGER; Reloc: ARRAY 200000 OF CHAR; rcount: INTEGER; - RtlProc: ARRAY 20 OF INTEGER; OutFilePos: INTEGER; RelocSection: SECTION; - fpu*: INTEGER; isfpu: BOOLEAN; maxfpu: INTEGER; fpucmd: ASMLINE; - kosexp: ARRAY 65536 OF RECORD Name: SCAN.NODE; Adr, NameLabel: INTEGER END; kosexpcount: INTEGER; - maxstrlen*: INTEGER; - -PROCEDURE set_maxstrlen* (value: INTEGER); -BEGIN - maxstrlen := value -END set_maxstrlen; - -PROCEDURE AddRtlProc*(idx, proc: INTEGER); -BEGIN - RtlProc[idx] := proc -END AddRtlProc; - -PROCEDURE IntToCard16(i: INTEGER): sys.CARD16; -VAR w: sys.CARD16; -BEGIN - sys.GET(sys.ADR(i), w) - RETURN w -END IntToCard16; - -PROCEDURE CopyStr(VAR Dest: ARRAY OF CHAR; Source: ARRAY OF CHAR; VAR di: INTEGER; si: INTEGER); -BEGIN - DEC(di); - REPEAT - INC(di); - Dest[di] := Source[si]; - INC(si) - UNTIL Dest[di] = 0X -END CopyStr; - -PROCEDURE exch(VAR a, b: INTEGER); -VAR c: INTEGER; -BEGIN - c := a; - a := b; - b := c -END exch; - -PROCEDURE Sort(VAR NamePtr, Adr: ARRAY OF INTEGER; Text: ARRAY OF CHAR; LB, RB: INTEGER); -VAR L, R: INTEGER; - - PROCEDURE strle(s1, s2: INTEGER): BOOLEAN; - VAR S1, S2: ARRAY 256 OF CHAR; i: INTEGER; - BEGIN - i := 0; - CopyStr(S1, Text, i, s1); - i := 0; - CopyStr(S2, Text, i, s2) - RETURN S1 <= S2 - END strle; - -BEGIN - IF LB < RB THEN - L := LB; - R := RB; - REPEAT - WHILE (L < RB) & strle(NamePtr[L], NamePtr[LB]) DO - INC(L) - END; - WHILE (R > LB) & strle(NamePtr[LB], NamePtr[R]) DO - DEC(R) - END; - IF L < R THEN - exch(NamePtr[L], NamePtr[R]); - exch(Adr[L], Adr[R]) - END - UNTIL L >= R; - IF R > LB THEN - exch(NamePtr[LB], NamePtr[R]); - exch(Adr[LB], Adr[R]); - Sort(NamePtr, Adr, Text, LB, R - 1) END; - Sort(NamePtr, Adr, Text, R + 1, RB) - END -END Sort; -PROCEDURE PackExport(Name: ARRAY OF CHAR); -VAR i: INTEGER; + TCODE = POINTER TO RECORD (ANYCODE) + + code: ARRAY CODECHUNK OF BYTE; + length: INTEGER + + END; + + LABEL = POINTER TO RECORD (ANYCODE) + + label: INTEGER + + END; + + JUMP = POINTER TO RECORD (ANYCODE) + + label, diff: INTEGER; + short: BOOLEAN + + END; + + JMP = POINTER TO RECORD (JUMP) + + END; + + JCC = POINTER TO RECORD (JUMP) + + jmp: INTEGER + + END; + + CALL = POINTER TO RECORD (JUMP) + + END; + + RELOC = POINTER TO RECORD (ANYCODE) + + op, value: INTEGER + + END; + + +VAR + + R: REG.REGS; + + program: BIN.PROGRAM; + + CodeList: LISTS.LIST; + + +PROCEDURE Byte (n: INTEGER): BYTE; + RETURN MACHINE.Byte(n, 0) +END Byte; + + +PROCEDURE Word (n: INTEGER): INTEGER; + RETURN MACHINE.Byte(n, 0) + MACHINE.Byte(n, 1) * 256 +END Word; + + +PROCEDURE OutByte* (n: BYTE); +VAR + c: TCODE; + last: ANYCODE; + BEGIN - Sort(etable.arrnameptr, etable.arradr, etable.text, 0, etable.namecount - 1); - FOR i := 0 TO etable.namecount - 1 DO - etable.arrnum[i] := IntToCard16(i) - END; - etable.size := 40 + etable.adrcount * 4 + etable.namecount * 6; - etable.arradroffset := 40; - etable.arrnameptroffset := 40 + etable.adrcount * 4; - etable.arrnumoffset := etable.arrnameptroffset + etable.namecount * 4; - etable.dllnameoffset := etable.size + etable.textlen; - CopyStr(etable.text, Name, etable.textlen, 0); - INC(etable.textlen); - FOR i := 0 TO etable.namecount - 1 DO - etable.arrnameptr[i] := etable.arrnameptr[i] + etable.size - END; - etable.size := etable.size + etable.textlen -END PackExport; + last := CodeList.last(ANYCODE); -PROCEDURE ProcExport*(Number: INTEGER; Name: SCAN.NODE; NameLabel: INTEGER); -BEGIN - IF dll THEN - etable.arradr[etable.adrcount] := Number; - INC(etable.adrcount); - etable.arrnameptr[etable.namecount] := etable.textlen; - INC(etable.namecount); - CopyStr(etable.text, Name.Name, etable.textlen, 0); - INC(etable.textlen) - ELSIF obj THEN - kosexp[kosexpcount].Name := Name; - kosexp[kosexpcount].Adr := Number; - kosexp[kosexpcount].NameLabel := NameLabel; - INC(kosexpcount) - END -END ProcExport; + IF (last IS TCODE) & (last(TCODE).length < CODECHUNK) THEN + c := last(TCODE); + c.code[c.length] := n; + INC(c.length) + ELSE + NEW(c); + c.code[0] := n; + c.length := 1; + LISTS.push(CodeList, c) + END -PROCEDURE Err(code: INTEGER); -BEGIN - CASE code OF - |1: UTILS.ErrMsg(67); UTILS.OutString(OutFile) - |2: UTILS.ErrMsg(69); UTILS.OutString(OutFile) - ELSE - END; - UTILS.Ln; - UTILS.HALT(1) -END Err; - -PROCEDURE Align*(n, m: INTEGER): INTEGER; - RETURN n + (m - n MOD m) MOD m -END Align; - -PROCEDURE PutReloc(R: RELOC); -VAR i: INTEGER; -BEGIN - sys.PUT(sys.ADR(Reloc[rcount]), R.Page); - INC(rcount, 4); - sys.PUT(sys.ADR(Reloc[rcount]), R.Size); - INC(rcount, 4); - FOR i := 0 TO ASR(R.Size - 8, 1) - 1 DO - sys.PUT(sys.ADR(Reloc[rcount]), R.reloc[i]); - INC(rcount, 2) - END -END PutReloc; - -PROCEDURE InitArray(VAR adr: INTEGER; chars: UTILS.STRING); -VAR i, x, n: INTEGER; -BEGIN - n := LEN(chars) - 1; - i := 0; - WHILE (i < n) & (chars[i] # 0X) DO - x := SCAN.hex(chars[i]) * 16 + SCAN.hex(chars[i + 1]); - sys.PUT(adr, CHR(x)); - INC(adr); - INC(i, 2) - END -END InitArray; - -PROCEDURE WriteF(F, A, N: INTEGER); -BEGIN - IF UTILS.Write(F, A, N) # N THEN - Err(2) - END -END WriteF; - -PROCEDURE Write(A, N: INTEGER); -BEGIN - sys.MOVE(A, OutFilePos, N); - OutFilePos := OutFilePos + N -END Write; - -PROCEDURE Fill(n: INTEGER; c: CHAR); -VAR i: INTEGER; -BEGIN - FOR i := 1 TO n DO - Write(sys.ADR(c), 1) - END -END Fill; - -PROCEDURE SetSection(VAR Section: SECTION; name: SECTIONNAME; size, adr, sizealign, OAPfile, attrflags: INTEGER); -BEGIN - Section.name := name; - Section.size := size; - Section.adr := adr; - Section.sizealign := sizealign; - Section.OAPfile := OAPfile; - Section.attrflags := attrflags; -END SetSection; - -PROCEDURE WritePE(FName: ARRAY OF CHAR; stksize, codesize, datasize, rdatasize, gsize: INTEGER); -CONST textattr = 60000020H; rdataattr = 40000040H; dataattr = 0C0000040H; relocattr = 42000040H; -VAR i, F, adr, acodesize, compver, version, stkalloc, heapsize, heapalloc, filesize, filebuf: INTEGER; - cur: ASMLINE; -BEGIN - - compver := 0; - version := 0; - stkalloc := stksize; - heapsize := 100000H; - heapalloc := 100000H; - acodesize := Align(codesize, 1000H) + 1000H; - adr := sys.ADR(rdata); - filesize := acodesize + Align(rdatasize, 1000H) + Align(datasize, 1000H) + Align(rcount, 1000H); - - InitArray(adr, "5000000040000000000000003400000000000000000000006200000000000000"); - InitArray(adr, "0000000000000000000000000000000000000000500000004000000000000000"); - InitArray(adr, "A4014C6F61644C6962726172794100001F0147657450726F6341646472657373"); - InitArray(adr, "00006B65726E656C33322E646C6C0000"); - - rdata[ 0] := acodesize + 50H; - rdata[ 1] := acodesize + 40H; - rdata[ 3] := acodesize + 34H; - rdata[ 6] := acodesize + 62H; - rdata[ 7] := acodesize; - rdata[13] := acodesize + 50H; - rdata[14] := acodesize + 40H; - - adr := sys.ADR(Header.msdos); - InitArray(adr, "4D5A90000300000004000000FFFF0000B8000000000000004000000000000000"); - InitArray(adr, "00000000000000000000000000000000000000000000000000000000B0000000"); - InitArray(adr, "0E1FBA0E00B409CD21B8014CCD21546869732070726F6772616D2063616E6E6F"); - InitArray(adr, "742062652072756E20696E20444F53206D6F64652E0D0D0A2400000000000000"); - InitArray(adr, "5DCF9F8719AEF1D419AEF1D419AEF1D497B1E2D413AEF1D4E58EE3D418AEF1D4"); - InitArray(adr, "5269636819AEF1D4000000000000000050450000"); - Header.typecomp := IntToCard16(014CH); - IF dll THEN - Header.seccount := IntToCard16(0004H); - Header.infflags := IntToCard16(210EH) - ELSE - Header.seccount := IntToCard16(0003H); - Header.infflags := IntToCard16(010FH) - END; - Header.time := UTILS.Date; - Header.PEoptsize := IntToCard16(00E0H); - Header.PEfile := IntToCard16(010BH); - Header.compver := IntToCard16(compver); - Header.codesize := Align(codesize, 200H); - Header.datasize := Align(datasize + gsize, 200H) + Align(rdatasize, 200H) + Align(rcount, 200H); - Header.startadr := 1000H; - Header.codeadr := 1000H; - Header.rdataadr := Header.codeadr + Align(codesize, 1000H); - Header.loadadr := LoadAdr; - Header.secalign := 1000H; - Header.filealign := 0200H; - Header.oldestver := 0004H; - Header.version := version; - Header.oldestverNT := 0004H; - Header.filesize := Align(codesize, 1000H) + Align(datasize + gsize, 1000H) + Align(rdatasize, 1000H) + Align(rcount, 1000H) + 1000H; - Header.headersize := 0400H; - Header.UI := IntToCard16(ORD(con) + 2); - Header.stksize := stksize; - Header.stkalloc := stkalloc; - Header.heapsize := heapsize; - Header.heapalloc := heapalloc; - Header.structcount := 10H; - IF dll THEN - Header.structs[0].adr := Header.rdataadr + 0DAH; - Header.structs[0].size := etable.size - END; - - Header.structs[1].adr := Header.rdataadr + 0CH; - Header.structs[1].size := 28H; - Header.structs[12].adr := Header.rdataadr; - Header.structs[12].size := 0CH; - - SetSection(Header.sections[0], ".text", codesize, 1000H, Align(codesize, 200H), 400H, textattr); - SetSection(Header.sections[1], ".rdata", rdatasize, Align(codesize, 1000H) + 1000H, Align(rdatasize, 200H), - Align(codesize, 200H) + 400H, rdataattr); - SetSection(Header.sections[2], ".data", datasize + gsize, Align(codesize, 1000H) + Align(rdatasize, 1000H) + 1000H, - Align(datasize, 200H), Align(codesize, 200H) + Align(rdatasize, 200H) + 400H, dataattr); - - IF dll THEN - SetSection(RelocSection, ".reloc", rcount, Header.sections[2].adr + Align(datasize + gsize, 1000H), Align(rcount, 200H), - Header.sections[2].OAPfile + Align(datasize, 200H), relocattr); - Header.structs[5].adr := RelocSection.adr; - Header.structs[5].size := rcount - END; - - F := UTILS.CreateF(FName); - IF F = 0 THEN - Err(1) - END; - OutFilePos := UTILS.GetMem(filesize); - filebuf := OutFilePos; - UTILS.MemErr(OutFilePos = 0); - - Write(sys.ADR(Header), sys.SIZE(HEADER)); - IF dll THEN - Write(sys.ADR(RelocSection), sys.SIZE(SECTION)); - Fill(Align(sys.SIZE(HEADER) + sys.SIZE(SECTION), 200H) - (sys.SIZE(HEADER) + sys.SIZE(SECTION)), 0X) - ELSE - Fill(Align(sys.SIZE(HEADER), 200H) - sys.SIZE(HEADER), 0X) - END; - - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - Write(sys.ADR(Code[cur.cmd]), cur.clen); - cur := cur.Next(ASMLINE) - END; - Fill(Align(codesize, 200H) - codesize, 0X); - Write(sys.ADR(rdata), 0DAH); - IF dll THEN - etable.time := Header.time; - Write(sys.ADR(etable), 40); - Write(sys.ADR(etable.arradr), etable.adrcount * 4); - Write(sys.ADR(etable.arrnameptr), etable.namecount * 4); - Write(sys.ADR(etable.arrnum), etable.namecount * 2); - Write(sys.ADR(etable.text), etable.textlen) - END; - Fill(Align(rdatasize, 200H) - rdatasize, 0X); - Write(sys.ADR(Data), datasize); - Fill(Align(datasize, 200H) - datasize, 0X); - IF dll THEN - Write(sys.ADR(Reloc), rcount); - Fill(Align(rcount, 200H) - rcount, 0X) - END; - WriteF(F, filebuf, OutFilePos - filebuf); - UTILS.CloseF(F) -END WritePE; - -PROCEDURE New; -VAR nov: ASMLINE; -BEGIN - NEW(nov); - UTILS.MemErr(nov = NIL); - nov.cmd := ccount; - UTILS.Insert(asmlist, nov, current); - current := current.Next(ASMLINE) -END New; - -PROCEDURE Empty(varadr: INTEGER); -BEGIN - New; - current.clen := 0; - current.tcmd := ECMD; - current.varadr := varadr -END Empty; - -PROCEDURE OutByte(byte: INTEGER); -BEGIN - New; - current.clen := 1; - Code[ccount] := CHR(byte); - INC(ccount) END OutByte; -PROCEDURE OutInt(int: INTEGER); + +PROCEDURE OutInt (n: INTEGER); BEGIN - New; - current.clen := 4; - sys.PUT(sys.ADR(Code[ccount]), int); - INC(ccount, 4) + OutByte(MACHINE.Byte(n, 0)); + OutByte(MACHINE.Byte(n, 1)); + OutByte(MACHINE.Byte(n, 2)); + OutByte(MACHINE.Byte(n, 3)) END OutInt; -PROCEDURE PushEAX; -BEGIN - OutByte(50H); - current.tcmd := PUSHEAX -END PushEAX; -PROCEDURE PushECX; +PROCEDURE OutByte2 (a, b: BYTE); BEGIN - OutByte(51H); - current.tcmd := PUSHECX -END PushECX; + OutByte(a); + OutByte(b) +END OutByte2; -PROCEDURE PushEDX; -BEGIN - OutByte(52H); - current.tcmd := PUSHEDX -END PushEDX; -PROCEDURE PopEAX; +PROCEDURE OutByte3 (a, b, c: BYTE); BEGIN - OutByte(58H); - current.tcmd := POPEAX -END PopEAX; + OutByte(a); + OutByte(b); + OutByte(c) +END OutByte3; -PROCEDURE PopECX; -BEGIN - OutByte(59H); - current.tcmd := POPECX -END PopECX; -PROCEDURE PopEDX; +PROCEDURE OutWord (n: INTEGER); BEGIN - OutByte(5AH); - current.tcmd := POPEDX -END PopEDX; + ASSERT((0 <= n) & (n <= 65535)); + OutByte2(n MOD 256, n DIV 256) +END OutWord; -PROCEDURE OutCode(cmd: UTILS.STRING); -VAR a, b: INTEGER; -BEGIN - New; - a := sys.ADR(Code[ccount]); - b := a; - InitArray(a, cmd); - ccount := a - b + ccount; - current.clen := a - b -END OutCode; -PROCEDURE Del*(last: ASMLINE); -BEGIN - last.Next := current.Next; - IF current = asmlist.Last THEN - asmlist.Last := last - END; - current := last -END Del; +PROCEDURE isByte (n: INTEGER): BOOLEAN; + RETURN (-128 <= n) & (n <= 127) +END isByte; -PROCEDURE NewLabel*(): INTEGER; -BEGIN - INC(Lcount) - RETURN Lcount -END NewLabel; -PROCEDURE PushCall*(asmline: ASMLINE); -BEGIN - New; - callstk[topstk][0] := asmline; - callstk[topstk][1] := current; - INC(topstk) -END PushCall; +PROCEDURE short (n: INTEGER): INTEGER; + RETURN 2 * ORD(isByte(n)) +END short; -PROCEDURE Param*; -BEGIN - current := callstk[topstk - 1][0] -END Param; -PROCEDURE EndCall*; -BEGIN - current := callstk[topstk - 1][1]; - DEC(topstk) -END EndCall; +PROCEDURE long (n: INTEGER): INTEGER; + RETURN 40H * ORD(~isByte(n)) +END long; -PROCEDURE Init*(UI: INTEGER); -VAR nov: ASMLINE; -BEGIN - dcount := 4; - dll := UI = 1; - gui := UI = 2; - con := UI = 3; - kos := UI = 4; - elf := UI = 5; - obj := UI = 6; - Lcount := HALT; - asmlist := UTILS.CreateList(); - NEW(nov); - UTILS.MemErr(nov = NIL); - UTILS.Push(asmlist, nov); - current := nov -END Init; -PROCEDURE datastr(str: UTILS.STRING); -VAR i, n: INTEGER; +PROCEDURE OutIntByte (n: INTEGER); BEGIN - i := 0; - n := LEN(str); - WHILE (i < n) & (str[i] # 0X) DO - Data[dcount] := str[i]; - INC(dcount); - INC(i) - END; - Data[dcount] := 0X; - INC(dcount) -END datastr; + IF isByte(n) THEN + OutByte(Byte(n)) + ELSE + OutInt(n) + END +END OutIntByte; -PROCEDURE dataint(n: INTEGER); -BEGIN - sys.PUT(sys.ADR(Data[dcount]), n); - INC(dcount, 4) -END dataint; -PROCEDURE jmp*(jamp: CHAR; label: INTEGER); -VAR n: INTEGER; +PROCEDURE shift* (op, reg: INTEGER); BEGIN - New; - CASE jamp OF - |JMP, CALL: - n := 5 - |JE, JLE, JGE, JG, JL, JNE: - Code[ccount] := 0FX; - INC(ccount); - n := 6 - ELSE - END; - current.clen := n; - Code[ccount] := jamp; - INC(ccount); - current.codeadr := sys.ADR(Code[ccount]); - current.varadr := sys.ADR(Labels[label]); - current.tcmd := JCMD; - current.short := TRUE; - INC(ccount, 4) + CASE op OF + |CODE.opASR, CODE.opASR1, CODE.opASR2: OutByte(0F8H + reg) + |CODE.opROR, CODE.opROR1, CODE.opROR2: OutByte(0C8H + reg) + |CODE.opLSL, CODE.opLSL1, CODE.opLSL2: OutByte(0E0H + reg) + |CODE.opLSR, CODE.opLSR1, CODE.opLSR2: OutByte(0E8H + reg) + END +END shift; + + +PROCEDURE mov (reg1, reg2: INTEGER); +BEGIN + OutByte2(89H, 0C0H + reg2 * 8 + reg1) // mov reg1, reg2 +END mov; + + +PROCEDURE xchg (reg1, reg2: INTEGER); +VAR + regs: SET; + +BEGIN + regs := {reg1, reg2}; + IF regs = {eax, ecx} THEN + OutByte(91H) // xchg eax, ecx + ELSIF regs = {eax, edx} THEN + OutByte(92H) // xchg eax, edx + ELSIF regs = {ecx, edx} THEN + OutByte2(87H, 0D1H) // xchg ecx, edx + END +END xchg; + + +PROCEDURE pop (reg: INTEGER); +BEGIN + OutByte(58H + reg) // pop reg +END pop; + + +PROCEDURE push (reg: INTEGER); +BEGIN + OutByte(50H + reg) // push reg +END push; + + +PROCEDURE movrc (reg, n: INTEGER); +BEGIN + OutByte(0B8H + reg); // mov reg, n + OutInt(n) +END movrc; + + +PROCEDURE pushc (n: INTEGER); +BEGIN + OutByte(68H + short(n)); // push n + OutIntByte(n) +END pushc; + + +PROCEDURE test (reg: INTEGER); +BEGIN + OutByte2(85H, 0C0H + reg * 9) // test reg, reg +END test; + + +PROCEDURE neg (reg: INTEGER); +BEGIN + OutByte2(0F7H, 0D8H + reg) // neg reg +END neg; + + +PROCEDURE not (reg: INTEGER); +BEGIN + OutByte2(0F7H, 0D0H + reg) // not reg +END not; + + +PROCEDURE add (reg1, reg2: INTEGER); +BEGIN + OutByte2(01H, 0C0H + reg2 * 8 + reg1) // add reg1, reg2 +END add; + + +PROCEDURE andrc (reg, n: INTEGER); +BEGIN + OutByte2(81H + short(n), 0E0H + reg); // and reg, n + OutIntByte(n) +END andrc; + + +PROCEDURE orrc (reg, n: INTEGER); +BEGIN + OutByte2(81H + short(n), 0C8H + reg); // or reg, n + OutIntByte(n) +END orrc; + + +PROCEDURE addrc (reg, n: INTEGER); +BEGIN + OutByte2(81H + short(n), 0C0H + reg); // add reg, n + OutIntByte(n) +END addrc; + + +PROCEDURE subrc (reg, n: INTEGER); +BEGIN + OutByte2(81H + short(n), 0E8H + reg); // sub reg, n + OutIntByte(n) +END subrc; + + +PROCEDURE cmprr (reg1, reg2: INTEGER); +BEGIN + OutByte2(39H, 0C0H + reg2 * 8 + reg1) // cmp reg1, reg2 +END cmprr; + + +PROCEDURE cmprc (reg, n: INTEGER); +BEGIN + OutByte2(81H + short(n), 0F8H + reg); // cmp reg, n + OutIntByte(n) +END cmprc; + + +PROCEDURE setcc (cond, reg: INTEGER); +BEGIN + OutByte3(0FH, cond, 0C0H + reg) // setcc reg +END setcc; + + +PROCEDURE drop; +BEGIN + REG.Drop(R) +END drop; + + +PROCEDURE log2* (x: INTEGER): INTEGER; +VAR + n: INTEGER; + +BEGIN + ASSERT(x > 0); + + n := 0; + WHILE ~ODD(x) DO + x := x DIV 2; + INC(n) + END; + + IF x # 1 THEN + n := -1 + END + + RETURN n +END log2; + + +PROCEDURE cond* (op: INTEGER): INTEGER; +VAR + res: INTEGER; + +BEGIN + CASE op OF + |CODE.opGT, CODE.opGTR, CODE.opLTL: res := jg + |CODE.opGE, CODE.opGER, CODE.opLEL: res := jge + |CODE.opLT, CODE.opLTR, CODE.opGTL: res := jl + |CODE.opLE, CODE.opLER, CODE.opGEL: res := jle + |CODE.opEQ, CODE.opEQR, CODE.opEQL: res := je + |CODE.opNE, CODE.opNER, CODE.opNEL: res := jne + END + + RETURN res +END cond; + + +PROCEDURE inv1* (op: INTEGER): INTEGER; +BEGIN + IF ODD(op) THEN + DEC(op) + ELSE + INC(op) + END + + RETURN op +END inv1; + + +PROCEDURE Reloc* (op, value: INTEGER); +VAR + reloc: RELOC; + +BEGIN + NEW(reloc); + reloc.op := op; + reloc.value := value; + LISTS.push(CodeList, reloc) +END Reloc; + + +PROCEDURE jcc* (cc, label: INTEGER); +VAR + j: JCC; + +BEGIN + NEW(j); + j.label := label; + j.jmp := cc; + j.short := FALSE; + LISTS.push(CodeList, j) +END jcc; + + +PROCEDURE jmp* (label: INTEGER); +VAR + j: JMP; + +BEGIN + NEW(j); + j.label := label; + j.short := FALSE; + LISTS.push(CodeList, j) END jmp; -PROCEDURE jmplong(jamp: CHAR; label: INTEGER); -BEGIN - jmp(jamp, label); - current.short := FALSE -END jmplong; -PROCEDURE Label*(label: INTEGER); -BEGIN - New; - current.varadr := sys.ADR(Labels[label]); - current.tcmd := LCMD -END Label; +PROCEDURE call* (label: INTEGER); +VAR + c: CALL; -PROCEDURE CmdN(Number: INTEGER); BEGIN - New; - current.clen := 4; - current.codeadr := sys.ADR(Code[ccount]); - current.varadr := sys.ADR(Labels[Number]); - current.tcmd := OCMD; - INC(ccount, 4) -END CmdN; + NEW(c); + c.label := label; + c.short := TRUE; + LISTS.push(CodeList, c) +END call; -PROCEDURE IntByte(bytecode, intcode: UTILS.STRING; n: INTEGER); -BEGIN - IF (n <= 127) & (n >= -128) THEN - OutCode(bytecode); - OutByte(n) - ELSE - OutCode(intcode); - OutInt(n) - END -END IntByte; -PROCEDURE DropFpu*(long: BOOLEAN); +PROCEDURE Pic (reg, opcode, value: INTEGER); BEGIN - IF long THEN - OutCode("83EC08DD1C24") - ELSE - OutCode("83EC04D91C24") - END; - DEC(fpu) -END DropFpu; + OutByte(0E8H); OutInt(0); // call L + // L: + pop(reg); + OutByte2(081H, 0C0H + reg); // add reg, ... + Reloc(opcode, value) +END Pic; + + +PROCEDURE CallRTL (pic: BOOLEAN; proc: INTEGER); +VAR + label: INTEGER; + reg1: INTEGER; -PROCEDURE AfterRet(func, float: BOOLEAN; callconv, parsize: INTEGER); BEGIN - IF callconv = cdecl THEN - OutCode("81C4"); - OutInt(parsize) - END; - IF func THEN - IF float THEN - OutCode("83EC08DD1C24") + label := CODE.codes.rtl[proc]; + + IF label < 0 THEN + label := -label; + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICIMP, label); + OutByte2(0FFH, 010H + reg1); // call dword[reg1] + drop + ELSE + OutByte2(0FFH, 015H); // call dword[label] + Reloc(BIN.RIMP, label) + END ELSE - PushEAX + call(label) END - END -END AfterRet; - -PROCEDURE FpuSave(local: INTEGER); -VAR i: INTEGER; -BEGIN - IF fpu > maxfpu THEN - maxfpu := fpu - END; - FOR i := 1 TO fpu DO - IntByte("DD5D", "DD9D", -local - i * 8) - END -END FpuSave; - -PROCEDURE Incfpu; -BEGIN - IF fpu >= FREGS THEN - UTILS.ErrMsgPos(SCAN.coord.line, SCAN.coord.col, 97); - UTILS.HALT(1) - END; - INC(fpu); - isfpu := TRUE -END Incfpu; - -PROCEDURE FpuLoad(local: INTEGER; float: BOOLEAN); -VAR i: INTEGER; -BEGIN - FOR i := fpu TO 1 BY -1 DO - IntByte("DD45", "DD85", -local - i * 8) - END; - IF float THEN - Incfpu; - OutCode("DD042483C408") - END -END FpuLoad; - -PROCEDURE Call*(proc: INTEGER; func, float: BOOLEAN; callconv, ccall, bases, level, parsize, local: INTEGER); -VAR i: INTEGER; -BEGIN - IF ccall # 0 THEN - FOR i := level TO level - bases + ORD(ccall = 1) + 1 BY -1 DO - IntByte("FF75", "FFB5", 4 * i + 4) - END; - IF ccall = 1 THEN - OutByte(55H) - END - END; - FpuSave(local); - jmplong(CALL, proc); - AfterRet(func, float, callconv, parsize); - FpuLoad(local, func & float) -END Call; - -PROCEDURE CallRTL(Proc: INTEGER); -BEGIN - New; - current.clen := 5; - Code[ccount] := CALL; - INC(ccount); - current.codeadr := sys.ADR(Code[ccount]); - current.varadr := sys.ADR(RtlProc[Proc]); - current.tcmd := JCMD; - INC(ccount, 4) END CallRTL; -PROCEDURE PushInt*(n: INTEGER); -BEGIN - OutByte(68H); - CmdN(n) -END PushInt; -PROCEDURE Prolog*(exename: UTILS.STRING); -BEGIN - ExecName := exename; - Labels[hInstance] := -dcount; - dataint(0); - Labels[SELFNAME] := -dcount; - datastr(exename); - Label(START); - IF dll THEN - OutCode("558BEC837D0C007507"); - CallRTL(_close); - OutCode("EB06837D0C017409B801000000C9C20C00") - ELSIF obj THEN - OutCode("558BEC") - END; - start := asmlist.Last(ASMLINE) -END Prolog; - -PROCEDURE AddRec*(base: INTEGER); -BEGIN - INC(reccount); - recarray[reccount] := base -END AddRec; - -PROCEDURE CmpOpt(inv: BOOLEAN): INTEGER; -VAR cur: ASMLINE; c: INTEGER; -BEGIN - c := ORD(Code[current.Prev.Prev(ASMLINE).cmd]); - IF inv THEN - IF ODD(c) THEN - DEC(c) - ELSE - INC(c) - END - END; - cur := current; - REPEAT - cur.tcmd := 0; - cur.clen := 0; - cur := cur.Prev(ASMLINE) - UNTIL cur.tcmd = ICMP1; - cur.tcmd := 0; - cur.clen := 0 - RETURN c - 16 -END CmpOpt; - -PROCEDURE ifwh*(L: INTEGER); -VAR c: INTEGER; -BEGIN - IF current.Prev(ASMLINE).tcmd = ICMP2 THEN - c := CmpOpt(TRUE); - OutCode("5A583BC2"); - jmp(CHR(c), L) - ELSE - PopECX; - OutCode("85C9"); - jmp(JE, L) - END -END ifwh; - -PROCEDURE PushConst*(Number: INTEGER); -BEGIN - IntByte("6A", "68", Number); - current.Prev(ASMLINE).varadr := Number -END PushConst; - -PROCEDURE IfWhile*(L: INTEGER; orop: BOOLEAN); -VAR c, L1: INTEGER; -BEGIN - L1 := NewLabel(); - IF current.Prev(ASMLINE).tcmd = ICMP2 THEN - c := CmpOpt(orop); - OutCode("5A583BC2"); - jmp(CHR(c), L1); - PushConst(ORD(orop)) - ELSE - PopECX; - OutCode("85C9"); - IF orop THEN - jmp(JE, L1) - ELSE - jmp(JNE, L1) - END; - PushECX - END; - jmp(JMP, L); - Label(L1) -END IfWhile; - -PROCEDURE newrec*; -BEGIN - CallRTL(_newrec) -END newrec; - -PROCEDURE disprec*; -BEGIN - CallRTL(_disprec) -END disprec; - -PROCEDURE String*(Number, Len: INTEGER; str: UTILS.STRING); -BEGIN - Labels[Number] := -dcount; - IF Len > 1 THEN - datastr(str) - ELSIF Len = 1 THEN - dataint(ORD(str[0])) - ELSE - dataint(0) - END -END String; - -PROCEDURE InsertFpuInit; -VAR t: ASMLINE; -BEGIN - IF isfpu THEN - t := current; - current := fpucmd; - IF maxfpu > 0 THEN - OutCode("83EC"); - OutByte(maxfpu * 8) - END; - OutCode("DBE3"); - current := t - END -END InsertFpuInit; - -PROCEDURE ProcBeg*(Number, Local: INTEGER; Module: BOOLEAN); -VAR i: INTEGER; -BEGIN - IF Module THEN - OutCode("EB0C"); - Label(Number + 3); - PushInt(Number + 2); - jmplong(JMP, HALT); - Label(Number + 1) - ELSE - Label(Number) - END; - OutCode("558BEC"); - IF Local > 12 THEN - IntByte("83EC", "81EC", Local); - OutCode("8BD733C08BFCB9"); - OutInt(ASR(Local, 2)); - OutCode("9CFCF3AB8BFA9D") - ELSE - FOR i := 4 TO Local BY 4 DO - OutCode("6A00") - END - END; - fpucmd := current; - fpu := 0; - maxfpu := 0; - isfpu := FALSE -END ProcBeg; - -PROCEDURE Leave*; -BEGIN - OutByte(0C9H); - InsertFpuInit -END Leave; - -PROCEDURE ProcEnd*(Number, Param: INTEGER; func, float: BOOLEAN); -BEGIN - IF func & ~float THEN - PopEAX - END; - OutByte(0C9H); - IF Param = 0 THEN - OutByte(0C3H) - ELSE - OutByte(0C2H); - OutByte(Param MOD 256); - OutByte(ASR(Param, 8)) - END; - InsertFpuInit -END ProcEnd; - -PROCEDURE Module*(Name: UTILS.STRING; Number: INTEGER); -BEGIN - String(Number + 2, LENGTH(Name), Name); - jmplong(JMP, Number + 1) -END Module; - -PROCEDURE Asm*(s: UTILS.STRING); -BEGIN - OutCode(s) -END Asm; - -PROCEDURE GlobalAdr*(offset: INTEGER); -BEGIN - OutByte(0BAH); - OutInt(offset); - current.codeadr := sys.ADR(Code[ccount - 4]); - current.tcmd := GCMD; - PushEDX -END GlobalAdr; - -PROCEDURE Mono*(Number: INTEGER); -BEGIN - PopEDX; - PushInt(Number) -END Mono; - -PROCEDURE StrMono*; -BEGIN - PopEDX; - OutCode("6A02"); - PushEDX -END StrMono; - -PROCEDURE Not*; -BEGIN - PopECX; - OutCode("85C90F94C1"); - PushECX -END Not; - -PROCEDURE NegSet*; -BEGIN - OutCode("F71424") -END NegSet; - -PROCEDURE Int*(Op: INTEGER); -BEGIN - PopEDX; - CASE Op OF - |lxPlus: OutCode("011424") - |lxMinus: OutCode("291424") - |lxMult: OutCode("58F7EA"); PushEAX - ELSE - END -END Int; - -PROCEDURE Set*(Op: INTEGER); -BEGIN - PopEDX; - OutByte(58H); - CASE Op OF - |lxPlus: OutByte(0BH) - |lxMinus: OutCode("F7D223") - |lxMult: OutByte(23H) - |lxSlash: OutByte(33H) - ELSE - END; - OutByte(0C2H); - PushEAX -END Set; - -PROCEDURE Setfpu*(newfpu: INTEGER); -BEGIN - fpu := newfpu -END Setfpu; - -PROCEDURE PushFlt*(x: LONGREAL); -VAR f: TFLT; L: INTEGER; -BEGIN - sys.PUT(sys.ADR(f), x); - Incfpu; - IF x = 0.0D0 THEN - OutCode("D9EE") - ELSIF x = 1.0D0 THEN - OutCode("D9E8") - ELSE - L := NewLabel(); - Labels[L] := -dcount; - dataint(f[0]); - dataint(f[1]); - OutByte(0BAH); - CmdN(L); - OutCode("DD02") - END -END PushFlt; - -PROCEDURE farith*(op: INTEGER); -VAR n: INTEGER; -BEGIN - OutByte(0DEH); - CASE op OF - |lxPlus: n := 0C1H - |lxMinus: n := 0E9H - |lxMult: n := 0C9H - |lxSlash: n := 0F9H - ELSE - END; - OutByte(n); - DEC(fpu) -END farith; - -PROCEDURE fcmp*(Op: INTEGER); -VAR n: INTEGER; -BEGIN - OutCode("33C9DED9DFE09E0F"); - CASE Op OF - |lxEQ: n := 94H - |lxNE: n := 95H - |lxLT: n := 97H - |lxGT: n := 92H - |lxLE: n := 93H - |lxGE: n := 96H - ELSE - END; - DEC(fpu, 2); - OutByte(n); - OutByte(0C1H); - PushECX -END fcmp; - -PROCEDURE fneg*; -BEGIN - OutCode("D9E0") -END fneg; - -PROCEDURE OnError*(n: INTEGER); -BEGIN - OutByte(68H); - OutInt(LSL(UTILS.Line, 4) + n); - jmplong(JMP, UTILS.Unit + 3) -END OnError; - -PROCEDURE idivmod*(opmod: BOOLEAN); -BEGIN - PopECX; - IF opmod THEN - OutCode("58E32E538BD833D9C1FB1F8BD0C1FA1F83F9FF750C3D0000008075055B6A00EB1AF7F985DB740685D2740203D15B52EB0A") - ELSE - OutCode("58E32C538BD833D9C1FB1F8BD0C1FA1F83F9FF750B3D0000008075045B50EB19F7F985DB740585D27401485B50EB0A") - END; - OnError(8) -END idivmod; - -PROCEDURE rset*; -BEGIN - CallRTL(_rset); - PushEAX -END rset; - -PROCEDURE inset*; -BEGIN - CallRTL(_inset); - PushEAX -END inset; - -PROCEDURE Dup*; -BEGIN - PopEDX; - PushEDX; - PushEDX -END Dup; - -PROCEDURE Inclusion*(Op: INTEGER); -BEGIN - PopEDX; - PopEAX; - IF Op = lxLE THEN - PushEDX - ELSE - PushEAX - END; - OutCode("0BC25933C8E3046A00EB026A01") -END Inclusion; - -PROCEDURE NegInt*; -BEGIN - OutCode("F71C24") -END NegInt; - -PROCEDURE CmpInt*(Op: INTEGER); -VAR n: INTEGER; -BEGIN - OutCode("33C95A583BC20F"); current.tcmd := ICMP1; - CASE Op OF - |lxEQ: n := 94H - |lxNE: n := 95H - |lxLT: n := 9CH - |lxGT: n := 9FH - |lxLE: n := 9EH - |lxGE: n := 9DH - ELSE - END; - OutByte(n); - OutByte(0C1H); current.tcmd := ICMP2; - PushECX; -END CmpInt; - -PROCEDURE CallVar*(func, float: BOOLEAN; callconv, parsize, local: INTEGER); -BEGIN - PopEDX; - OutCode("8B1285D2750A"); - OnError(2); - FpuSave(local); - OutCode("FFD2"); - AfterRet(func, float, callconv, parsize); - FpuLoad(local, func & float) -END CallVar; - -PROCEDURE LocalAdr*(offset, bases: INTEGER); -BEGIN - IF bases = 0 THEN - Empty(offset); - OutCode("8BD5") - ELSE - IntByte("8B55", "8B95", 4 * bases + 4) - END; - IntByte("83C2", "81C2", offset); - PushEDX; - IF bases = 0 THEN - Empty(offset) - END -END LocalAdr; - -PROCEDURE Field*(offset: INTEGER); -BEGIN - IF offset # 0 THEN - IntByte("830424", "810424", offset) - END -END Field; - -PROCEDURE DerefType*(n: INTEGER); -BEGIN - IntByte("8B5424", "8B9424", n); - OutCode("FF72FC") -END DerefType; - -PROCEDURE Guard*(T: INTEGER; Check: BOOLEAN); -BEGIN - IF Check THEN - PopEAX; - OutCode("85C074"); - IF T <= 127 THEN - OutByte(9) - ELSE - OutByte(12) - END; - PushEAX - END; - PushConst(T); - PushEAX; - CallRTL(_checktype); - IF Check THEN - PushEAX - ELSE - OutCode("85C0750A"); - OnError(3) - END -END Guard; - -PROCEDURE StProc*(proc: INTEGER); -BEGIN - CASE proc OF - |stINC: PopEDX; OutCode("590111") - |stDEC: PopEDX; OutCode("592911") - |stINC1: PopEDX; OutCode("FF02") - |stDEC1: PopEDX; OutCode("FF0A") - |stINCL: PopEDX; OutCode("580910") - |stEXCL: PopEDX; OutCode("582110") - |stPACK: OutCode("DB04245A5ADD02D9FDDD1A"); isfpu := TRUE - |stPACK1: OutCode("DB04245A5AD902D9FDD91A"); isfpu := TRUE - |stUNPK: PopEDX; OutCode("59DD01D9F4DD19DB1A"); isfpu := TRUE - |stUNPK1: PopEDX; OutCode("59D901D9F4D919DB1A"); isfpu := TRUE - |stCOPY: CallRTL(_strcopy) - |sysMOVE: CallRTL(_savearr) - ELSE - END -END StProc; - -PROCEDURE Assert*(proc, assrt: INTEGER); -BEGIN - PopEDX; - OutCode("85D2751368"); - OutInt(UTILS.Line * 16 + 1); - PushInt(UTILS.Unit + 2); - IF proc = stASSERT THEN - OutCode("6A026A") - ELSE - OutCode("6A016A") - END; - OutByte(assrt); - jmplong(JMP, ASSRT) -END Assert; - -PROCEDURE StFunc*(func: INTEGER); -BEGIN - CASE func OF - |stABS: PopEDX; OutCode("85D27D02F7DA"); PushEDX - |stFABS: OutCode("D9E1") - |stFLT: OutCode("DB0424"); PopEAX; Incfpu; - |stFLOOR: jmplong(CALL, _floor); PushEAX; DEC(fpu) - |stODD: OutCode("83242401") - |stROR: PopECX; OutCode("58D3C8"); PushEAX - |stASR: PopECX; OutCode("58D3F8"); PushEAX - |stLSL: PopECX; OutCode("58D3E0"); PushEAX - |stLSR: PopECX; OutCode("58D3E8"); PushEAX - |stORD: PopEDX; OutCode("85D274036A015A"); PushEDX; - |stMIN: PopEDX; OutCode("3914247E025852"); - |stMAX: PopEDX; OutCode("3B14247E025852"); - |stLENGTH: CallRTL(_length); PushEAX - ELSE - END -END StFunc; - -PROCEDURE Load*(T: INTEGER); -VAR lastcmd: ASMLINE; offset: INTEGER; - - PROCEDURE del; - BEGIN - lastcmd.tcmd := 0; - offset := lastcmd.varadr; - lastcmd := lastcmd.Prev(ASMLINE); - WHILE lastcmd.tcmd # ECMD DO - lastcmd.clen := 0; - lastcmd.tcmd := 0; - lastcmd := lastcmd.Prev(ASMLINE) - END; - lastcmd.tcmd := 0 - END del; +PROCEDURE SetLabel* (label: INTEGER); +VAR + L: LABEL; BEGIN - lastcmd := current; - CASE T OF - |TINTEGER, TSET, TPOINTER, TPROC: - IF lastcmd.tcmd = ECMD THEN - del; - IntByte("8B55", "8B95", offset); - PushEDX - ELSE - PopEDX; - OutCode("FF32") - END - |TCHAR, TBOOLEAN: - IF lastcmd.tcmd = ECMD THEN - del; - OutCode("0FB6"); - IntByte("55", "95", offset); - PushEDX - ELSE - PopEDX; - OutCode("0FB60A"); - PushECX - END - |TLONGREAL: - IF lastcmd.tcmd = ECMD THEN - del; - IntByte("DD45", "DD85", offset) - ELSE - PopEDX; - OutCode("DD02") - END; - Incfpu - |TREAL: - IF lastcmd.tcmd = ECMD THEN - del; - IntByte("D945", "D985", offset) - ELSE - PopEDX; - OutCode("D902") - END; - Incfpu - |TCARD16: - IF lastcmd.tcmd = ECMD THEN - del; - OutCode("33D2668B"); - IntByte("55", "95", offset); - PushEDX - ELSE - PopEDX; - OutCode("33C9668B0A"); - PushECX - END - ELSE - END -END Load; + NEW(L); + L.label := label; + LISTS.push(CodeList, L) +END SetLabel; + + +PROCEDURE fixup*; +VAR + code: ANYCODE; + count, i: INTEGER; + shorted: BOOLEAN; + jump: JUMP; -PROCEDURE Save*(T: INTEGER); BEGIN - CASE T OF - |TINTEGER, TSET, TPOINTER, TPROC: - PopEDX; - OutCode("588910") - |TCHAR, TSTRING, TBOOLEAN: - PopEDX; - OutCode("588810") - |TCARD16: - PopEDX; - OutCode("58668910") - |TLONGREAL: - PopEDX; - OutCode("DD1A"); - DEC(fpu) - |TREAL: - PopEDX; - OutCode("D91A"); - DEC(fpu) - |TRECORD: - CallRTL(_saverec); - OutCode("85C0750A"); - OnError(4) - |TARRAY: - CallRTL(_savearr) - ELSE - END -END Save; -PROCEDURE OpenArray*(A: TIDX; n: INTEGER); -VAR i: INTEGER; -BEGIN - PopEDX; - FOR i := n - 1 TO 0 BY -1 DO - PushConst(A[i]) - END; - PushEDX -END OpenArray; + REPEAT -PROCEDURE OpenIdx*(n: INTEGER); -BEGIN - OutByte(54H); - IF n > 1 THEN - PushConst(n); - CallRTL(_arrayidx) - ELSE - CallRTL(_arrayidx1) - END; - PopEDX; - OutCode("85D2750A"); - OnError(5); - PushEDX; -END OpenIdx; + shorted := FALSE; + count := 0; -PROCEDURE FixIdx*(len, size: INTEGER); -BEGIN - PopEDX; - IntByte("5983FA", "5981FA", len); - OutCode("720A"); - OnError(5); - IF size > 1 THEN - IntByte("6BD2", "69D2", size) - END; - OutCode("03D1"); - PushEDX -END FixIdx; + code := CodeList.first(ANYCODE); + WHILE code # NIL DO + code.offset := count; -PROCEDURE Idx*; -BEGIN - PopEDX; - PopECX; - OutCode("03D1"); - PushEDX -END Idx; + CASE code OF + |TCODE: INC(count, code.length) + |LABEL: BIN.SetLabel(program, code.label, count) + |JMP: IF code.short THEN INC(count, 2) ELSE INC(count, 5) END; code.offset := count + |JCC: IF code.short THEN INC(count, 2) ELSE INC(count, 6) END; code.offset := count + |CALL: INC(count, 5); code.offset := count + |RELOC: INC(count, 4) + END; -PROCEDURE DupLoadCheck*; -BEGIN - PopEDX; - OutCode("528B125285D2750A"); - OnError(6) -END DupLoadCheck; - -PROCEDURE DupLoad*; -BEGIN - PopEDX; - OutCode("528B12"); - PushEDX; -END DupLoad; - -PROCEDURE CheckNIL*; -BEGIN - PopEDX; - OutCode("85D2750A"); - OnError(6); - PushEDX; -END CheckNIL; - -PROCEDURE ExtArray*(A: TIDX; n, m: INTEGER); -VAR i: INTEGER; -BEGIN - FOR i := n - 1 TO 0 BY -1 DO - PushConst(A[i]) - END; - OutByte(54H); - PushConst(n); - PushConst(m); - CallRTL(_arrayrot) -END ExtArray; - -PROCEDURE ADR*(dim: INTEGER); -BEGIN - IF dim > 0 THEN - PopEDX; - OutCode("83C4"); - OutByte(dim * 4); - PushEDX - END -END ADR; - -PROCEDURE Len*(dim: INTEGER); -BEGIN - PopEDX; - IF dim < 0 THEN - PushConst(-dim) - ELSIF dim > 1 THEN - PopEDX; - OutCode("83C4"); - OutByte((dim - 1) * 4); - PushEDX - END -END Len; - -PROCEDURE For*(inc: BOOLEAN; VAR LBeg, LEnd: INTEGER); -BEGIN - LEnd := NewLabel(); - LBeg := NewLabel(); - Label(LBeg); - OutCode("8B14248B4424043910"); - IF inc THEN - jmp(JG, LEnd) - ELSE - jmp(JL, LEnd) - END -END For; - -PROCEDURE NextFor*(step, LBeg, LEnd: INTEGER); -BEGIN - OutCode("8B542404"); - IF step = 1 THEN - OutCode("FF02") - ELSIF step = -1 THEN - OutCode("FF0A") - ELSE - IntByte("8302", "8102", step) - END; - jmp(JMP, LBeg); - Label(LEnd); - OutCode("83C408") -END NextFor; - -PROCEDURE CaseLabel*(a, b, LBeg: INTEGER); -VAR L: INTEGER; -BEGIN - L := NewLabel(); - IntByte("83FA", "81FA", a); - IF a = b THEN - jmp(JNE, L) - ELSE - jmp(JL, L); - IntByte("83FA", "81FA", b); - jmp(JG, L) - END; - jmp(JMP, LBeg); - Label(L) -END CaseLabel; - -PROCEDURE Drop*; -BEGIN - PopEDX -END Drop; - -PROCEDURE strcmp*(Op, LR: INTEGER); -BEGIN - CASE Op OF - |lxEQ: PushConst(0) - |lxNE: PushConst(1) - |lxLT: PushConst(2) - |lxGT: PushConst(3) - |lxLE: PushConst(4) - |lxGE: PushConst(5) - ELSE - END; - CASE LR OF - |-1: CallRTL(_lstrcmp) - | 0: CallRTL(_strcmp) - | 1: CallRTL(_rstrcmp) - ELSE - END; - PushEAX -END strcmp; - -PROCEDURE Optimization; -VAR cur: ASMLINE; flag: BOOLEAN; -BEGIN - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - flag := FALSE; - CASE cur.tcmd OF - |PUSHEAX: - flag := cur.Next(ASMLINE).tcmd = POPEAX - |PUSHECX: - flag := cur.Next(ASMLINE).tcmd = POPECX - |PUSHEDX: - flag := cur.Next(ASMLINE).tcmd = POPEDX - ELSE - END; - IF flag THEN - cur.clen := 0; - cur.tcmd := 0; - cur := cur.Next(ASMLINE); - cur.clen := 0; - cur.tcmd := 0 - END; - cur := cur.Next(ASMLINE) - END -END Optimization; - -PROCEDURE WriteKOS(FName: ARRAY OF CHAR; stk, size, datasize, gsize: INTEGER; obj: BOOLEAN); -CONST strsize = 2048; -VAR Header: KOSHEADER; F, i, filesize, filebuf, a, sec, adr, size2: INTEGER; cur: ASMLINE; - Coff: COFFHEADER; sym: ARRAY 18 * 4 OF CHAR; FileName: UTILS.STRING; -BEGIN - F := UTILS.CreateF(FName); - IF F <= 0 THEN - Err(1) - END; - OutFilePos := UTILS.GetMem(Align(size, 4) + datasize + 1000H); - filebuf := OutFilePos; - UTILS.MemErr(OutFilePos = 0); - - IF ~obj THEN - Header.menuet01 := "MENUET01"; - Header.ver := 1; - Header.start := sys.SIZE(KOSHEADER) + ORD(kem) * 65536; - Header.size := Align(size, 4) + datasize; - Header.mem := Header.size + stk + gsize + strsize * 2 + 1000H; - Header.sp := Header.size + gsize + stk;// + ORD(kem) * 65536; - Header.param := Header.sp; - Header.path := Header.param + strsize; - - Write(sys.ADR(Header), sys.SIZE(KOSHEADER)); - - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - Write(sys.ADR(Code[cur.cmd]), cur.clen); - cur := cur.Next(ASMLINE) - END; - Fill(Align(size, 4) - size, 0X); - Write(sys.ADR(Data), datasize); - WriteF(F, filebuf, OutFilePos - filebuf) - - ELSE - - size2 := size; - size := Align(size, 4) - sys.SIZE(KOSHEADER); - Coff.Machine := IntToCard16(014CH); - Coff.NumberOfSections := IntToCard16(3); - Coff.TimeDateStamp := UTILS.Date; - Coff.SizeOfOptionalHeader := IntToCard16(0); - Coff.Characteristics := IntToCard16(0184H); - - Coff.text.name := ".flat"; - Coff.text.size := 0; - Coff.text.adr := 0; - Coff.text.sizealign := size; - Coff.text.OAPfile := 8CH; - Coff.text.reserved6 := size + datasize + 8CH; - Coff.text.reserved7 := 0; - Coff.text.attrflags := 40300020H; - - Coff.data.name := ".data"; - Coff.data.size := 0; - Coff.data.adr := 0; - Coff.data.sizealign := datasize; - Coff.data.OAPfile := size + 8CH; - Coff.data.reserved6 := 0; - Coff.data.reserved7 := 0; - Coff.data.reserved8 := 0; - Coff.data.attrflags := 0C0300040H; - - Coff.bss.name := ".bss"; - Coff.bss.size := 0; - Coff.bss.adr := 0; - Coff.bss.sizealign := gsize; - Coff.bss.OAPfile := 0; - Coff.bss.reserved6 := 0; - Coff.bss.reserved7 := 0; - Coff.bss.reserved8 := 0; - Coff.bss.attrflags := 0C03000C0H; - - size := Align(size2, 4); - rcount := 0; - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - IF cur.tcmd IN {OCMD, GCMD} THEN - sys.GET(sys.ADR(Code[cur.cmd]), a); - IF a < size THEN - a := a - sys.SIZE(KOSHEADER); - sec := 1 - ELSIF a < size + datasize THEN - a := a - size; - sec := 2 - ELSE - a := a - size - datasize; - sec := 3 + code := code.next(ANYCODE) END; - sys.PUT(sys.ADR(Code[cur.cmd]), a); - sys.PUT(sys.ADR(Reloc[rcount]), cur.adr - sys.SIZE(KOSHEADER)); - INC(rcount, 4); - sys.PUT(sys.ADR(Reloc[rcount]), sec); - INC(rcount, 4); - sys.PUT(sys.ADR(Reloc[rcount]), 06X); INC(rcount); - sys.PUT(sys.ADR(Reloc[rcount]), 00X); INC(rcount); - END; - Write(sys.ADR(Code[cur.cmd]), cur.clen); - cur := cur.Next(ASMLINE) - END; - size := size2; - Fill(Align(size, 4) - size2, 0X); - Write(sys.ADR(Data), datasize); - Coff.text.reserved8 := rcount DIV 10; - Coff.PointerToSymbolTable := Coff.text.reserved6 + rcount; - Coff.NumberOfSymbols := 4; - WriteF(F, sys.ADR(Coff), sys.SIZE(COFFHEADER)); - WriteF(F, filebuf, OutFilePos - filebuf); - WriteF(F, sys.ADR(Reloc), rcount); + code := CodeList.first(ANYCODE); + WHILE code # NIL DO - adr := sys.ADR(sym); - InitArray(adr, "4558504F52545300000000000100000002002E666C617400000000000000010000000300"); - InitArray(adr, "2E64617461000000000000000200000003002E6273730000000000000000030000000300"); - sys.PUT(sys.ADR(sym) + 8, Labels[Exports] - sys.SIZE(KOSHEADER)); + IF code IS JUMP THEN + jump := code(JUMP); + jump.diff := BIN.GetLabel(program, jump.label) - code.offset; + IF ~jump.short & isByte(jump.diff) THEN + jump.short := TRUE; + shorted := TRUE + END + END; - WriteF(F, sys.ADR(sym), LEN(sym)); - i := 4; - WriteF(F, sys.ADR(i), 4) - END; - UTILS.CloseF(F) -END WriteKOS; + code := code.next(ANYCODE) + END -PROCEDURE WriteELF(FName: ARRAY OF CHAR; code, data, glob: INTEGER); -VAR F, delta, filebuf: INTEGER; cur: ASMLINE; bytes: ARRAY 817H + 55FH + 4900 OF CHAR; + UNTIL ~shorted; - PROCEDURE Add(offset: INTEGER); - VAR m: INTEGER; - BEGIN - sys.GET(sys.ADR(bytes[offset]), m); - sys.PUT(sys.ADR(bytes[offset]), m + delta) - END Add; + code := CodeList.first(ANYCODE); + WHILE code # NIL DO - PROCEDURE Sub(offset: INTEGER); - VAR m: INTEGER; - BEGIN - sys.GET(sys.ADR(bytes[offset]), m); - sys.PUT(sys.ADR(bytes[offset]), m - delta) - END Sub; + CASE code OF - PROCEDURE Add8(a1, a2, a3, a4, a5, a6, a7, a8: INTEGER); - BEGIN - Add(a1); Add(a2); Add(a3); Add(a4); - Add(a5); Add(a6); Add(a7); Add(a8) - END Add8; + |TCODE: + FOR i := 0 TO code.length - 1 DO + BIN.PutCode(program, code.code[i]) + END -BEGIN - sys.MOVE(ELF.get(), sys.ADR(bytes[0]), ELF.size); + |LABEL: + BIN.SetLabel(program, code.label, code.offset) - DEC(code, 13); + |JMP: + IF code.short THEN + BIN.PutCode(program, 0EBH); + BIN.PutCode(program, Byte(code.diff)) + ELSE + BIN.PutCode(program, 0E9H); + BIN.PutCode32LE(program, code.diff) + END - delta := Align(data, 1000H) - 100000H; - Add8(0020H, 00A4H, 00A8H, 0258H, 02B8H, 0308H, 0494H, 049CH); - Add8(04A4H, 0679H, 0681H, 06A4H, 06B0H, 06BAH, 0703H, 0762H); - Add8(0774H, 0786H, 0819H, 0823H, 17C5H, 17E5H, 17E9H, 1811H); - Add8(1839H, 1861H, 1889H, 1A25H, 1A95H, 1AA5H, 1C05H, 1C55H); - Add(1CE5H); Add(1D09H); Add(1D15H); Add(1D25H); Add(1D35H); Add(1D55H); + |JCC: + IF code.short THEN + BIN.PutCode(program, code.jmp - 16); + BIN.PutCode(program, Byte(code.diff)) + ELSE + BIN.PutCode(program, 0FH); + BIN.PutCode(program, code.jmp); + BIN.PutCode32LE(program, code.diff) + END - delta := Align(glob, 1000H) - 3200000H; - Add(00A8H); Add(17EDH); Add(1C09H); Add(1D25H); + |CALL: + BIN.PutCode(program, 0E8H); + BIN.PutCode32LE(program, code.diff) - delta := Align(code, 1000H) - 100000H; - Add8(0020H, 0084H, 0088H, 0098H, 009CH, 00A0H, 00B8H, 00BCH); - Add8(00C0H, 0118H, 011CH, 0120H, 0258H, 0278H, 02B8H, 0308H); - Add8(048CH, 0494H, 049CH, 04A4H, 04ACH, 04B4H, 04BCH, 04C4H); - Add8(04CCH, 04D4H, 04DCH, 04E4H, 04ECH, 04F4H, 04FCH, 0504H); - Add8(050CH, 0514H, 052BH, 0544H, 054EH, 0554H, 055EH, 056EH); - Add8(057EH, 058EH, 059EH, 05AEH, 05BEH, 05CEH, 05DEH, 05EEH); - Add8(05FEH, 060EH, 061EH, 062EH, 064CH, 0651H, 0679H, 0681H); - Add8(0686H, 068CH, 06A4H, 06ABH, 06B0H, 06BAH, 06D7H, 06EBH); - Add8(0703H, 0762H, 0774H, 0786H, 0819H, 0823H, 0828H, 082DH); - Add8(1635H, 1655H, 1659H, 167DH, 1681H, 16A5H, 16A9H, 16CDH); - Add8(16D1H, 16F5H, 16F9H, 171DH, 1721H, 1745H, 1749H, 176DH); - Add8(1771H, 1795H, 1799H, 17BDH, 17C1H, 17E5H, 17E9H, 1811H); - Add8(1839H, 1861H, 1889H, 1985H, 1995H, 19A5H, 19B5H, 19C5H); - Add8(19D5H, 19E5H, 19F5H, 1A05H, 1A15H, 1A25H, 1A55H, 1A65H); - Add8(1A75H, 1A95H, 1AA5H, 1AD5H, 1AE5H, 1AF5H, 1B05H, 1B25H); - Add8(1B35H, 1B45H, 1B55H, 1B65H, 1B75H, 1BB5H, 1BC5H, 1BE5H); - Add8(1C05H, 1C15H, 1C55H, 1C75H, 1CA5H, 1CB5H, 1CE5H, 1D05H); - Add8(1D15H, 1D25H, 1D35H, 1D55H, 1D75H, 1D89H, 08DEH, 08E8H); - Sub(0845H); Sub(087BH); Sub(0916H); Add(0C52H); Add(0C8AH); Add(0D0AH); + |RELOC: + BIN.PutReloc(program, code.op); + BIN.PutCode32LE(program, code.value) - OutFilePos := UTILS.GetMem(code + data + 8000H); - filebuf := OutFilePos; - UTILS.MemErr(OutFilePos = 0); - - Write(sys.ADR(bytes), 817H); - Fill(2DDH, 90X); - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - Write(sys.ADR(Code[cur.cmd]), cur.clen); - cur := cur.Next(ASMLINE) - END; - Fill(Align(code, 1000H) - code, 90X); - Write(sys.ADR(bytes[817H]), 55FH); - Write(sys.ADR(Data), data); - Fill(Align(data, 1000H) - data, 0X); - Write(sys.ADR(bytes[817H + 55FH + 55FH]), 0DC5H); - - F := UTILS.CreateF(FName); - IF F <= 0 THEN - Err(1) - END; - WriteF(F, filebuf, OutFilePos - filebuf); - UTILS.CloseF(F) -END WriteELF; - -PROCEDURE DelProc*(beg, end: ASMLINE); -BEGIN - WHILE beg # end DO - beg.clen := 0; - beg.tcmd := 0; - beg := beg.Next(ASMLINE) - END; - beg.clen := 0; - beg.tcmd := 0 -END DelProc; - -PROCEDURE FixLabels*(FName: ARRAY OF CHAR; stk, gsize, glob: INTEGER); -VAR size, asize, i, rdatasize, RCount, n, temp, temp2, temp3: INTEGER; cur: ASMLINE; R: RELOC; c: CHAR; -BEGIN - dcount := Align(dcount, 4); - IF dll THEN - LoadAdr := 10000000H; - PackExport(ExecName) - ELSIF con OR gui THEN - LoadAdr := 400000H - ELSIF kos OR obj THEN - LoadAdr := sys.SIZE(KOSHEADER) + ORD(kem & kos) * 65536 - ELSIF elf THEN - LoadAdr := 134514420 + 1024; - INC(gsize, 1024) - END; - - IF dll OR con OR gui THEN - rdatasize := 0DAH + etable.size; - size := 1000H + LoadAdr; - ELSIF kos OR elf OR obj THEN - rdatasize := 0; - size := LoadAdr - END; - - Optimization; - temp2 := size; - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - cur.adr := size; - IF cur.tcmd = LCMD THEN - sys.PUT(cur.varadr, size) - END; - size := size + cur.clen; - cur := cur.Next(ASMLINE) - END; - - size := temp2; - cur := asmlist.First(ASMLINE); - WHILE cur # NIL DO - cur.adr := size; - IF cur.tcmd = LCMD THEN - sys.PUT(cur.varadr, size) - ELSIF (cur.tcmd = JCMD) & cur.short THEN - sys.GET(cur.varadr, i); - temp3 := i - cur.Next(ASMLINE).adr; - IF (-131 <= temp3) & (temp3 <= 123) THEN - sys.GET(cur(ASMLINE).codeadr - 1, c); - IF c = JMP THEN - sys.PUT(cur(ASMLINE).codeadr - 1, 0EBX) - ELSE (*JE, JNE, JLE, JGE, JG, JL*) - sys.PUT(cur(ASMLINE).codeadr - 2, ORD(c) - 16); - sys.PUT(cur(ASMLINE).codeadr - 1, temp3); - DEC(cur(ASMLINE).codeadr) END; - cur.clen := 2 - END - END; - size := size + cur.clen; - cur := cur.Next(ASMLINE) - END; - IF dll OR con OR gui THEN - asize := Align(size, 1000H) - ELSIF kos OR obj THEN - asize := Align(size, 4) - ELSIF elf THEN - asize := 134514420 + 6508 + Align(size - 13 - LoadAdr, 1000H) - END; - - FOR i := 0 TO Lcount DO - IF Labels[i] < 0 THEN - Labels[i] := -Labels[i] + asize + Align(rdatasize, 1000H) + code := code.next(ANYCODE) END - END; - temp := dcount; - IF elf THEN - asize := asize + Align(dcount, 1000H) + 64 + 1024; - sys.PUT(sys.ADR(Code[glob + 1]), asize - 1024); - dcount := 0 - END; +END fixup; - IF dll THEN - asize := asize - LoadAdr + 0DAH; - FOR i := 0 TO etable.namecount - 1 DO - etable.arradr[i] := Labels[etable.arradr[i]] - LoadAdr; - etable.arrnameptr[i] := etable.arrnameptr[i] + asize + +PROCEDURE UnOp (VAR reg: INTEGER); +BEGIN + REG.UnOp(R, reg) +END UnOp; + + +PROCEDURE BinOp (VAR reg1, reg2: INTEGER); +BEGIN + REG.BinOp(R, reg1, reg2) +END BinOp; + + +PROCEDURE PushAll (NumberOfParameters: INTEGER); +BEGIN + REG.PushAll(R); + R.pushed := R.pushed - NumberOfParameters +END PushAll; + + +PROCEDURE NewLabel (): INTEGER; +BEGIN + BIN.NewLabel(program) + RETURN CODE.NewLabel() +END NewLabel; + + +PROCEDURE GetRegA; +BEGIN + ASSERT(REG.GetReg(R, eax)) +END GetRegA; + + +PROCEDURE translate (code: CODE.CODES; pic: BOOLEAN; stroffs: INTEGER); +VAR + cmd: COMMAND; + + reg1, reg2: INTEGER; + + n, a, b, label, cc: INTEGER; + + param1, param2: INTEGER; + + float: REAL; + +BEGIN + cmd := code.commands.first(COMMAND); + + WHILE cmd # NIL DO + + param1 := cmd.param1; + param2 := cmd.param2; + + CASE cmd.opcode OF + + |CODE.opJMP: + jmp(param1) + + |CODE.opCALL: + call(param1) + + |CODE.opCALLI: + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICIMP, param1); + OutByte2(0FFH, 010H + reg1); // call dword[reg1] + drop + ELSE + OutByte2(0FFH, 015H); // call dword[L] + Reloc(BIN.RIMP, param1) + END + + |CODE.opCALLP: + UnOp(reg1); + OutByte2(0FFH, 0D0H + reg1); // call reg1 + drop; + ASSERT(R.top = -1) + + |CODE.opPRECALL: + n := param2; + IF (param1 # 0) & (n # 0) THEN + subrc(esp, 8) + END; + WHILE n > 0 DO + subrc(esp, 8); + OutByte3(0DDH, 01CH, 024H); // fstp qword[esp] + DEC(n) + END; + PushAll(0) + + |CODE.opALIGN16: + ASSERT(eax IN R.regs); + mov(eax, esp); + andrc(esp, -16); + n := (3 - param2 MOD 4) * 4; + IF n > 0 THEN + subrc(esp, n) + END; + push(eax) + + |CODE.opRES: + ASSERT(R.top = -1); + GetRegA; + n := param2; + WHILE n > 0 DO + OutByte3(0DDH, 004H, 024H); // fld qword[esp] + addrc(esp, 8); + DEC(n) + END + + |CODE.opRESF: + n := param2; + IF n > 0 THEN + OutByte3(0DDH, 5CH + long(n * 8), 24H); + OutIntByte(n * 8); // fstp qword[esp + n*8] + INC(n) + END; + + WHILE n > 0 DO + OutByte3(0DDH, 004H, 024H); // fld qword[esp] + addrc(esp, 8); + DEC(n) + END + + |CODE.opENTER: + ASSERT(R.top = -1); + + SetLabel(param1); + + push(ebp); + mov(ebp, esp); + + n := param2; + IF n > 4 THEN + movrc(ecx, n); + pushc(0); // @@: push 0 + OutByte2(0E2H, 0FCH) // loop @b + ELSE + WHILE n > 0 DO + pushc(0); + DEC(n) + END + END + + |CODE.opLEAVE, CODE.opLEAVER, CODE.opLEAVEF: + IF cmd.opcode = CODE.opLEAVER THEN + UnOp(reg1); + IF reg1 # eax THEN + GetRegA; + ASSERT(REG.Exchange(R, reg1, eax)); + drop + END; + drop + END; + + ASSERT(R.top = -1); + + mov(esp, ebp); + pop(ebp); + + n := param2; + IF n > 0 THEN + n := n * 4; + OutByte(0C2H); OutWord(Word(n)) // ret n + ELSE + OutByte(0C3H) // ret + END + + |CODE.opERRC: + pushc(param2) + + |CODE.opPARAM: + n := param2; + IF n = 1 THEN + UnOp(reg1); + push(reg1); + drop + ELSE + ASSERT(R.top + 1 <= n); + PushAll(n) + END + + |CODE.opCLEANUP: + n := param2 * 4; + IF n # 0 THEN + addrc(esp, n) + END + + |CODE.opPOPSP: + pop(esp) + + |CODE.opCONST: + reg1 := REG.GetAnyReg(R); + movrc(reg1, param2) + + |CODE.opLABEL: + SetLabel(param2) // L: + + |CODE.opNOP: + + |CODE.opGADR: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICBSS, param2) + ELSE + OutByte(0B8H + reg1); // mov reg1, _bss + param2 + Reloc(BIN.RBSS, param2) + END + + |CODE.opLADR: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] + OutIntByte(n) + + |CODE.opVADR: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutIntByte(n) + + |CODE.opSADR: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICDATA, stroffs + param2); + ELSE + OutByte(0B8H + reg1); // mov reg1, _data + stroffs + param2 + Reloc(BIN.RDATA, stroffs + param2) + END + + |CODE.opSAVEC: + UnOp(reg1); + OutByte2(0C7H, reg1); OutInt(param2); // mov dword[reg1], param2 + drop + + |CODE.opSAVE8C: + UnOp(reg1); + OutByte3(0C6H, reg1, Byte(param2)); // mov byte[reg1], param2 + drop + + |CODE.opSAVE16C: + UnOp(reg1); + OutByte3(66H, 0C7H, reg1); OutWord(Word(param2)); // mov word[reg1], param2 + drop + + |CODE.opVLOAD32: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutIntByte(n); + OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + + |CODE.opGLOAD32: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICBSS, param2); + OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + ELSE + OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[_bss + param2] + Reloc(BIN.RBSS, param2) + END + + |CODE.opLLOAD32: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutIntByte(n) + + |CODE.opLOAD32: + UnOp(reg1); + OutByte2(8BH, reg1 * 9) // mov reg1, dword[reg1] + + |CODE.opVLOAD8: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutIntByte(n); + OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + + |CODE.opGLOAD8: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICBSS, param2); + OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + ELSE + OutByte3(00FH, 0B6H, 05H + reg1 * 8); // movzx reg1, byte[_bss + param2] + Reloc(BIN.RBSS, param2) + END + + |CODE.opLLOAD8: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte3(0FH, 0B6H, 45H + reg1 * 8 + long(n)); // movzx reg1, byte[ebp + n] + OutIntByte(n) + + |CODE.opLOAD8: + UnOp(reg1); + OutByte3(0FH, 0B6H, reg1 * 9) // movzx reg1, byte[reg1] + + |CODE.opVLOAD16: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8BH, 45H + reg1 * 8 + long(n)); // mov reg1, dword[ebp + n] + OutIntByte(n); + OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + + |CODE.opGLOAD16: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICBSS, param2); + OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + ELSE + OutByte3(00FH, 0B7H, 05H + reg1 * 8); // movzx reg1, word[_bss + param2] + Reloc(BIN.RBSS, param2) + END + + |CODE.opLLOAD16: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte3(0FH, 0B7H, 45H + reg1 * 8 + long(n)); // movzx reg1, word[ebp + n] + OutIntByte(n) + + |CODE.opLOAD16: + UnOp(reg1); + OutByte3(0FH, 0B7H, reg1 * 9) // movzx reg1, word[reg1] + + |CODE.opUMINUS: + UnOp(reg1); + neg(reg1) + + |CODE.opADD: + BinOp(reg1, reg2); + add(reg1, reg2); + drop + + |CODE.opADDL, CODE.opADDR: + IF param2 # 0 THEN + UnOp(reg1); + IF param2 = 1 THEN + OutByte(40H + reg1) // inc reg1 + ELSIF param2 = -1 THEN + OutByte(48H + reg1) // dec reg1 + ELSE + addrc(reg1, param2) + END + END + + |CODE.opSUB: + BinOp(reg1, reg2); + OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 + drop + + |CODE.opSUBR, CODE.opSUBL: + UnOp(reg1); + n := param2; + IF n = 1 THEN + OutByte(48H + reg1) // dec reg1 + ELSIF n = -1 THEN + OutByte(40H + reg1) // inc reg1 + ELSIF n # 0 THEN + subrc(reg1, n) + END; + IF cmd.opcode = CODE.opSUBL THEN + neg(reg1) + END + + |CODE.opMULC: + UnOp(reg1); + + a := param2; + IF a > 1 THEN + n := log2(a) + ELSIF a < -1 THEN + n := log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + neg(reg1) + ELSIF a = 0 THEN + OutByte2(31H, 0C0H + reg1 * 9) // xor reg1, reg1 + ELSE + IF n > 0 THEN + IF a < 0 THEN + neg(reg1) + END; + + IF n # 1 THEN + OutByte3(0C1H, 0E0H + reg1, n) // shl reg1, n + ELSE + OutByte2(0D1H, 0E0H + reg1) // shl reg1, 1 + END + ELSE + OutByte2(69H + short(a), 0C0H + reg1 * 9); // imul reg1, a + OutIntByte(a) + END + END + + |CODE.opMUL: + BinOp(reg1, reg2); + OutByte3(0FH, 0AFH, 0C0H + reg1 * 8 + reg2); // imul reg1, reg2 + drop + + |CODE.opSAVE, CODE.opSAVE32: + BinOp(reg2, reg1); + OutByte2(89H, reg2 * 8 + reg1); // mov dword[reg1], reg2 + drop; + drop + + |CODE.opSAVE8: + BinOp(reg2, reg1); + OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 + drop; + drop + + |CODE.opSAVE16: + BinOp(reg2, reg1); + OutByte3(66H, 89H, reg2 * 8 + reg1); // mov word[reg1], reg2 + drop; + drop + + |CODE.opSAVEP: + UnOp(reg1); + IF pic THEN + reg2 := REG.GetAnyReg(R); + Pic(reg2, BIN.PICCODE, param2); + OutByte2(089H, reg2 * 8 + reg1); // mov dword[reg1], reg2 + drop + ELSE + OutByte2(0C7H, reg1); // mov dword[reg1], L + Reloc(BIN.RCODE, param2) + END; + drop + + |CODE.opSAVEIP: + UnOp(reg1); + IF pic THEN + reg2 := REG.GetAnyReg(R); + Pic(reg2, BIN.PICIMP, param2); + OutByte2(0FFH, 30H + reg2); // push dword[reg2] + OutByte2(08FH, reg1); // pop dword[reg1] + drop + ELSE + OutByte2(0FFH, 035H); // push dword[L] + Reloc(BIN.RIMP, param2); + OutByte2(08FH, reg1) // pop dword[reg1] + END; + drop + + |CODE.opPUSHP: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICCODE, param2) + ELSE + OutByte(0B8H + reg1); // mov reg1, L + Reloc(BIN.RCODE, param2) + END + + |CODE.opPUSHIP: + reg1 := REG.GetAnyReg(R); + IF pic THEN + Pic(reg1, BIN.PICIMP, param2); + OutByte2(08BH, reg1 * 9) // mov reg1, dword[reg1] + ELSE + OutByte2(08BH, 05H + reg1 * 8); // mov reg1, dword[L] + Reloc(BIN.RIMP, param2) + END + + |CODE.opNOT: + UnOp(reg1); + test(reg1); + setcc(sete, reg1); + andrc(reg1, 1) + + |CODE.opORD: + UnOp(reg1); + test(reg1); + setcc(setne, reg1); + andrc(reg1, 1) + + |CODE.opSBOOL: + BinOp(reg2, reg1); + test(reg2); + setcc(setne, reg2); + OutByte2(88H, reg2 * 8 + reg1); // mov byte[reg1], reg2 + drop; + drop + + |CODE.opSBOOLC: + UnOp(reg1); + OutByte3(0C6H, reg1, ORD(param2 # 0)); // mov byte[reg1], 0/1 + drop + + |CODE.opODD: + UnOp(reg1); + andrc(reg1, 1) + + |CODE.opGTR, CODE.opLTL, CODE.opGER, CODE.opLEL, + CODE.opLER, CODE.opGEL, CODE.opLTR, CODE.opGTL, + CODE.opEQR, CODE.opEQL, CODE.opNER, CODE.opNEL: + UnOp(reg1); + IF param2 = 0 THEN + test(reg1) + ELSE + cmprc(reg1, param2) + END; + drop; + cc := cond(cmd.opcode); + + IF cmd.next(COMMAND).opcode = CODE.opJE THEN + label := cmd.next(COMMAND).param1; + jcc(cc, label); + cmd := cmd.next(COMMAND) + + ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + label := cmd.next(COMMAND).param1; + jcc(inv1(cc), label); + cmd := cmd.next(COMMAND) + + ELSE + reg1 := REG.GetAnyReg(R); + setcc(cc + 16, reg1); + andrc(reg1, 1) + END; + + |CODE.opGT, CODE.opGE, CODE.opLT, + CODE.opLE, CODE.opEQ, CODE.opNE: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + drop; + drop; + cc := cond(cmd.opcode); + + IF cmd.next(COMMAND).opcode = CODE.opJE THEN + label := cmd.next(COMMAND).param1; + jcc(cc, label); + cmd := cmd.next(COMMAND) + + ELSIF cmd.next(COMMAND).opcode = CODE.opJNE THEN + label := cmd.next(COMMAND).param1; + jcc(inv1(cc), label); + cmd := cmd.next(COMMAND) + + ELSE + reg1 := REG.GetAnyReg(R); + setcc(cc + 16, reg1); + andrc(reg1, 1) + END + + |CODE.opEQB, CODE.opNEB: + BinOp(reg1, reg2); + drop; + drop; + + test(reg1); + OutByte2(74H, 5); // je @f + movrc(reg1, 1); // mov reg1, 1 + // @@: + test(reg2); + OutByte2(74H, 5); // je @f + movrc(reg2, 1); // mov reg2, 1 + // @@: + + cmprr(reg1, reg2); + reg1 := REG.GetAnyReg(R); + IF cmd.opcode = CODE.opEQB THEN + setcc(sete, reg1) + ELSE + setcc(setne, reg1) + END; + andrc(reg1, 1) + + |CODE.opDROP: + UnOp(reg1); + drop + + |CODE.opJNZ: + UnOp(reg1); + test(reg1); + jcc(jne, param1) + + |CODE.opJZ: + UnOp(reg1); + test(reg1); + jcc(je, param1) + + |CODE.opJE: + UnOp(reg1); + test(reg1); + jcc(jne, param1); + drop; + + |CODE.opJNE: + UnOp(reg1); + test(reg1); + jcc(je, param1); + drop; + + |CODE.opSWITCH: + UnOp(reg1); + IF param2 = 0 THEN + reg2 := eax + ELSE + reg2 := ecx + END; + IF reg1 # reg2 THEN + ASSERT(REG.GetReg(R, reg2)); + ASSERT(REG.Exchange(R, reg1, reg2)); + drop + END; + drop + + |CODE.opENDSW: + + |CODE.opCASEL: + cmprc(eax, param1); + jcc(jl, param2) + + |CODE.opCASER: + cmprc(eax, param1); + jcc(jg, param2) + + |CODE.opCASELR: + cmprc(eax, param1); + jcc(jl, param2); + jcc(jg, cmd.param3) + + |CODE.opCODE: + OutByte(param2) + + |CODE.opGET: + BinOp(reg1, reg2); + drop; + drop; + + CASE param2 OF + |1: + OutByte2(8AH, reg1 * 9); // mov reg1, byte[reg1] + OutByte2(88H, reg1 * 8 + reg2) // mov byte[reg2], reg1 + + |2: + OutByte3(66H, 8BH, reg1 * 9); // mov reg1, word[reg1] + OutByte3(66H, 89H, reg1 * 8 + reg2) // mov word[reg2], reg1 + + |4: + OutByte2(8BH, reg1 * 9); // mov reg1, dword[reg1] + OutByte2(89H, reg1 * 8 + reg2) // mov dword[reg2], reg1 + + |8: + PushAll(0); + push(reg2); + push(reg1); + pushc(8); + CallRTL(pic, CODE._move) + + END + + |CODE.opSAVES: + UnOp(reg1); + drop; + PushAll(0); + push(reg1); + + IF pic THEN + Pic(reg1, BIN.PICDATA, stroffs + param2); + push(reg1) + ELSE + OutByte(068H); // push _data + stroffs + param2 + Reloc(BIN.RDATA, stroffs + param2); + END; + + pushc(param1); + CallRTL(pic, CODE._move) + + |CODE.opCHKBYTE: + BinOp(reg1, reg2); + cmprc(reg1, 256); + jcc(jb, param1) + + |CODE.opCHKIDX: + UnOp(reg1); + cmprc(reg1, param2); + jcc(jb, param1) + + |CODE.opCHKIDX2: + BinOp(reg1, reg2); + IF param2 # -1 THEN + cmprr(reg2, reg1); + mov(reg1, reg2); + drop; + jcc(jb, param1) + ELSE + INCL(R.regs, reg1); + DEC(R.top); + R.stk[R.top] := reg2 + END + + |CODE.opLEN: + n := param2; + UnOp(reg1); + drop; + EXCL(R.regs, reg1); + + WHILE n > 0 DO + UnOp(reg2); + drop; + DEC(n) + END; + + INCL(R.regs, reg1); + ASSERT(REG.GetReg(R, reg1)) + + |CODE.opINC1: + UnOp(reg1); + OutByte2(0FFH, reg1); // inc dword[reg1] + drop + + |CODE.opDEC1: + UnOp(reg1); + OutByte2(0FFH, 8 + reg1); // dec dword[reg1] + drop + + |CODE.opINCC: + UnOp(reg1); + n := param2; + OutByte2(81H + short(n), reg1); OutIntByte(n); // add dword[reg1], n + drop + + |CODE.opDECC: + UnOp(reg1); + n := param2; + OutByte2(81H + short(n), 28H + reg1); OutIntByte(n); // sub dword[reg1], n + drop + + |CODE.opINC: + BinOp(reg1, reg2); + OutByte2(01H, reg1 * 8 + reg2); // add dword[reg2], reg1 + drop; + drop + + |CODE.opDEC: + BinOp(reg1, reg2); + OutByte2(29H, reg1 * 8 + reg2); // sub dword[reg2], reg1 + drop; + drop + + |CODE.opINC1B: + UnOp(reg1); + OutByte2(0FEH, reg1); // inc byte[reg1] + drop + + |CODE.opDEC1B: + UnOp(reg1); + OutByte2(0FEH, 08H + reg1); // dec byte[reg1] + drop + + |CODE.opINCCB: + UnOp(reg1); + OutByte3(80H, reg1, Byte(param2)); // add byte[reg1], n + drop + + |CODE.opDECCB: + UnOp(reg1); + OutByte3(80H, 28H + reg1, Byte(param2)); // sub byte[reg1], n + drop + + |CODE.opINCB, CODE.opDECB: + BinOp(reg1, reg2); + IF cmd.opcode = CODE.opINCB THEN + OutByte2(00H, reg1 * 8 + reg2) // add byte[reg2], reg1 + ELSE + OutByte2(28H, reg1 * 8 + reg2) // sub byte[reg2], reg1 + END; + drop; + drop + + |CODE.opMULS: + BinOp(reg1, reg2); + OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 + drop + + |CODE.opMULSC: + UnOp(reg1); + andrc(reg1, param2) + + |CODE.opDIVS: + BinOp(reg1, reg2); + OutByte2(31H, 0C0H + reg2 * 8 + reg1); // xor reg1, reg2 + drop + + |CODE.opDIVSC: + UnOp(reg1); + OutByte2(81H + short(param2), 0F0H + reg1); // xor reg1, n + OutIntByte(param2) + + |CODE.opADDS: + BinOp(reg1, reg2); + OutByte2(9H, 0C0H + reg2 * 8 + reg1); // or reg1, reg2 + drop + + |CODE.opSUBS: + BinOp(reg1, reg2); + not(reg2); + OutByte2(21H, 0C0H + reg2 * 8 + reg1); // and reg1, reg2 + drop + + |CODE.opADDSL, CODE.opADDSR: + UnOp(reg1); + orrc(reg1, param2) + + |CODE.opSUBSL: + UnOp(reg1); + not(reg1); + andrc(reg1, param2) + + |CODE.opSUBSR: + UnOp(reg1); + andrc(reg1, ORD(-BITS(param2))); + + |CODE.opUMINS: + UnOp(reg1); + not(reg1) + + |CODE.opLENGTH: + PushAll(2); + CallRTL(pic, CODE._length); + GetRegA + + |CODE.opLENGTHW: + PushAll(2); + CallRTL(pic, CODE._lengthw); + GetRegA + + |CODE.opCHR: + UnOp(reg1); + andrc(reg1, 255) + + |CODE.opWCHR: + UnOp(reg1); + andrc(reg1, 65535) + + |CODE.opASR, CODE.opROR, CODE.opLSL, CODE.opLSR: + UnOp(reg1); + IF reg1 # ecx THEN + ASSERT(REG.GetReg(R, ecx)); + ASSERT(REG.Exchange(R, reg1, ecx)); + drop + END; + + BinOp(reg1, reg2); + ASSERT(reg2 = ecx); + OutByte(0D3H); + shift(cmd.opcode, reg1); // shift reg1, cl + drop + + |CODE.opASR1, CODE.opROR1, CODE.opLSL1, CODE.opLSR1: + UnOp(reg1); + IF reg1 # ecx THEN + ASSERT(REG.GetReg(R, ecx)); + ASSERT(REG.Exchange(R, reg1, ecx)); + drop + END; + + reg1 := REG.GetAnyReg(R); + movrc(reg1, param2); + BinOp(reg1, reg2); + ASSERT(reg1 = ecx); + OutByte(0D3H); + shift(cmd.opcode, reg2); // shift reg2, cl + drop; + drop; + ASSERT(REG.GetReg(R, reg2)) + + |CODE.opASR2, CODE.opROR2, CODE.opLSL2, CODE.opLSR2: + UnOp(reg1); + n := ORD(BITS(param2) * {0..4}); + IF n # 1 THEN + OutByte(0C1H) + ELSE + OutByte(0D1H) + END; + shift(cmd.opcode, reg1); // shift reg1, n + IF n # 1 THEN + OutByte(n) + END + + |CODE.opMIN: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + OutByte2(07EH, 002H); // jle @f + mov(reg1, reg2); // mov reg1, reg2 + // @@: + drop + + |CODE.opMAX: + BinOp(reg1, reg2); + cmprr(reg1, reg2); + OutByte2(07DH, 002H); // jge @f + mov(reg1, reg2); // mov reg1, reg2 + // @@: + drop + + |CODE.opMINC: + UnOp(reg1); + cmprc(reg1, param2); + OutByte2(07EH, 005H); // jle @f + movrc(reg1, param2); // mov reg1, param2 + // @@: + + |CODE.opMAXC: + UnOp(reg1); + cmprc(reg1, param2); + OutByte2(07DH, 005H); // jge @f + movrc(reg1, param2); // mov reg1, param2 + // @@: + + |CODE.opIN: + label := NewLabel(); + BinOp(reg1, reg2); + cmprc(reg1, 32); + OutByte2(72H, 4); // jb L + OutByte2(31H, 0C0H + reg1 * 9); // xor reg1, reg1 + jmp(label); + //L: + OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 + setcc(setc, reg1); + andrc(reg1, 1); + SetLabel(label); + drop + + |CODE.opINR: + label := NewLabel(); + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + cmprc(reg1, 32); + OutByte2(72H, 4); // jb L + OutByte2(31H, 0C0H + reg1 * 9); // xor reg1, reg1 + jmp(label); + //L: + movrc(reg2, param2); + OutByte3(0FH, 0A3H, 0C0H + reg2 + 8 * reg1); // bt reg2, reg1 + setcc(setc, reg1); + andrc(reg1, 1); + SetLabel(label); + drop + + |CODE.opINL: + UnOp(reg1); + OutByte3(0FH, 0BAH, 0E0H + reg1); OutByte(param2); // bt reg1, param2 + setcc(setc, reg1); + andrc(reg1, 1) + + |CODE.opRSET: + PushAll(2); + CallRTL(pic, CODE._set); + GetRegA + + |CODE.opRSETR: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._set); + GetRegA + + |CODE.opRSETL: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._set2); + GetRegA + + |CODE.opRSET1: + UnOp(reg1); + PushAll(1); + push(reg1); + CallRTL(pic, CODE._set); + GetRegA + + |CODE.opINCL, CODE.opEXCL: + BinOp(reg1, reg2); + cmprc(reg1, 32); + OutByte2(73H, 03H); // jnb L + OutByte(0FH); + IF cmd.opcode = CODE.opINCL THEN + OutByte(0ABH) // bts dword[reg2], reg1 + ELSE + OutByte(0B3H) // btr dword[reg2], reg1 + END; + OutByte(reg2 + 8 * reg1); + //L: + drop; + drop + + |CODE.opINCLC: + UnOp(reg1); + OutByte3(0FH, 0BAH, 28H + reg1); OutByte(param2); //bts dword[reg1],param2 + drop + + |CODE.opEXCLC: + UnOp(reg1); + OutByte3(0FH, 0BAH, 30H + reg1); OutByte(param2); //btr dword[reg1],param2 + drop + + |CODE.opDIV: + PushAll(2); + CallRTL(pic, CODE._div); + GetRegA + + |CODE.opDIVR: + a := param2; + IF a > 1 THEN + n := log2(a) + ELSIF a < -1 THEN + n := log2(-a) + ELSE + n := -1 + END; + + IF a = 1 THEN + + ELSIF a = -1 THEN + UnOp(reg1); + neg(reg1) + ELSE + IF n > 0 THEN + UnOp(reg1); + + IF a < 0 THEN + reg2 := REG.GetAnyReg(R); + mov(reg2, reg1); + IF n # 1 THEN + OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n + ELSE + OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 + END; + OutByte2(29H, 0C0H + reg2 * 8 + reg1); // sub reg1, reg2 + drop + ELSE + IF n # 1 THEN + OutByte3(0C1H, 0F8H + reg1, n) // sar reg1, n + ELSE + OutByte2(0D1H, 0F8H + reg1) // sar reg1, 1 + END + END + + ELSE + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._div); + GetRegA + END + END + + |CODE.opDIVL: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._div2); + GetRegA + + |CODE.opMOD: + PushAll(2); + CallRTL(pic, CODE._mod); + GetRegA + + |CODE.opMODR: + a := param2; + IF a > 1 THEN + n := log2(a) + ELSIF a < -1 THEN + n := log2(-a) + ELSE + n := -1 + END; + + IF ABS(a) = 1 THEN + UnOp(reg1); + OutByte2(31H, 0C0H + reg1 * 9) // xor reg1, reg1 + ELSE + IF n > 0 THEN + UnOp(reg1); + andrc(reg1, ABS(a) - 1); + + IF a < 0 THEN + test(reg1); + OutByte(74H); // je @f + IF isByte(a) THEN + OutByte(3) + ELSE + OutByte(6) + END; + addrc(reg1, a) + // @@: + END + + ELSE + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._mod); + GetRegA + END + END + + |CODE.opMODL: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._mod2); + GetRegA + + |CODE.opERR: + CallRTL(pic, CODE._error) + + |CODE.opABS: + UnOp(reg1); + test(reg1); + OutByte2(07DH, 002H); // jge @f + neg(reg1); // neg reg1 + // @@: + + |CODE.opCOPY: + PushAll(2); + pushc(param2); + CallRTL(pic, CODE._move2) + + |CODE.opMOVE: + PushAll(3); + CallRTL(pic, CODE._move2) + + |CODE.opCOPYA: + PushAll(4); + pushc(param2); + CallRTL(pic, CODE._arrcpy); + GetRegA + + |CODE.opCOPYS: + PushAll(4); + pushc(param2); + CallRTL(pic, CODE._strcpy) + + |CODE.opCOPYS2: + PushAll(4); + pushc(param2); + CallRTL(pic, CODE._strcpy2) + + |CODE.opROT: + PushAll(0); + push(esp); + pushc(param2); + CallRTL(pic, CODE._rot) + + |CODE.opNEW: + PushAll(1); + n := param2 + 8; + ASSERT(MACHINE.Align(n, 32)); + pushc(n); + pushc(param1); + CallRTL(pic, CODE._new) + + |CODE.opDISP: + PushAll(1); + CallRTL(pic, CODE._dispose) + + |CODE.opEQS .. CODE.opGES: + PushAll(4); + pushc(cmd.opcode - CODE.opEQS); + CallRTL(pic, CODE._strcmp); + GetRegA + + |CODE.opEQS2 .. CODE.opGES2: + PushAll(4); + pushc(cmd.opcode - CODE.opEQS2); + CallRTL(pic, CODE._strcmp2); + GetRegA + + |CODE.opEQSW .. CODE.opGESW: + PushAll(4); + pushc(cmd.opcode - CODE.opEQSW); + CallRTL(pic, CODE._strcmpw); + GetRegA + + |CODE.opEQSW2 .. CODE.opGESW2: + PushAll(4); + pushc(cmd.opcode - CODE.opEQSW2); + CallRTL(pic, CODE._strcmpw2); + GetRegA + + |CODE.opEQP, CODE.opNEP, CODE.opEQIP, CODE.opNEIP: + UnOp(reg1); + CASE cmd.opcode OF + |CODE.opEQP, CODE.opNEP: + IF pic THEN + reg2 := REG.GetAnyReg(R); + Pic(reg2, BIN.PICCODE, param1); + cmprr(reg1, reg2); + drop + ELSE + OutByte2(081H, 0F8H + reg1); // cmp reg1, L + Reloc(BIN.RCODE, param1) + END + + |CODE.opEQIP, CODE.opNEIP: + IF pic THEN + reg2 := REG.GetAnyReg(R); + Pic(reg2, BIN.PICIMP, param1); + OutByte2(03BH, reg1 * 8 + reg2); //cmp reg1, dword [reg2] + drop + ELSE + OutByte2(3BH, 05H + reg1 * 8); // cmp reg1, dword[L] + Reloc(BIN.RIMP, param1) + END + + END; + drop; + reg1 := REG.GetAnyReg(R); + + CASE cmd.opcode OF + |CODE.opEQP, CODE.opEQIP: setcc(sete, reg1) + |CODE.opNEP, CODE.opNEIP: setcc(setne, reg1) + END; + + andrc(reg1, 1) + + |CODE.opPUSHT: + UnOp(reg1); + reg2 := REG.GetAnyReg(R); + OutByte3(8BH, 40H + reg2 * 8 + reg1, 0FCH) // mov reg2, dword[reg1 - 4] + + |CODE.opISREC: + PushAll(2); + pushc(param2); + CallRTL(pic, CODE._isrec); + GetRegA + + |CODE.opIS: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._is); + GetRegA + + |CODE.opTYPEGR: + PushAll(1); + pushc(param2); + CallRTL(pic, CODE._guardrec); + GetRegA + + |CODE.opTYPEGP: + UnOp(reg1); + PushAll(0); + push(reg1); + pushc(param2); + CallRTL(pic, CODE._guard); + GetRegA + + |CODE.opTYPEGD: + UnOp(reg1); + PushAll(0); + OutByte3(0FFH, 070H + reg1, 0FCH); // push dword[reg1 - 4] + pushc(param2); + CallRTL(pic, CODE._guardrec); + GetRegA + + |CODE.opCASET: + push(ecx); + push(ecx); + pushc(param2); + CallRTL(pic, CODE._guardrec); + pop(ecx); + test(eax); + jcc(jne, param1) + + |CODE.opPACK: + BinOp(reg1, reg2); + push(reg2); + OutByte3(0DBH, 004H, 024H); // fild dword[esp] + OutByte2(0DDH, reg1); // fld qword[reg1] + OutByte2(0D9H, 0FDH); // fscale + OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + pop(reg2); + drop; + drop + + |CODE.opPACKC: + UnOp(reg1); + pushc(param2); + OutByte3(0DBH, 004H, 024H); // fild dword[esp] + OutByte2(0DDH, reg1); // fld qword[reg1] + OutByte2(0D9H, 0FDH); // fscale + OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + pop(reg1); + drop + + |CODE.opUNPK: + BinOp(reg1, reg2); + OutByte2(0DDH, reg1); // fld qword[reg1] + OutByte2(0D9H, 0F4H); // fxtract + OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] + drop; + drop + + |CODE.opPUSHF: + subrc(esp, 8); + OutByte3(0DDH, 01CH, 024H) // fstp qword[esp] + + |CODE.opLOADF: + UnOp(reg1); + OutByte2(0DDH, reg1); // fld qword[reg1] + drop + + |CODE.opCONSTF: + float := cmd.float; + IF float = 0.0 THEN + OutByte2(0D9H, 0EEH) // fldz + ELSIF float = 1.0 THEN + OutByte2(0D9H, 0E8H) // fld1 + ELSIF float = -1.0 THEN + OutByte2(0D9H, 0E8H); // fld1 + OutByte2(0D9H, 0E0H) // fchs + ELSE + n := UTILS.splitf(float, a, b); + pushc(b); + pushc(a); + OutByte3(0DDH, 004H, 024H); // fld qword[esp] + addrc(esp, 8) + END + + |CODE.opSAVEF: + UnOp(reg1); + OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + drop + + |CODE.opADDF, CODE.opADDFI: + OutByte2(0DEH, 0C1H) // faddp st1, st + + |CODE.opSUBF: + OutByte2(0DEH, 0E9H) // fsubp st1, st + + |CODE.opSUBFI: + OutByte2(0DEH, 0E1H) // fsubrp st1, st + + |CODE.opMULF: + OutByte2(0DEH, 0C9H) // fmulp st1, st + + |CODE.opDIVF: + OutByte2(0DEH, 0F9H) // fdivp st1, st + + |CODE.opDIVFI: + OutByte2(0DEH, 0F1H) // fdivrp st1, st + + |CODE.opUMINF: + OutByte2(0D9H, 0E0H) // fchs + + |CODE.opFABS: + OutByte2(0D9H, 0E1H) // fabs + + |CODE.opFLT: + UnOp(reg1); + push(reg1); + OutByte3(0DBH, 004H, 024H); // fild dword[esp] + pop(reg1); + drop + + |CODE.opFLOOR: + reg1 := REG.GetAnyReg(R); + subrc(esp, 8); + OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 004H); // fstcw word[esp+4] + OutByte2(09BH, 0D9H); OutByte3(07CH, 024H, 006H); // fstcw word[esp+6] + OutByte2(066H, 081H); OutByte3(064H, 024H, 004H); OutWord(0F3FFH); // and word[esp+4], 1111001111111111b + OutByte2(066H, 081H); OutByte3(04CH, 024H, 004H); OutWord(00400H); // or word[esp+4], 0000010000000000b + OutByte2(0D9H, 06CH); OutByte2(024H, 004H); // fldcw word[esp+4] + OutByte2(0D9H, 0FCH); // frndint + OutByte3(0DBH, 01CH, 024H); // fistp dword[esp] + pop(reg1); + OutByte2(0D9H, 06CH); OutByte2(024H, 002H); // fldcw word[esp+2] + addrc(esp, 4) + + |CODE.opEQF, CODE.opEQFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 003H); // jp L + setcc(sete, al) + // L: + + |CODE.opNEF, CODE.opNEFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 003H); // jp L + setcc(setne, al) + // L: + + |CODE.opLTF, CODE.opGTFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 00EH); // jp L + setcc(setc, al); + setcc(sete, ah); + test(eax); + setcc(sete, al); + andrc(eax, 1) + // L: + + |CODE.opGTF, CODE.opLTFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 00FH); // jp L + setcc(setc, al); + setcc(sete, ah); + cmprc(eax, 1); + setcc(sete, al); + andrc(eax, 1) + // L: + + |CODE.opLEF, CODE.opGEFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 003H); // jp L + setcc(setnc, al) + // L: + + |CODE.opGEF, CODE.opLEFI: + GetRegA; + OutByte2(0DAH, 0E9H); // fucompp + OutByte3(09BH, 0DFH, 0E0H); // fstsw ax + OutByte(09EH); // sahf + movrc(eax, 0); + OutByte2(07AH, 010H); // jp L + setcc(setc, al); + setcc(sete, ah); + OutByte2(000H, 0E0H); // add al,ah + OutByte2(03CH, 001H); // cmp al,1 + setcc(sete, al); + andrc(eax, 1) + // L: + + |CODE.opINF: + pushc(7FF00000H); + pushc(0); + OutByte3(0DDH, 004H, 024H); // fld qword[esp] + addrc(esp, 8) + + |CODE.opLADR_UNPK: + n := param2 * 4; + reg1 := REG.GetAnyReg(R); + OutByte2(8DH, 45H + reg1 * 8 + long(n)); // lea reg1, dword[ebp + n] + OutIntByte(n); + BinOp(reg1, reg2); + OutByte2(0DDH, reg1); // fld qword[reg1] + OutByte2(0D9H, 0F4H); // fxtract + OutByte2(0DDH, 018H + reg1); // fstp qword[reg1] + OutByte2(0DBH, 018H + reg2); // fistp dword[reg2] + drop; + drop + + |CODE.opSADR_PARAM: + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICDATA, stroffs + param2); + push(reg1); + drop + ELSE + OutByte(068H); // push _data + stroffs + param2 + Reloc(BIN.RDATA, stroffs + param2) + END + + |CODE.opVADR_PARAM: + n := param2 * 4; + OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] + OutIntByte(n) + + |CODE.opCONST_PARAM: + pushc(param2) + + |CODE.opGLOAD32_PARAM: + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICBSS, param2); + OutByte2(0FFH, 30H + reg1); // push dword[reg1] + drop + ELSE + OutByte2(0FFH, 035H); // push dword[_bss + param2] + Reloc(BIN.RBSS, param2) + END + + |CODE.opLLOAD32_PARAM: + n := param2 * 4; + OutByte2(0FFH, 75H + long(n)); // push dword[ebp + n] + OutIntByte(n) + + |CODE.opLOAD32_PARAM: + UnOp(reg1); + OutByte2(0FFH, 30H + reg1); // push dword[reg1] + drop + + |CODE.opGADR_SAVEC: + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICBSS, param1); + OutByte2(0C7H, reg1); // mov dword[reg1], param2 + OutInt(param2); + drop + ELSE + OutByte2(0C7H, 05H); // mov dword[_bss + param2], param2 + Reloc(BIN.RBSS, param1); + OutInt(param2) + END + + |CODE.opLADR_SAVEC: + n := param1 * 4; + OutByte2(0C7H, 45H + long(n)); // mov dword[ebp + n], param2 + OutIntByte(n); + OutInt(param2) + + |CODE.opLADR_SAVE: + n := param2 * 4; + UnOp(reg1); + OutByte2(89H, 45H + reg1 * 8 + long(n)); // mov dword[ebp + n], reg1 + OutIntByte(n); + drop + + |CODE.opLADR_INC1: + n := param2 * 4; + OutByte2(0FFH, 45H + long(n)); // inc dword[ebp + n] + OutIntByte(n) + + |CODE.opLADR_DEC1: + n := param2 * 4; + OutByte2(0FFH, 4DH + long(n)); // dec dword[ebp + n] + OutIntByte(n) + + |CODE.opLADR_INCC: + n := param1 * 4; + OutByte2(81H + short(param2), 45H + long(n)); // add dword[ebp + n], param2 + OutIntByte(n); + OutIntByte(param2) + + |CODE.opLADR_DECC: + n := param1 * 4; + OutByte2(81H + short(param2), 6DH + long(n)); // sub dword[ebp + n], param2 + OutIntByte(n); + OutIntByte(param2) + + |CODE.opLADR_INC1B: + n := param2 * 4; + OutByte2(0FEH, 45H + long(n)); // inc byte[ebp + n] + OutIntByte(n) + + |CODE.opLADR_DEC1B: + n := param2 * 4; + OutByte2(0FEH, 4DH + long(n)); // dec byte[ebp + n] + OutIntByte(n) + + |CODE.opLADR_INCCB: + n := param1 * 4; + OutByte2(80H, 45H + long(n)); // add byte[ebp + n], param2 + OutIntByte(n); + OutByte(param2 MOD 256) + + |CODE.opLADR_DECCB: + n := param1 * 4; + OutByte2(80H, 6DH + long(n)); // sub byte[ebp + n], param2 + OutIntByte(n); + OutByte(param2 MOD 256) + + |CODE.opLADR_INC: + n := param2 * 4; + UnOp(reg1); + OutByte2(01H, 45H + long(n) + reg1 * 8); // add dword[ebp + n], reg1 + OutIntByte(n); + drop + + |CODE.opLADR_DEC: + n := param2 * 4; + UnOp(reg1); + OutByte2(29H, 45H + long(n) + reg1 * 8); // sub dword[ebp + n], reg1 + OutIntByte(n); + drop + + |CODE.opLADR_INCB: + n := param2 * 4; + UnOp(reg1); + OutByte2(00H, 45H + long(n) + reg1 * 8); // add byte[ebp + n], reg1 + OutIntByte(n); + drop + + |CODE.opLADR_DECB: + n := param2 * 4; + UnOp(reg1); + OutByte2(28H, 45H + long(n) + reg1 * 8); // sub byte[ebp + n], reg1 + OutIntByte(n); + drop + + |CODE.opLADR_INCL, CODE.opLADR_EXCL: + n := param2 * 4; + UnOp(reg1); + cmprc(reg1, 32); + label := NewLabel(); + jcc(jnb, label); + OutByte3(0FH, 0ABH + 8 * ORD(cmd.opcode = CODE.opLADR_EXCL), 45H + long(n) + reg1 * 8); // bts(r) dword[ebp + n], reg1 + OutIntByte(n); + SetLabel(label); + drop + + |CODE.opLADR_INCLC, CODE.opLADR_EXCLC: + n := param1 * 4; + OutByte3(0FH, 0BAH, 6DH + long(n) + 8 * ORD(cmd.opcode = CODE.opLADR_EXCLC)); // bts(r) dword[ebp + n], param2 + OutIntByte(n); + OutByte(param2) + + |CODE.opLOOP, CODE.opENDLOOP: + + END; + + cmd := cmd.next(COMMAND) END; - etable.arradroffset := etable.arradroffset + asize; - etable.arrnameptroffset := etable.arrnameptroffset + asize; - etable.arrnumoffset := etable.arrnumoffset + asize; - etable.dllnameoffset := etable.dllnameoffset + asize; - asize := asize + LoadAdr - 0DAH - END; - IF dll OR con OR gui THEN - Labels[LoadLibrary] := asize + 4; - Labels[GetProcAddress] := asize; - R.Page := 0; - R.Size := 0; - RCount := 0; - END; - cur := asmlist.First(ASMLINE); - FOR i := 0 TO LEN(RtlProc) - 1 DO - RtlProc[i] := Labels[RtlProc[i]] - END; + ASSERT(R.pushed = 0); + ASSERT(R.top = -1) - temp3 := asize + Align(rdatasize, 1000H) + dcount; - WHILE cur # NIL DO - CASE cur.tcmd OF - |JCMD: - sys.GET(cur.varadr, i); - sys.PUT(cur.codeadr, i - cur.Next(ASMLINE).adr) - |GCMD: - sys.GET(cur.codeadr, i); - sys.PUT(cur.codeadr, i + temp3) - |OCMD: - sys.MOVE(cur.varadr, cur.codeadr, 4) +END translate; + + +PROCEDURE prolog (code: CODE.CODES; pic: BOOLEAN; target, stack, dllinit, dllret: INTEGER); +VAR + reg1, entry, tcount, dcount: INTEGER; + +BEGIN + + entry := NewLabel(); + SetLabel(entry); + + IF target = mConst.Target_iDLL THEN + push(ebp); + mov(ebp, esp); + OutByte3(0FFH, 75H, 16); // push dword[ebp+16] + OutByte3(0FFH, 75H, 12); // push dword[ebp+12] + OutByte3(0FFH, 75H, 8); // push dword[ebp+8] + CallRTL(pic, CODE._dllentry); + test(eax); + jcc(je, dllret) + ELSIF target = mConst.Target_iObject THEN + SetLabel(dllinit) + END; + + IF target = mConst.Target_iKolibri THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.IMPTAB, 0); + push(reg1); // push IMPORT + drop + ELSIF target = mConst.Target_iObject THEN + OutByte(68H); // push IMPORT + Reloc(BIN.IMPTAB, 0) + ELSIF target = mConst.Target_iELF32 THEN + push(esp) ELSE + pushc(0) + END; + + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICCODE, entry); + push(reg1); // push CODE + drop + ELSE + OutByte(68H); // push CODE + Reloc(BIN.RCODE, entry) END; - IF dll & (cur.tcmd IN {GCMD, OCMD}) THEN - n := cur.adr - LoadAdr; - IF ASR(n, 12) = ASR(R.Page, 12) THEN - R.reloc[RCount] := IntToCard16(n MOD 1000H + 3000H); - INC(RCount); - INC(R.Size, 2) - ELSE - IF R.Size # 0 THEN - PutReloc(R) - END; - R.Page := ASR(n, 12) * 1000H; - R.Size := 10; - R.reloc[0] := IntToCard16(n MOD 1000H + 3000H); - RCount := 1 - END - END; - cur := cur.Next(ASMLINE) - END; - IF R.Size # 0 THEN - PutReloc(R) - END; - IF dll OR con OR gui THEN - WritePE(FName, stk, size - 1000H - LoadAdr, dcount, rdatasize, gsize) - ELSIF kos OR obj THEN - WriteKOS(FName, Align(stk, 4), size, dcount, gsize, obj) - ELSIF elf THEN - WriteELF(FName, size - LoadAdr, temp, gsize) - END -END FixLabels; -PROCEDURE OutStringZ(str: ARRAY OF CHAR); -VAR i: INTEGER; -BEGIN - New; - current.clen := LENGTH(str); - FOR i := 0 TO current.clen - 1 DO - Code[ccount] := str[i]; - INC(ccount) - END; - Code[ccount] := 0X; - INC(ccount); - INC(current.clen) -END OutStringZ; - -PROCEDURE Epilog*(gsize: INTEGER; FName: ARRAY OF CHAR; stk: INTEGER); -VAR i, glob: INTEGER; -BEGIN - glob := 0; - IF gsize < maxstrlen THEN - gsize := maxstrlen - END; - gsize := Align(gsize, 4) + 4; - COPY(FName, OutFile); - Labels[RTABLE] := -dcount; - dataint(recarray[0]); - FOR i := 1 TO reccount DO - dataint(recarray[i]) - END; - current := start; - IF con OR gui OR dll THEN - PushInt(LoadLibrary); - PushInt(GetProcAddress); - OutCode("5859FF31FF3054") - ELSIF elf THEN - OutCode("6800000000"); - glob := current.cmd; - ELSIF kos OR obj THEN - OutByte(54H) - END; - GlobalAdr(0); - PushConst(ASR(gsize, 2)); - PushInt(RTABLE); - PushInt(SELFNAME); - CallRTL(_init); - current := asmlist.Last(ASMLINE); - IF dll THEN - OutCode("B801000000C9C20C00") - END; - IF obj THEN - OutCode("B801000000C9C20000") - END; - OutCode("EB05"); - Label(ASSRT); - CallRTL(_assrt); - OutCode("EB09"); - Label(HALT); - OutCode("6A006A00"); - CallRTL(_assrt); - OutCode("6A00"); - CallRTL(_halt); - Label(_floor); - OutCode("83EC06D93C2466812424FFF366810C24FFF7D92C2483C402D9FCDB1C2458C3"); - IF obj THEN - Label(Exports); - CmdN(szSTART); CmdN(START); - CmdN(szversion); OutInt(stk); - FOR i := 0 TO kosexpcount - 1 DO - CmdN(kosexp[i].NameLabel); CmdN(kosexp[i].Adr) + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICDATA, 0); + push(reg1); // push _data + drop + ELSE + OutByte(68H); // push _data + Reloc(BIN.RDATA, 0) END; - OutInt(0); - Label(szSTART); OutStringZ("lib_init"); - Label(szversion); OutStringZ("version"); - FOR i := 0 TO kosexpcount - 1 DO - Label(kosexp[i].NameLabel); - OutStringZ(kosexp[i].Name.Name) + + tcount := CHL.Length(code.types); + dcount := CHL.Length(code.data); + + pushc(tcount); + + IF pic THEN + reg1 := REG.GetAnyReg(R); + Pic(reg1, BIN.PICDATA, tcount * 4 + dcount); + push(reg1); // push _data + tcount * 4 + dcount + drop + ELSE + OutByte(68H); // push _data + Reloc(BIN.RDATA, tcount * 4 + dcount) + END; + + CallRTL(pic, CODE._init) +END prolog; + + +PROCEDURE epilog (code: CODE.CODES; pic: BOOLEAN; modname: ARRAY OF CHAR; target, stack, ver, dllinit, dllret: INTEGER); +VAR + i, n: INTEGER; + exp: CODE.EXPORT_PROC; + path, name, ext: PATHS.PATH; + + tcount, dcount: INTEGER; + + + PROCEDURE import (imp: LISTS.LIST); + VAR + lib: CODE.IMPORT_LIB; + proc: CODE.IMPORT_PROC; + + BEGIN + + lib := imp.first(CODE.IMPORT_LIB); + WHILE lib # NIL DO + BIN.Import(program, lib.name, 0); + proc := lib.procs.first(CODE.IMPORT_PROC); + WHILE proc # NIL DO + BIN.Import(program, proc.name, proc.label); + proc := proc.next(CODE.IMPORT_PROC) + END; + lib := lib.next(CODE.IMPORT_LIB) + END + + END import; + + +BEGIN + + IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iKolibri, mConst.Target_iELF32} THEN + pushc(0); + CallRTL(pic, CODE._exit); + ELSIF target = mConst.Target_iDLL THEN + SetLabel(dllret); + movrc(eax, 1); + OutByte(0C9H); // leave + OutByte3(0C2H, 0CH, 0) // ret 12 + ELSIF target = mConst.Target_iObject THEN + movrc(eax, 1); + OutByte(0C3H) // ret + END; + + fixup; + + tcount := CHL.Length(code.types); + dcount := CHL.Length(code.data); + + FOR i := 0 TO tcount - 1 DO + BIN.PutData32LE(program, CHL.GetInt(code.types, i)) + END; + + FOR i := 0 TO dcount - 1 DO + BIN.PutData(program, CHL.GetByte(code.data, i)) + END; + + program.modname := CHL.Length(program.data); + + PATHS.split(modname, path, name, ext); + BIN.PutDataStr(program, name); + BIN.PutDataStr(program, ext); + BIN.PutData(program, 0); + + IF target = mConst.Target_iObject THEN + BIN.Export(program, "lib_init", dllinit); + END; + + exp := code.export.first(CODE.EXPORT_PROC); + WHILE exp # NIL DO + BIN.Export(program, exp.name, exp.label); + exp := exp.next(CODE.EXPORT_PROC) + END; + + import(code.import); + + n := code.dmin - CHL.Length(code.data); + IF n > 0 THEN + INC(code.bss, n) + END; + + BIN.SetParams(program, MAX(code.bss, 4), stack * (1024 * 1024), WCHR(ver DIV 65536), WCHR(ver MOD 65536)); + +END epilog; + + +PROCEDURE CodeGen* (code: CODE.CODES; outname: ARRAY OF CHAR; target, stack, base, ver: INTEGER; pic: BOOLEAN); +VAR + dllret, dllinit: INTEGER; + +BEGIN + + CodeList := LISTS.create(NIL); + + program := BIN.create(code.lcount); + + dllinit := NewLabel(); + dllret := NewLabel(); + + IF target = mConst.Target_iObject THEN + pic := FALSE + END; + + IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL, mConst.Target_iELF32} THEN + pic := TRUE + END; + + R := REG.Create(push, pop, mov, xchg, NIL, NIL, {eax, ecx, edx}, {}); + + prolog(code, pic, target, stack, dllinit, dllret); + translate(code, pic, CHL.Length(code.types) * 4); + epilog(code, pic, outname, target, stack, ver, dllinit, dllret); + + BIN.fixup(program); + + IF target IN {mConst.Target_iConsole, mConst.Target_iGUI, mConst.Target_iDLL} THEN + PE32.write(program, outname, base, target = mConst.Target_iConsole, target = mConst.Target_iDLL, FALSE) + ELSIF target = mConst.Target_iKolibri THEN + KOS.write(program, outname) + ELSIF target = mConst.Target_iObject THEN + MSCOFF.write(program, outname, ver) + ELSIF target = mConst.Target_iELF32 THEN + ELF.write(program, outname, FALSE) END - END; - FixLabels(FName, stk, gsize, glob) -END Epilog; -PROCEDURE setkem*; -BEGIN - kem := TRUE -END setkem; +END CodeGen; + +PROCEDURE SetProgram* (prog: BIN.PROGRAM); BEGIN - kem := FALSE + program := prog; + CodeList := LISTS.create(NIL) +END SetProgram; + + END X86. \ No newline at end of file
<p>The Programming Language Oberon</p><p>Revision 22.9.2011</p><p>Niklaus Wirth</p> -

Make it as simple as possible, but not simpler.

(A. Einstein) -

Table of Contents

- -

1. Introduction

-

2. Syntax

-

3. Vocabulary

-

4. Declarations and scope rules

-

5. Constant declarations

-

6. Type declarations

-

7. Variable declarations

-

8. Expressions

-

9. Statements

-

10. Procedure declarations

-

11. Modules

-

Appendix: The Syntax of Oberon

-
<p>1. Introduction</p> -

Oberon is a general-purpose programming language that evolved from Modula-2. Its principal new feature is the concept of type extension. It permits the construction of new data types on the basis of existing ones and to relate them.

-

This report is not intended as a programmer's tutorial. It is intentionally kept concise. Its function is to serve as a reference for programmers, implementors, and manual writers. What remains unsaid is mostly left so intentionally, either because it is derivable from stated rules of the language, or because it would unnecessarily restrict the freedom of implementors.

-

This document describes the language defined in 1988/90 as revised in 2007/11.

-
-
<p>2. Syntax</p> -

A language is an infinite set of sentences, namely the sentences well formed according to its syntax. In Oberon, these sentences are called compilation units. Each unit is a finite sequence of symbols from a finite vocabulary. The vocabulary of Oberon consists of identifiers, numbers, strings, operators, delimiters, and comments. They are called lexical symbols and are composed of sequences of characters. (Note the distinction between symbols and characters.)

-

To describe the syntax, an extended Backus-Naur Formalism called EBNF is used. Brackets [ and ] denote optionality of the enclosed sentential form, and braces { and } denote its repetition (possibly 0 times). Syntactic entities (non-terminal symbols) are denoted by English words expressing their intuitive meaning. Symbols of the language vocabulary (terminal symbols) are denoted by strings enclosed in quote marks or by words in capital letters.

-
-
<p>3. Vocabulary</p> -

The following lexical rules must be observed when composing symbols. Blanks and line breaks must not occur within symbols (except in comments, and blanks in strings). They are ignored unless they are essential to separate two consecutive symbols. Capital and lower-case letters are considered as being distinct.

-

Identifiers are sequences of letters and digits. The first character must be a letter.

- -

ident = letter {letter | digit}.

- -

Examples:

- -

x scan Oberon GetSymbol firstLetter

- -

Numbers are (unsigned) integers or real numbers. Integers are sequences of digits and may be followed by a suffix letter. If no suffix is specified, the representation is decimal. The suffix H indicates hexadecimal representation.

-

A real number always contains a decimal point. Optionally it may also contain a decimal scale factor. The letter E is pronounced as "times ten to the power of". A real number is of type REAL, unless it contains a scale factor with the letter D, in which case it is of type LONGREAL.

- -

number = integer | real.

-

integer = digit {digit} | digit {hexDigit} "H".

-

real = digit {digit} "." {digit} [ScaleFactor].

-

ScaleFactor = ("E" | "D") ["+" | "-"] digit {digit}.

-

hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F".

-

digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9".

- -

Examples:

- -

1987

-

100H = 256

-

12.3

-

4.567E8 = 456700000

- -

Strings are sequences of characters enclosed in quote marks ("). A string cannot contain the delimiting quote mark. Alternatively, a single-character string may be specified by the ordinal number of the character in hexadecimal notation followed by an "X". The number of characters in a string is called the length of the string.

- -

string = """ {character} """ | digit {hexdigit} "X" .

- -

Examples:

- -

"OBERON" "Don't worry!" 22X

- -

Operators and delimiters are the special characters, character pairs, or reserved words listed below. These reserved words consist exclusively of capital letters and cannot be used in the role of identifiers.

- -

+ := ARRAY IMPORT THEN

-

- ^ BEGIN IN TO

-

* = BY IS TRUE

-

/ # CASE MOD TYPE

-

~ < CONST MODULE UNTIL

-

& > DIV NIL VAR

-

. <= DO OF WHILE

-

, >= ELSE OR

-

; .. ELSIF POINTER

-

| : END PROCEDURE

-

( ) FALSE RECORD

-

[ ] FOR REPEAT

-

{ } IF RETURN

- -

Comments may be inserted between any two symbols in a program. They are arbitrary character sequences opened by the bracket (* and closed by *). Comments do not affect the meaning of a program. They may be nested.

-
-
<p>4. Declarations and scope rules</p> -

Every identifier occurring in a program must be introduced by a declaration, unless it is a predefined identifier. Declarations also serve to specify certain permanent properties of an object, such as whether it is a constant, a type, a variable, or a procedure.

-

The identifier is then used to refer to the associated object. This is possible in those parts of a program only which are within the scope of the declaration. No identifier may denote more than one object within a given scope. The scope extends textually from the point of the declaration to the end of the block (procedure or module) to which the declaration belongs and hence to which the object is local. The scope rule has the following amendments:

-

1. If a type T is defined as POINTER TO T1 (see 6.4), the identifier T1 can be declared textually following the declaration of T, but it must lie within the same scope.

-

2. Field identifiers of a record declaration (see 6.3) are valid in field designators only.

-

In its declaration, an identifier in the global scope may be followed by an export mark (*) to indicate that it be exported from its declaring module. In this case, the identifier may be used in other modules, if they import the declaring module. The identifier is then prefixed by the identifier designating its module (see Ch. 11). The prefix and the identifier are separated by a period and together are called a qualified identifier.

- -

qualident = [ident "."] ident.

-

identdef = ident ["*"].

- -

The following identifiers are predefined; their meaning is defined in section 6.1 (types) or 10.2 (procedures):

- -

ABS ASR ASSERT BOOLEAN CHAR

-

CHR COPY DEC EXCL FLOOR

-

FLT INC INCL INTEGER LEN

-

LSL LONG LONGREAL NEW ODD

-

ORD PACK REAL ROR SET

-

SHORT UNPK

-
-
<p>5. Constant declarations</p> -

A constant declaration associates an identifier with a constant value.

- -

ConstantDeclaration = identdef "=" ConstExpression.

-

ConstExpression = expression.

- -

A constant expression can be evaluated by a mere textual scan without actually executing the program. Its operands are constants (see Ch. 8). Examples of constant declarations are:

- -

N = 100

-

limit = 2*N - 1

-

all = {0 .. WordSize-1}

-

name = "Oberon"

-
-
<p>6. Type declarations</p> -

A data type determines the set of values which variables of that type may assume, and the operators that are applicable. A type declaration is used to associate an identifier with a type. The types define the structure of variables of this type and, by implication, the operators that are applicable to components. There are two different structures, namely arrays and records, with different component selectors.

- -

TypeDeclaration = identdef "=" StrucType.

-

StrucType = ArrayType | RecordType | PointerType | ProcedureType.

-

type = qualident | StrucType.

- -

Examples:

- -

Table = ARRAY N OF REAL

-

Tree = POINTER TO Node

-

Node = RECORD

-

key: INTEGER;

-

left, right: Tree

-

END

-

CenterNode = RECORD (Node)

-

name: ARRAY 32 OF CHAR;

-

subnode: Tree

-

END

-

Function = PROCEDURE (x: INTEGER): INTEGER

-
<p>6.1. Basic types</p> -

The following basic types are denoted by predeclared identifiers. The associated operators are defined in 8.2, and the predeclared function procedures in 10.2. The values of a given basic type are the following:

- -

BOOLEAN the truth values TRUE and FALSE

-

CHAR the characters of a standard character set

-

INTEGER the integers

-

REAL real numbers

-

LONGREAL real numbers

-

SET the sets of integers between 0 and 31

- -

The type LONGREAL is intended to represent real numbers with a higher number of digits than REAL. However, the two types may be identical.

-
-
<p>6.2. Array types</p> -

An array is a structure consisting of a fixed number of elements which are all of the same type, called the element type. The number of elements of an array is called its length. The elements of the array are designated by indices, which are integers between 0 and the length minus 1.

- -

ArrayType = ARRAY length {"," length} OF type.

-

length = ConstExpression.

- -

A declaration of the form

- -

ARRAY N0, N1, ... , Nk OF T

-

is understood as an abbreviation of the declaration -

ARRAY N0 OF

-

ARRAY N1 OF

-

...

-

ARRAY Nk OF T

- -

Examples of array types:

- -

ARRAY N OF INTEGER

-

ARRAY 10, 20 OF REAL

-
-
<p>6.3. Record types</p> -

A record type is a structure consisting of a fixed number of elements of possibly different types. The record type declaration specifies for each element, called field, its type and an identifier which denotes the field. The scope of these field identifiers is the record definition itself, but they are also visible within field designators (see 8.1) referring to elements of record variables.

- -

RecordType = RECORD ["(" BaseType ")"] [FieldListSequence] END.

-

BaseType = qualident.

-

FieldListSequence = FieldList {";" FieldList}.

-

FieldList = IdentList ":" type.

-

IdentList = identdef {"," identdef}.

- -

If a record type is exported, field identifiers that are to be visible outside the declaring module must be marked. They are called public fields; unmarked fields are called private fields.

-

Record types are extensible, i.e. a record type can be defined as an extension of another record type. In the examples above, CenterNode (directly) extends Node, which is the (direct) base type of CenterNode. More specifically, CenterNode extends Node with the fields name and subnode.

-

Definition: A type T extends a type T0, if it equals T0, or if it directly extends an extension of T0. Conversely, a type T0 is a base type of T, if it equals T, or if it is the direct base type of a base type of T.

-

Examples of record types:

- -

RECORD day, month, year: INTEGER

-

END

-

RECORD

-

name, firstname: ARRAY 32 OF CHAR;

-

age: INTEGER;

-

salary: REAL

-

END

-
-
<p>6.4. Pointer types</p> -

Variables of a pointer type P assume as values pointers to variables of some type T. It must be a record type. The pointer type P is said to be bound to T, and T is the pointer base type of P. Pointer types inherit the extension relation of their base types, if there is any. If a type T is an extension of T0 and P is a pointer type bound to T, then P is also an extension of P0, the pointer type bound to T0.

- -

PointerType = POINTER TO type.

- -

If p is a variable of type P = POINTER TO T, then a call of the predefined procedure NEW(p) has the following effect (see 10.2): A variable of type T is allocated in free storage, and a pointer to it is assigned to p. This pointer p is of type P and the referenced variable p^ is of type T. Failure of allocation results in p obtaining the value NIL. Any pointer variable may be assigned the value NIL, which points to no variable at all.

-
-
<p>6.5. Procedure types</p> -

Variables of a procedure type T have a procedure (or NIL) as value. If a procedure P is assigned to a procedure variable of type T, the (types of the) formal parameters of P must be the same as those indicated in the formal parameters of T. The same holds for the result type in the case of a function procedure (see 10.1). P must not be declared local to another procedure, and neither can it be a standard procedure.

- -

ProcedureType = PROCEDURE [FormalParameters].

-
-
-
<p>7. Variable declarations</p> -

Variable declarations serve to introduce variables and associate them with identifiers that must be unique within the given scope. They also serve to associate fixed data types with the variables.

- -

VariableDeclaration = IdentList ":" type.

- -

Variables whose identifiers appear in the same list are all of the same type. Examples of variable declarations (refer to examples in Ch. 6):

- -

i, j, k: INTEGER

-

x, y: REAL

-

p, q: BOOLEAN

-

s: SET

-

f: Function

-

a: ARRAY 100 OF REAL

-

w: ARRAY 16 OF

-

RECORD

-

ch: CHAR;

-

count: INTEGER

-

END

-

t: Tree

-
-
<p>8. Expressions</p> -

Expressions are constructs denoting rules of computation whereby constants and current values of variables are combined to derive other values by the application of operators and function procedures. Expressions consist of operands and operators. Parentheses may be used to express specific associations of operators and operands.

-
<p>8.1. Operands</p> -

With the exception of sets and literal constants, i.e. numbers and strings, operands are denoted by designators. A designator consists of an identifier referring to the constant, variable, or procedure to be designated. This identifier may possibly be qualified by module identifiers (see Ch. 4 and 11), and it may be followed by selectors, if the designated object is an element of a structure.

-

If A designates an array, then A[E] denotes that element of A whose index is the current value of the expression E. The type of E must be of type INTEGER. A designator of the form A[E1, E2, ..., En] stands for A[E1][E2] ... [En]. If p designates a pointer variable, p^ denotes the variable which is referenced by p. If r designates a record, then r.f denotes the field f of r. If p designates a pointer, p.f denotes the field f of the record p^, i.e. the dot implies dereferencing and p.f stands for p^.f.

-

The typeguard v(T0) asserts that v is of type T0, i.e. it aborts program execution, if it is not of type T0. The guard is applicable, if

-

1. T0 is an extension of the declared type T of v, and if

-

2. v is a variable parameter of record type, or v is a pointer.

- -

designator = qualident {selector}.

-

selector = "." ident | "[" ExpList "]" | "^" | "(" qualident ")".

-

ExpList = expression {"," expression}.

- -

If the designated object is a variable, then the designator refers to the variable's current value. If the object is a procedure, a designator without parameter list refers to that procedure. If it is followed by a (possibly empty) parameter list, the designator implies an activation of the procedure and stands for the value resulting from its execution. The (types of the) actual parameters must correspond to the formal parameters as specified in the procedure's declaration (see Ch. 10).

-

Examples of designators (see examples in Ch. 7):

- -

i (INTEGER)

-

a[i] (REAL)

-

w[3].ch (CHAR)

-

t.key (INTEGER)

-

t.left.right (Tree)

-

t(CenterNode).subnode (Tree)

-
-
<p>8.2. Operators</p> -

The syntax of expressions distinguishes between four classes of operators with different precedences (binding strengths). The operator ~ has the highest precedence, followed by multiplication operators, addition operators, and relations. Operators of the same precedence associate from left to right. For example, x-y-z stands for (x-y)-z.

- -

expression = SimpleExpression [relation SimpleExpression].

-

relation = "=" | "#" | "<" | "<=" | ">" | ">=" | IN | IS.

-

SimpleExpression = ["+"|"-"] term {AddOperator term}.

-

AddOperator = "+" | "-" | OR.

-

term = factor {MulOperator factor}.

-

MulOperator = "*" | "/" | DIV | MOD | "&" .

-

factor = number | string | NIL | TRUE | FALSE |

-

set | designator [ActualParameters] | "(" expression ")" | "~" factor.

-

set = "{" [element {"," element}] "}".

-

element = expression [".." expression].

-

ActualParameters = "(" [ExpList] ")" .

- -

The available operators are listed in the following tables. In some instances, several different operations are designated by the same operator symbol. In these cases, the actual operation is identified by the type of the operands.

-
<p><emphasis>8.2.1. Logical operators</emphasis></p> -

symbol result

- -

OR logical disjunction

-

& logical conjunction

-

~ negation

- -

These operators apply to BOOLEAN operands and yield a BOOLEAN result.

- -

p OR q stands for "if p then TRUE, else q"

-

p & q stands for "if p then q, else FALSE"

-

~ p stands for "not p"

-
-
<p><emphasis>8.2.2. Arithmetic operators</emphasis></p> -

symbol result

- -

+ sum

-

- difference

-

* product

-

/ quotient

-

DIV integer quotient

-

MOD modulus

- -

The operators +, -, *, and / apply to operands of numeric types. Both operands must be of the same type, which is also the type of the result. When used as unary operators, - denotes sign inversion and + denotes the identity operation.

-

The operators DIV and MOD apply to integer operands only. Let q = x DIV y, and r = x MOD y. Then quotient q and remainder r are defined by the equation

- -

x = q*y + r 0 <= r < y

-
-
<p><emphasis>8.2.3. Set operators</emphasis></p> -

symbol result

- -

+ union

-

- difference

-

* intersection

-

/ symmetric set difference

- -

When used with a single operand of type SET, the minus sign denotes the set complement.

-
-
<p><emphasis>8.2.4. Relations</emphasis></p> -

symbol relation

- -

= equal

-

# unequal

-

< less

-

<= less or equal

-

> greater

-

>= greater or equal

-

IN set membership

-

IS type test

- -

Relations are Boolean. The ordering relations <, <=, >, >= apply to the numeric types, CHAR, and character arrays. The relations = and # also apply to the types BOOLEAN and SET, and to pointer and procedure types. The relations <= and >= denote inclusion when applied to sets.

-

x IN s stands for "x is an element of s". x must be of type INTEGER, and s of type SET.

-

v IS T stands for "v is of type T" and is called a type test. It is applicable, if

-

1. T is an extension of the declared type T0 of v, and if

-

2. v is a variable parameter of record type or v is a pointer.

-

Assuming, for instance, that T is an extension of T0 and that v is a designator declared of type T0, then the test v IS T determines whether the actually designated variable is (not only a T0, but also) a T. The value of NIL IS T is undefined.

-

Examples of expressions (refer to examples in Ch. 7):

- -

1987 (INTEGER)

-

i DIV 3 (INTEGER)

-

~p OR q (BOOLEAN)

-

(i+j) * (i-j) (INTEGER)

-

s - {8, 9, 13} (SET)

-

a[i+j] * a[i-j] (REAL)

-

(0<=i) & (i<100) (BOOLEAN)

-

t.key = 0 (BOOLEAN)

-

k IN {i .. j-1} (BOOLEAN)

-

t IS CenterNode (BOOLEAN)

-
-
-
-
<p>9. Statements</p> -

Statements denote actions. There are elementary and structured statements. Elementary statements are not composed of any parts that are themselves statements. They are the assignment and the procedure call. Structured statements are composed of parts that are themselves statements. They are used to express sequencing and conditional, selective, and repetitive execution. A statement may also be empty, in which case it denotes no action. The empty statement is included in order to relax punctuation rules in statement sequences.

- -

statement = [assignment | ProcedureCall | IfStatement | CaseStatement |

-

WhileStatement | RepeatStatement | ForStatement].

-
<p>9.1. Assignments</p> -

The assignment serves to replace the current value of a variable by a new value specified by an expression. The assignment operator is written as ":=" and pronounced as becomes.

- -

assignment = designator ":=" expression.

- -

If a value parameter is structured (of array or record type), no assignment to it or to its elements are permitted. Neither may assignments be made to imported variables.

-

The type of the expression must be the same as that of the designator. The following exceptions hold:

-

1. The constant NIL can be assigned to variables of any pointer or procedure type.

-

2. Strings can be assigned to any array of characters, provided the number of characters in the string is not greater than that of the array. If it is less, a null character (0X) is appended. Singlecharacter strings can also be assigned to variables of type CHAR.

-

3. In the case of records, the type of the source must be an extension of the type of the destination. Examples of assignments (see examples in Ch. 7):

- -

i := 0

-

p := i = j

-

x := FLT(i + 1)

-

k := (i + j) DIV 2

-

f := log2

-

s := {2, 3, 5, 7, 11, 13}

-

a[i] := (x+y) * (x-y)

-

t.key := i

-

w[i+1].ch := "A"

-
-
<p>9.2. Procedure calls</p> -

A procedure call serves to activate a procedure. The procedure call may contain a list of actual parameters which are substituted in place of their corresponding formal parameters defined in the procedure declaration (see Ch. 10). The correspondence is established by the positions of the parameters in the lists of actual and formal parameters respectively. There exist two kinds of parameters: variable and value parameters.

-

In the case of variable parameters, the actual parameter must be a designator denoting a variable. If it designates an element of a structured variable, the selector is evaluated when the formal/actual parameter substitution takes place, i.e. before the execution of the procedure. If the parameter is a value parameter, the corresponding actual parameter must be an expression. This expression is evaluated prior to the procedure activation, and the resulting value is assigned to the formal parameter which now constitutes a local variable (see also 10.1.).

- -

ProcedureCall = designator [ActualParameters].

- -

Examples of procedure calls:

- -

ReadInt(i) (see Ch. 10)

-

WriteInt(2*j + 1, 6)

-

INC(w[k].count)

-
-
<p>9.3. Statement sequences</p> -

Statement sequences denote the sequence of actions specified by the component statements which are separated by semicolons.

- -

StatementSequence = statement {";" statement}.

-
-
<p>9.4. If statements</p> -

IfStatement = IF expression THEN StatementSequence

-

{ELSIF expression THEN StatementSequence}

-

[ELSE StatementSequence]

-

END.

- -

If statements specify the conditional execution of guarded statements. The Boolean expression preceding a statement is called its guard. The guards are evaluated in sequence of occurrence, until one evaluates to TRUE, whereafter its associated statement sequence is executed. If no guard is satisfied, the statement sequence following the symbol ELSE is executed, if there is one.

-

Example:

- -

IF (ch >= "A") & (ch <= "Z") THEN ReadIdentifier

-

ELSIF (ch >= "0") & (ch <= "9") THEN ReadNumber

-

ELSIF ch = 22X THEN ReadString

-

END

-
-
<p>9.5. Case statements</p> -

Case statements specify the selection and execution of a statement sequence according to the value of an expression. First the case expression is evaluated, then the statement sequence is executed whose case label list contains the obtained value. The case expression must be of type INTEGER or CHAR, and all labels must be integers or single-character strings, respectively.

- -

CaseStatement = CASE expression OF case {"|" case} END.

-

case = [CaseLabelList ":" StatementSequence].

-

CaseLabelList = LabelRange {"," LabelRange}.

-

LabelRange = label [".." label].

-

label = integer | string | ident.

- -

Example:

- -

CASE k OF

-

0: x := x + y

-

| 1: x := x - y

-

| 2: x := x * y

-

| 3: x := x / y

-

END

-
-
<p>9.6. While statements</p> -

While statements specify repetition. If any of the Boolean expressions (guards) yields TRUE, the corresponding statement sequence is executed. The expression evaluation and the statement execution are repeated until none of the Boolean expressions yields TRUE.

- -

WhileStatement = WHILE expression DO StatementSequence

-

{ELSIF expression DO StatementSequence} END.

- -

Examples:

- -

WHILE j > 0 DO

-

j := j DIV 2; i := i+1

-

END

-

WHILE (t # NIL) & (t.key # i) DO

-

t := t.left

-

END

-

WHILE m > n DO m := m - n

-

ELSIF n > m DO n := n - m

-

END

-
-
<p>9.7. Repeat Statements</p> -

A repeat statement specifies the repeated execution of a statement sequence until a condition is satisfied. The statement sequence is executed at least once.

- -

RepeatStatement = REPEAT StatementSequence UNTIL expression.

-
-
<p>9.8. For statements</p> -

A for statement specifies the repeated execution of a statement sequence for a given number of times, while a progression of values is assigned to an integer variable called the control variable of the for statement.

- -

ForStatement =

-

FOR ident ":=" expression TO expression [BY ConstExpression] DO

-

StatementSequence END .

- -

The for statement

- -

FOR v := beg TO end BY inc DO S END

- -is, if inc > 0, equivalent to - -

v := beg; lim := end;

-

WHILE v <= lim DO S; v := v + inc END

- -and if inc < 0 it is equivalent to - -

v := beg; lim := end;

-

WHILE v >= lim DO S; v := v + inc END

- -

The types of v, beg and end must be INTEGER, and inc must be an integer (constant expression). If the step is not specified, it is assumed to be 1.

-
-
-
<p>10. Procedure declarations</p> -

Procedure declarations consist of a procedure heading and a procedure body. The heading specifies the procedure identifier, the formal parameters, and the result type (if any). The body contains declarations and statements. The procedure identifier is repeated at the end of the procedure declaration.

-

There are two kinds of procedures, namely proper procedures and function procedures. The latter are activated by a function designator as a constituent of an expression, and yield a result that is an operand in the expression. Proper procedures are activated by a procedure call. A function procedure is distinguished in the declaration by indication of the type of its result following the parameter list. Its body must end with a RETURN clause which defines the result of the function procedure.

-

All constants, variables, types, and procedures declared within a procedure body are local to the procedure. The values of local variables are undefined upon entry to the procedure. Since procedures may be declared as local objects too, procedure declarations may be nested.

-

In addition to its formal parameters and locally declared objects, the objects declared in the environment of the procedure are also visible in the procedure (with the exception of variables and of those objects that have the same name as an object declared locally).

-

The use of the procedure identifier in a call within its declaration implies recursive activation of the procedure.

- -

ProcedureDeclaration = ProcedureHeading ";" ProcedureBody ident.

-

ProcedureHeading = PROCEDURE identdef [FormalParameters].

-

ProcedureBody = DeclarationSequence [BEGIN StatementSequence]

-

[RETURN expression] END.

-

DeclarationSequence = [CONST {ConstantDeclaration ";"}]

-

[TYPE {TypeDeclaration ";"}] [VAR {VariableDeclaration ";"}]

-

{ProcedureDeclaration ";"}.

-
<p>10.1. Formal parameters</p> -

Formal parameters are identifiers which denote actual parameters specified in the procedure call. The correspondence between formal and actual parameters is established when the procedure is called. There are two kinds of parameters, namely value and variable parameters. A variable parameter corresponds to an actual parameter that is a variable, and it stands for that variable. A value parameter corresponds to an actual parameter that is an expression, and it stands for its value, which cannot be changed by assignment. However, if a value parameter is of a scalar type, it represents a local variable to which the value of the actual expression is initially assigned.

-

The kind of a parameter is indicated in the formal parameter list: Variable parameters are denoted by the symbol VAR and value parameters by the absence of a prefix.

-

A function procedure without parameters must have an empty parameter list. It must be called by a function designator whose actual parameter list is empty too.

-

Formal parameters are local to the procedure, i.e. their scope is the program text which constitutes the procedure declaration.

- -

FormalParameters = "(" [FPSection {";" FPSection}] ")" [":" qualident].

-

FPSection = [VAR] ident {"," ident} ":" FormalType.

-

FormalType = {ARRAY OF} qualident.

- -

The type of each formal parameter is specified in the parameter list. For variable parameters, it must be identical to the corresponding actual parameter's type, except in the case of a record, where it must be a base type of the corresponding actual parameter's type.

-

If the formal parameter's type is specified as

- -

ARRAY OF T

- -the parameter is said to be an open array, and the corresponding actual parameter may be of arbitrary length. -

If a formal parameter specifies a procedure type, then the corresponding actual parameter must be either a procedure declared globally, or a variable (or parameter) of that procedure type. It cannot be a predefined procedure. The result type of a procedure can be neither a record nor an array.

-

Examples of procedure declarations:

- -

PROCEDURE ReadInt(VAR x: INTEGER);

-

VAR i : INTEGER; ch: CHAR;

-

BEGIN i := 0; Read(ch);

-

WHILE ("0" <= ch) & (ch <= "9") DO

-

i := 10*i + (ORD(ch)-ORD("0")); Read(ch)

-

END ;

-

x := i

-

END ReadInt

- -

PROCEDURE WriteInt(x: INTEGER); (* 0 <= x < 10^5 *)

-

VAR i: INTEGER;

-

buf: ARRAY 5 OF INTEGER;

-

BEGIN i := 0;

-

REPEAT buf[i] := x MOD 10; x := x DIV 10; INC(i) UNTIL x = 0;

-

REPEAT DEC(i); Write(CHR(buf[i] + ORD("0"))) UNTIL i = 0

-

END WriteInt

- -

PROCEDURE log2(x: INTEGER): INTEGER;

-

VAR y: INTEGER; (*assume x>0*)

-

BEGIN y := 0;

-

WHILE x > 1 DO x := x DIV 2; INC(y) END ;

-

RETURN y

-

END log2

-
-
<p>10.2. Predefined procedures</p> -

The following table lists the predefined procedures. Some are generic procedures, i.e. they apply to several types of operands. v stands for a variable, x and n for expressions, and T for a type.

- -

Function procedures:

- -

Name Argument type Result type Function

- -

ABS(x) numeric type type of x absolute value

-

ODD(x) INTEGER BOOLEAN x MOD 2 = 1

-

LEN(v) v: array INTEGER the length of v

-

LSL(x, n) x, n: INTEGER type of x logical shift left, x * 2n

-

ASR(x, n) x, n: INTEGER type of x signed shift right, x DIV 2n

-

ROR(x, n) x. n: INTEGER type of x x rotated right by n bits

- -

Type conversion functions:

- -

Name Argument type Result type Function

- -

FLOOR(x) REAL, LONGREAL INTEGER largest integer <= x

-

FLT(x) INTEGER REAL identity

-

ORD(x) CHAR, BOOLEAN, SET INTEGER ordinal number of x

-

CHR(x) INTEGER CHAR character with ordinal number x

-

LONG(x) REAL LONGREAL x

-

SHORT(x) LONGREAL REAL x

- -

Proper procedures:

- -

Name Argument types Function

- -

INC(v) INTEGER v := v + 1

-

INC(v, n) INTEGER v := v + n

-

DEC(v) INTEGER v := v - 1

-

DEC(v, n) INTEGER v := v - n

-

INCL(v, x) v: SET; x: INTEGER v := v + {x}

-

EXCL(v, x) v: SET; x: INTEGER v := v - {x}

-

COPY(x, v) x: character array, string v := x

-

v: character array

-

NEW(v) pointer type allocate v^

-

ASSERT(b) BOOLEAN abort, if ~b

-

ASSERT(b, n) BOOLEAN, INTEGER

-

PACK(x, y) REAL; INTEGER pack x and y into x

-

UNPK(x, y) REAL; INTEGER unpack x into x and y

- -

Procedures INC and DEC may have an explicit increment or decrement. It must be a constant. Also for INCL and EXCL, x must be a constant. The second parameter n of ASSERT is a value transmitted to the system as an abort parameter.

-

The parameter y of PACK represents the exponent of x. PACK(x, y) is equivalent to x := x * 2y. UNPK is the reverse operation of PACK. The resulting x is normalized, i.e. 1.0 <= x < 2.0.

-
-
-
<p>11. Modules</p> -

A module is a collection of declarations of constants, types, variables, and procedures, and a sequence of statements for the purpose of assigning initial values to the variables. A module typically constitutes a text that is compilable as a unit.

- -

module = MODULE ident ";" [ImportList ";"] DeclarationSequence

-

[BEGIN StatementSequence] END ident "." .

-

ImportList = IMPORT import {"," import} ";" .

-

Import = ident [":=" ident].

- -

The import list specifies the modules of which the module is a client. If an identifier x is exported from a module M, and if M is listed in a module's import list, then x is referred to as M.x. If the form "M := M1" is used in the import list, an exported object x declared within M1 is referenced in the importing module as M.x .

-

Identifiers that are to be visible in client modules, i.e. which are to be exported, must be marked by an asterisk (export mark) in their declaration. Variables cannot be exported, with the exception of those of scalar types in read-only mode.

-

The statement sequence following the symbol BEGIN is executed when the module is added to a system (loaded). Individual (parameterless) procedures can thereafter be activated from the system, and these procedures serve as commands.

-

Example:

- -

MODULE Out; (*exported procedures: Write, WriteInt, WriteLn*)

-

IMPORT Texts, Oberon;

-

VAR W: Texts.Writer;

- -

PROCEDURE Write*(ch: CHAR);

-

BEGIN Texts.Write(W, ch)

-

END ;

- -

PROCEDURE WriteInt*(x, n: INTEGER);

-

VAR i: INTEGER; a: ARRAY 16 OF CHAR;

-

BEGIN i := 0;

-

IF x < 0 THEN Texts.Write(W, "-"); x := -x END ;

-

REPEAT a[i] := CHR(x MOD 10 + ORD("0")); x := x DIV 10; INC(i) UNTIL x = 0;

-

REPEAT Texts.Write(W, " "); DEC(n) UNTIL n <= i;

-

REPEAT DEC(i); Texts.Write(W, a[i]) UNTIL i = 0

-

END WriteInt;

- -

PROCEDURE WriteLn*;

-

BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)

-

END WriteLn;

- -

BEGIN Texts.OpenWriter(W)

-

END Out.

-
<p>11.1 The Module SYSTEM</p> -

The optional module SYSTEM contains definitions that are necessary to program low-level operations referring directly to resources particular to a given computer and/or implementation. These include for example facilities for accessing devices that are controlled by the computer, and perhaps facilities to break the data type compatibility rules otherwise imposed by the language definition. It is strongly recommended to restrict their use to specific low-level modules, as such modules are inherently non-portable and not "type-safe". However, they are easily recognized due to the identifier SYSTEM appearing in their import lists. The subsequent definitions are generally applicable. However, individual implementations may include in their module SYSTEM additional definitions that are particular to the specific, underlying computer. In the following, v stands for a variable, x, a, and n for expressions.

- -

Function procedures:

- -

Name Argument types Result type Function

- -

ADR(v) any INTEGER address of variable v

-

SIZE(T) any type INTEGER size in bytes

-

BIT(a, n) a, n: INTEGER BOOLEAN bit n of mem[a]

- -

Proper procedures:

- -

Name Argument types Function

- -

GET(a, v) a: INTEGER; v: any basic type v := mem[a]

-

PUT(a, x) a: INTEGER; x: any basic type mem[a] := x

-
-
-
<p>Appendix</p><p>The Syntax of Oberon</p> -

letter = "A" | "B" | … | "Z" | "a" | "b" | … | "z".

-

digit = "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9".

-

hexDigit = digit | "A" | "B" | "C" | "D" | "E" | "F".

-

ident = letter {letter | digit}.

-

qualident = [ident "."] ident.

-

identdef = ident ["*"].

-

integer = digit {digit} | digit {hexDigit} "H".

-

real = digit {digit} "." {digit} [ScaleFactor].

-

ScaleFactor = ("E" | "D") ["+" | "-"] digit {digit}.

-

number = integer | real.

-

string = """ {character} """ | digit {hexDigit} "X".

-

ConstantDeclaration = identdef "=" ConstExpression.

-

ConstExpression = expression.

-

TypeDeclaration = identdef "=" StrucType.

-

StrucType = ArrayType | RecordType | PointerType | ProcedureType.

-

type = qualident | StrucType.

-

ArrayType = ARRAY length {"," length} OF type.

-

length = ConstExpression.

-

RecordType = RECORD ["(" BaseType ")"] [FieldListSequence] END.

-

BaseType = qualident.

-

FieldListSequence = FieldList {";" FieldList}.

-

FieldList = IdentList ":" type.

-

IdentList = identdef {"," identdef}.

-

PointerType = POINTER TO type.

-

ProcedureType = PROCEDURE [FormalParameters].

-

VariableDeclaration = IdentList ":" type.

-

expression = SimpleExpression [relation SimpleExpression].

-

relation = "=" | "#" | "<" | "<=" | ">" | ">=" | IN | IS.

-

SimpleExpression = ["+" | "-"] term {AddOperator term}.

-

AddOperator = "+" | "-" | OR.

-

term = factor {MulOperator factor}.

-

MulOperator = "*" | "/" | DIV | MOD | "&".

-

factor = number | string | NIL | TRUE | FALSE |

-

set | designator [ActualParameters] | "(" expression ")" | "~" factor.

-

designator = qualident {selector}.

-

selector = "." ident | "[" ExpList "]" | "^" | "(" qualident ")".

-

set = "{" [element {"," element}] "}".

-

element = expression [".." expression].

-

ExpList = expression {"," expression}.

-

ActualParameters = "(" [ExpList] ")" .

-

statement = [assignment | ProcedureCall | IfStatement | CaseStatement |

-

WhileStatement | RepeatStatement | ForStatement].

-

assignment = designator ":=" expression.

-

ProcedureCall = designator [ActualParameters].

-

StatementSequence = statement {";" statement}.

-

IfStatement = IF expression THEN StatementSequence

-

{ELSIF expression THEN StatementSequence}

-

[ELSE StatementSequence] END.

-

CaseStatement = CASE expression OF case {"|" case} END.

-

case = [CaseLabelList ":" StatementSequence].

-

CaseLabelList = LabelRange {"," LabelRange}.

-

LabelRange = label [".." label].

-

label = integer | string | ident.

-

WhileStatement = WHILE expression DO StatementSequence

-

{ELSIF expression DO StatementSequence} END.

-

RepeatStatement = REPEAT StatementSequence UNTIL expression.

-

ForStatement = FOR ident ":=" expression TO expression [BY ConstExpression]

-

DO StatementSequence END.

-

ProcedureDeclaration = ProcedureHeading ";" ProcedureBody ident.

-

ProcedureHeading = PROCEDURE identdef [FormalParameters].

-

ProcedureBody = DeclarationSequence [BEGIN StatementSequence]

-

[RETURN expression] END.

-

DeclarationSequence = [CONST {ConstDeclaration ";"}]

-

[TYPE {TypeDeclaration ";"}]

-

[VAR {VariableDeclaration ";"}]

-

{ProcedureDeclaration ";"}.

-

FormalParameters = "(" [FPSection {";" FPSection}] ")" [":" qualident].

-

FPSection = [VAR] ident {"," ident} ":" FormalType.

-

FormalType = {ARRAY OF} qualident.

-

module = MODULE ident ";" [ImportList] DeclarationSequence

-

[BEGIN StatementSequence] END ident "." .

-

ImportList = IMPORT import {"," import} ";".

-

import = ident [":=" ident].

-
-