{***************************************************************************}
{                                                                           }
{                         File: SRC:PasDefs.TEXT                            }
{                     PASCAL Language System Definitions                    }
{                                                                           }
{            (C) Copyright 1981, 1982, 1983 Apple Computer, Inc.            }
{                                                                           }
{                            All rights reserved.                           }
{                                                                24-Mar-83  }
{ 24-Mar-83 Changes to track WorkBench changes                              }
{ 10-Nov-82 Modified to run on One PasLib                                   }
{***************************************************************************}

{$S LIB1 }

{$I flags.text }

UNIT PasDefs;

  INTRINSIC;

  INTERFACE

    {$IFC ForOs }

    USES
      {$U n/SULib} StdUnit;
      {$ENDC }

      {$SETC RANGEF = 0 }
      {$SETC DEBUGF = 0 }
      {$SETC INFOF = 1 }

    CONST
      NameStrLen = 8; { Length of Identifier Names }
      MaxLStringLen = 80; { Reasonably long: error messages etc. }

      Blank = ' ';
      Empty = '';

    TYPE
      NameString = PACKED ARRAY [1..NameStrLen] OF char;
      LString = String[MaxLStringLen];

      MemPtr = ^Integer; { "untyped" pointer to memory }
      ProcPtr = ^Integer; { in place of Procedure variables }

    VAR
      Errors: Integer; { *** Set to 0 in MainProg *** }
      ListingFile: Text; { Errors go here }
      ListFlag: Boolean; { true if ListingFile <> 'CONSOLE:' or '#1:' }

    PROCEDURE InitPasDefs;

    PROCEDURE PasHalt;

    PROCEDURE SumErrors;

    FUNCTION Min(I, J: Integer): Integer;

    FUNCTION Max(I, J: Integer): Integer;

    FUNCTION UpToLow(Src: char): char;

    FUNCTION LowToUp(Src: char): char;

    PROCEDURE TruncLStr(VAR Victim: LString; MaxLen: Integer);

    PROCEDURE EatBlanks(VAR Strg: LString);

    PROCEDURE StrUpToLow(VAR Dest: LString);

    PROCEDURE StrLowToUp(VAR Dest: LString);

    PROCEDURE Warning(S: LString);

    PROCEDURE Error(S: LString);

    PROCEDURE FatalError(S: LString);

  IMPLEMENTATION

    {$IFC RANGEF = 1 }
    {$R+ }
    {$ELSEC }
    {$R- }
    {$ENDC }

    {$IFC INFOF = 1 }
    {$D+ }
    {$ELSEC }
    {$D- }
    {$ENDC }

    PROCEDURE KillExec;
     { this procedure will stop an exec file, on the Monitor or O.S. }

      VAR
        p: ^Integer;
        I: Integer;
        Ch: char;

      BEGIN
        {$IFC ForOs }
        SUStopExec(I);
        IF I > 0 THEN
          BEGIN
          write('Error number ', I, ' killing OS exec, <space to continue>');
          REPEAT
            read(Ch)
          UNTIL Ch = ' ';
          END;
        {$ELSEC }
        p := pointer($D00 - 122); p^ := 0;
        {$ENDC }
      END;

    {$S LIB1 }

    PROCEDURE InitPasDefs;

      BEGIN
        Errors := 0; Rewrite(ListingFile, 'CONSOLE:'); ListFlag := False;
      END;

    PROCEDURE PasHalt;

      BEGIN
        KillExec;
        Halt;
      END;

    PROCEDURE SumErrors;

      BEGIN
        WriteLn(ListingFile, Errors: 4, ' Errors detected.');
        IF ListFlag THEN WriteLn(Errors: 4, ' Errors detected.');
      END;

    FUNCTION Min{(I, J :Integer) :Integer};

      BEGIN
        IF (I < J) THEN
          Min := I
        ELSE
          Min := J;
      END;

    FUNCTION Max{(I, J :Integer) :Integer};

      BEGIN
        IF (I > J) THEN
          Max := I
        ELSE
          Max := J;
      END;

    FUNCTION UpToLow{(Src :Char) :Char};

      BEGIN
        IF ((Src >= 'A') AND (Src <= 'Z')) THEN
          UpToLow := Chr(Ord(Src) - Ord('A') + Ord('a'))
        ELSE
          UpToLow := Src;
      END;

    FUNCTION LowToUp{(Src :Char) :Char};

      BEGIN
        IF ((Src >= 'a') AND (Src <= 'z')) THEN
          LowToUp := Chr(Ord(Src) - Ord('a') + Ord('A'))
        ELSE
          LowToUp := Src;
      END;

    PROCEDURE TruncLStr{(VAR Victim :LString; MaxLen :Integer)};

      BEGIN
        IF (Length(Victim) > MaxLen) THEN Victim := Copy(Victim, 1, MaxLen);
      END;

    PROCEDURE EatBlanks{(VAR Strg :LString)};

      CONST
        ASCIIDEL = 127;

      VAR
        I: Integer;

      BEGIN
        I := 1;
        WHILE (I <= Length(Strg)) DO
          IF ((Strg[I] > Blank) AND (Strg[I] < Chr(ASCIIDEL))) THEN
            I := I + 1
          ELSE
            Delete(Strg, I, 1);
      END;

    PROCEDURE StrUpToLow{(VAR Dest :LString)};

      VAR
        CharNow: Integer;

      BEGIN
        FOR CharNow := 1 TO Length(Dest) DO
          Dest[CharNow] := UpToLow(Dest[CharNow]);
      END;

    PROCEDURE StrLowToUp{(VAR Dest :LString)};

      VAR
        CharNow: Integer;

      BEGIN
        FOR CharNow := 1 TO Length(Dest) DO
          Dest[CharNow] := LowToUp(Dest[CharNow]);
      END;

    PROCEDURE Warning{ (S: LString) };

      BEGIN
        WriteLn(ListingFile, '*** Warning - ', S, ' ***');
      END;

    PROCEDURE Error{ (S: LString) };

      BEGIN
        WriteLn(ListingFile, '*** Error - ', S, ' ***');
        KillExec;
        Errors := Errors + 1;
      END;

    PROCEDURE FatalError{ (S: LString) };

      VAR
        Ch: char;

      BEGIN
        KillExec;
        WriteLn(ListingFile, '*** Fatal Error - ', S, ' ***');
        Errors := Errors + 1;
        IF ListFlag THEN WriteLn('*** Fatal Error - ', S, ' ***');
        write('Type <sp> to continue.');
        REPEAT
          read(Ch)
        UNTIL (Ch = Blank);
        PasHalt;
      END;
END {PasDefs} .

