  (*$p**************************************************************************)
  (*                                                                           *)
  (*                           File: INIT.TEXT                                 *)
  (*                                                                           *)
  (*              (c) Copyright 1981 Silicon Valley Software, Inc.             *)
  (*                            1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                            All rights reserved.               11-Jun-82   *)
  (*                                                                           *)
  (*  5-11-83 Initialize: init forwcount                                       *)
  (*  5-24-83 Initialize: report error text for i/o errors on file opens       *)
  (*  5-27-83 Initialize: init overflow flag default=no checking               *)
  (*  6-22-83 Initstdtypes: re-allow INTERACTIVE files(Paslib converts to TEXT)*)
  (*  6-22-83 Initstdnames: re-allow INTERACTIVE files(Paslib converts to TEXT)*)
  (*  6-23-83 Initialize: init InIU                                            *)
  (*  6-29-83 Init: call to copyrights to give current copyright info          *)
  (*  7-05-83 Initundecl: init pfarglist to nil to prevent bus error           *)
  (*  9-01-83 Initstdnames: remove class OBJECT (but not type nilclassptr^)    *)
  (* 10-25-83 Initialize: init RodFlag, ForwChkFlag                            *)
  (* 12-20-83 Initialize: ClassesToInit, UnitsToInit                           *)
  (* 12-27-83 Initialize: NextCrNbr                                            *)
  (* 12-27-83 InitStdProcs: KlassPtr - defines %_CLASS interpreter proc        *)
  (* 12-27-83 InitStdFuncs: CkObCpPtr defines %_CKOBCP function                *)
  (* 12-27-83 InitStdFuncs: CkObCnPtr defines %_CKOBCN function                *)
  (* 01-01-84 InitRW1, InitRW2: CREATION removed as a reserved word            *)
  (* 01-09-84 ThisClass, CurrClass                                             *)
  (* 01-20-84 ConstBegSys changed to allow for constant expressions            *)
  (* 01-21-84 InitSets: DecBegSys, IdDecBegSys, AllBegSys                      *)
  (* 03-06-84 Initialize: CallGen                                              *)
  (* 04-14-84 UNIVflag added to VARS                                           *)
  (*****************************************************************************)
  {[j=0/0/80!,i=1]}

  {$S INIT }

  PROCEDURE Initialize;

    VAR
      i: Integer;
      Dummy: Boolean;
      DateStr: String[20];
      ListFName, DefFName, Vol, Name, Ext: SUStr;
      WhatUserTyped, ILibWhatUserTyped: PromptState;
      Trick: RECORD
               CASE Integer OF
                 0:
                   (i: Integer);
                 1:
                   (c: PACKED ARRAY [0..1] OF Char);
             END;

    PROCEDURE KCSDefaults;

      VAR
        i: Integer;
        p: ^Integer;

      BEGIN {KCSDefaults - initialize kcs arithmetic -- zero $300 thru $341}
        {$IFC NOT FOROS}
        FOR i := 0 TO 32 DO
          BEGIN
          p := Pointer(768 + i + i); p^ := 0;
          END;
        {$ENDC}
      END; {KCSDefaults}

    PROCEDURE InitScanner;

      VAR
        i: Integer;
        lCh: Char;

      PROCEDURE InitRW1;

        BEGIN {InitRW1 - length sorted names used in reserved word lookup}     {!}{[g=2]}
          RWnames[01] := 'IF      ';          RWnames[02] := 'OR      ';
          RWnames[03] := 'DO      ';          RWnames[04] := 'OF      ';
          RWnames[05] := 'TO      ';          RWnames[06] := 'IN      ';
          RWnames[07] := 'END     ';          RWnames[08] := 'NIL     ';
          RWnames[09] := 'FOR     ';          RWnames[10] := 'NOT     ';
          RWnames[11] := 'DIV     ';          RWnames[12] := 'MOD     ';
          RWnames[13] := 'AND     ';          RWnames[14] := 'SET     ';
          RWnames[15] := 'VAR     ';          RWnames[16] := 'THEN    ';
          RWnames[17] := 'CASE    ';          RWnames[18] := 'WITH    ';
          RWnames[19] := 'TYPE    ';          RWnames[20] := 'FILE    ';
          RWnames[21] := 'GOTO    ';          RWnames[22] := 'ELSE    ';
          RWnames[23] := 'USES    ';          RWnames[24] := 'UNIT    ';
          RWnames[25] := 'BEGIN   ';          RWnames[26] := 'LABEL   ';
          RWnames[27] := 'WHILE   ';          RWnames[28] := 'UNTIL   ';
          RWnames[29] := 'CONST   ';          RWnames[30] := 'ARRAY   ';
          RWnames[31] := 'DOWNTO  ';          RWnames[32] := 'PACKED  ';
          RWnames[33] := 'RECORD  ';          RWnames[34] := 'REPEAT  ';
          RWnames[35] := 'STRING  ';          RWnames[36] := 'PROGRAM ';
          RWnames[37] := 'METHODS ';          RWnames[38] := 'SUBCLASS';       {!C}
          RWnames[39] := 'FUNCTION';          RWnames[40] := 'PROCEDUR';
          RWnames[41] := 'INTERFAC';          RWnames[42] := 'IMPLEMEN';
          RWnames[43] := 'OTHERWIS';          RWnames[44] := 'INTRINSI';       {!IU!}
        END; {InitRW1}

      PROCEDURE InitRW2;

        BEGIN {InitRW2 - length of reserved word index into RWnames}
          LRWnames[0] := 00;                  LRWnames[1] := 00;
          LRWnames[2] := 06;                  LRWnames[3] := 15;
          LRWnames[4] := 24;                  LRWnames[5] := 30;
          LRWnames[6] := 35;                  LRWnames[7] := 37;
          LRWnames[8] := 44;                                                   {!C}{!IU!}

          {Parsing symbols corresponding to each reserved word}

          RWsymbol[01] := IFSY;               RWsymbol[02] := ORSY;
          RWsymbol[03] := DOSY;               RWsymbol[04] := OFSY;
          RWsymbol[05] := TOSY;               RWsymbol[06] := INSY;
          RWsymbol[07] := ENDSY;              RWsymbol[08] := NILSY;
          RWsymbol[09] := FORSY;              RWsymbol[10] := NOTSY;
          RWsymbol[11] := DIVSY;              RWsymbol[12] := MODSY;
          RWsymbol[13] := ANDSY;              RWsymbol[14] := SETSY;
          RWsymbol[15] := VARSY;              RWsymbol[16] := THENSY;
          RWsymbol[17] := CASESY;             RWsymbol[18] := WITHSY;
          RWsymbol[19] := TYPESY;             RWsymbol[20] := FILESY;
          RWsymbol[21] := GOTOSY;             RWsymbol[22] := ELSESY;
          RWsymbol[23] := USESSY;             RWsymbol[24] := UNITSY;
          RWsymbol[25] := BEGINSY;            RWsymbol[26] := LABELSY;
          RWsymbol[27] := WHILESY;            RWsymbol[28] := UNTILSY;
          RWsymbol[29] := CONSTSY;            RWsymbol[30] := ARRAYSY;
          RWsymbol[31] := DOWNTOSY;           RWsymbol[32] := PACKEDSY;
          RWsymbol[33] := RECORDSY;           RWsymbol[34] := REPEATSY;
          RWsymbol[35] := STRINGSY;           RWsymbol[36] := PROGRAMSY;
          RWsymbol[37] := METHSY;             RWsymbol[38] := SUBCLSY;         {!C}
          RWsymbol[39] := FUNCTSY;            RWsymbol[40] := PROCSY;
          RWsymbol[41] := INTERSY;            RWsymbol[42] := IMPLESY;
          RWsymbol[43] := OTHERSY;            RWsymbol[44] := INTRINSY;        {!IU!}{[g=1]}
        END; {InitRW2}

      BEGIN {InitScanner}
        Ch := ' '; {Look ahead character}
        pCurLine := -1; CurLine := '';
        PrevLine := '';
        DotFlag := False;
        InitRW1; InitRW2;
        FOR i := 0 TO 255 DO ChClass[i] := ERRSY;
        FOR lCh := '0' TO '9' DO ChClass[Ord(lCh)] := DIGITCL;
        FOR lCh := 'a' TO 'z' DO ChClass[Ord(lCh)] := LETCL;
        FOR lCh := 'A' TO 'Z' DO ChClass[Ord(lCh)] := LETCL;
        ChClass[Ord('_')] := LETCL;
        ChClass[3] := EOFSY; {Endfile}
        ChClass[9] := BLANKCL; {Tab}
        ChClass[12] := BLANKCL; {Formfeed}
                                                                               {!}{[g=2]}
        ChClass[Ord(')')] := RPARENSY;       ChClass[Ord(',')] := COMMASY;
        ChClass[Ord(';')] := SEMISY;         ChClass[Ord('^')] := UPARROWSY;
        ChClass[Ord('[')] := LBRACKSY;       ChClass[Ord(']')] := RBRACKSY;
        ChClass[Ord('*')] := STARSY;         ChClass[Ord('+')] := PLUSSY;
        ChClass[Ord('-')] := MINUSSY;        ChClass[Ord('/')] := SLASHSY;
        ChClass[Ord(' ')] := BLANKCL;        ChClass[Ord('=')] := EQSY;
        ChClass[Ord('(')] := LPARENSY;       ChClass[Ord('<')] := LTSY;
        ChClass[Ord('>')] := GTSY;           ChClass[Ord('.')] := PERIODSY;
        ChClass[Ord(':')] := COLONSY;        ChClass[Ord('@')] := ATSIGNSY;
        ChClass[Ord('{')] := LBRACECL;       ChClass[Ord('''')] := SCONSTSY;
        ChClass[Ord('$')] := DOLLARSY;                                         {!}{[g=1]}
      END; {InitScanner}
    (*
    PROCEDURE InitSets;

      BEGIN {InitSets}
        BlockBegSys := [LABELSY, CONSTSY, TYPESY, VARSY, PROCSY, FUNCTSY, BEGINSY,
                       METHSY];
        ConstBegSys := [PLUSSY, MINUSSY, ICONSTSY, RCONSTSY, SCONSTSY, CCONSTSY,
                       IDENTSY, LPARENSY, NOTSY, LBRACKSY];                    {!01-20-84}
        SimpTypeBegSys := [LPARENSY] + ConstBegSys - [SCONSTSY];
        TypeDels := [ARRAYSY, FILESY, RECORDSY, SETSY, STRINGSY, SUBCLSY];
        TypeBegSys := [UPARROWSY, PACKEDSY] + TypeDels + SimpTypeBegSys;
        SelectSys := [UPARROWSY, PERIODSY, LBRACKSY];
        FacBegSys := [ICONSTSY, RCONSTSY, SCONSTSY, CCONSTSY, IDENTSY, LPARENSY,
                     LBRACKSY, NOTSY, NILSY, ATSIGNSY];
        StatBegSys := [BEGINSY, GOTOSY, IFSY, WHILESY, REPEATSY, FORSY, WITHSY,
                      CASESY];
        IdDecBegSys := [LABELSY, CONSTSY, TYPESY, VARSY];                      {!01-21-84}
        DecBegSys := IdDecBegSys + [PROCSY, FUNCTSY];                          {!01-21-84}
        AllBegSys := BlockBegSys + StatBegSys;                                 {!01-21-84}
      END; {InitSets}
    *)
    PROCEDURE InitStdTypes;

      VAR
        IndexPtr: pT;

      BEGIN {InitStdTypes}
        New(LIntPtr, SCALAR, STANDARD);
        WITH LIntPtr^ DO
          BEGIN
          FType := False; Form := SCALAR; ScalKind := STANDARD;
          Bytes := 4; Bits := 0;
          END;
        New(IntPtr, SUBRANGE);
        WITH IntPtr^ DO
          BEGIN
          FType := False; Form := SUBRANGE; RangeOf := LIntPtr;
          Min := - 32767 - 1; Max := 32767;
          Bytes := 2; Bits := 0;
          END;
        New(SIntPtr, SUBRANGE);
        WITH SIntPtr^ DO
          BEGIN
          FType := False; Form := SUBRANGE; RangeOf := LIntPtr;
          Min := - 128; Max := 127;
          Bytes := 1; Bits := 0;
          END;
        New(RealPtr, SCALAR, STANDARD);
        WITH RealPtr^ DO
          BEGIN
          FType := False; Form := SCALAR; ScalKind := STANDARD;
          Bytes := 4; Bits := 0;
          END;
        New(CharPtr, SCALAR, STANDARD);
        WITH CharPtr^ DO
          BEGIN
          FType := False; Form := SCALAR; ScalKind := STANDARD;
          Bytes := 1; Bits := 0;
          END;
        New(BoolPtr, SCALAR, DECLARED);
        WITH BoolPtr^ DO
          BEGIN
          FType := False; Form := SCALAR; ScalKind := DECLARED;
          Bytes := 0; Bits := 1;
          END;
        New(TextPtr, FILES);
        WITH TextPtr^ DO
          BEGIN
          FType := True; Form := FILES; FileOf := CharPtr; PckdFile := True;
          Bytes := 602; Bits := 0;
          END;
        New(InterPtr, FILES);
        WITH InterPtr^ DO
          BEGIN
          FType := True; Form := FILES; FileOf := CharPtr; PckdFile := True;
          Bytes := 602; Bits := 0;
          END;
        New(NilPtr, POINTERS);
        WITH NilPtr^ DO
          BEGIN
          FType := False; Form := POINTERS; PointerTo := NIL;
          Bytes := 4; Bits := 0;
          END;
        New(Str0Ptr, SCONST);
        WITH Str0Ptr^ DO
          BEGIN
          FType := False; Form := SCONST; StringLen := 0;
          Bytes := 1; Bits := 0;
          END;
        New(Str1Ptr, SCONST); Str1Ptr^ := Str0Ptr^;
        WITH Str1Ptr^ DO
          BEGIN
          StringLen := 1; Bytes := 2;
          END;
        New(AlfaPtr, ARRAYS);
        WITH AlfaPtr^ DO
          BEGIN
          Form := ARRAYS; PckdArr := True; ArrayOf := CharPtr;
          BitPacked := True; BitsPerEl := 8;
          Bits := 0; Bytes := 8;
          New(IndexPtr, SUBRANGE); IndexedBy := IndexPtr;
          WITH IndexPtr^ DO
            BEGIN
            FType := False; Form := SUBRANGE;
            Min := 1; Max := 8; RangeOf := IntPtr;
            Bits := 4; Bytes := 0;
            END;
          END;
                                                                               {!C type of the nil class }
        New(NilClassPtr, CLASSES);
        WITH NilClassPtr^ DO
          BEGIN
          Bytes := 4; Bits := 0; FType := False;
          Form := CLASSES; WasDeclared := True;
          SuperClass := NIL; TotalOrder := NIL;
          ClassLevel := - 2;
          SizeInstance := 4;
          LastEvenMethod := 0; LastOddMethod := 0;
          MethodOff := 0; MethodLev := 0;
          ItsId := NIL;
          ClFields := NIL; ClFstField := NIL; ClFstMethod := NIL;
          END;

        {return type of procs}
        New(ProcPtr, PROCVALUES);
        WITH ProcPtr^ DO
          BEGIN
          FType := False;
          Form := PROCVALUES;
          Bits := 0;
          Bytes := 4;
          END;                                                                 {!C}
      END; {InitStdTypes}

    PROCEDURE InitStdNames;

      VAR
        lpN, lpN1: pN;

      BEGIN {InitStdNames}
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'INTEGER '; IdType := IntPtr; Next := NIL; Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'LONGINT '; IdType := LIntPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'REAL    '; IdType := RealPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'CHAR    '; IdType := CharPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'BOOLEAN '; IdType := BoolPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, CONSTS);
        WITH lpN^ DO
          BEGIN
          Name := 'FALSE   '; IdType := BoolPtr; Next := NIL;
          Class := CONSTS; ValueOf.Ivalu := 0;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN1, IDENTNODE, CONSTS);
        WITH lpN1^ DO
          BEGIN
          Name := 'TRUE    '; IdType := BoolPtr; Next := lpN;
          Class := CONSTS; ValueOf.Ivalu := 1;
          Node := IDENTNODE;
          END;
        EnterId(lpN1);
        BoolPtr^.MaxConst := lpN1;
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'TEXT    '; IdType := TextPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(InputPtr, IDENTNODE, VARS);
        WITH InputPtr^ DO
          BEGIN
          Name := 'INPUT   '; IdType := TextPtr; Next := NIL;
          Class := VARS; Vkind := INDRCT; Vlev := 1; Voff := 8;
          Node := IDENTNODE; UNIVflag := False;                                {!4-14-84}
          END;
        EnterId(InputPtr);
        New(OutputPtr, IDENTNODE, VARS);
        WITH OutputPtr^ DO
          BEGIN
          Name := 'OUTPUT  '; IdType := TextPtr; Next := NIL;
          Class := VARS; Vkind := INDRCT; Vlev := 1; Voff := 12;
          Node := IDENTNODE; UNIVflag := False;                                {!4-14-84}
          END;
        EnterId(OutputPtr);
        New(lpN, IDENTNODE, CONSTS);
        WITH lpN^ DO
          BEGIN
          Name := 'MAXINT  '; IdType := IntPtr; Next := NIL;
          Class := CONSTS; ValueOf.Ivalu := 32767;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
        New(lpN, IDENTNODE, TYPES);
        WITH lpN^ DO
          BEGIN
          Name := 'INTERACT'; IdType := InterPtr; Next := NIL;
          Class := TYPES;
          Node := IDENTNODE;
          END;
        EnterId(lpN);
      END; {InitStdNames}

    PROCEDURE DefFormArg(VAR Formal: pN; FormName: Alfa; ItsType: pT;
                         Kind: AccessKind; Offset: Integer);

      BEGIN {DefFormArg}
        New(Formal, IDENTNODE, VARS);
        WITH Formal^ DO
          BEGIN
          Name := FormName;
          Node := IDENTNODE; Class := VARS; Vkind := Kind;
          IdType := ItsType; IsSELF := False; InRegister := - 1;
          Vlev := 2; Voff := Offset; Next := NIL; UNIVflag := False;           {!4-14-84}
          END;
      END; {DefFormArg}

    PROCEDURE InitStdProcs;

      CONST
        MAXPROCS = 29;

      VAR
        N: ARRAY [1..MAXPROCS] OF Alfa;
        i: Integer;
        lpN: pN;

      BEGIN {InitStdProcs}                                                     {!}{[g=3]}
        N[01] := 'NEW     ';    N[02] := 'MARK    ';    N[03] := 'RELEASE ';
        N[04] := 'GET     ';    N[05] := 'PUT     ';    N[06] := 'RESET   ';
        N[07] := 'REWRITE ';    N[08] := 'READ    ';    N[09] := 'READLN  ';
        N[10] := 'WRITE   ';    N[11] := 'WRITELN ';    N[12] := 'PAGE    ';
        N[13] := 'PACK   *';    N[14] := 'UNPACK *';    N[15] := 'CLOSE   ';
        N[16] := 'DELETE  ';    N[17] := 'INSERT  ';    N[18] := 'UNITREAD';
        N[19] := 'UNITWRIT';    N[20] := 'SEEK    ';    N[21] := 'HALT    ';
        N[22] := 'MOVELEFT';    N[23] := 'MOVERIGH';    N[24] := 'FILLCHAR';
        N[25] := 'UNITCLEA';    N[26] := 'GOTOXY  ';    N[27] := 'DISPOSE*';
        N[28] := 'UNITSTAT';    N[29] := 'EXIT    ';                           {!}{[g=1]}

        FOR i := 1 TO MAXPROCS DO
          IF N[i][8] <> '*' THEN
            BEGIN
            New(lpN, IDENTNODE, PROC, STANDARD);
            WITH lpN^ DO
              BEGIN
              Name := N[i]; IdType := NIL; Next := NIL;
              Class := PROC; PFdeclKind := STANDARD; Key := i;
              Node := IDENTNODE;
              END;
            EnterId(lpN);
            IF i = 8 THEN ReadPtr := lpN;                            {!2-18-84}
            IF i = 10 THEN WritePtr := lpN;                          {!2-18-84}
            END;

        {
        PROCEDURE %_Class(ThisCl, SuperCl: Alfa;
                          VAR MasterP: LongInt;
                          EvenMethods, OddMethods, ClassSize: Integer);
        }
        New(KlassPtr, IDENTNODE, PROC, DECLARED);                              {!12-27-83}
        WITH KlassPtr^ DO
          BEGIN
          Name := '%_CLASS ';
          Node := IDENTNODE; Class := PROC;
          PFdeclKind := DECLARED; PFdecl := DECL;
          IdType := NIL; Next := NIL;
          PFlev := 1; RtnNo := - 1;
          ParmBytes := 26; Lc := 16;
          DefFormArg(PFargList, 'ThisCl  ', AlfaPtr, DRCT, - 8);
          DefFormArg(PFargList^.Next, 'SuperCl ', AlfaPtr, DRCT, - 16);
          DefFormArg(PFargList^.Next^.Next, 'MasterP ', LIntptr, INDRCT, 14);
          DefFormArg(PFargList^.Next^.Next^.Next, 'EvenMeth', IntPtr, DRCT, 12);
          DefFormArg(PFargList^.Next^.Next^.Next^.Next, 'OddMeth ', IntPtr, DRCT,
                     10);
          DefFormArg(PFargList^.Next^.Next^.Next^.Next^.Next, 'ClasSize', IntPtr,
                     DRCT, 8);
          END; {%_CLASS}
      END; {InitStdProcs}

    PROCEDURE InitStdFuncs;

      CONST
        MAXFUNCS = 36;

      VAR
        N: ARRAY [1..MAXFUNCS] OF Alfa;
        i: Integer;
        lpN: pN;

      BEGIN {InitStdFuncs}                                                     {!}{[g=3]}
        N[01] := 'ABS     ';    N[02] := 'ARCTAN  ';    N[03] := 'CHR     ';
        N[04] := 'COS     ';    N[05] := 'EOF     ';    N[06] := 'EOLN    ';
        N[07] := 'EXP     ';    N[08] := 'LN      ';    N[09] := 'ODD     ';
        N[10] := 'ORD     ';    N[11] := 'PRED    ';    N[12] := 'ROUND   ';
        N[13] := 'SIN     ';    N[14] := 'SQR     ';    N[15] := 'SQRT    ';
        N[16] := 'SUCC    ';    N[17] := 'TRUNC   ';    N[18] := 'POINTER ';
        N[19] := 'LENGTH  ';    N[20] := 'POS     ';    N[21] := 'CONCAT  ';
        N[22] := 'COPY    ';    N[23] := 'BLOCKREA';    N[24] := 'BLOCKWRI';
        N[25] := 'IORESULT';    N[26] := 'SIZEOF  ';    N[27] := 'PWROFTEN';
        N[28] := 'SCANEQ  ';    N[29] := 'SCANNE  ';    N[30] := 'UNITBUSY';
        N[31] := 'MEMAVAIL';    N[32] := 'ORD4    ';    N[33] := 'HEAPRESU';
        N[34] := 'KEYPRESS';    N[35] := 'THISCLAS';    N[36] := 'INCLASS ';   {!}{[g=1]}

        FOR i := 1 TO MAXFUNCS DO
          IF N[i][8] <> '*' THEN
            BEGIN
            New(lpN, IDENTNODE, FUNC, STANDARD);
            WITH lpN^ DO
              BEGIN
              Name := N[i]; IdType := NIL; Next := NIL;
              Class := FUNC; PFdeclKind := STANDARD; Key := i;
              Node := IDENTNODE;
              END;
            EnterId(lpN);
            END;
        {
        FUNCTION %_CkObCn(FromClass: LongInt; VAR ToClass: Alfa): LongInt;
        }
        New(CkObCnPtr, IDENTNODE, FUNC, DECLARED);                             {!12-27-83}
        WITH CkObCnPtr^ DO
          BEGIN
          Name := '%_CKOBCN';
          Node := IDENTNODE; Class := FUNC;
          PFdeclKind := DECLARED; PFdecl := DECL;
          IdType := LIntPtr; Next := NIL;
          PFlev := 1; RtnNo := - 1;
          ParmBytes := 16; Lc := 8;
          New(PFargList, IDENTNODE, VARS);
          DefFormArg(PFargList, 'FromClas', LIntPtr, DRCT, 12);
          DefFormArg(PFargList^.Next, 'ToClass ', AlfaPtr, DRCT, - 8);
          END; {%_CkObCn}
        {
        FUNCTION %_CkObCp(FromId: LongInt; VAR ToClass: LongInt): LongInt;
        }
        New(CkObCpPtr, IDENTNODE, FUNC, DECLARED);                             {!12-27-83}
        WITH CkObCpPtr^ DO
          BEGIN
          Name := '%_CKOBCP';
          Node := IDENTNODE; Class := FUNC;
          PFdeclKind := DECLARED; PFdecl := DECL;
          IdType := LIntPtr; Next := NIL;
          PFlev := 1; RtnNo := - 1;
          ParmBytes := 16; Lc := 0;
          DefFormArg(PFargList, 'FromId  ', LIntPtr, DRCT, 12);
          DefFormArg(PFargList^.Next, 'ToClass ', LIntPtr, INDRCT, 8);
          END; {%_CkObCp}
        {
        FUNCTION %_InObCn(Object: LongInt; VAR ClassName: Alfa): Boolean;
        }
        New(InObCnPtr, IDENTNODE, FUNC, DECLARED);                             {!01-07-84}
        WITH InObCnPtr^ DO
          BEGIN
          Name := '%_INOBCN';
          Node := IDENTNODE; Class := FUNC;
          PFdeclKind := DECLARED; PFdecl := DECL;
          IdType := BoolPtr; Next := NIL;
          PFlev := 1; RtnNo := - 1;
          ParmBytes := 16; Lc := 8;
          DefFormArg(PFargList, 'Object  ', LIntPtr, DRCT, 12);
          DefFormArg(PFargList^.Next, 'ClassNam', AlfaPtr, DRCT, - 8);
          END; {%_InObCn}
        {
        FUNCTION %_InObCp(Object: LongInt; VAR ClassName: LongInt): Boolean;
        }
        New(InObCpPtr, IDENTNODE, FUNC, DECLARED);                             {!12-27-83}
        WITH InObCpPtr^ DO
          BEGIN
          Name := '%_INOBCP';
          Node := IDENTNODE; Class := FUNC;
          PFdeclKind := DECLARED; PFdecl := DECL;
          IdType := BoolPtr; Next := NIL;
          PFlev := 1; RtnNo := - 1;
          ParmBytes := 16; Lc := 0;
          DefFormArg(PFargList, 'Object  ', LIntPtr, DRCT, 12);
          DefFormArg(PFargList^.Next, 'ClassNam', LIntPtr, INDRCT, 8);
          END; {%_InObCp}
      END; {InitStdFuncs}

    PROCEDURE InitUnDecl;

      BEGIN {InitUnDecl}
        New(uCstPtr, IDENTNODE, CONSTS);
        WITH uCstPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := CONSTS;
          Llink := NIL; Rlink := NIL; Next := NIL;
          ValueOf.Ivalu := 0;
          Node := IDENTNODE;
          END;
        New(uTypPtr, IDENTNODE, TYPES);
        WITH uTypPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := TYPES;
          Llink := NIL; Rlink := NIL; Next := NIL;
          Node := IDENTNODE;
          END;
        New(uVarPtr, IDENTNODE, VARS);
        WITH uVarPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := VARS;
          Llink := NIL; Rlink := NIL; Next := NIL;
          Vkind := DRCT; Vlev := 0; Voff := 0;
          Node := IDENTNODE; UNIVflag := False;                                {!4-14-84}
          END;
        New(uFldPtr, IDENTNODE, FIELD);
        WITH uFldPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := FIELD;
          Llink := NIL; Rlink := NIL; Next := NIL;
          PckdField := False; FOff := 0; BitOff := 0;
          Node := IDENTNODE;
          END;
        New(uPrcPtr, IDENTNODE, PROC);
        WITH uPrcPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := PROC;
          Llink := NIL; Rlink := NIL; Next := NIL; PFdeclKind := DECLARED;
          PFlev := 0; PFargList := NIL; PFdecl := DECL; Lc := 0;
          RtnNo := - 1;
          Node := IDENTNODE;
          END;
        New(uFctPtr, IDENTNODE, FUNC);
        WITH uFctPtr^ DO
          BEGIN
          Name := '        '; IdType := NIL; Class := FUNC;
          Llink := NIL; Rlink := NIL; Next := NIL; PFdeclKind := DECLARED;
          PFlev := 0; PFargList := NIL;  PFdecl := DECL; Lc := 0;
          RtnNo := - 1;
          Node := IDENTNODE;
          END;
      END; {InitUnDecl}

    PROCEDURE InitConditional;

      VAR
        tpN: pN;

      BEGIN {InitConditional}
        CondTos := 0;
        CondStack[CondTos] := NULL;
        ParsingOption := False;

        New(CondRoot);
        WITH CondRoot^ DO
          BEGIN
          Name := 'FALSE   ';
          ValueOf.Ivalu := 0;
          Llink := NIL;
          New(tpN);
          Rlink := tpN;
          WITH Rlink^ DO
            BEGIN
            Name := 'TRUE    ';
            ValueOf.Ivalu := 1;
            Llink := NIL; Rlink := NIL;
            END;
          END;
      END; {InitConditional}

    PROCEDURE ProcessOptions(VAR OptsLine: SUStr; VAR WhatUserTyped: PromptState);

      VAR
        Len: Integer;
        Ovflo: Boolean;

      BEGIN {ProcessOptions}
        Len := Length(OptsLine);
        IF Len > 2 THEN
          IF OptsLine[1] = '$' THEN
            CASE SUUpCh(OptsLine[2]) OF                                        {!}{[@=5]}
              'A': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {save regs}
                     SaveA2D3 := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END {save regs}
                   ELSE IF Len >= 5 THEN
                     BEGIN {ASM}
                     SUUpStr(@OptsLine);
                     IF Copy(OptsLine, 2, 3) = 'ASM' THEN
                       IF OptsLine[5] IN ['+', '-'] THEN
                         BEGIN
                         ShowAsmCode := OptsLine[5] = '+';
                         NewAsmStatus := ShowAsmCode;
                         AsmListOk := ShowAsmCode;
                         WhatUserTyped := SUInvalid;
                         END
                       ELSE IF Len >= 9 THEN
                         IF Copy(OptsLine, 5, 5) = ' ONLY' THEN
                           BEGIN
                           AsmOnly := True;
                           WhatUserTyped := SUInvalid;
                           END
                         ELSE IF Copy(OptsLine, 5, 5) = ' PROC' THEN
                           BEGIN
                           AsmProc := True;
                           WhatUserTyped := SUInvalid;
                           END;
                     END; {ASM}

              'C': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {code}
                     CodeFlag := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END; {code}

              'D': BEGIN {open debugging file}
                   OptsLine := Copy(OptsLine, 3, Len - 2);
                   SUTrimBlanks(@OptsLine);
                   SUAddExtension(@OptsLine, '.TEXT', SUMaxStrLeng, Dummy);
                   WriteLn('Opening debug file ', OptsLine);
                   Rewrite(Debugging, OptsLine);
                   DebugDebug := NOT IOError(IOResult, 'Can''t open debug file');
                   WhatUserTyped := SUInvalid;
                   END; {opening debugging file}

              'E': BEGIN {open error log file}
                   IF OptsLine[3] IN ['+', '-'] THEN
                     CallEditor := OptsLine[3] = '+'
                   ELSE
                     BEGIN
                     ErrFName := Copy(OptsLine, 3, Len - 2);
                     SUTrimBlanks(@ErrFName);
                     SUAddExtension(@ErrFName, '.TEXT', SUMaxStrLeng, Dummy);
                     WriteLn('Opening error file ', ErrFName);
                     SUAddExtension(@ErrFName, '.TEXT', SUMaxStrLeng, Ovflo);
                     Rewrite(ErrFile, ErrFName);
                     ErrFileOpen := NOT IOError(IOResult, 'Can''t open error file.');
                     END;
                   WhatUserTyped := SUInvalid;
                   END; {opening error log file}

              'G': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {Gen}
                     CallGen := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END; {Gen}

              'L': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {Listing}
                     ListingOk := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END; {Listing}

              'M': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {Mac}
                     MacFlag := OptsLine[3] = '+';
                     SaveA2D3 := MacFlag;
                     WhatUserTyped := SUInvalid;
                     END; {Mac}

              'O': BEGIN {OV and OPT}
                   SUUpStr(@OptsLine);
                   IF Len >= 4 THEN
                     IF Copy(OptsLine, 2, 2) = 'OV' THEN
                       IF OptsLine[4] IN ['+', '-'] THEN
                         BEGIN {OV}
                         OflowFlag := OptsLine[4] = '+';
                         WhatUserTyped := SUInvalid;
                         END; {OV}
                   IF WhatUserTyped <> SUInvalid THEN
                     IF Len >= 5 THEN
                       IF Copy(OptsLine, 2, 3) = 'OPT' THEN
                         IF OptsLine[5] IN ['+', '-'] THEN
                           BEGIN {OPT}
                           OptFlag := OptsLine[5] = '+'; OptLimFlag := True;
                           IF (Len >= 6) AND (OptsLine[6] IN ['+', '-']) THEN
                             OptLimFlag := OptsLine[6] = '-';
                           WhatUserTyped := SUInvalid;
                           END; {OPT}
                   END; {OV and OPT}

              'R': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {range}
                     RangeFlag := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END; {range}
               END; {case}
      END; {ProcessOptions}

    BEGIN {Initialize}
      Aborted := True;
      KCSDefaults;
      SUInit;
      InitIO;
      iPasDefs;

      PCInit;
      Dummy := PCClose(True, 'For Code Gen');
      Dummy := PCClose(True, 'For Editor');
      Ecmd := ' E'; Ecmd[1] := SUEsc;
      Gcmd := ' G'; Gcmd[1] := SUEsc;

      Trick.i := 0; Trick.c[0] := Chr(1); FlipBytes := Trick.i = 1;
      ErrFileOpen := False;
      MsgFileOpen := False;
      CodeOpened := False;
      DebugOpened := False;
      DebugDebug := False;                                                     {!DBG!}
      TotalLines := 1;
      Errors := 0; ErrIndex := 0; LastErrLn := -1; EofLn := -1;
      PrevLn := 0;
      Forwcount := 0;
      TopOfOpenFileStack := 0;
      New(SaveInbufP); {must precede first scan}
      New(ListingFCBP); New(ListingBufrP);
      ListOpen := False; Listing := False; NewListFile := False;
      ConsListing := False; ListingOk := True; AsmListOk := True;
      Pass2Listing := False; NewAsmStatus := False; ShowAsmCode := False;
      LastLine := 0;
      OptFlag := True; OptLimFlag := True;                                     {!01-31-84}
      RangeFlag := True;
      CodeFlag := True;
      OflowFlag := False;
      CallGen := False;{spring - make true}                                    {!03-06-84}
      CallEditor := False;                                                     {!03-06-84}
      AsmOnly := False; AsmProc := False; SaveA2D3 := False; MacFlag := False;

      {$ifc ForOs}
      GetTD(@DateStr);
      WriteLn(TITLE, VERSION, ' ':23, DateStr);
      {$elsec}
      GotoXY(0, 0);
      WriteLn(TITLE, VERSION, ' ': 9, DATE);
      {$endc}
      Copyrights;
      WriteLn;

      ILibWhatUserTyped := SUNone; {flag for default Intrinsic.Lib}

      REPEAT
        REPEAT
          Write('Input file - ');
          SUGetFN(@ObjName, WhatUserTyped, '', '', '.TEXT');
          SuTrimBlanks(@ObjName);
          IF WhatUserTyped IN [SUEscape, SUDefault, SUNone] THEN GOTO 999;
          IF WhatUserTyped = SUInvalid THEN Write('Bad file name');
          IF WhatUserTyped = SUOptions THEN
            REPEAT
              Write('Name for Intrinsic.Lib to use in this Compile: ');
              SUGetFN(@WhichFile, ILibWhatUserTyped, '', '', '');
              IF ILibWhatUserTyped = SUEscape THEN GOTO 999;
              IF NOT (ILibWhatUserTyped IN [SUValid, SUNone]) THEN KillExec;
            UNTIL ILibWhatUserTyped IN [SUValid, SUNone];
          IF NOT (WhatUserTyped IN [SUValid, SUOptions]) THEN KillExec;
          ProcessOptions(ObjName, WhatUserTyped);
        UNTIL WhatUserTyped = SUValid;
        IF NOT OpenNewFile(ObjName, SOURCE) THEN
          BEGIN
          Dummy := IOError(IOResult, 'Can''t open file');
          WhatUserTyped := SUInvalid;
          KillExec;
          END;
      UNTIL WhatUserTyped = SUValid;

      IF ILibWhatUserTyped = SUNone THEN
        BEGIN
        {$ifc foros}
        SUInitSysVols;
        WhichFile := Concat(SUOSBootV, '-INTRINSIC.LIB');
        {$elsec}
        WhichFile := '*INTRINSIC.LIB';
        {$endc}
        END;

      {$IFC IULIB}
      SearchLibrary := True; IULibIn := False;
      {$ENDC}

      FillInbuf;

      IF ListingOk THEN
        BEGIN
        REPEAT
          Write('List file - ');
          SUGetFN(@ListFName, WhatUserTyped, '', '', '.TEXT');
          IF WhatUserTyped = SUEscape THEN GOTO 999;
          IF WhatUserTyped = SUInvalid THEN
            BEGIN
            WriteLn('Bad file name');
            KillExec;
            END;
          IF WhatUserTyped = SUValid THEN
            IF NOT IOError(OpenF(ListFName, ListingFCBP, IOWrite, ListingBufrP),
                                 'Can''t open file') THEN
              BEGIN
              Listing := True; ListOpen := True;
              ConsListing := (ListingFCBP^.DevType = IOConsDev);
              NewListFile := (ListingFCBP^.DevType = IOBlkDev);
              END
            ELSE
              BEGIN
              WhatUserTyped := SUInvalid;
              KillExec;
              END;
        UNTIL WhatUserTyped IN [SUValid, SUNone, SUDefault];

        Pass2Listing := Listing AND NewListFile AND AsmListOk;
        END;

      SUSplitFN(@ObjName, @Vol, @Name, @Ext);
      SUMakeFN(@DefFName, @Vol, @Name, '', Dummy);

      REPEAT
        IF CallGen THEN
          BEGIN
          Write('Output file - ');
          SUGetFN(@ICodeName, WhatUserTyped, '', DefFName, '.OBJ');
          END
        ELSE
          BEGIN
          Write('I-code file - ');
          SUGetFN(@ICodeName, WhatUserTyped, '', DefFName, '.I');
          END;
        IF WhatUserTyped = SUEscape THEN GOTO 999;
        IF WhatUserTyped = SUInvalid THEN
          BEGIN
          WriteLn('Bad file name');
          KillExec;
          END;
        IF WhatUserTyped IN [SUValid, SUNone, SUDefault] THEN
          BEGIN
          IF CallGen THEN
            BEGIN
            SUSplitFN(@ICodeName, @Vol, @Name, @Ext);
            SUMakeFN(@ICodeName, @Vol, @Name, '.I', Dummy);
            ObjName := ICodeName; {code gen's .OBJ name will be the .I name}
            END;
          Rewrite(ICodeFile, ICodeName);
          IF NOT IOError(IOResult, 'Can''t open file') THEN
            CodeOpened := True
          ELSE
            BEGIN
            WhatUserTyped := SUInvalid;
            KillExec;
            END;
          END;
      UNTIL WhatUserTyped IN [SUValid, SUNone, SUDefault];

      WriteLn; {$I+}

      StartTimer;

      IF Listing THEN
        BEGIN
        {$ifc ForOs}
        PutStrS(ListingFCBP, Concat(TITLE, VERSION), 0);
        PutStrS(ListingFCBP, ' ', 79 - Length(TITLE) - Length(VERSION) - Length(DateStr));
        PutLineP(ListingFCBP, @DateStr);
        {$elsec}
        PutLineS(ListingFCBP, Concat(TITLE, ' ', VERSION, ' ', DATE));
        {$endc}
        PutcF(ListingFCBP, IONewline);
        END;

      Level := 0;
      Top := 0;
      WITH Display[0] DO
        BEGIN
        NameTree := NIL; Occur := BLK;
        Labels := NIL; RootLink := NIL;
        Mark(ProcBase);                                                        {!DBG!}
        END;

      InitScanner;
      {InitSets;}
      InitStdTypes;
      InitStdNames;
      InitStdProcs;
      InitStdFuncs;
      InitUnDecl;

      Level := 1; Top := 1;
      Mark(Display[1].ProcBase);                                               {!DBG!}

      PrintErrors := True;
      IOFlag := True;
      DbugFlag := True;
      StkXFlag := True;
      ForwChkFlag := True;
      RodFlag := False;
      ByteNo := 0; BlockNo := 0;
      LocProcNo := 1;
      DbgIdx := 0;
      DbgBlkNum := 0;                                                          {!DBG!}
      NumUnits := 1;                                                           {!DBG!}
      UnitList := NIL;
      InUnit := False;
      InterFlag := False;
      InIU := False;
      InClassDecl := False;                                                    {!C}
      InUses := False;                                                         {!C}
      HandleCheck := True;                                                     {!C}
      NextCrNbr := 0;                                                          {!C 12-27-83}
      ClassesToInit := False; UnitsToInit := False;                            {!12-20-83}
      CurrClass := ''; ThisClass := NIL;                                       {!01-09-84}
      UFname := '*SYSLIB.OBJ'; SegName := '        '; ProgName := '        ';
      SwapFlag := False;
      Using := False;
      Left := '-'; Right := '-'; ProcLev := ' '; NestLev := -1;
      Blanks[0] := Chr(80);
      FOR i := 1 TO 80 DO Blanks[i] := ' ';
      InitConditional;
      Aborted := False;
    END; {Initialize}

