sstrings.inc 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2005, 2011 by Florian Klaempfl, Jonas Maebe
  4. members of the Free Pascal development team.
  5. This file implements support routines for Shortstrings with FPC/JVM
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. constructor ShortstringClass.Create(const arr: array of ansichar; maxlen: byte);
  13. begin
  14. setlength(fdata,maxlen);
  15. if high(arr)=-1 then
  16. exit;
  17. curlen:=min(high(arr)+1,maxlen);
  18. JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(fdata),0,curlen);
  19. end;
  20. constructor ShortstringClass.Create(const arr: array of unicodechar; maxlen: byte);
  21. begin
  22. if high(arr)=-1 then
  23. begin
  24. setlength(fdata,maxlen);
  25. exit;
  26. end;
  27. fdata:=TAnsiCharArray(JLString.Create(arr).getBytes);
  28. setlength(fdata,maxlen);
  29. curlen:=min(high(fdata)+1,maxlen);
  30. end;
  31. constructor ShortstringClass.Create(const u: unicodestring; maxlen: byte);
  32. begin
  33. if system.length(u)=0 then
  34. begin
  35. setlength(fdata,maxlen);
  36. exit;
  37. end;
  38. fdata:=TAnsiCharArray(JLString(u).getBytes);
  39. setlength(fdata,maxlen);
  40. curlen:=min(high(fdata)+1,maxlen);
  41. end;
  42. constructor ShortstringClass.Create(const a: ansistring; maxlen: byte);
  43. var
  44. alen: jint;
  45. begin
  46. setlength(fdata,maxlen);
  47. alen:=system.length(a);
  48. if alen=0 then
  49. exit;
  50. curlen:=min(alen,maxlen);
  51. JLSystem.ArrayCopy(JLObject(AnsistringClass(a).fdata),0,JLObject(fdata),0,curlen);
  52. end;
  53. constructor ShortstringClass.Create(const s: shortstring; maxlen: byte);overload;
  54. begin
  55. setlength(fdata,maxlen);
  56. if system.length(s)=0 then
  57. exit;
  58. curlen:=min(system.length(s),maxlen);
  59. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),0,JLObject(fdata),0,min(system.length(s),maxlen));
  60. end;
  61. constructor ShortstringClass.Create(ch: ansichar; maxlen: byte);overload;
  62. begin
  63. setlength(fdata,maxlen);
  64. fdata[0]:=ch;
  65. curlen:=1;
  66. end;
  67. constructor ShortstringClass.Create(ch: unicodechar; maxlen: byte);overload;
  68. begin
  69. fdata:=TAnsiCharArray(JLString.Create(ch).getBytes);
  70. curlen:=min(system.length(fdata),maxlen);
  71. setlength(fdata,maxlen);
  72. end;
  73. class function ShortstringClass.CreateEmpty(maxlen: byte): ShortstringClass;
  74. begin
  75. result:=ShortstringClass.Create;
  76. setlength(result.fdata,maxlen);
  77. end;
  78. class function ShortstringClass.CreateFromLiteralStringBytes(const u: unicodestring): shortstring;
  79. var
  80. i: longint;
  81. begin
  82. { used to construct constant shortstrings from Java string constants }
  83. ShortstringClass(@result).curlen:=min(system.length(u),255);
  84. setlength(ShortstringClass(@result).fdata,ShortstringClass(@result).curlen);
  85. for i:=1 to ShortstringClass(@result).curlen do
  86. ShortstringClass(@result).fdata[i-1]:=ansichar(ord(u[i]));
  87. end;
  88. procedure ShortstringClass.FpcDeepCopy(dest: ShortstringClass);
  89. begin
  90. { should only be called for shortstrings of the same maximum length }
  91. dest.curlen:=curlen;
  92. JLSystem.ArrayCopy(JLObject(fdata),0,JLObject(dest.fdata),0,system.length(fdata));
  93. end;
  94. procedure ShortstringClass.setChar(index: jint; char: ansichar);
  95. begin
  96. { index is 1-based here }
  97. { support accessing the length byte }
  98. if index=0 then
  99. curlen:=ord(char)
  100. else
  101. fdata[index-1]:=char;
  102. end;
  103. function ShortstringClass.charAt(index: jint): ansichar;
  104. begin
  105. { index is already decreased by one, because same calling code is used for
  106. JLString.charAt() }
  107. { support accessing the length byte }
  108. if (index=-1) then
  109. result:=ansichar(curlen)
  110. else
  111. result:=fdata[index];
  112. end;
  113. function ShortstringClass.toUnicodeString: unicodestring;
  114. begin
  115. result:=UnicodeString(JLString.Create(TJByteArray(fdata)));
  116. end;
  117. function ShortstringClass.toAnsistring: ansistring;
  118. begin
  119. result:=ansistring(AnsistringClass.Create(pshortstring(self)^));
  120. end;
  121. function ShortstringClass.toString: JLString;
  122. begin
  123. if curlen<>0 then
  124. result:=JLString.Create(TJByteArray(fdata),0,curlen-1)
  125. else
  126. result:='';
  127. end;
  128. function ShortstringClass.clone: JLObject;
  129. begin
  130. result:=ShortstringClass.Create(pshortstring(self)^,system.length(fdata));
  131. end;
  132. function ShortstringClass.length: jint;
  133. begin
  134. result:=curlen;
  135. end;
  136. class function AnsiCharArrayClass.CreateFromLiteralStringBytes(const u: unicodestring; maxlen: byte): TAnsiCharArray;
  137. var
  138. i: longint;
  139. begin
  140. { used to construct constant chararrays from Java string constants }
  141. setlength(result,system.length(u));
  142. for i:=1 to system.length(u) do
  143. result[i-1]:=ansichar(ord(u[i]));
  144. end;
  145. procedure fpc_Shortstr_SetLength(var s:shortstring;len:SizeInt); compilerproc;
  146. begin
  147. if len>255 then
  148. len:=255;
  149. ShortstringClass(@s).curlen:=len;
  150. end;
  151. procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring); compilerproc;
  152. var
  153. len: longint;
  154. begin
  155. len:=length(sstr);
  156. if len>high(res) then
  157. len:=high(res);
  158. ShortstringClass(@res).curlen:=len;
  159. JLSystem.ArrayCopy(JLObject(ShortstringClass(@sstr).fdata),0,JLObject(ShortstringClass(@res).fdata),0,len);
  160. end;
  161. procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
  162. var
  163. tmpres: ShortstringClass;
  164. s1l, s2l: longint;
  165. begin
  166. s1l:=length(s1);
  167. s2l:=length(s2);
  168. if (s1l+s2l)>high(dests) then
  169. begin
  170. if s1l>high(dests) then
  171. s1l:=high(dests);
  172. s2l:=high(dests)-s1l;
  173. end;
  174. if ShortstringClass(@dests)=ShortstringClass(@s1) then
  175. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
  176. else if ShortstringClass(@dests)=ShortstringClass(@s2) then
  177. begin
  178. JLSystem.ArrayCopy(JLObject(ShortstringClass(@dests).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l);
  179. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
  180. end
  181. else
  182. begin
  183. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s1).fdata),0,JLObject(ShortstringClass(@dests).fdata),0,s1l);
  184. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@dests).fdata),s1l,s2l)
  185. end;
  186. ShortstringClass(@dests).curlen:=s1l+s2l;
  187. end;
  188. procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of ShortstringClass);compilerproc;
  189. var
  190. s2l : byte;
  191. LowStart,i,
  192. Len : longint;
  193. needtemp : boolean;
  194. tmpstr : shortstring;
  195. p,pdest : ShortstringClass;
  196. begin
  197. if high(sarr)=0 then
  198. begin
  199. DestS:='';
  200. exit;
  201. end;
  202. lowstart:=low(sarr);
  203. if ShortstringClass(@DestS)=sarr[lowstart] then
  204. inc(lowstart);
  205. { Check for another reuse, then we can't use
  206. the append optimization and need to use a temp }
  207. needtemp:=false;
  208. for i:=lowstart to high(sarr) do
  209. begin
  210. if ShortstringClass(@DestS)=sarr[i] then
  211. begin
  212. needtemp:=true;
  213. break;
  214. end;
  215. end;
  216. if needtemp then
  217. begin
  218. lowstart:=low(sarr);
  219. tmpstr:='';
  220. pdest:=ShortstringClass(@tmpstr)
  221. end
  222. else
  223. begin
  224. { Start with empty DestS if we start with concatting
  225. the first array element }
  226. if lowstart=low(sarr) then
  227. DestS:='';
  228. pdest:=ShortstringClass(@DestS);
  229. end;
  230. { Concat all strings, except the string we already
  231. copied in DestS }
  232. Len:=pdest.curlen;
  233. for i:=lowstart to high(sarr) do
  234. begin
  235. p:=sarr[i];
  236. if assigned(p) then
  237. begin
  238. s2l:=p.curlen;
  239. if Len+s2l>high(dests) then
  240. s2l:=high(dests)-Len;
  241. JLSystem.ArrayCopy(JLObject(p.fdata),0,JLObject(pdest.fdata),len,s2l);
  242. inc(Len,s2l);
  243. end;
  244. end;
  245. pdest.curlen:=len;
  246. if needtemp then
  247. DestS:=TmpStr;
  248. end;
  249. procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring); compilerproc;
  250. var
  251. s1l, s2l : integer;
  252. begin
  253. s1l:=length(s1);
  254. s2l:=length(s2);
  255. if s1l+s2l>high(s1) then
  256. s2l:=high(s1)-s1l;
  257. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s2).fdata),0,JLObject(ShortstringClass(@s1).fdata),s1l,s2l);
  258. s1[0]:=chr(s1l+s2l);
  259. end;
  260. function fpc_shortstr_compare(const left,right:shortstring) : longint; compilerproc;
  261. Var
  262. MaxI,Temp, i : SizeInt;
  263. begin
  264. if ShortstringClass(@left)=ShortstringClass(@right) then
  265. begin
  266. result:=0;
  267. exit;
  268. end;
  269. Maxi:=Length(left);
  270. temp:=Length(right);
  271. If MaxI>Temp then
  272. MaxI:=Temp;
  273. if MaxI>0 then
  274. begin
  275. for i:=0 to MaxI-1 do
  276. begin
  277. result:=ord(ShortstringClass(@left).fdata[i])-ord(ShortstringClass(@right).fdata[i]);
  278. if result<>0 then
  279. exit;
  280. end;
  281. result:=Length(left)-Length(right);
  282. end
  283. else
  284. result:=Length(left)-Length(right);
  285. end;
  286. function fpc_shortstr_compare_equal(const left,right:shortstring) : longint; compilerproc;
  287. Var
  288. MaxI,Temp : SizeInt;
  289. begin
  290. if ShortstringClass(@left)=ShortstringClass(@right) then
  291. begin
  292. result:=0;
  293. exit;
  294. end;
  295. result:=ord(not JUArrays.equals(TJByteArray(ShortstringClass(@left).fdata),TJByteArray(ShortstringClass(@right).fdata)));
  296. end;
  297. procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of AnsiChar; zerobased: boolean = true); compilerproc;
  298. var
  299. l: longint;
  300. index: longint;
  301. len: byte;
  302. foundnull: boolean;
  303. begin
  304. l:=high(arr)+1;
  305. if l>=high(res)+1 then
  306. l:=high(res)
  307. else if l<0 then
  308. l:=0;
  309. if zerobased then
  310. begin
  311. foundnull:=false;
  312. for index:=low(arr) to l-1 do
  313. if arr[index]=#0 then
  314. begin
  315. foundnull:=true;
  316. break;
  317. end;
  318. if not foundnull then
  319. len:=l
  320. else
  321. len:=index;
  322. end
  323. else
  324. len:=l;
  325. JLSystem.ArrayCopy(JLObject(@arr),0,JLObject(ShortstringClass(@res).fdata),0,len);
  326. ShortstringClass(@res).curlen:=len;
  327. end;
  328. procedure fpc_shortstr_to_chararray(out res: array of AnsiChar; const src: ShortString); compilerproc;
  329. var
  330. len: longint;
  331. begin
  332. len:=length(src);
  333. if len>length(res) then
  334. len:=length(res);
  335. { make sure we don't access char 1 if length is 0 (JM) }
  336. if len>0 then
  337. JLSystem.ArrayCopy(JLObject(ShortstringClass(@src).fdata),0,JLObject(@res),0,len);
  338. JUArrays.fill(TJByteArray(@res),len,high(res),0);
  339. end;
  340. procedure fpc_Char_To_ShortStr(out res : shortstring;const c : AnsiChar) compilerproc;
  341. {
  342. Converts a WideChar to a ShortString;
  343. }
  344. begin
  345. setlength(res,1);
  346. ShortstringClass(@res).fdata[0]:=c;
  347. end;
  348. Function fpc_shortstr_Copy(const s:shortstring;index:SizeInt;count:SizeInt):shortstring;compilerproc;
  349. begin
  350. if count<0 then
  351. count:=0;
  352. if index>1 then
  353. dec(index)
  354. else
  355. index:=0;
  356. if index>length(s) then
  357. count:=0
  358. else
  359. if count>length(s)-index then
  360. count:=length(s)-index;
  361. ShortstringClass(@result).curlen:=count;
  362. JLSystem.ArrayCopy(JLObject(ShortstringClass(@s).fdata),index,JLObject(ShortstringClass(@result).fdata),0,count);
  363. end;
  364. function fpc_char_copy(c:AnsiChar;index : SizeInt;count : SizeInt): shortstring;compilerproc;
  365. begin
  366. if (index=1) and (Count>0) then
  367. fpc_char_Copy:=c
  368. else
  369. fpc_char_Copy:='';
  370. end;
  371. function upcase(const s : shortstring) : shortstring;
  372. var
  373. u : unicodestring;
  374. begin
  375. u:=s;
  376. result:=upcase(u);
  377. end;
  378. function lowercase(const s : shortstring) : shortstring;
  379. var
  380. u : unicodestring;
  381. begin
  382. u:=s;
  383. result:=lowercase(u);
  384. end;
  385. Function Pos (Const Substr : Shortstring; Const Source : Shortstring) : SizeInt;
  386. var
  387. i,j,k,MaxLen, SubstrLen : SizeInt;
  388. begin
  389. Pos:=0;
  390. SubstrLen:=Length(SubStr);
  391. if SubstrLen>0 then
  392. begin
  393. MaxLen:=Length(source)-Length(SubStr);
  394. i:=0;
  395. while (i<=MaxLen) do
  396. begin
  397. inc(i);
  398. j:=0;
  399. k:=i-1;
  400. while (j<SubstrLen) and
  401. (ShortstringClass(@SubStr).fdata[j]=ShortstringClass(@Source).fdata[k]) do
  402. begin
  403. inc(j);
  404. inc(k);
  405. end;
  406. if (j=SubstrLen) then
  407. begin
  408. Pos:=i;
  409. exit;
  410. end;
  411. end;
  412. end;
  413. end;
  414. { Faster version for a char alone. Must be implemented because }
  415. { pos(c: char; const s: shortstring) also exists, so otherwise }
  416. { using pos(char,pchar) will always call the shortstring version }
  417. { (exact match for first argument), also with $h+ (JM) }
  418. Function Pos (c : AnsiChar; Const s : ShortString) : SizeInt;
  419. var
  420. i: SizeInt;
  421. begin
  422. for i:=1 to length(s) do
  423. begin
  424. if ShortstringClass(@s).fdata[i-1]=c then
  425. begin
  426. pos:=i;
  427. exit;
  428. end;
  429. end;
  430. pos:=0;
  431. end;