home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / UPCONV13.ZIP / TOK_STR.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-04-14  |  3.0 KB  |  133 lines
  1. Program Sort_Tok;
  2. { Sorts the typed array of Pascal tokens,
  3.   builds them into 80-char strings (suitable for incorporation
  4.   as typed constant arrays into a Pascal program),
  5.   outputs to TOKENS.STR.
  6. }
  7.  
  8. Uses Crt;
  9.  
  10.  
  11. {$I TOKENS.INC}
  12.  
  13. FUNCTION Up_Strg (S : String) : String;
  14.   BEGIN
  15. Inline(
  16.   $31/$C0/       {  xor   ax,ax}
  17.   $8A/$86/>S/    {  mov   al,>S[bp]  ;snarf the length}
  18.   $09/$C0/       {  or    ax,ax      ;0 length?}
  19.   $74/$18/       {  jz    Exit       ;yep, exit}
  20.  
  21.   $89/$C1/       {  mov   cx,ax      ;loop counter}
  22.   $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  23.   $31/$F6/       {  xor   si,si}
  24.                  {L1:}
  25.   $46/           {  inc   si       ;next char}
  26.   $36/           {  SS:}
  27.   $8A/$82/>S/    {  mov   al,>S[bp][si]  ;snarf the char}
  28.   $38/$D0/       {  cmp   al,dl}
  29.   $72/$05/       {  jb    S1       ;already uppercase}
  30.   $36/           {  SS:}
  31.   $28/$B2/>S/    {  sub  >S[bp][si],dh   ;uppercase it}
  32.                  {S1:}
  33.   $E2/$EF);      {  loop  L1}
  34.                  {Exit:}
  35.  
  36.     Up_Strg := S;    {return the function}
  37.   END;  {of Up_Strg}
  38.  
  39.  
  40. PROCEDURE Quick_Sort;
  41.  
  42.   PROCEDURE Alpha_Sort(l,r : INTEGER);
  43.     VAR
  44.       i,j : INTEGER;
  45.       X,W : STRING[20];
  46.     BEGIN
  47.       i := l;
  48.       j := r;
  49.  
  50.       X := Up_Strg(CToken[ (l+r) ShR 1 ]);
  51.  
  52.       REPEAT
  53.         WHILE Up_Strg(CToken[i]) < X DO Inc(i);
  54.         WHILE X < Up_Strg(CToken[j]) DO Dec(j);
  55.  
  56.         IF i <= j THEN BEGIN
  57.           W := CToken[i];
  58.           CToken[i] := CToken[j];
  59.           CToken[j] := W;
  60.           Inc(i);
  61.           Dec(j);
  62.         END
  63.       UNTIL i > j;
  64.  
  65.       IF l < j THEN Alpha_Sort(l,j);
  66.       IF i < r THEN Alpha_Sort(i,r)
  67.     END;  {of Alpha_Sort}
  68.  
  69.  
  70.   PROCEDURE Len_Sort(l,r : INTEGER);
  71.     VAR
  72.       i,j : INTEGER;
  73.       X,W : STRING[20];
  74.     BEGIN
  75.       i := l;
  76.       j := r;
  77.  
  78.       X := CToken[ (l+r) ShR 1 ];  {v1.3}
  79.  
  80.       REPEAT
  81.         WHILE LENGTH(CToken[i]) > LENGTH(X) DO Inc(i);
  82.         WHILE LENGTH(X) > LENGTH(CToken[j]) DO Dec(j);
  83.  
  84.         IF i <= j THEN BEGIN
  85.           W := CToken[i];
  86.           CToken[i] := CToken[j];
  87.           CToken[j] := W;
  88.           Inc(i);
  89.           Dec(j);
  90.         END
  91.       UNTIL i > j;
  92.  
  93.       IF l < j THEN Len_Sort(l,j);
  94.       IF i < r THEN Len_Sort(i,r)
  95.     END;  {of Len_Sort}
  96.  
  97.   BEGIN  {Quick_Sort}
  98.     Len_Sort(0,NRTOKENS);
  99.     Alpha_Sort(0,NRTOKENS);
  100.   END;  {of Quick_Sort}
  101.  
  102. CONST
  103.   QUOTE = '''';
  104.  
  105. VAR
  106.   Text_File : TEXT;
  107.   indx      : word;
  108.   Tok       : String;
  109.  
  110. BEGIN  {main}
  111.  
  112.   Quick_sort;
  113.  
  114.   Assign(Text_File,'TOKEN.STR');
  115.   Rewrite(Text_File);
  116.  
  117.   FOR indx := 0 TO NRTOKENS DO BEGIN
  118.     IF LENGTH(Tok) + LENGTH(CToken[indx]) < 78
  119.     THEN Tok := Tok + ' ' + CToken[indx]
  120.     ELSE BEGIN
  121.       Writeln(QUOTE + Tok + ' ' + QUOTE);
  122.       Writeln(Text_File,QUOTE + Tok + ' ' + QUOTE + ',');
  123.       Tok := '';
  124.     END;
  125.   END;
  126.   IF Tok <> '' THEN BEGIN
  127.     Writeln(QUOTE + Tok + ' ' + QUOTE);
  128.     Writeln(Text_File,QUOTE + Tok + ' ' + QUOTE);
  129.   END;
  130.   Close(Text_File);
  131.  
  132. END.
  133.