home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol162 / ccp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  5.8 KB  |  233 lines
  1.  
  2. program pascals(input,output);
  3. {author:
  4.     n. wirth, e. t. h. ch-8092 zurich, 1.3.76}
  5. {modified:
  6.      m.ben-ari, tel aviv univ., 1980}
  7. {modified for Pascal/MT+ V.5.5 : 
  8.     m. haberler, university of economics / vienna, 1983}
  9.  
  10. label
  11.    99;
  12.  
  13. const
  14.    nkw    = 26;        {no. of key words}
  15.    alng = 10;        {no. of significant chars in indentifiers}
  16.    llng = 121;        {inputline lenght}
  17.    kmax = 15;        {max no. of significant digitis}
  18.    tmax = 70;        {size    of table}
  19.    bmax = 20;        {size    of block-table}
  20.    amax = 10;        {size    of array table}
  21.    cmax = 500;        {size    of code}
  22.    lmax = 7;        {maximum level}
  23.    smax = 150;        {size    of string table}
  24.    omax = 63;        {highest order code}
  25.    xmax = 32767;    {2**15 - 1}
  26.    nmax = maxint;
  27.    lineleng = 132;    {output line lenght}
  28.    linelimit =    400;    {max lines to    print}
  29.    stmax = 2800;    {stacksize}
  30.    stkincr = 200;    {stacksize for    each process}
  31.    pmax = 7;        {max concurrent processes}
  32.  
  33. { interpreter    declarations }
  34.  
  35.    stepmax = 8;        {max steps befors process switch}
  36.    tru    = 1;        {integer value of true}
  37.    fals = 0;        {integer value of false}
  38.    charl = 0;        {lowest character ordinal}
  39.    charh = 255;        {highest character ordinal}
  40.  
  41. type
  42.    pstrg  = ^string;
  43.    fntyp  = string[16];
  44.    symbol =
  45.       (intcon,    charcon, string, notsy,    plus, minus, times, idiv, imod,
  46.     andsy, orsy, eql, neq, geq, gtr, lss, leq, lparent, rparent,
  47.     lbrack,    rbrack,    comma, semicolon, period, colon, becomes, constsy
  48.     , typesy, varsy, functionsy, proceduresy, arraysy, programsy,
  49.     ident, beginsy,    ifsy, repeatsy,    whilesy, forsy,    endsy, elsesy,
  50.     untilsy, ofsy, dosy, tosy, thensy);
  51.    index = - xmax .. +    xmax;
  52.    alfa = packed array
  53.       [1.. alng] of char;
  54.    object =
  55.       (konstant, variable, type1, prozedure, funktion);
  56.    types =
  57.       (notyp, ints, bools, chars, arrays);
  58.    er =
  59.       (erid, ertyp, erkey, erpun, erpar, ernf,    erdup, erch, ersh, erln);
  60.    symset = set of symbol;
  61.    typset = set of types;
  62.    item = record
  63.           typ: types;
  64.           ref: index;
  65.        end;
  66.    order = packed record
  67.               f: - omax    .. + omax;
  68.               x: - lmax    .. + lmax;
  69.               y: - nmax    .. + nmax;
  70.            end;
  71.    ptype = 0..pmax;        {index over processes}
  72.  
  73. var
  74.    ptr: pstrg;
  75.    sfn: fntyp;    { variables to  retrieve command line args (source file name)}
  76.    sy:    symbol;        {last    symbol read by insymbol}
  77.    id:    alfa;        {identifier freom insymbol}
  78.    inum: integer;    {integer from insymbol}
  79.    rnum: real;        {real    number from insymbol}
  80.    sleng: integer;    {string length}
  81.    ch:    char;        {last    character read from source program}
  82.    line: array
  83.       [1.. llng] of char;
  84.    cc:    integer;    {character counter}
  85.    lc:    integer;    {program location counter}
  86.    ll:    integer;    {length of current line}
  87.    errs: set of er;
  88.    errpos: integer;
  89.    progname: alfa;
  90.    skipflag: boolean;
  91.    constbegsys, typebegsys, blockbegsys, facbegsys, statbegsys: symset;
  92.    key: array
  93.       [1.. nkw] of alfa;
  94.    ksy: array
  95.       [1.. nkw] of symbol;
  96.    sps: array
  97.       [char]    of symbol;        {special aymbols}
  98.    t, a, b, sx, c1, c2: integer;    {indices to tables}
  99.    stantyps: typset;
  100.    display: array
  101.       [0.. lmax] of integer;        
  102.    tab: array
  103.       [0.. tmax] of             {identifier table}
  104.    packed record
  105.           name: alfa;
  106.           link: index;
  107.           obj: object;
  108.           typ: types;
  109.           ref: index;
  110.           normal: boolean;
  111.           lev: 0.. lmax;
  112.           adr: integer;
  113.        end;
  114.    atab: array
  115.       [1.. amax] of             {array table}
  116.    packed record
  117.           inxtyp, eltyp: types;
  118.           elref, low, high,    elsize,    size: index;
  119.        end;
  120.    btab: array
  121.       [1..bmax] of             {block-table}
  122.    packed record
  123.           last, lastpar, psize, vsize: index
  124.        end;
  125.    stab: packed array
  126.       [0.. smax] of char;        {string table}
  127.    code: array
  128.       [0.. cmax] of order;
  129.    command : char;
  130.  
  131.  
  132. external function @cmd:pstrg;  { returns CP/M command line tail }
  133.  
  134. { contents of initialization overlay }
  135.  
  136. external [1] procedure init_reserved_words;
  137. external [1] procedure init_predefined_identifiers;
  138.  
  139.  
  140. { contents of compiler overlay }
  141.  
  142. external [2] procedure nextch;
  143. external [2] procedure errormsg;
  144. external [2] procedure emit(fct : integer);
  145. external [2] procedure error(n: er);
  146. external [2] procedure fatal(n:integer);
  147. external [2] procedure insymbol;
  148. external [2] procedure block(fsys: symset; isfun: boolean; level: integer);
  149.  
  150. { interpreter overlay }
  151.  
  152. external [3] procedure interpret;
  153.  
  154.  
  155. begin { main program }
  156.  
  157.    writeln('Concurrent Pascal-S compiler');
  158. { get command line tail & open input file }
  159.    ptr := @cmd;
  160.    sfn := ptr^;
  161.    assign(input,sfn);
  162.    reset(input);
  163.    init_reserved_words;
  164.    constbegsys    := [plus, minus, intcon, charcon, ident];
  165.    typebegsys := [ident, arraysy];
  166.    blockbegsys    := [constsy, typesy, varsy, proceduresy, functionsy,
  167.       beginsy];
  168.    facbegsys := [intcon, charcon, ident, lparent, notsy];
  169.    statbegsys := [beginsy, ifsy, whilesy, repeatsy, forsy];
  170.    stantyps :=    [notyp, ints, bools, chars];
  171.    lc := 0;
  172.    ll := 0;
  173.    cc := 0;
  174.    ch := ' ';
  175.    errpos := 0;
  176.    errs := [];
  177.    t := - 1;
  178.    a := 0;
  179.    b := 1;
  180.    sx := 0;
  181.    c2 := 0;
  182.    init_predefined_identifiers;
  183.    insymbol;
  184.    display[0] := 1;
  185.    skipflag :=    false;
  186.    if sy <> programsy
  187.    then
  188.       error(erkey)
  189.    else
  190.       begin
  191.       insymbol;
  192.       if sy    <> ident
  193.       then
  194.          error(erid)
  195.       else
  196.          begin
  197.         progname := id;
  198.         insymbol;
  199.          end
  200.       end;
  201.    with btab[1] do
  202.       begin
  203.       last := t;
  204.       lastpar := 1;
  205.       psize    := 0;
  206.       vsize    := 0
  207.       end;
  208.    block(blockbegsys +    statbegsys, false, 1);
  209.    if sy <> period then
  210.       error(erpun);
  211.    if btab[2].vsize > stmax - stkincr * pmax    then
  212.       error(erln);
  213.    emit(31);        {halt}
  214. {  if not eof(input) then
  215.       readln; }
  216.    if errs = []
  217.    then
  218.       begin
  219.       assign(input,'CON:');
  220.       repeat
  221.             reset(input);
  222.         writeln;    
  223.         interpret;
  224.         writeln;writeln('enter  e  to exit, anything else to continue');
  225.         if eof(input) then reset(input);
  226.         readln(command);    
  227.       until (command = 'e') or (command = 'E');
  228.       end
  229.    else
  230.       errormsg;
  231. 99: writeln
  232. end {pascals}.
  233.