Listing: 1 (* Release 3.10 *) 2 (*-------------------------------------------------------------------------* 3 * * 4 * STR.MOD - String functions * 5 * * 6 * COPYRIGHT (C) 1987..1992 Clarion Software Corporation. * 7 * All Rights Reserved * 8 * * 9 *--------------------------------------------------------------------------*) 10 11 (*%F _fdata *) 12 (*# call(seg_name => null) *) 13 (*%E *) 14 (*%T _fdata *) 15 (*# call(seg_name => STR) *) 16 (*# data(seg_name => null) *) 17 (*%E *) 18 (*# module(implementation=>off) *) 19 (*# call(o_a_copy => off) *) 20 (*# check(stack=>off, 21 index=>off, 22 range=>off, 23 overflow=>off, 24 nil_ptr=>off) *) 25 26 IMPLEMENTATION MODULE Str; 27 28 29 IMPORT Lib, MATHLIB, SYSTEM; 30 31 CONST 32 StrictRealConv = FALSE ; 33 34 (*# save *) 35 (*%T _DLL *) 36 (*# call(seg_name=>STRDLL) *) 37 (*%E *) 38 PROCEDURE Caps(VAR S: ARRAY OF CHAR); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 39 PROCEDURE Lows(VAR S: ARRAY OF CHAR); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 40 PROCEDURE Compare(S1,S2: ARRAY OF CHAR) : INTEGER; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 41 PROCEDURE Length(S : ARRAY OF CHAR) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 42 PROCEDURE Concat(VAR R: ARRAY OF CHAR; S1,S2: ARRAY OF CHAR); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 43 PROCEDURE Append(VAR R: ARRAY OF CHAR; S: ARRAY OF CHAR); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 44 PROCEDURE Copy (VAR R: ARRAY OF CHAR; S: ARRAY OF CHAR); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 45 PROCEDURE Slice (VAR R: ARRAY OF CHAR; S: ARRAY OF CHAR; P,L: CARDINAL); IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 46 PROCEDURE Pos(S,P: ARRAY OF CHAR) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 47 PROCEDURE NextPos(S,P: ARRAY OF CHAR; Place: CARDINAL) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 48 PROCEDURE CharPos(S: ARRAY OF CHAR; C: CHAR) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 49 PROCEDURE RCharPos(S: ARRAY OF CHAR; C: CHAR) : CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 50 PROCEDURE Same(Stg,Pattern:ARRAY OF CHAR):BOOLEAN; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 51 PROCEDURE Count(Stg:ARRAY OF CHAR;Ch:CHAR):CARDINAL; IN AsmLib; ***** ^ not supported yet ***** ^ not supported yet 52 (*# restore *) 53 54 PROCEDURE Prepend(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR); ***** ^ not supported yet ***** ^ not supported yet 55 56 VAR 57 ShiftLen: CARDINAL; 58 S1Len, S2Len: CARDINAL; 59 BEGIN 60 S1Len:=Length(S1)+1; ***** ^ not supported yet ***** ^ not supported yet 61 S2Len:=Length(S2); ***** ^ not supported yet ***** ^ not supported yet 62 IF S2Len > HIGH(S1) THEN ***** ^ undeclared identifier ***** ^ not supported yet 63 Copy(S1, S2); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 64 RETURN; 65 END; 66 ShiftLen:=HIGH(S1)-S2Len + 1; ***** ^ undeclared identifier ***** ^ not supported yet 67 IF ShiftLen > S1Len THEN ShiftLen:=S1Len END; 68 Lib.Move(ADR(S1), ADR(S1[S2Len]), ShiftLen); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 69 Lib.Move(ADR(S2), ADR(S1), S2Len); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet 70 END Prepend; ***** ^ not supported yet 71 72 PROCEDURE Subst(VAR S1: ARRAY OF CHAR; Target: ARRAY OF CHAR; New: ARRAY OF CHAR); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 73 74 VAR 75 TargetPos, TargetLen: CARDINAL; 76 BEGIN 77 TargetPos:=Pos(S1, Target); ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 78 IF TargetPos = MAX(CARDINAL) THEN RETURN END; ***** ^ undeclared identifier ***** ^ not supported yet 79 TargetLen:=Length(Target); ***** ^ not supported yet ***** ^ not supported yet 80 Lib.Move(ADR(S1[TargetPos+TargetLen]), ADR(S1[TargetPos]), Length(S1)-TargetLen-TargetPos+1); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 81 Insert(S1, New, TargetPos); ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 82 END Subst; ***** ^ not supported yet 83 84 PROCEDURE Delete(VAR S: ARRAY OF CHAR; P,L: CARDINAL); ***** ^ not supported yet 85 VAR 86 Le,I : CARDINAL; 87 BEGIN 88 IF L # 0 THEN 89 Le := Length(S); ***** ^ not supported yet ***** ^ not supported yet 90 IF P < Le THEN 91 IF L < Le - P THEN 92 I := P+L; 93 REPEAT 94 S[P] := S[I]; ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 95 INC(P); ***** ^ undeclared identifier ***** ^ not supported yet 96 INC(I); ***** ^ undeclared identifier ***** ^ not supported yet 97 UNTIL I=Le; 98 END; 99 S[P] := CHR(0); ***** ^ not supported yet ***** ^ not supported yet ***** ^ undeclared identifier ***** ^ not supported yet 100 END; 101 END; 102 END Delete; ***** ^ not supported yet 103 104 PROCEDURE Insert(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR; P: CARDINAL); ***** ^ not supported yet ***** ^ not supported yet 105 VAR 106 I,J,C,L : CARDINAL; 107 BEGIN 108 L := Length(S1); ***** ^ not supported yet ***** ^ not supported yet 109 I := Length(S2); ***** ^ not supported yet ***** ^ not supported yet 110 C := L; 111 IF C < P THEN P := C END; 112 DEC(C,P); ***** ^ undeclared identifier ***** ^ not supported yet 113 FOR J := C TO 0 BY -1 DO 114 IF (J+P+I <= HIGH(S1)) THEN S1[J+P+I] := S1[J+P]; END; ***** ^ undeclared identifier ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet ***** ^ not supported yet 115 END; 116 J := 0; 117 WHILE (J0 DO 155 DEC(I); 156 INCL(CS,T[I]); 157 END; 158 Item(R,S,CS,N); 159 END ItemS; 160 161 PROCEDURE Match(Source,Pattern: ARRAY OF CHAR) : BOOLEAN; 162 (* 163 returns TRUE if the string in Source matches the string in Pattern 164 The pattern may contain any number of the wild characters '*' and '?' 165 '?' matches any single character 166 '*' matches any sequence of charcters (including a zero length sequence) 167 EG '*m?t*i*' will match 'Automatic' 168 *) 169 170 PROCEDURE Rmatch(VAR s: ARRAY OF CHAR; i: CARDINAL; 171 VAR p: ARRAY OF CHAR; j: CARDINAL) : BOOLEAN; 172 173 (* s = to be tested , i = position in s *) 174 (* p = pattern to match ,j = position in p *) 175 176 VAR 177 matched: BOOLEAN; 178 k : CARDINAL; 179 BEGIN 180 IF p[0]=CHR(0) THEN RETURN TRUE END; 181 LOOP 182 IF ((i > HIGH(s)) OR (s[i] = CHR(0))) AND 183 ((j > HIGH(p)) OR (p[j] = CHR(0))) THEN 184 RETURN TRUE 185 ELSIF ((j > HIGH(p)) OR (p[j] = CHR(0))) THEN 186 RETURN FALSE 187 ELSIF (p[j] = '*') THEN 188 k :=i; 189 IF ((j = HIGH(p)) OR (p[j+1] = CHR(0))) THEN 190 RETURN TRUE 191 ELSE 192 LOOP 193 matched := Rmatch(s,k,p,j+1); 194 IF matched OR (k > HIGH(s)) OR (s[k] = CHR(0)) THEN 195 RETURN matched; 196 END; 197 INC(k); 198 END; 199 END 200 ELSIF ((p[j]='?')AND(s[i]<>0C)) OR (CAP(p[j]) = CAP(s[i])) THEN 201 INC(i); 202 INC(j); 203 ELSE 204 RETURN FALSE; 205 END; 206 END; 207 END Rmatch; 208 209 BEGIN 210 RETURN Rmatch(Source,0,Pattern,0); 211 END Match; 212 213 TYPE 214 ConvIntType = ARRAY ['0'..'F'] OF SHORTCARD; 215 BA = ARRAY[0..1] OF SHORTCARD; 216 217 CONST 218 ConvStr = '0123456789ABCDEF'; 219 ConvInt = ConvIntType( 0,1,2,3,4,5,6,7,8,9,255,255,255,255,255,255,255,10,11,12,13,14,15 ); 220 Div = BA(0,4); 221 222 VAR FloatUse : BOOLEAN; 223 224 (*%F _WINDOWS *) 225 PROCEDURE FixRealToStr(V:LONGREAL;Precision:CARDINAL;VAR S:ARRAY OF CHAR;VAR OK:BOOLEAN); 226 VAR 227 j,i,l : CARDINAL; 228 X : MATHLIB.PackedBcd; 229 c : CHAR; 230 NoDigits : BOOLEAN; 231 Z : LONGREAL; 232 BEGIN 233 OK := TRUE; 234 IF Precision > 17 THEN 235 Precision := 17; 236 END; 237 l := HIGH(S); 238 j := 0; 239 NoDigits := TRUE; 240 IF ABS(V) >= 1.0E18 THEN 241 S[0] := '?'; 242 INC(j); 243 OK := FALSE; 244 ELSE 245 LOOP 246 Z := V * MATHLIB.IntPow(10.0,Precision); 247 IF ABS(Z) < 1.0E18 THEN 248 EXIT; 249 END; 250 DEC(Precision); 251 END; 252 X := MATHLIB.LongToBcd(Z); 253 IF X[9]=80H THEN 254 S[0] := '-'; 255 INC(j); 256 END; 257 FOR i := 17 TO 0 BY -1 DO 258 c := CHAR(SHORTCARD('0') + (X[i DIV 2] >> Div[i MOD 2]) MOD 16); 259 IF (c # '0') OR (i = Precision) OR NOT NoDigits THEN 260 NoDigits := FALSE; 261 IF j > l THEN 262 OK := FALSE; 263 RETURN; 264 END; 265 S[j] := c; 266 INC(j); 267 END; 268 IF (i = Precision) AND (i # 0) THEN 269 IF j > l THEN 270 OK := FALSE; 271 RETURN; 272 END; 273 S[j] := '.'; 274 INC(j); 275 END; 276 END; 277 END; 278 IF j <= l THEN 279 S[j] := CHR(0); 280 END; 281 END FixRealToStr; 282 (*%E *) 283 284 (*%T _WINDOWS *) 285 PROCEDURE FixRealToStr(V:LONGREAL;Precision:CARDINAL;VAR S:ARRAY OF CHAR;VAR OK:BOOLEAN); 286 VAR 287 j,l,m : INTEGER; 288 t : LONGREAL; 289 BEGIN 290 OK := TRUE; 291 IF V = 0.0 THEN 292 FOR j := 0 TO Precision + 1 DO 293 S[j] := '0'; 294 END; (*FOR*) 295 S[1] := '.'; 296 S[Precision+2] := 0C; 297 ELSE 298 S[0] := 0C; 299 IF V < 0.0 THEN 300 Copy(S,'-'); 301 V := -V; 302 END; (*IF*) 303 t := MATHLIB.IntPow(10.0,INTEGER(Precision)); 304 V := (V * t + 0.5) / t; 305 m := TRUNC(MATHLIB.Log10(V)); 306 IF m <= 0 THEN 307 l := 0; 308 t := V; 309 ELSE 310 l := m; 311 t := V / MATHLIB.IntPow(10.0,m); 312 END; (*IF*) 313 FOR j := l TO (-INTEGER(Precision)) BY -1 DO 314 Append(S,CHR(TRUNC(t) + 48)); 315 IF j = 0 THEN 316 Append(S,'.'); 317 END; (*IF*) 318 t := (t - LONGREAL(TRUNC(t))) * 10.0; 319 END; (*FOR*) 320 END; (*IF*) 321 END FixRealToStr; 322 (*%E *) 323 324 PROCEDURE CheckBase(VAR b: CARDINAL); 325 BEGIN 326 IF b < 2 THEN b := 2; END; 327 IF b > 16 THEN b := 16; END; 328 END CheckBase; 329 330 PROCEDURE Reverse(VAR s: ARRAY OF CHAR; l,h: CARDINAL); 331 VAR T : CHAR; 332 BEGIN 333 WHILE l < h DO 334 T := s[l]; 335 s[l] := s[h]; 336 s[h] := T; 337 INC(l); 338 DEC(h); 339 END; 340 END Reverse; 341 342 343 PROCEDURE IntToStr(V: LONGINT;VAR S: ARRAY OF CHAR; Base: CARDINAL; VAR OK: BOOLEAN); 344 VAR 345 i,l : CARDINAL; 346 b : LONGCARD; 347 BEGIN 348 OK := TRUE; 349 l := HIGH(S); 350 CheckBase( Base ); 351 b := VAL( LONGCARD,Base ); 352 IF V < 0 THEN 353 S[0] := '-'; 354 i := 1; 355 V := -V; 356 ELSIF FloatUse THEN 357 S[0] := '+'; 358 i := 1; 359 ELSE 360 i := 0; 361 END; 362 363 LOOP 364 IF i > l THEN OK := FALSE; EXIT; END; 365 S[i] := ConvStr[CARDINAL( LONGCARD(V) MOD b )]; 366 INC(i); 367 V := LONGCARD(V) DIV b; 368 IF V = 0 THEN EXIT END; 369 END; 370 IF i <= l THEN S[i] := CHR(0); END; 371 IF S[0] < '0' THEN 372 Reverse( S,1,i-1 ); 373 ELSE 374 Reverse( S,0,i-1 ); 375 END; 376 END IntToStr; 377 378 379 PROCEDURE CardToStr(V: LONGCARD; VAR S: ARRAY OF CHAR; 380 Base: CARDINAL; VAR OK: BOOLEAN); 381 VAR 382 i,l : CARDINAL; 383 b : LONGCARD; 384 BEGIN 385 OK := TRUE; 386 l := HIGH(S); 387 CheckBase( Base ); 388 b := VAL( LONGCARD,Base ); 389 i := 0; 390 LOOP 391 IF i > l THEN OK := FALSE; EXIT END; 392 S[i] := ConvStr[CARDINAL( V MOD b )]; 393 INC(i); 394 V := V DIV b; 395 IF V = 0 THEN EXIT END; 396 END; 397 IF i <= l THEN S[i] := CHR(0); END; 398 Reverse( S,0,i-1 ); 399 END CardToStr; 400 401 402 (*$V-*) 403 PROCEDURE StrToCI(S: ARRAY OF CHAR; Base: CARDINAL; VAR OK: BOOLEAN) : LONGCARD; 404 VAR 405 i,l : CARDINAL; 406 b,t,y : LONGCARD; 407 c : CHAR; 408 x : SHORTCARD; 409 BEGIN 410 CheckBase( Base ); 411 b := VAL( LONGCARD,Base); 412 i := 0; 413 l := HIGH( S ); 414 IF (S[0] = '-') OR (S[0] = '+') THEN 415 i := 1; 416 END; 417 t := 0; 418 IF S[i] = CHR(0) THEN OK := FALSE; END; 419 WHILE (i <= l) AND (S[i] # CHR(0)) DO 420 c := S[i]; 421 IF (c < '0') OR (c > 'F') THEN 422 OK := FALSE; 423 RETURN t; 424 END; 425 x := ConvInt[c]; 426 IF (x > SHORTCARD(b)-1 ) OR (t > (MAX(LONGCARD)-LONGCARD(x)) DIV b) THEN OK := FALSE; END; 427 t := t*b+VAL( LONGCARD,x ); 428 INC( i ); 429 END; 430 RETURN t; 431 END StrToCI; 432 433 434 PROCEDURE StrToInt(S: ARRAY OF CHAR; Base: CARDINAL; VAR OK: BOOLEAN) : LONGINT; 435 VAR t : LONGCARD; 436 BEGIN 437 OK := TRUE; 438 t := StrToCI( S,Base,OK); 439 IF t > 7FFFFFFFH THEN OK := FALSE; END; 440 IF S[0] = '-' THEN 441 RETURN -LONGINT(t) 442 ELSE 443 RETURN LONGINT(t); 444 END; 445 END StrToInt; 446 447 448 PROCEDURE StrToCard(S: ARRAY OF CHAR; Base: CARDINAL; VAR OK: BOOLEAN) : LONGCARD; 449 VAR t : LONGCARD; 450 BEGIN 451 OK := TRUE; 452 t := StrToCI( S,Base,OK); 453 IF S[0] = '-' THEN OK := FALSE; END; 454 RETURN t; 455 END StrToCard; 456 457 458 PROCEDURE StrToReal(S: ARRAY OF CHAR; VAR OK: BOOLEAN) : LONGREAL; 459 CONST 460 Zero = 0.0; 461 VAR 462 c,expsign : CHAR; 463 exp,after : INTEGER; 464 i : CARDINAL; 465 res,p10 : LONGREAL; 466 Neg : BOOLEAN; 467 BEGIN 468 OK := TRUE; 469 c := S[0]; 470 Neg := FALSE; 471 IF c = '+' THEN 472 i := 1; 473 ELSIF c = '-' THEN 474 i := 1; 475 Neg := TRUE; 476 ELSE 477 i := 0; 478 END; (*IF*) 479 res := Zero; 480 c := S[i]; 481 WHILE (c # '.') & (i <= HIGH(S)) DO 482 IF (c > '9') OR (c < '0') THEN 483 IF StrictRealConv & (c = 0C) THEN 484 OK := FALSE; 485 RETURN Zero; 486 ELSE 487 c := '.'; 488 DEC(i) ; 489 END; (*IF*) 490 ELSE 491 res := res * 10.0 + VAL(LONGREAL,ORD(c) - ORD('0')); 492 INC(i); 493 c := S[i]; 494 END; (*IF*) 495 END; (*WHILE*) 496 after := 0; 497 IF i >= HIGH(S) THEN 498 IF StrictRealConv THEN 499 OK := FALSE; 500 RETURN Zero; 501 ELSE 502 RETURN res; 503 END; (*IF*) 504 END; (*IF*) 505 INC(i); 506 c := S[i]; 507 WHILE (i <= HIGH(S)) & (c # 0C) & (c # 'E') DO 508 IF (c > '9') OR (c < '0') THEN 509 OK := FALSE; 510 RETURN Zero; 511 END; (*IF*) 512 res := res * 10.0 + VAL(LONGREAL,ORD(c) - ORD('0')); 513 INC(i); 514 INC(after); 515 c := S[i]; 516 END; (*WHILE*) 517 IF c = 'E' THEN 518 INC(i); 519 expsign := S[i]; 520 IF expsign = '+' THEN 521 INC(i) 522 ELSIF expsign = '-' THEN 523 INC(i) 524 END; (*IF*) 525 c := S[i]; 526 exp := 0; 527 WHILE (i <= HIGH(S)) & (c # 0C) DO 528 IF (c > '9') OR (c < '0') THEN 529 OK := FALSE; 530 RETURN Zero; 531 END; (*IF*) 532 exp := exp * 8 + exp * 2 + INTEGER(ORD(c) - ORD('0')); 533 INC(i); 534 c := S[i]; 535 END; (*WHILE*) 536 IF expsign = '-' THEN 537 exp := -exp; 538 END; (*IF*) 539 ELSE 540 exp := 0; 541 END; (*IF*) 542 exp := exp - after; 543 p10 := 1.0; 544 FOR i := 1 TO ABS(exp) DO 545 p10 := p10 * 10.0; 546 END; (*FOR*) 547 IF Neg THEN 548 res := - res; 549 END; (*IF*) 550 IF exp < 0 THEN 551 RETURN res / p10; 552 ELSE 553 RETURN res * p10; 554 END; (*IF*) 555 END StrToReal; 556 557 (*%F _WINDOWS *) 558 PROCEDURE RealToStr(V: LONGREAL; Precision: CARDINAL; Eng: BOOLEAN; 559 VAR S: ARRAY OF CHAR; VAR OK: BOOLEAN); 560 VAR 561 X : MATHLIB.PackedBcd; 562 i,j,l : CARDINAL; 563 r,t : LONGREAL; 564 Exp,m : INTEGER; 565 Str : ARRAY[0..7] OF CHAR; 566 tb, 567 FirstTime: BOOLEAN; 568 569 BEGIN 570 OK := TRUE; 571 l := HIGH( S ); 572 IF Precision = 0 THEN 573 Precision := 1; 574 ELSIF Precision > 17 THEN 575 Precision := 17; 576 END; 577 FirstTime := TRUE; 578 579 IF V # 0.0 THEN 580 t := MATHLIB.Log10( ABS( V ) ); 581 ELSE 582 t := 1.0; 583 END; 584 585 Exp := TRUNC( t ); 586 LOOP 587 m := 1; 588 IF Eng THEN 589 IF (ABS(V) < 1.0) THEN 590 DEC(m,ABS(Exp) MOD 3 ); 591 IF m < 1 THEN INC(m,3); END; 592 ELSE 593 INC(m,Exp MOD 3 ); 594 END; 595 END; 596 597 X := MATHLIB.LongToBcd( V*MATHLIB.IntPow(10.0,INTEGER(Precision)-Exp-1) ); 598 j := 0; 599 IF NOT FirstTime THEN 600 EXIT; 601 ELSIF (X[Precision DIV 2] >> Div[Precision MOD 2 ] ) MOD 16 # 0 THEN 602 INC( Exp ); 603 FirstTime := FALSE; 604 ELSIF (X[(Precision-1) DIV 2] >> Div[(Precision-1) MOD 2 ] ) MOD 16 = 0 THEN 605 DEC( Exp ); 606 FirstTime := FALSE; 607 ELSE 608 EXIT; 609 END; 610 611 END; 612 IF X[9]=80H THEN 613 S[0] := '-'; 614 ELSE 615 S[0] := ' '; 616 END; 617 INC(j); 618 619 FOR i := Precision-1 TO 0 BY -1 DO 620 IF j > l THEN OK := FALSE; RETURN; END; 621 622 S[j] := CHAR( SHORTCARD('0') + (X[i DIV 2] >> Div[i MOD 2 ] ) MOD 16 ); 623 INC( j ); 624 IF i = Precision-CARDINAL(m) THEN 625 IF j > l THEN OK := FALSE; RETURN; END; 626 S[j] := '.'; 627 INC(j); 628 END; 629 END; 630 631 IF j > l THEN OK := FALSE; RETURN; END; 632 S[j] := 'E'; 633 INC( j ); 634 IF j <= l THEN S[j] := CHR(0); END; 635 636 tb := FloatUse; 637 FloatUse := TRUE; 638 639 IntToStr( VAL( LONGINT,Exp-m+1 ),Str,10,OK ); 640 641 FloatUse := tb; 642 643 IF ( Length( Str ) + j )-1 > l THEN OK := FALSE; END; 644 Append( S,Str ); 645 END RealToStr; 646 (*%E *) 647 648 (*%T _WINDOWS *) 649 PROCEDURE RealToStr(V:LONGREAL;Precision:CARDINAL;Eng:BOOLEAN;VAR S:ARRAY OF CHAR;VAR OK:BOOLEAN); 650 VAR 651 j,w : CARDINAL; 652 m,i : INTEGER; 653 t : LONGREAL; 654 BEGIN 655 OK := TRUE; 656 S[0] := 0C; 657 m := 0; 658 IF Precision > 17 THEN 659 Precision := 17; 660 END; (*IF*) 661 IF V < 0.0 THEN 662 Copy(S,'-'); 663 V := -V; 664 END; (*IF*) 665 IF V # 0.0 THEN 666 m := TRUNC(MATHLIB.Log10(V)); 667 IF m > 0 THEN 668 V := V / MATHLIB.IntPow(10.0,m); 669 END; (*IF*) 670 IF V < 1.0 THEN 671 V := V * 10.0; 672 DEC(m); 673 END; 674 t := MATHLIB.IntPow(10.0,INTEGER(Precision)); 675 V := (V * t + 0.5) / t; 676 IF V >= 10.0 THEN 677 V := V / 10.0; 678 INC(m); 679 END; (*IF*) 680 IF Eng THEN 681 i := m; 682 IF m > 0 THEN 683 m := ((m + 2) DIV 3) * 3; 684 ELSE 685 m := ((m - 2) DIV 3) * 3; 686 END; (*IF*) 687 V := V / MATHLIB.IntPow(10.0,m - i); 688 END; (*IF*) 689 END; (*IF*) 690 w := TRUNC(V); 691 V := (V - LONGREAL(w)) * 10.0; 692 IF Eng & (Precision > 0) THEN 693 IF w DIV 100 > 0 THEN 694 Str.Append(S,CHR((w DIV 100) + 48)); 695 w := w MOD 100; 696 DEC(Precision); 697 END; (*IF*) 698 IF (w DIV 10 > 0) & (Precision > 0) THEN 699 Str.Append(S,CHR((w DIV 10) + 48)); 700 w := w MOD 10; 701 DEC(Precision); 702 END; (*IF*) 703 END; (*IF*) 704 IF Precision > 0 THEN 705 Str.Append(S,CHR(w + 48)); 706 DEC(Precision); 707 Str.Append(S,'.'); 708 IF Precision > 0 THEN 709 FOR j := 1 TO Precision DO 710 Append(S,CHR(TRUNC(V) + 48)); 711 V := (V - LONGREAL(TRUNC(V))) * 10.0; 712 END; (*FOR*) 713 END; (*IF*) 714 END; (*IF*) 715 IF m < 0 THEN 716 Str.Append(S,'E-'); 717 m := -m; 718 ELSE 719 Str.Append(S,'E+'); 720 END; (*IF*) 721 IF m DIV 100 > 0 THEN 722 Str.Append(S,CHR((m DIV 100) + 48)); 723 m := m MOD 100; 724 END; (*IF*) 725 IF m DIV 10 > 0 THEN 726 Str.Append(S,CHR((m DIV 10) + 48)); 727 END; (*IF*) 728 Str.Append(S,CHR((m MOD 10) + 48)); 729 END RealToStr; 730 (*%E *) 731 732 (*# save,call(o_a_copy=>off,o_a_size=>on)*) 733 PROCEDURE FindSubStr(Source,Pattern:ARRAY OF CHAR;VAR Pos:ARRAY OF PosLen):BOOLEAN; 734 VAR 735 s,p,n,l : CARDINAL; 736 BEGIN 737 Lib.Fill(ADR(Pos),SIZE(Pos),0FFH); 738 IF Length(Source) = 0 THEN 739 RETURN FALSE; 740 END; (*IF*) 741 l := Length(Pattern); 742 IF l = 0 THEN 743 Pos[0] := PosLen(0,0); 744 RETURN TRUE; 745 END; (*IF*) 746 IF (Pattern[0] = '*') OR (Pattern[0] = '?') THEN 747 IF l = 1 THEN 748 Pos[0].Pos := 0; 749 IF Pattern[0] = '*' THEN 750 Pos[0].Pos := 0; 751 Pos[0].Len := Length(Source); 752 ELSE 753 Pos[0] := PosLen(0,1); 754 END; (*IF*) 755 RETURN TRUE; 756 ELSE 757 s := 0; 758 END; (*IF*) 759 ELSE 760 s := CharPos(Source,Pattern[0]); 761 IF s = MAX(CARDINAL) THEN 762 RETURN FALSE; 763 END; (*IF*) 764 END; (*IF*) 765 n := 0; 766 p := 1; 767 WHILE p < l DO 768 INC(s); 769 IF (s > HIGH(Source)) OR (Source[s] = 0C) THEN 770 RETURN FALSE; 771 END; (*IF*) 772 CASE Pattern[p] OF 773 '?' : IF n <= HIGH(Pos) THEN 774 Pos[n].Pos := s; 775 Pos[n].Len := 1; 776 INC(n); 777 END; (*IF*) | 778 '*' : IF n <= HIGH(Pos) THEN 779 Pos[n].Pos := s; 780 IF (p >= HIGH(Pattern)) OR (Pattern[p+1] = 0C) THEN 781 RETURN TRUE; 782 ELSE 783 Pos[n].Len := NextPos(Source,Pattern[p+1],s); (* s/b NextCharPos *) 784 IF Pos[n].Len = MAX(CARDINAL) THEN 785 RETURN FALSE; 786 ELSE 787 DEC(Pos[n].Len,s); 788 INC(s,Pos[n].Len); 789 INC(n); 790 END; (*IF*) 791 END; (*IF*) 792 END; (*IF*) 793 INC(p); | 794 ELSE 795 IF CAP(Pattern[p]) # CAP(Source[s]) THEN 796 RETURN FALSE; 797 END; (*IF*) 798 END; (*CASE*) 799 INC(p); 800 END; (*WHILE*) 801 RETURN TRUE; 802 END FindSubStr; 803 (*# restore *) 804 (* The following are Implemented in asmlib 805 806 PROCEDURE CapS(VAR S: ARRAY OF CHAR); 807 VAR I : CARDINAL; 808 BEGIN 809 FOR I := 0 TO HIGH(S) DO S[I] := CAP(S[I]); END; 810 END CapS; 811 812 813 PROCEDURE Compare(S1,S2: ARRAY OF CHAR) : INTEGER; 814 VAR 815 L1,L2,L,Index : CARDINAL; 816 BEGIN 817 L1 := Length(S1); 818 L2 := Length(S2); 819 IF L1 CHR(0)) DO 852 Ns[I] := S[J]; 853 INC(I); 854 INC(J); 855 END; 856 IF I<=HIGH(Ns) THEN Ns[I] := CHR(0) END; 857 END Append; 858 859 860 PROCEDURE Copy(VAR Ns: ARRAY OF CHAR; S: ARRAY OF CHAR); 861 VAR 862 H,L : CARDINAL; 863 BEGIN 864 H := HIGH(Ns)+1; 865 L := Length(S); 866 IF L > H THEN L := H END; 867 Lib.Move(ADR(S),ADR(Ns),L); 868 IF L < H THEN Ns[L] := CHR(0) END; 869 END Copy; 870 871 872 PROCEDURE Concat(VAR Ns: ARRAY OF CHAR; S1,S2: ARRAY OF CHAR); 873 VAR 874 I,J : CARDINAL; 875 BEGIN 876 J := 0; 877 WHILE (J <= HIGH(Ns)) AND (J <= HIGH(S1)) AND (S1[J] <> CHAR(0)) DO 878 Ns[J] := S1[J]; 879 INC(J); 880 END; 881 882 I := 0; 883 LOOP 884 IF (J > HIGH(Ns)) THEN EXIT; END; 885 IF (I > HIGH(S2)) THEN Ns[J] := CHR(0); EXIT; END; 886 Ns[J] := S2[I]; 887 IF S2[I] = CHR(0) THEN EXIT; END; 888 INC(I); 889 INC(J); 890 END; 891 END Concat; 892 893 894 PROCEDURE Pos(S,P: ARRAY OF CHAR) : CARDINAL; 895 VAR 896 I,J,K,HP,HS : CARDINAL; 897 BEGIN 898 HP := HIGH(P); 899 HS := HIGH(S); 900 I := 0; 901 LOOP 902 IF (I > HS) OR (S[I] = CHR(0)) THEN RETURN MAX(CARDINAL) END; 903 J := 0; 904 K := I; 905 LOOP 906 IF (J > HP) OR (P[J] = CHR(0)) THEN RETURN I END; 907 IF K > HS THEN RETURN MAX( CARDINAL ); END; 908 IF S[K] # P[J] THEN EXIT END; 909 INC(J); 910 INC(K); 911 END; 912 INC(I); 913 END; 914 END Pos; 915 916 *) 917 918 PROCEDURE StrToC(S: ARRAY OF CHAR; VAR D: ARRAY OF CHAR): BOOLEAN; 919 920 VAR 921 n: CARDINAL; 922 c: CHAR; 923 BEGIN 924 n := 0; 925 LOOP 926 IF n > HIGH(D) THEN 927 RETURN FALSE; 928 END; 929 IF n > HIGH(S) THEN 930 c := 0C; 931 ELSE 932 c := S[n]; 933 END; 934 D[n] := c; 935 IF c = 0C THEN 936 RETURN TRUE 937 END; 938 INC(n); 939 END; 940 END StrToC; 941 942 PROCEDURE StrToPas(S: ARRAY OF CHAR; VAR D: ARRAY OF CHAR): BOOLEAN; 943 944 VAR 945 n: CARDINAL; 946 c: CHAR; 947 BEGIN 948 n := 1; 949 LOOP 950 IF n > HIGH(D) THEN 951 D[0] := 0C; 952 RETURN FALSE; 953 END; 954 IF n > SIZE(S) THEN 955 c := 0C; 956 ELSE 957 c := S[n-1]; 958 END; 959 IF c = 0C THEN 960 D[0] := CHAR(n-1); 961 RETURN TRUE 962 END; 963 D[n] := c; 964 INC(n); 965 END; 966 END StrToPas; 967 968 BEGIN 969 FloatUse := FALSE; 970 END Str. 169 errors