source: trunk/Sibyl/RTL/STRINGS.PAS@ 201

Last change on this file since 201 was 8, checked in by RBRi, 19 years ago

+ rest of sibyl stuff

  • Property svn:eol-style set to native
File size: 12.7 KB
Line 
1{**************************************************************************
2 * General Unit for Speed-Pascal/2 *
3 * *
4 * *
5 * Copyright (C) 1995..96 SpeedSoft *
6 * Partial Copyright (C) 1995 Uwe Chalas (Thanks a lot !) *
7 * *
8 * All REP MOVSB changed to 32 Bit *
9 * *
10 **************************************************************************}
11
12
13UNIT Strings;
14
15
16INTERFACE
17
18USES Os2Def;
19
20FUNCTION StrNew(Str: PChar): PChar;
21PROCEDURE StrDispose(Str: PChar);
22FUNCTION StrEnd(Str:PChar):PChar;
23FUNCTION StrMove(Dest, Source: PChar; Count: ULONG): PChar;
24FUNCTION StrCat(Dest,Source:PChar):PChar;
25FUNCTION StrCopy(Dest,Source:PChar):PChar;
26FUNCTION StrECopy(Dest,Source:PChar):PChar;
27FUNCTION StrLCopy(Dest,Source:PChar;Len:LONGINT):PChar;
28FUNCTION StrLen(pszStr:PChar):ULONG;
29FUNCTION StrPos(MainStr,SubStr:PChar):Pchar;
30FUNCTION StrPosN(MainStr,SubStr:PChar):LONGINT;
31FUNCTION StrScan(Str:PChar; Chr : Char):PChar;
32FUNCTION StrScanN(Str:PChar; Chr : Char):LONGINT;
33FUNCTION StrRScan(Str:PChar; Chr : Char):PChar;
34FUNCTION StrRScanN(Str:PChar; Chr : Char):LONGINT;
35FUNCTION StrUpper(Str:PChar):PChar;
36FUNCTION StrLower(Str:PChar):PChar;
37FUNCTION StrPCopy(Dest: PChar;CONST Source: String): PChar;
38FUNCTION StrPas(Str:PChar):String;
39FUNCTION StrComp(Str1,Str2:PChar):Integer;
40FUNCTION StriComp(Str1,Str2:PChar):Integer;
41FUNCTION StrLComp(Str1, Str2: PChar; MaxLen: LongWord): Integer;
42FUNCTION StrLIComp(Str1,Str2:PChar;MaxLen:LONGWORD):Integer;
43
44IMPLEMENTATION
45
46IMPORTS
47FUNCTION WinUpper(ahab:HAB;idcp,idcc:LONGWORD;apsz:PSZ):LONGWORD;
48 APIENTRY; 'PMWIN' index 893;
49FUNCTION WinCompareStrings(ahab:HAB;idcp,idcc:LONGWORD;psz1,psz2:PSZ;
50 reserved:LONGWORD):LONGWORD;
51 APIENTRY; 'PMWIN' index 708;
52END;
53
54CONST
55 WCS_ERROR =0;
56 WCS_EQ =1;
57 WCS_LT =2;
58 WCS_GT =3;
59
60ASSEMBLER
61
62STRINGS.!StrEnd PROC NEAR32
63//get pointer to end of string into EAX
64//changes EAX,EBX,ECX und EDI
65 MOV EBX,ESP
66 MOV EDI,[EBX+4]
67 XOR EAX,EAX
68 CMP EDI,0
69 JE !Out!StrEnd //String is NIL
70 MOV ECX,$0FFFFFFFF
71 CLD
72 REPNE
73 SCASB
74 DEC EDI
75 MOV EAX,EDI
76!Out!StrEnd:
77 RETN32 4
78STRINGS.!StrEnd ENDP
79
80STRINGS.!StrLen PROC NEAR32
81//get length of string
82//changes EAX,EBX,ECX und EDI
83 MOV EBX,ESP
84 MOV EDI,[EBX+4]
85 XOR EAX,EAX
86 CMP EDI,0
87 JE !Out!StrLen //String is NIL
88 MOV ECX,$0FFFFFFFF
89 CLD
90 REPNE
91 SCASB
92 NOT ECX
93 DEC ECX
94 MOV EAX,ECX
95!Out!StrLen:
96 RETN32 4
97STRINGS.!StrLen ENDP
98
99END; {Assembler}
100
101{Allocate copy of Str}
102FUNCTION StrNew(Str: PChar): PChar;
103VAR
104 L: LONGWORD;
105 result:PChar;
106BEGIN
107 result := NIL;
108 L := StrLen(Str);
109 IF L > 0 THEN
110 BEGIN
111 Inc(L);
112 GetMem(Result, L);
113 StrMove(Result,Str,L);
114 END;
115 StrNew:=Result;
116END;
117
118{Dispose Str}
119PROCEDURE StrDispose(Str: PChar);
120BEGIN
121 IF Str <> NIL THEN FreeMem(Str, StrLen(Str) + 1);
122END;
123
124{Get Pointer to End of String}
125FUNCTION StrEnd(Str:PChar):PChar;
126BEGIN
127 ASM
128 PUSH DWORD PTR Str
129 CALLN32 STRINGS.!StrEnd
130 MOV Result,EAX
131 END;
132END;
133
134{Copy one string into another}
135FUNCTION StrMove(Dest, Source: PChar; Count: ULONG): PChar;
136VAR result:PChar;
137LABEL l;
138BEGIN
139 result:=NIL;
140 IF Source=NIL THEN goto l;
141 IF Dest=NIL THEN goto l;
142 IF Count=0 THEN goto l;
143 Move(Source^,Dest^,Count);
144 result:=Dest;
145l:
146 StrMove := result;
147END;
148
149{Concat two strings}
150FUNCTION StrCat(Dest,Source:PChar):PChar;
151BEGIN
152 ASM
153 MOV ESI,Source //Source to ESI
154 XOR EAX,EAX //EAX := 0
155 CMP ESI,0 //If Source = NIL..,
156 JE !OUTStrCat //... get out here !
157
158 PUSH DWORD PTR Dest //Dest auf den Stack
159 CALLN32 STRINGS.!StrEnd //StrEnd-Proc aufrufen
160 CMP EAX,0 //StrEnd returns 0 ?
161 JE !OutStrCat //if yes get out
162
163 PUSH EDI //StrEnd (Dest)
164
165 XOR EAX,EAX
166 MOV EDI,Source
167 MOV ECX,$0FFFFFFFF
168 CLD
169 REPNE
170 SCASB
171 NOT ECX
172
173 POP EDI //StrEnd (Dest)
174 MOV ESI,Source
175
176 MOV EDX,ECX
177 SHR ECX,2
178 REP
179 MOVSD
180 MOV ECX,EDX
181 AND ECX,3
182 REP
183 MOVSB
184
185 MOV EAX,Dest
186!OutStrCat:
187 MOV Result,EAX
188 END;
189END;
190
191{Copy String into another}
192FUNCTION StrCopy(Dest,Source:PChar):PChar;
193BEGIN
194 ASM
195 MOV EDI,Source
196 MOV ESI,Dest
197 XOR EAX,EAX
198 CMP EDI,0
199 JE !OUTStrCopy
200 CMP ESI,0
201 JE !OUTStrCopy
202 MOV ECX,$0FFFFFFFF
203 CLD
204 REPNE
205 SCASB
206 NOT ECX
207
208 MOV ESI,Source
209 MOV EDI,Dest
210 MOV EDX,ECX
211 SHR ECX,2
212 REP
213 MOVSD
214 MOV ECX,EDX
215 AND ECX,3
216 REP
217 MOVSB
218
219 MOV EAX,Dest
220!OUTStrCopy:
221 MOV Result,EAX
222 END;
223END;
224
225FUNCTION StrECopy(Dest,Source:PChar):PChar;
226BEGIN
227 result:=StrCopy(Dest,Source);
228 result:=StrEnd(result);
229END;
230
231FUNCTION StrLCopy(Dest,Source:PChar;Len:LONGINT):PChar;
232BEGIN
233 ASM
234 MOV EDI,Source
235 MOV ESI,Dest
236 XOR EAX,EAX
237 CMP EDI,0
238 JE !OUTStrCopy_xx
239 CMP ESI,0
240 JE !OUTStrCopy_xx
241 MOV ECX,$0FFFFFFFF
242 CLD
243 REPNE
244 SCASB
245 NOT ECX
246
247 CMP ECX,Len
248 JBE !strxxxx2
249 MOV ECX,Len
250!strxxxx2:
251 MOV ESI,Source
252 MOV EDI,Dest
253 MOV EDX,ECX
254 SHR ECX,2
255 REP
256 MOVSD
257 MOV ECX,EDX
258 AND ECX,3
259 REP
260 MOVSB
261
262 MOV EAX,Dest
263!OUTStrCopy_xx:
264 MOV Result,EAX
265 END;
266END;
267
268{Get length of string}
269FUNCTION StrLen(pszStr:PChar):ULONG;
270BEGIN
271 ASM
272 PUSH DWORD PTR pszStr
273 CALLN32 STRINGS.!StrLen
274 MOV Result,EAX
275 END;
276END;
277
278{Get pos-pointer to substring from string}
279FUNCTION StrPos(MainStr,SubStr:PChar):PChar;
280BEGIN
281 ASM
282 PUSH DWORD PTR SubStr //SubStr
283 CALLN32 STRINGS.!StrLen
284 CMP EAX,0
285 JE !ErrOutStrPos
286
287 MOV EDX,EAX //L„nge von SubStr in EDX
288 PUSH DWORD PTR MainStr
289 CALLN32 STRINGS.!StrLen
290 CMP EAX,0
291 JE !ErrOutStrPos
292 SUB EAX,EDX
293 JB !ErrOutStrPos
294 MOV EDI,MainStr
295!1:
296 MOV ESI,SubStr
297 LODSB
298 REPNE
299 SCASB
300 JNE !ErrOutStrPos;
301 MOV EAX,ECX
302 PUSH EDI
303 MOV ECX,EDX //L„nge SubStr nach ECX
304 DEC ECX
305 REPE
306 CMPSB
307 MOV ECX,EAX
308 POP EDI
309 JNE !1
310 MOV EAX,EDI
311 DEC EAX
312 JMP !out
313!ErrOutStrPos:
314 XOR EAX,EAX
315!Out:
316 MOV Result,EAX
317 END;
318END;
319
320
321{returns -1 if subStr is not inside of MainStr, otherwise position }
322FUNCTION StrPosN(MainStr,SubStr:PChar):LONGINT;
323BEGIN
324 ASM
325 PUSH DWORD PTR SubStr
326 CALLN32 STRINGS.!StrLen
327 CMP EAX,0
328 JE !ErrOutPos
329
330 MOV EDX,EAX //L„nge von SubStr in EDX
331 PUSH DWORD PTR MainStr
332 CALLN32 STRINGS.!StrLen
333 CMP EAX,0
334 JE !ErrOutPos
335 SUB EAX,EDX
336 JB !ErrOutPos
337 MOV EDI,MainStr
338!1_1:
339 MOV ESI,SubStr
340 LODSB
341 REPNE
342 SCASB
343 JNE !ErrOutPos
344 MOV EAX,ECX
345
346 PUSH EDI
347 MOV ECX,EDX //L„nge SubStr nach ECX
348 DEC ECX
349 REPE
350 CMPSB
351 MOV ECX,EAX
352 POP EDI
353 JNE !1_1
354
355 SUB EDI,MainStr
356 MOV EAX,EDI
357 DEC EAX
358 JMP !out_1
359!ErrOutPos:
360 MOV EAX,$0FFFFFFFF
361!Out_1:
362 MOV Result,EAX
363 END;
364END;
365
366{Scan for char inside of string and return pointer to it}
367FUNCTION StrScan(Str:PChar; Chr : Char):PChar;
368BEGIN
369 ASM
370 PUSH DWORD PTR Str
371 CALLN32 STRINGS.!StrLen
372 CMP EAX,0
373 JE !OutStrScan
374 MOV AL,Chr
375 MOV EDI,Str
376 CLD
377 REPNE
378 SCASB
379 MOV EAX,0
380 CWD
381 JNE !OutStrScan
382 MOV EAX,EDI
383 DEC EAX
384!OutStrScan:
385 MOV Result,EAX
386 END;
387END;
388
389{returns -1 IF Chr is not inside of Str, Otherwise position}
390FUNCTION StrScanN(Str:PChar; Chr : Char):LONGINT;
391BEGIN
392 ASM
393 PUSH DWORD PTR Str
394 CALLN32 STRINGS.!StrLen
395 CMP EAX,0
396 JE !ErrStrScanN
397 MOV AL,Chr
398 MOV EDI,Str
399 CLD
400 REPNE
401 SCASB
402 CWD
403 JNE !ErrStrScanN
404 SUB EDI,Str
405 MOV EAX,EDI
406 DEC EAX
407 JMP !OutStrScanN
408!ErrStrScanN:
409 MOV EAX,$0FFFFFFFF
410!OutStrScann:
411 MOV Result,EAX
412 END;
413END;
414
415{Get pointer to last appearance of character}
416FUNCTION StrRScan(Str:PChar; Chr : Char):PChar;
417BEGIN
418 ASM
419 PUSH DWORD PTR Str
420 CALLN32 STRINGS.!StrLen
421 CMP EAX,0
422 JE !OutStrRScan
423 MOV AL,Chr
424 DEC EDI //returned from !StrLen
425 MOV ECX,EAX
426 STD
427 REPNE
428 SCASB
429 MOV EAX,0
430 CWD
431 JNE !OutStrRScan
432 MOV EAX,EDI
433 INC EAX
434!OutStrRScan:
435 CLD
436 MOV Result,EAX
437 END;
438END;
439
440{returns -1 if chr is not inside of Str, otherwise pos of last appearance}
441FUNCTION StrRScanN(Str:PChar; Chr : Char):LONGINT;
442BEGIN
443 ASM
444 PUSH DWORD PTR Str
445 CALLN32 STRINGS.!StrLen
446 CMP EAX,0
447 JE !ErrStrRScanN
448 MOV AL,Chr
449 DEC EDI
450 MOV ECX,EAX
451 STD
452 REPNE
453 SCASB
454 CWD
455 JNE !ErrStrRScanN
456 SUB EDI,Str
457 MOV EAX,EDI
458 INC EAX
459 JMP !OutStrRScanN
460!ErrStrRScanN:
461 MOV EAX,$0FFFFFFFF
462!OutStrRScanN:
463 CLD
464 MOV Result,EAX
465 END;
466END;
467
468{Convert string to upper}
469FUNCTION StrUpper(Str:PChar):PChar;
470BEGIN
471 WinUpper(0,0,0,Str^);
472 StrUpper := Str;
473END;
474
475{Convert string to lower}
476FUNCTION StrLower(Str:PChar):PChar;
477BEGIN
478 ASM
479 CLD
480 MOV ESI,Str
481!SL1:
482 LODSB
483 OR AL,AL
484 JE !OutStrLower
485
486 CMP AL,'Ž'
487 JNE !SLUE
488 MOV AL,'„'
489 JMP !SetChar
490!SLUE:
491 CMP AL,'š'
492 JNE !SLOE
493 MOV AL,''
494 JMP !SetChar
495!SLOE:
496 CMP AL,'™'
497 JNE !SL2
498 MOV AL,'”'
499 JMP !SetChar
500!SL2:
501 CMP AL, 'A'
502 JB !SL1
503 CMP AL,'Z'
504 JA !SL1
505 ADD AL,$20
506!SetChar:
507 MOV [ESI-1],AL
508 JMP !SL1
509!OutStrLower:
510 MOV EAX,Str
511 MOV Result,EAX
512 END;
513END;
514
515{Convert Pascal String to pointer}
516FUNCTION StrPCopy(Dest: PChar;CONST Source: String): PChar;
517BEGIN
518 ASM
519 MOV ESI,Source
520 MOV EDI,Dest
521 MOV CL,[ESI+0]
522 INC ESI
523 MOVZX ECX,CL
524
525 CLD
526 MOV EDX,ECX
527 SHR ECX,2
528 REP
529 MOVSD
530 MOV ECX,EDX
531 AND ECX,3
532 REP
533 MOVSB
534!OutStrPCopy:
535 MOVB [EDI+0],0 //terminate with zero
536 MOV EAX,Dest
537 MOV Result,EAX
538 END;
539END;
540
541{Convert PChar to Pascal String}
542FUNCTION StrPas(Str:PChar):String;
543BEGIN
544 ASM
545 PUSH DWORD PTR Str //Get Str
546 CALLN32 STRINGS.!StrLen
547 POP EBX
548 CMP EAX,0
549 JE !ErrStrPas
550 MOV EDI,Result //DestString
551 MOV ESI,Str //SourceStr
552 MOVZX ECX,AL
553 STOSB
554
555 MOV EDX,ECX
556 SHR ECX,2
557 REP
558 MOVSD
559 MOV ECX,EDX
560 AND ECX,3
561 REP
562 MOVSB
563
564 JMP !OutStrPas
565!ErrStrPas:
566 MOV EDI,Result //get result string
567 MOVB [EDI+0],0 //terminate with zero
568!OutStrPas:
569 END;
570END;
571
572{Compare strings without upper and lower case}
573FUNCTION StrIComp(Str1,Str2:PChar):Integer;
574VAR Res : LONGWORD;
575BEGIN
576 Res := WinCompareStrings(0,0,0,Str1^,Str2^,0);
577 case Res of
578 WCS_EQ : StrIComp := 0;
579 WCS_LT : StrIComp := -1;
580 WCS_GT : StrIComp := 1;
581 WCS_ERROR : StrIComp := $FF;
582 end;
583END;
584
585FUNCTION StrLIComp(Str1,Str2:PChar;MaxLen:LONGWORD):Integer;
586VAR Res : LONGWORD;
587 c1,c2:Char;
588BEGIN
589 IF StrLen(Str1) > MaxLen then
590 BEGIN
591 c1 := PString(Str1)^[MaxLen];
592 PString(Str1)^[MaxLen] := #0;
593 END
594 ELSE c1 := #0;
595
596 IF StrLen(Str2) > MaxLen then
597 BEGIN
598 c2 := PString(Str2)^[MaxLen];
599 PString(Str2)^[MaxLen] := #0;
600 END
601 ELSE c2 := #0;
602
603 Res := WinCompareStrings(0,0,0,Str1^,Str2^,0);
604 CASE Res OF
605 WCS_EQ : StrLIComp := 0;
606 WCS_LT : StrLIComp := -1;
607 WCS_GT : StrLIComp := 1;
608 WCS_ERROR : StrLIComp := $FF;
609 END;
610 IF c1 <> #0 THEN PString(Str1)^[MaxLen] := c1;
611 IF c2 <> #0 THEN PString(Str2)^[MaxLen] := c2;
612END;
613
614
615{Compare strings}
616FUNCTION StrComp(Str1,Str2:PChar):Integer;
617BEGIN
618 ASM
619 CLD
620 MOV EDI,Str2
621 MOV ECX,$0FFFFFFFF
622 XOR EAX,EAX
623 CWD
624 REPNE
625 SCASB
626 NOT ECX
627 MOV ESI,Str1
628 MOV EDI,Str2
629 XOR EAX,EAX
630 CMP ESI,0
631 JE !OutStrComp
632 CMP EDI,0
633 JE !OutStrComp
634 REPE
635 CMPSB
636 XOR AX,AX
637 XOR DX,DX
638 MOV AL,[ESI-1]
639 MOV DL,[EDI-1]
640 SUB AX,DX
641!OutStrComp:
642 MOV Result,EAX
643 END;
644END;
645
646FUNCTION StrLComp(Str1, Str2: PChar; MaxLen: LongWord): Integer;
647BEGIN
648 ASM
649 CLD
650 MOV EDI,Str2
651 MOV EAX,MaxLen
652 CMP EAX,0
653 JE !ErrStrLComp
654 MOV ECX,EAX
655 PUSH EBX
656 XCHG EAX,EBX
657 XOR EAX,EAX
658 CWD
659 REPNE
660 SCASB
661 SUB EBX,ECX
662 MOV ECX,EBX
663 POP EBX
664 MOV EDI,Str2
665 MOV ESI,Str1
666 REPE
667 CMPSB
668 XOR AX,AX
669 XOR DX,DX
670 MOV AL,[ESI-1]
671 MOV DL,[EDI-1]
672 SUB AX,DX
673 JMP !OutStrLComp
674!ErrStrLComp:
675 MOV EAX,42
676!OutStrLComp:
677 MOV Result,EAX
678 END;
679END;
680
681
682
683END.
684
685
Note: See TracBrowser for help on using the repository browser.