home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / ASSEMBLY / CONV_A11.ZIP / TOKSTR_A.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-06  |  2.9 KB  |  124 lines
  1. Program TokStr_A;
  2.  
  3. { Sorts the typed array of assembly language/MASM tokens,
  4.   builds them into 255-char strings (suitable for incorporation
  5.   as typed constant arrays into a Pascal program),
  6.   outputs to CONV_A.DAT.
  7.  
  8.   v1.1
  9.     Fixed a bug where first word in output lines was NOT properly
  10.     preceded by a space.
  11.     Added Uc string uppercase function as EXTERNAL.
  12. }
  13.  
  14. CONST
  15.   TokFilename : STRING[10] = 'CONV_A.DAT';
  16.  
  17.  
  18. {$I TOKENS_A.INC}
  19.  
  20. {$F+}
  21.  
  22. {v1.1 Link in the Uc string uppercase function}
  23. {$L UC}
  24.  
  25. FUNCTION Uc(S : STRING) : STRING; EXTERNAL;
  26.  
  27. {$F-}
  28.  
  29.  
  30.  
  31. PROCEDURE Quick_Sort;
  32.  
  33.   PROCEDURE Alpha_Sort(l,r : INTEGER);
  34.     VAR
  35.       i,j : INTEGER;
  36.       X,W : STRING[20];
  37.     BEGIN
  38.       i := l;
  39.       j := r;
  40.  
  41.       X := Uc(CToken[ (l+r) ShR 1 ]);   {v1.1}
  42.  
  43.       REPEAT
  44.         WHILE Uc(CToken[i]) < X DO Inc(i);  {v1.1}
  45.         WHILE X < Uc(CToken[j]) DO Dec(j);  {v1.1}
  46.  
  47.         IF i <= j THEN BEGIN
  48.           W := CToken[i];
  49.           CToken[i] := CToken[j];
  50.           CToken[j] := W;
  51.           Inc(i);
  52.           Dec(j);
  53.         END
  54.       UNTIL i > j;
  55.  
  56.       IF l < j THEN Alpha_Sort(l,j);
  57.       IF i < r THEN Alpha_Sort(i,r)
  58.     END;  {of Alpha_Sort}
  59.  
  60.  
  61.   PROCEDURE Len_Sort(l,r : INTEGER);
  62.     VAR
  63.       i,j : INTEGER;
  64.       X,W : STRING[20];
  65.     BEGIN
  66.       i := l;
  67.       j := r;
  68.  
  69.       X := CToken[ (l+r) ShR 1 ];  {v1.3}
  70.  
  71.       REPEAT
  72.         WHILE LENGTH(CToken[i]) > LENGTH(X) DO Inc(i);
  73.         WHILE LENGTH(X) > LENGTH(CToken[j]) DO Dec(j);
  74.  
  75.         IF i <= j THEN BEGIN
  76.           W := CToken[i];
  77.           CToken[i] := CToken[j];
  78.           CToken[j] := W;
  79.           Inc(i);
  80.           Dec(j);
  81.         END
  82.       UNTIL i > j;
  83.  
  84.       IF l < j THEN Len_Sort(l,j);
  85.       IF i < r THEN Len_Sort(i,r)
  86.     END;  {of Len_Sort}
  87.  
  88.   BEGIN  {Quick_Sort}
  89.     Len_Sort(0,NRTOKENS);
  90.     Alpha_Sort(0,NRTOKENS);
  91.   END;  {of Quick_Sort}
  92.  
  93.  
  94. VAR
  95.   Text_File : TEXT;
  96.   indx : Word;
  97.   Tok       : String;
  98.  
  99. BEGIN  {main}
  100.  
  101.   Quick_sort;
  102.  
  103.   Assign(Text_File,'CONV_A.DAT');
  104.   Rewrite(Text_File);
  105.  
  106.   Tok := ' ';                   {Initialize Token string}
  107.                                 { with leading space v1.1}
  108.  
  109.   FOR indx := 0 TO NRTOKENS DO BEGIN
  110.     IF LENGTH(Tok) + LENGTH(CToken[indx]) < 253 {string isn't too long}
  111.     THEN Tok := Tok + CToken[indx] + ' '        {so continue to concatenate}
  112.     ELSE BEGIN                                  {string is max length,
  113.                                                  can't add token yet}
  114.       Writeln(Text_File,Tok);            {v1.1 write out the long string}
  115.       Tok := ' ' + CToken[indx] + ' ';   {leading space,   v1.1
  116.                                           pick up the token
  117.                                           that wouldn't fit last time}
  118.     END;
  119.   END;
  120.   IF Tok <> ''                          {if any remaining line}
  121.   THEN Writeln(Text_File,Tok);          {write it out}
  122.   Close(Text_File);
  123. END.
  124.