home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PIBTERM / PIBT41S1.ARC / GENPARM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-03-04  |  3.8 KB  |  132 lines
  1. (*$R-,V-,S-*)
  2. PROGRAM GenParm;
  3.  
  4. TYPE
  5.    AnyStr = STRING[255];
  6.  
  7. VAR
  8.    Max_Param_Names : INTEGER;
  9.    Param_Text      : ARRAY[ 1 .. 220 ] OF AnyStr;
  10.    Max_Descriptor  : INTEGER;
  11.    Max_Desc_Short  : INTEGER;
  12.  
  13. VAR
  14.    I, J, K         : INTEGER;
  15.    L               : INTEGER;
  16.    PLine           : AnyStr;
  17.    F               : TEXT;
  18.    G               : TEXT;
  19.    PNameI          : STRING[2];
  20.    PNameJ          : STRING[2];
  21.  
  22. BEGIN (* GenParm *)
  23.  
  24.    ASSIGN ( F, 'PARMDAT.DEF' );
  25.    RESET  ( F );
  26.  
  27.    ASSIGN ( G, 'BBB.PAS' );
  28.    REWRITE( G );
  29.  
  30.    Max_Param_Names := 0;
  31.  
  32.    REPEAT
  33.       INC( Max_Param_Names );
  34.       READLN( F , Param_Text[Max_Param_Names] );
  35.    UNTIL ( EOF( F ) );
  36.  
  37.    CLOSE( F );
  38.  
  39.    FOR I := 1 TO PRED( Max_Param_Names ) DO
  40.       BEGIN
  41.          PNameI := Param_Text[I][1] + Param_Text[I][2];
  42.          FOR J := SUCC( I ) TO Max_Param_Names DO
  43.             BEGIN
  44.                PNameJ := Param_Text[J][1] + Param_Text[J][2];
  45.                IF ( PNameJ < PNameI ) THEN
  46.                   BEGIN
  47.                      PLine         := Param_Text[I];
  48.                      Param_Text[I] := Param_Text[J];
  49.                      Param_Text[J] := PLine;
  50.                      PNameI        := Param_Text[I][1] + Param_Text[I][2];
  51.                   END;
  52.             END;
  53.       END;
  54.  
  55.    WRITELN( G , 'CONST' );
  56.    WRITELN( G , '   Max_Param_Names = ', Max_Param_Names, ';');
  57.    WRITELN( G , ' ' );
  58.    WRITELN( G , '(* STRUCTURED *) CONST');
  59.    WRITELN( G , '   Parameters : ARRAY[ 1 .. Max_Param_Names ] OF Parameter_Record_Type =');
  60.    WRITELN( G , '                (');
  61.  
  62.    FOR I := 1 TO Max_Param_Names DO
  63.       BEGIN
  64.          PLine := Param_Text[I];
  65.          WRITE  ( G , '    (*', I:3, '*)      ( ');
  66.          WRITE  ( G , 'PName : ''',PLine[1],PLine[2],'''; ');
  67.          WRITE  ( G , 'PType : ',COPY( PLine, 4, 14 ),'; ');
  68.          WRITE  ( G , 'PAddr : NIL; PDesc : NIL )');
  69.          IF ( I <> Max_Param_Names ) THEN
  70.             WRITE( G , ',' );
  71.          WRITELN( G );
  72.       END;
  73.  
  74.    WRITE  ( G , ' );');
  75.    WRITELN( G );
  76.    WRITELN( G );
  77.  
  78.    Max_Descriptor := 0;
  79.    Max_Desc_Short := 0;
  80.  
  81.    WRITELN( G , ' ' );
  82.    WRITELN( G , '(* STRUCTURED *) CONST');
  83.  
  84.    FOR I := 1 TO Max_Param_Names DO
  85.       BEGIN
  86.          PLine  := Param_Text[I];
  87.          PNameI := Pline[1] + Pline[2];
  88.          PLine  := COPY( PLine, 45, 255 );
  89.          L      := LENGTH( PLine );
  90.          IF ( L = 0 ) THEN
  91.             BEGIN
  92.                L     := 1;
  93.                PLine := ' ';
  94.             END;
  95.          IF ( L > Max_Descriptor ) THEN
  96.             Max_Descriptor := L;
  97.          Max_Desc_Short := Max_Desc_Short + L;
  98.          WRITELN( G , '   Desc_', PNameI, ': STRING[',L, '] = ''', PLine, ''';' );
  99.       END;
  100.  
  101.    WRITELN( G );
  102.    WRITELN( G );
  103.  
  104.    WRITELN( G , 'PROCEDURE Set_Parameter_Addresses;' );
  105.    WRITELN( G , ' ' );
  106.    WRITELN( G , 'BEGIN (* Set_Parameter_Addresses *)');
  107.    WRITELN( G , ' ' );
  108.  
  109.    FOR I := 1 TO Max_Param_Names DO
  110.       BEGIN
  111.          PLine  := Param_Text[I];
  112.          PNameI := PLine[1] + PLine[2];
  113.          PLine  := COPY( PLine, 19, 26 );
  114.          WHILE( POS( ' ' , PLine ) > 0 ) DO
  115.             DELETE( PLine, POS( ' ' , PLine ), 1 );
  116.          IF ( LENGTH( PLine ) > 0 ) THEN
  117.             WRITELN( G , '   Parameters[',I:3,'].PAddr := @', PLine, ';' );
  118.          WRITELN( G , '   Parameters[',I:3,'].PDesc := @Desc_', PNameI, ';' );
  119.          WRITELN( G , ' ');
  120.       END;
  121.  
  122.    WRITELN( G , 'END   (* Set_Parameter_Addresses *);');
  123.  
  124.    CLOSE( G );
  125.  
  126.    WRITELN;
  127.    WRITELN('Number of parameters   : ',Max_Param_Names);
  128.    WRITELN('Maximum descriptor     : ',Max_Descriptor );
  129.    WRITELN('Total descriptor length: ',Max_Descriptor * Max_Param_Names);
  130.    WRITELN('Total short desc. len. : ',Max_Desc_Short );
  131.  
  132. END   (* GenParm *).