Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/TPF.ZIP/TPFDCL.PAS

Pascal/Delphi Source File | 1985-05-27 | 13.6 KB | 601 lines

{[B+]}

{*-----------------------*
 | Formal Parameter List |
 *-----------------------*}


procedure Parameters;
{
! Format a formal parameter list: if they start less than halfway
! across the page, they are all lined up with the first parameter,
! on successive lines. If they start more than halfway across the
! page, they begin on the next line, indented double the usual
! (arbitrary)
}
    begin
    if Write_Col > One_Half_Line then Format_Line(Indent + 2 * Tab_Spaces);
    Next_Sym;
    Indent_Plus(Write_Col - Indent);

    while Sym in [Identifier, Var_Sym] do
        begin
        if Sym <> Identifier then Next_Sym;
        if Sym <> Identifier then Abort(Syntax);
        Indent_Plus(Continue_Spaces);
        Ident_List;
        Undent;

        if Sym = Colon then
            begin
            Next_Sym;
            Scan_Type;
            end;

        if Sym = Semicolon then
            begin
            Next_Sym;
            Format_Line(Indent);
            end;
        end;

    Check_Sym(Close_Paren);
    Terminal_Semicolon;
    Undent;
    Stat_Indent := Indent;
    end; {Parameters}


procedure Field_List;

  { Scan field list of type specification }

    var
        Invar_Part: Boolean;            {true if there was an invarient part}
        Label_Start, Label_End: Integer; {lines for case label bunching}
        Case_Start: Col_Log;            {start of a variant}
        Successful: Boolean;            {dummy param}

    begin
    Invar_Part := false;

    while Sym = Identifier do
        begin
        Invar_Part := true;
        Indent_Plus(Continue_Spaces);
        Ident_List;
        Check_Sym(Colon);
        Undent;
        Scan_Type;
        if Sym = Semicolon then Next_Sym;
        if Sym = Identifier then Format_Line(Indent);
        end;

    if Sym = Case_Sym then
        begin {case}
        if Invar_Part then Format_Line(Indent);
        Next_Sym;
        Indent_Plus(Continue_Spaces);

        if Sym = Identifier then Next_Sym
        else Scan_Type;

        if Sym = Colon then
            begin
            Next_Sym;
            Scan_Type
            end;

        Check_Sym(Of_Sym);
        Undent;
        Indent_Plus(Tab_Spaces);
        Stat_Indent := Indent;
        Format_Line(Indent);

        repeat {variant part}
            Label_Start := Current_Line;
            Const_List;
            Check_Sym(Colon);
            Label_End := Current_Line;
            Indent_Plus(Tab_Spaces);
            Stat_Indent := Indent;
            Log_Symbol_Start(Case_Start);
            Format_Line(Indent);
            Check_Sym(Open_Paren);
            Indent_Plus(1); {compensate for paren}
            Field_List;
            Undent;
            Check_Sym(Close_Paren);
            Undent;
            Stat_Indent := Indent;
            if Sym = Semicolon then Next_Sym;
            if Bunching and (Label_Start = Label_End) then
                Bunch(Case_Start, Successful);
            if not (Sym in [End_Sym, Close_Paren]) then Format_Line(Indent);
        until not (Sym in Constants);

        Undent;
        Stat_Indent := Indent;
        end {case}
    end; {Field_List}


procedure Record_Type(Packed_Start: Col_Log);
{
! Handle a record type, includes a kluge to move "packed" down to the
! next line
}
    begin
    Indent_Plus(Tab_Spaces);

    with Packed_Start do
        if Formatting and (Log_Char <> 0) and
           (Char_Count - Log_Char < Buf_Size) then

            with Unwritten[Log_Char mod Buf_Size] do
                begin {note that this kluge assumes the logged point has
                       become a space so it can be changed to a newline}
                Action_Is := Begin_Line;
                Spacing := Indent;
                Write_Col := Indent + Write_Col - Log_Col;
                Current_Line := Current_Line + 1;
                end

        else Format_Line(Indent);

    Next_Sym;
    Indent_Plus(Tab_Spaces);
    Stat_Indent := Indent;
    Format_Line(Indent);
    Field_List;
    Undent;
    Format_Line(Indent);
    Check_Sym(End_Sym);
    Terminal_Semicolon;
    Undent;
    end; {Record_Type}


procedure Array_Type;
{
! Format an array type
}
    begin
    Indent_Plus(Tab_Spaces);
    Next_Sym;
    Set_Symbol_Break(0);
    Check_Sym(Open_Brack);

    while Sym in Constants do
        begin
        Constant;

        if Sym = Subrange then
            begin
            Next_Sym;
            Constant;
            end;

        if (Sym = Comma) or (Sym = Semicolon) then
            begin
            Next_Sym;
            Set_Symbol_Break(0);
            end;
        end; {while}

    Check_Sym(Close_Brack);
    Check_Sym(Of_Sym);
    Scan_Type;
    Terminal_Semicolon;
    Undent;
    end; {Array_Type}


