Category : Modula II Source Code
Archive   : STRINGS.ZIP
Filename : STRNEW.MOD

 
Output of file : STRNEW.MOD contained in archive : STRINGS.ZIP
(*$M CODE*)(*$D DATA*)
IMPLEMENTATION MODULE StrNew;

IMPORT Lib;
FROM StrAsm IMPORT Reverse;
FROM Str IMPORT Length, Copy;
(* Modified and additional procedures for JPI TopSpeed Modula-2's
Str module by

Carl Neiburger
169 N. 25th St.
San Jose, Calif. 95116

CompuServe No. 72336,2257

To use these procedures as an integral part of Str.MOD:

1) Add this statement to Str.MOD:

FROM StrAsm IMPORT Reverse;

2) Replace the existing procedures Delete, Insert and IntToStr
in Str.MOD with the same procedures as written below.

3) Copy CardToString, below, into Str.MOD.

4) Delete the procedure Reverse in Str.MOD.

5) In Str's procedure CardToStr change the line
Reverse(S, 0, i - 1)
to read
Reverse(S,S)

6) Copy the header of CardToString into Str.DEF.

7) Make sure that StrAsm.DEF and StrAsm.OBJ are in the appropriate
directories in your system.

*)

PROCEDURE Delete(VAR S: ARRAY OF CHAR; P,L: CARDINAL);
VAR
Le, I : CARDINAL;
BEGIN
Le := Length(S);
IF (P > Le - 1) OR (L = 0) THEN RETURN END;
IF P + L > Le THEN L := Le - P END;
I := P + L;
Lib.Move (ADR(S[I]), ADR(S[P]), Le-I);
DEC(Le, L);
S[Le] := 0C
END Delete;

PROCEDURE Insert(VAR S1: ARRAY OF CHAR; S2: ARRAY OF CHAR; P: CARDINAL);
VAR
MaxSpace,InsLen,MovLen,Len: CARDINAL;
BEGIN
Len := Length(S1);
IF (P > HIGH(S1)) AND (Len = HIGH(S1)) THEN RETURN END;
IF P >= Len THEN P := Len END;
MaxSpace := HIGH(S1) - P + 1;
InsLen := Length(S2);
IF InsLen > MaxSpace THEN InsLen := MaxSpace END;
IF Len >= HIGH(S1) THEN MovLen := MaxSpace - InsLen
ELSE MovLen := Len - P + 1 END;
IF MovLen > 0 THEN Lib.Move(ADR(S1[P]), ADR(S1[P+InsLen]),MovLen) END;
Lib.Move(ADR(S2), ADR(S1[P]), InsLen)
END Insert;


(*$V+*)

(*$R+,S+,I+*)
CONST
ConvStr = '0123456789ABCDEF';

PROCEDURE CardToString(N: LONGCARD; VAR S: ARRAY OF CHAR;
FILL: CARDINAL; C: CHAR);
VAR i: CARDINAL; ERR : BOOLEAN;
BEGIN
IF FILL > SIZE(S) THEN
FILL := SIZE(S)
END;
IF FILL > 1 THEN
Lib.Fill(ADR(S), FILL, C);
END;
i := 0;
REPEAT
S[i] := ConvStr[CARDINAL(N MOD 10)];
N := N DIV 10;
INC(i);
ERR := (i > HIGH(S)) AND (N > 0)
UNTIL (N < 1) OR ERR;
IF ERR THEN
Copy(S, '?');
RETURN
END;
IF i < FILL THEN
i := FILL
END;
IF i <= HIGH (S) THEN
S[i] := 0C
END;
Reverse(S,S) (* Reverse(S, 0, i - 1) *)
END CardToString;

PROCEDURE IntToStr(V: LONGINT;VAR S: ARRAY OF CHAR; Base: CARDINAL; VAR OK: BOOLEAN);
VAR
i,l : CARDINAL;
b : LONGCARD;
sign: CHAR;
BEGIN
OK := TRUE;
l := HIGH(S);
CheckBase( Base );
b := VAL( LONGCARD,Base );
i := 0;
IF V < 0 THEN
sign := '-';
V := -V;
ELSIF FloatUse THEN
sign := '+';
ELSE
sign := 0C
END;

LOOP
IF i > l THEN OK := FALSE; EXIT; END;
S[i] := ConvStr[CARDINAL( LONGCARD(V) MOD b )];
INC(i);
V := LONGCARD(V) DIV b;
IF V = 0 THEN EXIT END;
END;
IF i <= l THEN S[i] := CHR(0); END;
Reverse(S,S);
IF sign <> 0C THEN
IF i >= l THEN
OK := FALSE;
ELSE
Insert( S, sign, 0 )
END;
END;
END IntToStr;

END StrNew.


  3 Responses to “Category : Modula II Source Code
Archive   : STRINGS.ZIP
Filename : STRNEW.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/