home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / naxos / source / syscomp.pas < prev   
Pascal/Delphi Source File  |  1992-02-08  |  4KB  |  137 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V+,X-}
  2. {$M 16384,0,655360}
  3.  
  4. (*--------------------------------------------------------*)
  5. (*                       SYSCOMP.PAS                      *)
  6. (*      NAXOS Systemdictionary Compiler Version 2.0       *)
  7. (*           (C) 1992 DMV-Verlag & A. Zissis              *)
  8. (*             Compiler: Turbo Pascal 6.0                 *)
  9. (*--------------------------------------------------------*)
  10.  
  11. PROGRAM SysComp;
  12.  
  13. CONST
  14.   MaxName      = 12;    { Namensgröße     }
  15.  
  16. TYPE
  17.   PDEps        = POINTER;
  18.   pSymtab      = ^Symtab;
  19.   Symtab       = RECORD
  20.                    Name : STRING[12];
  21.                    Typ  : BYTE;
  22.                    QFA  : WORD;
  23.                    Par0,
  24.                    Par1,
  25.                    Par2,
  26.                    Par3 : WORD;
  27.                    RLink,
  28.                    LLink: pSymtab;
  29.                  END;
  30.  
  31.   WortTyp      = STRING[16];
  32. VAR
  33.   Ptr,
  34.   Root         : pSymtab;
  35.   D            : pSymtab;  { Wörterbuch         }
  36.   InFile       : TEXT;
  37.   OutFile      : FILE;
  38.   Wort         : STRING[12];
  39.   Code         : BYTE;
  40.   by           : WORD;
  41.   okr,okl      : BOOLEAN;
  42.  
  43. PROCEDURE Error(n: BYTE);
  44. BEGIN
  45.   CASE n OF
  46.     1 : WriteLn('Zuviele Definitionen');
  47.     2 : WriteLn('Dateiname fehlt');
  48.     3 : WriteLn('Fehler beim Öffnen des Quellfiles');
  49.     4 : WriteLn('Fehler beim Öffnen des Zielfiles');
  50.     5 : WriteLn('Fehler im Quelltext (leere Zeile)');
  51.   END;
  52.   Halt(0);
  53. END;
  54.  
  55. PROCEDURE TueName(Name: STRING; Typ: BYTE);
  56. VAR
  57.   p1, p2: pSymtab;
  58. { Name holen und überprüfen, Header bauen }
  59. BEGIN
  60.   Write('▒');
  61.   IF Name[0] > Chr(MaxName) THEN Name[0] := Chr(MaxName);
  62.   New(D);
  63.   D^.Name  := Name;
  64.   D^.LLink := NIL;
  65.   D^.RLink := NIL;
  66.   D^.QFA   :=  0;  { QFAs  }
  67.   D^.Typ   := Typ; { TYP   }
  68.   D^.Par0  := 0;   { PAR 0 }
  69.   D^.Par1  := 0;   { PAR 1 }
  70.   D^.Par2  := 0;   { PAR 2 }
  71.   D^.Par3  := 0;   { PAR 3 }
  72.   p1       := Root;
  73.   REPEAT
  74.     p2 := p1;
  75.     IF D^.Name > p1^.Name THEN p1 := p1^.RLink
  76.                           ELSE p1 := p1^.LLink;
  77.   UNTIL p1 = NIL;
  78.   IF D^.Name > p2^.Name THEN p2^.RLink := D
  79.                         ELSE p2^.LLink := D;
  80. END;
  81.  
  82. PROCEDURE Sv(Ptr: pSymtab);
  83. BEGIN
  84.     BlockWrite(OutFile,Ptr^, 1);
  85.     IF Ptr^.LLink <> NIL THEN Sv(Ptr^.LLink);
  86.     IF Ptr^.RLink <> NIL THEN Sv(Ptr^.RLink);
  87. END;
  88.  
  89. BEGIN
  90.   WriteLn('NAXOS Systemdictionary Compiler V2.00');
  91.   WriteLn('(C) 1992 DMV-Verlag & A. Zissis');
  92.   WriteLn; WriteLn;
  93.   IF ParamCount = 0 THEN Error(2);
  94.   New(Root);
  95.   Root^.RLink := NIL;
  96.   Root^.LLink := NIL;
  97.   Root^.Name  := 'EEEEEEEEEEEE';
  98.   Root^.Typ   := 254;
  99.  
  100.   IF Pos('.', ParamStr(1))= 0 THEN
  101.     Assign(InFile, ParamStr(1) + '.SRC')
  102.   ELSE
  103.     Assign(InFile, ParamStr(1));
  104.   {$I-}  Reset(InFile); {$I+}
  105.   IF IOResult <> 0 THEN Error(3);
  106.   REPEAT
  107.     {$I-}
  108.     Read(InFile,Wort);
  109.     WHILE (Wort[1] = '/') AND (Wort[2] = '/') DO BEGIN
  110.       ReadLn(InFile);
  111.       Read(Wort);
  112.     END;
  113.  
  114.     Read(InFile, Code);
  115.     ReadLn(InFile);
  116.     {$I+}
  117.     IF IOResult <> 0 THEN Error(5);
  118.     WHILE Wort[1] = ' ' DO Delete(Wort,1,1);
  119.     IF Pos(' ', Wort) <> 0 THEN
  120.       Wort[0] := Chr(Pos(' ', Wort) - 1);
  121.     TueName(Wort, Code);
  122.   UNTIL EoF(InFile);
  123.   Close(InFile);
  124.   WriteLn; WriteLn;
  125.   Assign(OutFile, 'SYSTEM.DIC');
  126.   {$I-} ReWrite(OutFile, SizeOf(Root^) - 8); {$I+}
  127.   IF IOResult <> 0 THEN Error(4);
  128.   Sv(Root);
  129.   by := FileSize(OutFile);
  130.   Close(OutFile);
  131.   WriteLn('SYSTEM.DIC erzeugt ', by,
  132.           ' Einträge ', by * (SizeOf(Root^) - 8),' Bytes');
  133. END.
  134.  
  135. (*--------------------------------------------------------*)
  136. (*                  Ende von SYSCOMP.PAS                  *)
  137.