procedure String_Type;
{
! Handle the Turbo string type -- string[constant]
}
    begin
    Next_Sym;
    Set_Symbol_Break(0);
    Check_Sym(Open_Brack);
    Constant;
    Check_Sym(Close_Brack);
    end;


procedure Enum_Type;
{
! Handle an enumeration type, align to the right of the opening
! parenthesis if there is room, otherwise use normal continuation
}
    begin
    Next_Sym;

    if Write_Col <= Three_Fourth_Line then Indent_Plus(Write_Col - Indent)
    else Indent_Plus(Continue_Spaces);

    Ident_List;
    Check_Sym(Close_Paren);
    Terminal_Semicolon;
    Undent;
    end; {Enum_Type}


procedure Scan_Type;
{
! Scan a type, formatting differs for each one
}

    var
        Packed_Start: Col_Log;

    begin
    Indent_Plus(Continue_Spaces);

    if Sym = Packed_Sym then
        begin {mark start of 'packed' - must actually be a space}
        Log_Symbol_Start(Packed_Start);
        Next_Sym;
        end
    else Packed_Start.Log_Char := 0;

    Undent;
    check(Type_Beg_Sys);

    case Sym of
        Open_Paren: Enum_Type;
        Array_Sym: Array_Type;
        String_Sym: String_Type;

        File_Sym:
            begin
            Next_Sym;

            if Sym = Of_Sym then
                begin
                Next_Sym;
                Scan_Type;
                end;
            end;

        Set_Sym:
            begin
            Next_Sym;
            Check_Sym(Of_Sym);
            Scan_Type;
            end;

        Identifier, Number, Plus, Minus, Str_Const:
            begin {simple or subrange}
            Constant;
            if Sym = Subrange then
                begin
                Next_Sym;
                Constant;
                end;
            end;

        Pointer:
            begin
            Next_Sym;
            Scan_Type;
            end;

        Record_Sym: Record_Type(Packed_Start);
        end; {case}

    Stat_Indent := Indent;
    end; {Scan_Type}


procedure Do_Label; {label declaration}
    begin
    Reset_Char_Count;
    Next_On_New_Line(1, Tab_Spaces);
    Format_Line(Indent);

    while Sym in [Number, Identifier] do
        begin
        Next_Sym;
        if Sym = Comma then Next_Sym;
        end; {while}

    Check_Sym(Semicolon);
    Undent;
    end;


procedure Structured_Constant;
(*
! structured_constant ::= set_constant | array_or_record_constant
!
! array_or_record_constant ::= '(' array_or_record_element_list ')'
!
! array_or_record_element_list ::=
!       array_or_record_element [{','|';'} array_or_record_element]
!
! array_or_record_element ::=
!       | [identifier ':']{constant | array_or_record_constant}
!
| set_constant ::= '[' range [',' range] ']'
!
! range ::= constant ['..' constant]
*)


    procedure Array_Or_Record_Constant(BreakAt: Integer);
        begin

        repeat
            Next_Sym;

            if Sym = Identifier then
                begin

                Next_Sym;

                if Sym = Colon then
                    begin
                    Next_Sym;

                    if Sym = Open_Paren then
                        Array_Or_Record_Constant(BreakAt + 1)
                    else Constant;

                    end;
                end
            else if Sym = Open_Paren then
                Array_Or_Record_Constant(BreakAt + 1)
            else Constant;

        until not ((Sym = Comma) or (Sym = Semicolon));

        Check_Sym(Close_Paren);
        end;

    begin

    if Sym = Open_Paren then Array_Or_Record_Constant(0)
    else if Sym = Open_Brack then {set constant }
        begin

        repeat
            Next_Sym;
            Constant;

            if Sym = Subrange then
                begin
                Next_Sym;
                Constant;
                end;
        until Sym <> Comma;

        Check_Sym(Close_Brack);
        end
    else Constant;
    end;


procedure Do_Const;

    var
        Const_Start: Col_Log;           {start of particular declaration}
        First_Const: Boolean;           {first constant in decl}

    begin {constant declaration}
    In_Declaration := true;
    Reset_Char_Count;
    Next_On_New_Line(1, Tab_Spaces);
    First_Const := true;

    while Sym = Identifier do
        begin
        Log_Symbol_Start(Const_Start);
        Format_Line(Indent);
        Next_Sym;

        if Sym = Colon then
            begin
            Next_Sym;
            Scan_Type;
            end;

        Check_Sym(Equal);
        Structured_Constant;

        if Sym = Semicolon then Put_Sym
        else Abort(Syntax);

        if (Stats_Per_Line > 1) and not First_Const then
            Bunch_Statement(Const_Start);
        Next_Sym; {split so comments format right}
        First_Const := false;
        end; {while}

    Undent;
    Stat_Indent := Indent;
    In_Declaration := false;
    end; {Do_Const}


procedure Do_Type; {type_declaration}
    begin
    In_Type_Or_Var_Dcl := true;
    In_Declaration := true;
    Next_On_New_Line(1, Tab_Spaces);

    while Sym = Identifier do
        begin
        Reset_Char_Count;
        Format_Line(Indent);
        Next_Sym;
        Check_Sym(Equal);
        Scan_Type;
        Check_Sym(Semicolon);
        end; {while}

    Undent;
    Stat_Indent := Indent;
    In_Type_Or_Var_Dcl := false;
    In_Declaration := false;
    end; {Do_Type}


procedure Do_Var;
    begin {var declaration}
    In_Type_Or_Var_Dcl := true;
    In_Declaration := true;
    Next_On_New_Line(1, Tab_Spaces);

    while Sym = Identifier do
        begin
        Reset_Char_Count;
        Format_Line(Indent);
        Indent_Plus(Continue_Spaces);
        check([Identifier]);
        Ident_List;
        Check_Sym(Colon);
        Undent;
        Scan_Type;

        { Check for "absolute constant[:constant] }

        if Sym = Absolute_Sym then
            begin
            Next_Sym;
            Constant;

            if Sym = Colon then
                begin
                Next_Sym;
                Constant;
                end;
            end;

        Check_Sym(Semicolon);
        end; {while}

    Undent;
    Stat_Indent := Indent;
    In_Type_Or_Var_Dcl := false;
    In_Declaration := false;
    end; {Do_Var}


procedure Do_Program; {program or processor}
    begin
    Next_On_New_Line(0, Continue_Spaces);
    Check_Sym(Identifier);

    if Sym = Open_Paren then
        begin
        Next_Sym;

        while Sym = Identifier do
            begin
            Next_Sym;

            if Sym = Comma then
                begin
                Next_Sym;
                Set_Symbol_Break(0);
                end;
            end;

        Check_Sym(Close_Paren);
        end;

    Check_Sym(Semicolon);
    Undent;
    Indent_Plus(Tab_Spaces);
    Do_Block;
    if Sym = Period then Next_Sym;
    Undent;
    end; {Do_Program}


procedure Do_Procedure;

    var
        Start_Sym: Symbols;

    begin
    Reset_Char_Count;
    Start_Sym := Sym;
    Next_On_New_Line(2, Continue_Spaces);

    if Start_Sym = Overlay_Sym then
        begin
        Start_Sym := Sym;

        if (Sym <> Procedure_Sym) and (Sym <> Function_Sym) then
            Abort(Syntax);
        Next_Sym;
        end;

    Check_Sym(Identifier);
    if Sym = Open_Paren then Parameters;

    if Start_Sym = Function_Sym then
        if Sym = Colon then
            begin {if function was declared forward, the second appearance has
                   no result type}
            Check_Sym(Colon);
            Check_Sym(Identifier);
            end;

    Terminal_Semicolon;
    Undent;
    Check_Sym(Semicolon);
    Indent_Plus(Tab_Spaces);

    if Sym in [Extern_Sym, Forward_Sym] then
        begin
        Format_Line(Indent);
        if Sym = Extern_Sym then
            begin
            Next_Sym;
            if Sym <> Str_Const then Abort(Syntax);
            end;
        Next_Sym;
        end
    else if Sym in Block_Beg_Sys then Do_Block
    else Abort(Syntax);

    if Sym = Semicolon then
        begin
        Put_Sym;
        Undent;
        Stat_Indent := Indent;
        Next_Sym;
        end
    else Abort(Syntax);
    end; {Do_Procedure}


procedure Do_Block;
{
! Scan a block, including types, etc
}
    begin
    Stat_Indent := Indent;

    while Sym in Heading_Beg_Sys do
        begin {declarations}
        case Sym of
            Label_Sym: Do_Label;
            Const_sym: Do_Const;
            Type_Sym: Do_Type;
            Var_Sym: Do_Var;
            Overlay_Sym, Procedure_Sym, Function_Sym: Do_Procedure;
            end;

        Stat_Indent := Indent;
        end; {while}

    if Sym = Begin_Sym then
    Do_Begin(true);

    end; {Do_Block}