  (*$p**************************************************************************)
  (*                                                                           *)
  (*                          File: CODE.5.TEXT                                *)
  (*                                                                           *)
  (*              (C) Copyright 1981 Silicon Valley Software, Inc.             *)
  (*                            1983, 1984 Apple Computer, Inc.                *)
  (*                                                                           *)
  (*                            All rights reserved.               20-Jul-82   *)
  (*                                                                           *)
  (*  6-28-83 Initialize: call copyrights procedure                            *)
  (*  9-23-83 Genproc: save-restore of A2,D3 when used                         *)
  (* 12-27-83 OutProcInfo, GenProc: kluge for Create                           *)
  (*  1-14-84 New functions FindSet and FindStr for literal compaction         *)
  (*  3-06-84 Initialize: prog communication with the Compiler                 *)
  (*****************************************************************************)
  {[j=0/0/80!,@=6,i=1]}
  {$S }

  PROCEDURE GenProc;

    VAR
      LcPatchWord, LcPatchLoc, ParamBytes, i, j, k, Count, HalfValu, FinalLoc,
      SaveIc, MoveMMark, EndMovemMark, Pos, UsedLoc, SetWords, DisLbl, Dest,
      PrevLblRef, PrevLblDef: Integer;
      SaveLNum, MOVEMLNum: LongInt;
      Father, LinkName, SegName: Alfa8;
      lInt: pIntList;
      lString: pStrCRec;
      lpULab: pUserLabel;
      lpILab: pLabelRec;
      Base: Register;
      HeapMark: ^Boolean;
      StackExpansion: Boolean;
      BigCStart, SetP, StrP: pBigCRef;                                         {!01-14-84}
      Ch: Char;
      SLinkName, SUserPNam: String[ALFALEN];
      Line: Str80;

    PROCEDURE RefLbl(Index, DestIndex: Integer; Fwd: Boolean);

      BEGIN {RefLbl}
        IF Fwd THEN WHILE Tags[DestIndex] = NOPI DO DestIndex := DestIndex + 1;
        IF pLblDef^[DestIndex] = 0 THEN
          BEGIN
          DisLbl := DisLbl + 1;
          pLblRef^[Index] := DisLbl;
          pLblDef^[DestIndex] := DisLbl;
          END
        ELSE
          pLblRef^[Index] := pLblDef^[DestIndex];
      END; {RefLbl}

    PROCEDURE FindShortJumps;

      VAR
        Pass, NumShortened, Index, MaxIndex, lDelta, Loc, Dest, Diff, i: Integer;
        ElimFlag: Boolean;

      BEGIN {FindShortJumps}
        IF ShowAsmCode THEN
          FOR i := 0 TO (Ic DIV 2) - 1 DO
            BEGIN
            Delta[i] := 0;
            pLblRef^[i] := 0; pLblDef^[i] := 0;
            END
        ELSE
          FOR i := 0 TO (Ic DIV 2) - 1 DO Delta[i] := 0;

        Pass := 0;
        REPEAT
          NumShortened := 0; Pass := Pass + 1;

          { Determine if any jumps can be shortened based on current deltas }

          Index := 0; MaxIndex := Ic DIV 2; ElimFlag := False;
          WHILE Index < MaxIndex DO
            BEGIN
            CASE Tags[Index] OF
              ABSI, NOPI, CASJ:
                    Index := Index + 1;
              JMPS: BEGIN
                    Loc := Index * 2 + 2 - Delta[Index];
                    Dest := CodeBuff[Index + 1];
                    Dest := Dest - Delta[Dest DIV 2];
                    Diff := Dest - Loc;
                    IF Diff = 0 THEN
                      BEGIN
                      NumShortened := NumShortened + 1;
                      Tags[Index] := NOPI;
                      ElimFlag := True;
                      END;
                    Index := Index + 2;
                    END;
              JMPL: BEGIN
                    Loc := Index * 2 + 2 - Delta[Index];
                    Dest := CodeBuff[Index + 1];
                    Dest := Dest - Delta[Dest DIV 2];
                    Diff := Dest - Loc;
                    IF (Diff <= 128) AND (Diff >= - 128) THEN
                      IF Diff <> 2 THEN
                        BEGIN
                        NumShortened := NumShortened + 1;
                        Tags[Index] := JMPS;
                        Tags[Index + 1] := NOPI;
                        END
                      ELSE
                        BEGIN
                        NumShortened := NumShortened + 2;
                        Tags[Index] := NOPI;
                        Tags[Index + 1] := NOPI;
                        ElimFlag := True;
                        END;
                    Index := Index + 2;
                    END;
            END; {case}
            END;

          { Update delta values }

          lDelta := 0;
          FOR Index := 0 TO MaxIndex - 1 DO
            BEGIN
            Delta[Index] := lDelta;
            IF Tags[Index] = NOPI THEN lDelta := lDelta + 2;
            END;

          IF Pass <= 5 THEN
            ShortJumps[Pass] := ShortJumps[Pass] + NumShortened
          ELSE
            ShortJumps[5] := ShortJumps[5] + NumShortened;
        UNTIL ((NumShortened = 0) OR (Pass >= 5)) AND NOT ElimFlag;
      END; {FindShortJumps}

    PROCEDURE SqueezeBuffer;

      VAR
        SourceLoc, TargetLoc, MaxSourceLoc, JmpDelta, JmpDest, JmpDest1, DestLoc,
        TableLoc, CurrLoc, T: Integer;

      BEGIN
        MaxSourceLoc := Ic DIV 2;
        SourceLoc := 0; TargetLoc := 0;
        WHILE SourceLoc < MaxSourceLoc DO
          CASE Tags[SourceLoc] OF
            ABSI: BEGIN
                  CodeBuff[TargetLoc] := CodeBuff[SourceLoc];
                  pLineNumber^[TargetLoc] := pLineNumber^[SourceLoc];
                  IF ShowAsmCode THEN
                    BEGIN
                    pLblRef^[TargetLoc] := pLblRef^[SourceLoc];
                    pLblDef^[TargetLoc] := pLblDef^[SourceLoc];
                    END;
                  TargetLoc := TargetLoc + 1;
                  SourceLoc := SourceLoc + 1;
                  END;
            JMPS: BEGIN
                  JmpDest := CodeBuff[SourceLoc + 1];
                  CurrLoc := 2 * SourceLoc;
                  JmpDest1 := JmpDest - Delta[JmpDest DIV 2];
                  pLineNumber^[TargetLoc] := pLineNumber^[SourceLoc];
                  IF ShowAsmCode THEN
                    BEGIN
                    IF JmpDest < CurrLoc THEN
                      RefLbl(SourceLoc, JmpDest1 DIV 2, False)
                    ELSE
                      RefLbl(SourceLoc, JmpDest DIV 2, True);
                    pLblRef^[TargetLoc] := pLblRef^[SourceLoc];
                    pLblDef^[TargetLoc] := pLblDef^[SourceLoc];
                    END;
                  JmpDelta := JmpDest1 - (CurrLoc + 2 - Delta[SourceLoc]);
                  IF JmpDelta < 0 THEN JmpDelta := JmpDelta + 256; {forces 1 byte}
                  CodeBuff[TargetLoc] := CodeBuff[SourceLoc] + JmpDelta;
                  TargetLoc := TargetLoc + 1;
                  SourceLoc := SourceLoc + 2;
                  END;
            JMPL: BEGIN
                  JmpDest := CodeBuff[SourceLoc + 1];
                  CurrLoc := 2 * SourceLoc;
                  JmpDest1 := JmpDest - Delta[JmpDest DIV 2];
                  pLineNumber^[TargetLoc] := pLineNumber^[SourceLoc];
                  T := TargetLoc + 1;
                  pLineNumber^[T] := pLineNumber^[SourceLoc];
                  IF ShowAsmCode THEN
                    BEGIN
                    IF JmpDest < CurrLoc THEN
                      RefLbl(SourceLoc, JmpDest1 DIV 2, False)
                    ELSE
                      RefLbl(SourceLoc, JmpDest DIV 2, True);
                    pLblRef^[TargetLoc] := pLblRef^[SourceLoc];
                    pLblDef^[TargetLoc] := pLblDef^[SourceLoc];
                    pLblRef^[T] := pLblRef^[SourceLoc];
                    pLblDef^[T] := pLblDef^[SourceLoc];
                    END;
                  JmpDelta := JmpDest1 - (CurrLoc + 2 - Delta[SourceLoc]);
                  CodeBuff[TargetLoc] := CodeBuff[SourceLoc];
                  CodeBuff[T] := JmpDelta;
                  TargetLoc := TargetLoc + 2;
                  SourceLoc := SourceLoc + 2;
                  END;
            NOPI: SourceLoc := SourceLoc + 1;
            CASJ: BEGIN
                  TableLoc := TargetLoc * 2 - 2;
                  REPEAT
                    JmpDest := CodeBuff[SourceLoc];
                    pLineNumber^[TargetLoc] := pLineNumber^[SourceLoc];
                    IF ShowAsmCode THEN
                      BEGIN
                      RefLbl(SourceLoc, JmpDest DIV 2, True);
                      pLblRef^[SourceLoc] := - pLblRef^[SourceLoc]; {- ==> case lbl}
                      pLblRef^[TargetLoc] := pLblRef^[SourceLoc];
                      pLblDef^[TargetLoc] := pLblDef^[SourceLoc];
                      END;
                    JmpDelta := (JmpDest - Delta[JmpDest DIV 2]) - TableLoc;
                    CodeBuff[TargetLoc] := JmpDelta;
                    TargetLoc := TargetLoc + 1;
                    SourceLoc := SourceLoc + 1;
                  UNTIL Tags[SourceLoc] <> CASJ;
                  END;
          END; {case, while}
        Ic := TargetLoc * 2;
        LastCode := TargetLoc;
      END; {squeezebuffer}

    PROCEDURE FormatCode;

      VAR
        i: Integer;
        lName: Alfa8;
        lInt: pIntList;
        lpULab: pUserLabel;
        lpILab: pLabelRec;
        OV: ObjVarBlock;

      PROCEDURE OutComTree(fCom: pCommonRec);

        VAR
          i, Count: Integer;
          lInt: pIntList;

        BEGIN
          IF fCom <> NIL THEN
            WITH fCom^ DO
              BEGIN
              OutComTree(Left); OutComTree(Right);
              Count := 0; lInt := RefList;
              WHILE lInt <> NIL DO
                BEGIN
                Count := Count + 1; lInt := lInt^.Next;
                END;

              { Common Block Reference }

              SetObjInvar(OutBlock, CommonReloc, Count * SizeOf(iRefVariant));
              OutBlock.bCommonReloc.CommonName := Name;
              PutObjInvar(OutFile, OutBlock);
              lInt := RefList;
              WHILE lInt <> NIL DO
                BEGIN
                WITH lInt^ DO PutObjLong(OutFile, Int - Delta[Int DIV 2]);
                lInt := lInt^.Next;
                END;
              END;
        END; {outcomtree}

      BEGIN {formatcode}
        SetObjInvar(OutBlock, ModuleName, 0);
        WITH OutBlock.bModuleName DO
          BEGIN
          ModuleName := UserPNam;
          SegmentName := SegName; CSize := 0;
          END;
        PutObjInvar(OutFile, OutBlock);

        IF ProcLvl = 1 THEN
          BEGIN
          SetObjInvar(OutBlock, StartAddress, 0);
          WITH OutBlock.bStartAddress DO
            BEGIN
            Start := 0; GSize := Lc;
            END;
          PutObjInvar(OutFile, OutBlock);
          END;

        SetObjInvar(OutBlock, EntryPoint, 0);
        OutBlock.bEntryPoint.LinkName := LinkName;
        OutBlock.bEntryPoint.UserName := UserPNam;
        OutBlock.bEntryPoint.Loc := 0;
        PutObjInvar(OutFile, OutBlock);

        lpULab := ULabelList;
        WHILE lpULab <> NIL DO
          BEGIN
          WITH lpULab^ DO
            IF LinkerNo >= 0 THEN
              BEGIN
              lpILab := LookUpILabel(IntNo); MakeLName(LinkerNo, lName);

              SetObjInvar(OutBlock, EntryPoint, 0);
              OutBlock.bEntryPoint.LinkName := lName;
              lName := 'Label***';
              OutBlock.bEntryPoint.UserName := lName;
              OutBlock.bEntryPoint.Loc := lpILab^.Loc - Delta[lpILab^.Loc DIV 2];
              PutObjInvar(OutFile, OutBlock);
              END;
          lpULab := lpULab^.Next;
          END;

        SavedPL := ProcList;
        WHILE ProcList <> NIL DO
          WITH ProcList^ DO
            BEGIN
            lInt := RefList; i := 0;
            WHILE lInt <> NIL DO
              BEGIN
              i := i + 1; lInt := lInt^.Next;
              END;
            IF ShortCalls THEN
              BEGIN
              SetObjInvar(OutBlock, ShortExternal, i * SizeOf(iShortRef));
              OutBlock.bShortExternal.LinkName := LinkName;
              OutBlock.bShortExternal.UserName := UserName;
              PutObjInvar(OutFile, OutBlock);
              OV.VarHeader := ShortRef; lInt := RefList;
              WHILE lInt <> NIL DO
                BEGIN
                OV.bShortRef := lInt^.Int - Delta[lInt^.Int DIV 2];
                PutObjVar(OutFile, ShortRef, OV);
                lInt := lInt^.Next;
                END;
              END {if}
            ELSE
              BEGIN
              SetObjInvar(OutBlock, EXTERNAL, i * SizeOf(iRefVariant));
              OutBlock.bExternal.LinkName := LinkName;
              OutBlock.bExternal.UserName := UserName;
              PutObjInvar(OutFile, OutBlock);
              OV.VarHeader := RefVariant; lInt := RefList;
              WHILE lInt <> NIL DO
                BEGIN
                OV.bRefVariant := lInt^.Int - Delta[lInt^.Int DIV 2];
                PutObjVar(OutFile, RefVariant, OV);
                lInt := lInt^.Next;
                END;
              END; {else}
            ProcList := Next;
            END;

        { Common Variable References }

        OutComTree(CommonTree);

        SetObjInvar(OutBlock, CodeBlock, Ic);
        OutBlock.bCodeBlock.ADDR := 0;
        PutObjInvar(OutFile, OutBlock);
        PutObjSeq(OutFile, Pointer(Ord(@CodeBuff)), Ic);

        SetObjInvar(OutBlock, EndBlock, 0);
        OutBlock.bEndBlock.CSize := Ic;
        PutObjInvar(OutFile, OutBlock);
      END; {formatcode}

                                                                               {!C}

    PROCEDURE OutProcInfo;

      VAR
        i: Integer;
        TempName: Alfa8;                                                       {!12-27-83}
        j: RECORD
             CASE Integer OF
               0:
                 (i: Integer);
               1:
                 (HI: - 128..127;
                  Lo: - 128..127)
           END;

      BEGIN
        TempName := UserPNam;                                                  {!12-27-83}
        IF Father <> '        ' THEN                                           {!12-27-83}
          IF Father = UserPNam THEN                                            {!12-27-83}
            TempName := 'CREATE  '; {special kluge for CREATE}                 {!12-27-83}

        FOR i := 1 TO ALFALEN DO
          IF Odd(i) THEN
            BEGIN
            IF i = 1 THEN
              j.HI := Ord(TempName[1]) + 128                                   {!12-27-83}
            ELSE
              j.HI := Ord(TempName[i]);                                        {!12-27-83}
            END
          ELSE
            BEGIN
            IF (i = 2) AND (Father <> '        ') THEN
              j.Lo := Ord(TempName[i]) + 128                                   {!12-27-83}
            ELSE
              j.Lo := Ord(TempName[i]);                                        {!12-27-83}
            Gen(j.i);
            IF ShowAsmCode THEN
              BEGIN
              pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
              END;
            END;
        IF Father <> '        ' THEN
          FOR i := 1 TO ALFALEN DO
            IF Odd(i) THEN
              j.HI := Ord(Father[i])
            ELSE
              BEGIN
              j.Lo := Ord(Father[i]);
              Gen(j.i);
              IF ShowAsmCode THEN
                BEGIN
                pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
                END;
              END;
        CaPatchLoc := Ic;
        Gen(0); { size of constant area }
        IF ShowAsmCode THEN
          BEGIN
          pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
          END;
      END; {outprocinfo}
                                                                               {!C}

    PROCEDURE GenStkExpansionCode;

      CONST
        DynStk = 4096;

      TYPE
        Cheat = RECORD
                  CASE Boolean OF
                    True:
                      (i: ARRAY [0..1] OF Integer);
                    False:
                      (l: LongInt);
                END;

      VAR
        X: Cheat;

      BEGIN
        IF Lc < 0 THEN
          CodError(2012)
        ELSE
          BEGIN
          IF Lc + DynStk < 0 THEN
            BEGIN
            X.l := Ord4(Lc) + DynStk;
            Gen($204F); { MOVE.L A7,A0 }
            Gen($91FC); Gen(X.i[0]); Gen(X.i[1]); { SUB.L #s,(A0) }
            Gen($4A50); { TST.W (A0) }
            END
          ELSE
            BEGIN
            Gen($4A6F); Gen( - Lc - DynStk); { TST.W -s(A7) }
            END;
          END;
      END; {genstkexpansioncode}

    PROCEDURE FindSet(VAR SetP: pBigCRef; VAR Pos: Integer);                   {!01-14-84}

      VAR
        PosInMax, MaxLen: Integer;
        PoolSetP, MaxP: pBigCRef;

      FUNCTION IsSubset(NewSetP, PoolSetP: pBigCRef; VAR Pos: Integer): Boolean;

        VAR
          PoolP, NewP, tPoolP, tNewP: pIntList;
          PoolLen, NewLen, Limit: Integer;
          tPos, tLimit: Integer;
          FirstByte: Integer;
          PoolHalf, NewHalf, tPoolHalf, tNewHalf: Boolean;
          Found, Matched: Boolean;

        FUNCTION NextSetByte(VAR Half: Boolean; VAR p: pIntList): Integer;

          BEGIN {NextSetByte - get next byte in a set constant at P. P^ is
                 controlled by this routine to point at the current IntList of 2
                 bytes. The value of half is the current integer half within the
                 group of 2 bytes that P points to.}
            IF Half THEN
              BEGIN
              Half := False;
              NextSetByte := p^.Int MOD 256;
              p := p^.Next;
              END
            ELSE
              BEGIN
              Half := True;
              NextSetByte := p^.Int DIV 256;
              END;
          END; {NextSetByte}

        BEGIN {IsSubset - check to see if the new set at NewSetP^ is equal to the
               set in the literal pool at PoolSetP^.}
          IsSubset := False;

          IF PoolSetP^.BigVal.CstKind = SETCNST THEN
            IF NewSetP^.BigVal.SetBytes <= PoolSetP^.BigVal.SetBytes THEN
              BEGIN {match sets - we can use a subset of a pool set if it matches
                     the following criteria: }
                    {  1. The subset starts on a word boundary, i.e., its
                          position in the IntList structure is odd, and,
                       2. The target (new) set must have an even number of
                          bytes so that the end of the subset will fill up
                          whole words, or,
                       3. If the new set has an odd number of characters, n,
                          then it can still match a subset of the pool set, if
                          and only if the subset is represented by the last n
                          characters of the pool set. }
              PoolP := PoolSetP^.BigVal.SetValu; PoolHalf := False;
              NewP := NewSetP^.BigVal.SetValu; NewHalf := False;
              PoolLen := PoolSetP^.BigVal.SetBytes;
              NewLen := NewSetP^.BigVal.SetBytes;
              Limit := PoolLen - NewLen + 1;
              Pos := 1; FirstByte := NextSetByte(NewHalf, NewP);
              Found := False;

              WHILE (Pos <= Limit) AND NOT Found DO
                IF (FirstByte <> NextSetByte(PoolHalf, PoolP)) OR NOT Odd(Pos) THEN
                  Pos := Pos + 1 {follows criteria 1}
                ELSE
                  BEGIN {found a possible subset, check it out}
                  tLimit := Pos + NewLen; tPos := Pos + 1;
                  tPoolP := PoolP; tPoolHalf := PoolHalf;
                  tNewP := NewP; tNewHalf := NewHalf;
                  Matched := True;

                  WHILE (tPos < tLimit) AND Matched DO
                    IF NextSetByte(tPoolHalf, tPoolP) <> NextSetByte(tNewHalf, tNewP) THEN
                      Matched := False
                    ELSE
                      tPos := tPos + 1;

                  IF NOT Matched THEN
                    Pos := Pos + 1
                  ELSE IF NOT Odd(NewLen) THEN
                    Found := True {criteria 2}
                  ELSE IF Pos < Limit THEN
                    Pos := Pos + 1
                  ELSE {Pos = Limit}
                    Found := True; {criteria 3}
                  END; {looking at a possible subset}

              IsSubset := Found;
              END;
        END; {IsSubset}

      BEGIN {FindSet - search the entire literal pool for the desired set at
             SetP^. If one is found, use it instead of the original. When
             searching the literal pool, return the largest set that contains the
             desired set.}
        PoolSetP := BigCStart;
        MaxP := NIL; MaxLen := 0;

        WHILE PoolSetP <> NIL DO
          BEGIN
          IF PoolSetP <> SetP THEN
            IF IsSubset(SetP, PoolSetP, Pos) THEN
              IF PoolSetP^.BigVal.SetBytes > MaxLen THEN
                BEGIN
                MaxLen := PoolSetP^.BigVal.SetBytes;
                MaxP := PoolSetP;
                PosInMax := Pos;
                END;

          PoolSetP := PoolSetP^.Next;
          END;

        IF MaxP = NIL THEN
          Pos := 1 {use original set as-is}
        ELSE
          BEGIN {use largest set containing SetP^}
          SetP := MaxP;
          Pos := PosInMax;
          END;
      END; {FindSet}                                                           {!01-14-84}

    FUNCTION NextStrCh(VAR j: Integer; VAR p: pStrCRec): Char;                 {!01-14-84}

      BEGIN {NextStrCh - get next char in a string constant at P. P^ is controlled
             by this routine to point at the current StrCRec of 8 characters. The
             value of j is the current character within the group of 8 characters
             that P points to.}
        j := j + 1;
        IF j > 8 THEN
          BEGIN
          j := 1; p := p^.Next;
          END;
        NextStrCh := p^.StrVal[j];
      END; {NextStrCh}                                                         {!01-14-84}

    PROCEDURE FindStr(VAR StrP: pBigCRef; VAR Pos: Integer);                   {!01-14-84}

      VAR
        PosInMax, MaxLen: Integer;
        PoolStrP, MaxP: pBigCRef;

      FUNCTION IsSubstr(NewStrP, PoolStrP: pBigCRef; VAR Pos: Integer): Boolean;

        VAR
          PoolP, NewP, tPoolP, tNewP: pStrCRec;
          PoolJ, NewJ, PoolLen, NewLen, Limit, tLimit: Integer;
          tPos, tPoolJ, tNewJ: Integer;
          FirstCh: Char;
          Found, Matched: Boolean;

        BEGIN {IsSubstr - check to see if the new string at NewStrP^ is a substr
               or equal to the string in the literal pool at PoolStrP^. A
               candidate at in the literal pool of strings at PoolStrP^ must have
               the same type as the new string (STRCNST, PAOCCNST). For STRCNST
               the lengths must be equal. For PAOCCNST the length of the new
               string at NewStrP^ can be less then or equal to the string at
               NewStrP^ and can be found at position Pos in the pool string.}
          IsSubstr := False;

          IF NewStrP^.BigVal.CstKind = STRCNST THEN
            BEGIN
            IF PoolStrP^.BigVal.CstKind = STRCNST THEN
              IF NewStrP^.BigVal.Len = PoolStrP^.BigVal.Len THEN
                BEGIN {match STRCNST's - both strings must be exactly equal}
                Matched := True;
                PoolP := PoolStrP^.BigVal.StrValu;
                NewP := NewStrP^.BigVal.StrValu;

                WHILE (PoolP <> NIL) AND (NewP <> NIL) AND Matched DO
                  IF PoolP^.StrVal <> NewP^.StrVal THEN
                    Matched := False
                  ELSE
                    BEGIN
                    PoolP := PoolP^.Next; NewP := NewP^.Next;
                    END;

                IF Matched THEN
                  IF PoolP = NIL THEN
                    IF NewP = NIL THEN
                      BEGIN
                      IsSubstr := True;
                      Pos := 1;
                      END;
                END; {matching STRCNST's}
            END
          ELSE IF PoolStrP^.BigVal.CstKind = PAOCCNST THEN
            IF NewStrP^.BigVal.Len <= PoolStrP^.BigVal.Len THEN
              BEGIN {match PAOCCNST's - we can use a substring of a pool string if
                     it matches the following criteria: }
                    {  1. The substring starts on a word boundary, i.e., its
                          position in the StrCRec structure is odd, and,
                       2. The target (new) string must have an even number of
                          characters so that the end of the subset will fill up
                          whole words, or,
                       3. If the new string has an odd number of characters, n,
                          then it can still match a substring of the pool string,
                          if and only if the subset is represented by the last n
                          characters of the pool string. }
              PoolP := PoolStrP^.BigVal.StrValu; PoolJ := 0;
              NewP := NewStrP^.BigVal.StrValu; NewJ := 0;
              PoolLen := PoolStrP^.BigVal.Len;
              NewLen := NewStrP^.BigVal.Len;
              Limit := PoolLen - NewLen + 1;
              Pos := 1; FirstCh := NextStrCh(NewJ, NewP);
              Found := False;

              WHILE (Pos <= Limit) AND NOT Found DO
                IF (FirstCh <> NextStrCh(PoolJ, PoolP)) OR NOT Odd(Pos) THEN
                  Pos := Pos + 1 {follows criteria 1}
                ELSE
                  BEGIN {found a possible substring, check it out}
                  tLimit := Pos + NewLen; tPos := Pos + 1;
                  tPoolP := PoolP; tPoolJ := PoolJ;
                  tNewP := NewP; tNewJ := NewJ;
                  Matched := True;

                  WHILE (tPos < tLimit) AND Matched DO
                    IF NextStrCh(tPoolJ, tPoolP) <> NextStrCh(tNewJ, tNewP) THEN
                      Matched := False
                    ELSE
                      tPos := tPos + 1;

                  IF NOT Matched THEN
                    Pos := Pos + 1
                  ELSE IF NOT Odd(NewLen) THEN
                    Found := True {criteria 2}
                  ELSE IF Pos < Limit THEN
                    Pos := Pos + 1
                  ELSE {Pos = Limit}
                    Found := True; {criteria 3}
                  END; {looking at a possible substring}

              IsSubstr := Found;
              END; {matching PAOCCNST's}
        END; {IsSubstr}

      BEGIN {FindStr - search the entire literal pool for the desired string at
             StrP^. If one is found, use it instead of the original. For
             PAOCCNST's, when searching the literal pool, return the largest
             string that contains the desired string.}
        PoolStrP := BigCStart;
        MaxP := NIL; MaxLen := 0;

        WHILE PoolStrP <> NIL DO
          BEGIN
          IF PoolStrP <> StrP THEN
            IF IsSubstr(StrP, PoolStrP, Pos) THEN
              IF StrP^.BigVal.CstKind = STRCNST THEN
                BEGIN
                StrP := PoolStrP;
                Exit(FindStr);
                END
              ELSE IF PoolStrP^.BigVal.Len > MaxLen THEN
                BEGIN
                MaxLen := PoolStrP^.BigVal.Len;
                MaxP := PoolStrP;
                PosInMax := Pos;
                END;

          PoolStrP := PoolStrP^.Next;
          END;

        IF MaxP = NIL THEN
          Pos := 1 {use original string as-is}
        ELSE
          BEGIN {use largest string containing StrP^}
          StrP := MaxP;
          Pos := PosInMax;
          END;
      END; {FindStr}                                                           {!01-14-84}

    BEGIN {genproc}
      FirstLNum := 0;

      SLinkName[0] := Chr(ALFALEN);
      FOR i := 1 TO ALFALEN DO
        BEGIN
        Ch := Chr(NextByte);
        LinkName[i] := Ch; SLinkName[i] := Ch;
        END;
      SUserPNam[0] := Chr(ALFALEN);
      FOR i := 1 TO ALFALEN DO
        BEGIN
        Ch := Chr(NextByte);
        UserPNam[i] := Ch; SUserPNam[i] := Ch;
        END;
                                                                               {!C}
      FOR i := 1 TO ALFALEN DO Father[i] := Chr(NextByte);
      FOR i := 1 TO ALFALEN DO
        BEGIN
        Ch := Chr(NextByte); SegName[i] := Ch; CurrSeg[i] := Ch;
        END;

      Funct := (NextByte = 1);
      ProcLvl := NextByte;
      Lc := NextWord;
      ParamBytes := NextWord;
      i := NextByte;
      GlobalLabels := Odd(i);
      IF MacFlag THEN
        StackExpansion := False
      ELSE
        StackExpansion := Odd(i DIV 2);
      i := NextWord; { mask of registers used }
      RegMask.iMask := i;
      Ic := 0;
      ClearRegs;
      FOR i := D0 TO SP DO IF i IN RegMask.sMask THEN Reg[i].Count := 1;

      IF SaveA2D3 THEN
        BEGIN {With this condition, the compiler will obey assembly-language rules
               for saving and restoring registers, ie. D3-D7 and A2-A7 are
               preserved across the proc call. The compiler has calculated the
               non-temporary regs to save, leaving A2 and D3 to save if used.
               This code needed whenever assembly language calls Pascal using the
               'strict' rules (possible live values in A2 and D3 during call).
               Here, save temporary regs, but free them for use in body. If not
               used, will patch up the saveregs after code generated. (Currently
               needed for Macintosh, which calls Pascal from ROM)}
        RegMask.sMask := RegMask.sMask + [D3, A2];
        Reg[A2].Count := 1;
        Reg[D3].Count := 1;
        A2Used := False;
        D3Used := False;
        END;

      HaveExtTmp := False;
      HaveRealTmp := False;
      HaveDblTmp := False;
      DisLbl := 0;
      ProcList := NIL;
      BigCList := NIL;
      LabelTree := NIL;
      ULabelList := NIL;
      CommonTree := NIL;
      WithLevel := 0;
      FCAllLevel := 0;
      NextLabel := 0;
      Mark(HeapMark);

      IF ProcLvl = 1 THEN
        BEGIN
        GenJSR('%_BEGIN ');
        Gen($4E56); Gen(0); { TST.W -s(A7) }
        Gen($2C5F); { MOVE.L (A7)+,A6 }
        IF Lc < 0 THEN CodError(2011);
        Gen($4E55); { LINK #-lc,A5 }
        LcPatchLoc := Ic; Gen( - Lc);
        Gen($9FED); Gen(16); { SUBA.L 16(A5),A7 }
        GenJSR('%_INIT  ');
        IF GlobalLabels THEN
          BEGIN
          GetTemp(SaveSpCAttr, 4);
          Gen($2B4F); Gen(SaveSpCAttr.VOffset); { MOVE.L SP,savesp(A5) }
          GetTemp(SaveA6CAttr, 4);
          Gen($2B4E); Gen(SaveA6CAttr.VOffset); { MOVE.L A6,saveA6(A5) }
          END;
        END
      ELSE
        BEGIN
        IF StackExpansion THEN GenStkExpansionCode;
        Gen($4E56); LcPatchLoc := Ic; Gen( - Lc); { LINK #-lc,A6 }
        IF (RegMask.sMask <> []) OR GlobalLabels THEN { Globally Alloc'ed Regs}
          BEGIN
          IF GlobalLabels THEN
            BEGIN {all reg's saved - none used in this procedure, this is just to
                   deal with the global labels }
            FOR i := D1st TO Dnth DO Reg[i].Count := 1;
            FOR i := A1st TO Anth DO Reg[i].Count := 1;
            END;

          { reg's saved at entry,restored at exit }

          MoveMMark := Ic; MOVEMLNUM := LNum;
          RegMask.iMask := SaveRegs;
          EndMovemMark := Ic;
          ClearRegs;
          END;
        END;

      IF GlobalLabels THEN
        BEGIN
        GetTemp(GotoCAttr, 4); Base := GetBase(GotoCAttr.VLev);
        Gen($42A7); GenJSR('%_LSTSG '); { CLR.L -(SP) }
        GenRR(8543, Base, 0); Gen(GotoCAttr.VOffset); { MOVE.L (SP)+,goto(A?) }
        END;

      IF SaveA2D3 THEN
        BEGIN
        Reg[A2].Count := 0;
        Reg[D3].Count := 0;
        END;

      StmtList(254 {ENDPROC} );
      DumpProcInfo := NextByte;

      {put in final global data size.  Make zero for Macintosh
       since its loader creates global data area.}
      IF MacFlag AND (ProcLvl = 1) THEN
        PatchWord(LcPatchLoc, 0)
      ELSE
        PatchWord(LcPatchLoc, - Lc);

      IF GlobalLabels AND (ProcLvl > 1) THEN { don't cut back reg. save area }
        LcPatchWord := - Lc - 4 * (Anth - A1st + Dnth - D1st + 2)
      ELSE
        LcPatchWord := - Lc;

      lpULab := ULabelList;
      WHILE lpULab <> NIL DO
        WITH lpULab^ DO
          BEGIN
          IF (LinkerNo >= 0) AND (ProcLvl > 1) THEN
            BEGIN
            lpILab := LookUpILabel(IntNo);
            PatchWord(lpILab^.Loc + 2, LcPatchWord);
            END;
          lpULab := Next;
          END;

      IF ProcLvl = 1 THEN
        BEGIN
        GenJSR('%_TERM  ');
        Gen($4E5D); { UNLK A5 }
        GenJSR('%_END   ');
        Gen($4E75); { RTS }
        Gen($4E5E); { UNLK A6 }
        Gen($4E75); { RTS }
        END
      ELSE
        BEGIN
        IF SaveA2D3 THEN
          BEGIN {if A2 or D3 not used, patch them out of the save-register code}
          IF NOT (A2Used AND D3Used) THEN
            BEGIN
            SaveIc := Ic; SaveLNum := LNum;
            Ic := MoveMMark; LNum := MOVEMLNum;
            ClearRegs;
            FOR i := D0 TO SP DO IF i IN RegMask.sMask THEN Reg[i].Count := 1;
            IF NOT A2Used THEN Reg[A2].Count := 0;
            IF NOT D3Used THEN Reg[D3].Count := 0;
            RegMask.iMask := SaveRegs;
            FOR i := (Ic DIV 2) TO (EndMovemMark DIV 2 - 1) DO Tags[i] := NOPI;
            Ic := SaveIc; LNum := SaveLNum;
            END;
          END;
        RestoreRegs(RegMask.iMask); { restore global registers }
        Gen($4E5E); { UNLK A6 }
        IF ParamBytes <= 8 THEN
          Gen($4E75) { RTS }
        ELSE IF ParamBytes = 12 THEN
          BEGIN
          Gen($2E9F); { MOVE.L (SP)+,(SP) }
          Gen($4E75); { MOVE.L (SP)+,(SP) }
          END
        ELSE
          BEGIN
          Gen($205F); { MOVE.L (SP)+,A0 }
          IF ParamBytes <= 16 THEN
            GenRR($504F, ParamBytes MOD 8, 0) { ADDQ.W #x,SP }
          ELSE
            BEGIN
            Gen($DEFC); Gen(ParamBytes - 8); { ADDA.w #x,SP }
            END;
          Gen($4ED0); { JMP (A0) }
          END;
        END;

      FindShortJumps;
      SqueezeBuffer;
      IF DumpProcInfo = 1 THEN OutProcInfo;

      { Output Big Constants }

      IF ShowAsmCode THEN
        BEGIN {always init lbl arrays one entry ahead because set constants may
               have their labels at the byte following the constant}
        i := Ic; Gen(0); Ic := i;
        pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
        PrevLblDef := - 1;
        DisLbl := 0; {const lbls will be separate}
        END;

      BigCStart := BigCList;
      WHILE BigCList <> NIL DO
        WITH BigCList^ DO
          BEGIN
          FinalLoc := Loc - Delta[Loc DIV 2];
          CASE BigVal.CstKind OF
            SETCNST:
                  BEGIN
                  SetWords := (BigVal.SetBytes + 1) DIV 2;
                  SetP := BigCList;
                  FindSet(SetP, Pos);
                  IF SetP^.StartLoc >= 0 THEN
                    BEGIN
                    Dest := SetP^.StartLoc + Pos - 1;
                    IF BigVal.FrontAddress THEN
                      PatchWord(FinalLoc, Dest - FinalLoc)
                    ELSE
                      BEGIN
                      Dest := Dest + 2 * SetWords;
                      PatchWord(FinalLoc, Dest - FinalLoc);
                      END;
                    END
                  ELSE
                    BEGIN
                    SetP^.StartLoc := Ic; StartLoc := Ic;
                    Dest := Ic + Pos - 1;
                    IF BigVal.FrontAddress THEN
                      PatchWord(FinalLoc, Dest - FinalLoc)
                    ELSE
                      BEGIN
                      Dest := Dest + 2 * SetWords;
                      PatchWord(FinalLoc, Dest - FinalLoc);
                      END;
                    WITH SetP^ DO
                      BEGIN
                      lInt := BigVal.SetValu;
                      FOR j := 1 TO (BigVal.SetBytes + 1) DIV 2 DO
                        BEGIN
                        Gen(lInt^.Int); lInt := lInt^.Next;
                        IF ShowAsmCode THEN
                          BEGIN
                          i := Ic; Gen(0); Ic := i;
                          pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
                          END;
                        END;
                      END;
                    END;
                  IF ShowAsmCode THEN
                    BEGIN
                    DisLbl := DisLbl + 8000; {lbls 8000..15999 ==> sets}
                    PrevLblRef := (FinalLoc - 2) DIV 2;
                    PrevLblDef := Dest DIV 2;
                    RefLbl((FinalLoc - 2) DIV 2, Dest DIV 2, False);
                    i := SetP^.StartLoc DIV 2; {start of set}
                    IF pLblDef^[i] = 0 THEN
                      BEGIN {make sure start of set is labeled}
                      DisLbl := DisLbl + 1; pLblDef^[i] := DisLbl;
                      END;
                    i := (SetP^.StartLoc + Pos - 1) DIV 2;
                    IF pLblDef^[i] = 0 THEN
                      BEGIN {make sure start of this constant also is labeled}
                      DisLbl := DisLbl + 1; pLblDef^[i] := DisLbl;
                      END;
                    DisLbl := DisLbl - 8000;
                    END;
                  END;
            STRCNST, PAOCCNST:
                  BEGIN
                  StrP := BigCList;
                  FindStr(StrP, Pos);
                  IF StrP^.StartLoc >= 0 THEN
                    BEGIN
                    Dest := StrP^.StartLoc + Pos - 1;
                    PatchWord(FinalLoc, Dest - FinalLoc);
                    END
                  ELSE
                    BEGIN
                    StrP^.StartLoc := Ic; StartLoc := Ic;
                    Dest := Ic + Pos - 1;
                    PatchWord(FinalLoc, Dest - FinalLoc);
                    WITH StrP^ DO
                      BEGIN
                      IF BigVal.CstKind = STRCNST THEN
                        BEGIN
                        HalfValu := BigVal.Len * 256; Count := 1;
                        END
                      ELSE
                        Count := 0;
                      j := 0; lString := BigVal.StrValu;
                      FOR k := 1 TO BigVal.Len DO
                        BEGIN
                        IF Odd(Count) THEN
                          BEGIN
                          Gen(HalfValu + Ord(NextStrCh(j, lString)));
                          IF ShowAsmCode THEN
                            BEGIN
                            i := Ic; Gen(0); Ic := i;
                            pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
                            END;
                          END
                        ELSE
                          HalfValu := Ord(NextStrCh(j, lString)) * 256;
                        Count := Count + 1;
                        END;
                      IF Odd(Count) THEN
                        BEGIN
                        Gen(HalfValu);
                        IF ShowAsmCode THEN
                          BEGIN
                          i := Ic; Gen(0); Ic := i;
                          pLblRef^[CurrCode] := 0; pLblDef^[CurrCode] := 0;
                          END;
                        END;
                      END;
                    END;
                  IF ShowAsmCode THEN
                    BEGIN
                    IF BigVal.CstKind = PAOCCNST THEN
                      DisLbl := DisLbl + 16000 {lbls 16000..23999 ==> PA of char}
                    ELSE
                      DisLbl := DisLbl + 24000; {lbls 24000..31999 ==> string}
                    i := Dest DIV 2;
                    IF PrevLblDef <> i THEN
                      RefLbl((FinalLoc - 2) DIV 2, i, False)
                    ELSE
                      BEGIN {prev const was a set with its lbl at start of this
                             string const so redefine set label as string label}
                      j := pLblDef^[PrevLblDef] - 8000;
                      IF BigVal.CstKind = PAOCCNST THEN
                        j := j + 16000
                      ELSE
                        j := j + 24000;
                      pLblDef^[PrevLblDef] := j; pLblRef^[PrevLblRef] := j;
                      pLblRef^[(FinalLoc - 2) DIV 2] := j;
                      END;
                    PrevLblDef := -1;
                    i := StrP^.StartLoc DIV 2; {start of string}
                    IF pLblDef^[i] = 0 THEN
                      BEGIN {make sure start of string is labeled}
                      DisLbl := DisLbl + 1; pLblDef^[i] := DisLbl;
                      END;
                    IF BigVal.CstKind = PAOCCNST THEN
                      DisLbl := DisLbl - 16000
                    ELSE
                      DisLbl := DisLbl - 24000;
                    END;
                  END;
          END; {case}
          BigCList := Next;
          END;

      IF DumpProcInfo = 1 THEN CodeBuff[CaPatchLoc DIV 2] := Ic - CaPatchLoc - 2;

      FormatCode;

      IF Listing THEN MakeListing;

      IF NOT ConsListing THEN
        BEGIN
        IF FirstOnCons THEN WriteLn;
        IF (Father <> '        ') AND (Father = UserPNam) THEN
          Line := 'CREATE  '
        ELSE
          Line := SUserPNam;
        Line := Concat(Line, ' - ', SLinkName, '  ', '  Code size =', PutIntP(Ic,
                       7)^);
        WriteLn(Line);
        FirstOnCons := False;
        END;

      CSizeLo := CSizeLo + Ic MOD 100; CSizeHi := CSizeHi + Ic DIV 100;
      IF CSizeLo >= 100 THEN
        BEGIN
        CSizeLo := CSizeLo - 100; CSizeHi := CSizeHi + 1;
        END;
      Release(HeapMark);
    END; {genproc}

  PROCEDURE UnitHeader;

    VAR
      i, Junk, UDataSize: Integer;
      UnitName: Alfa8;
      UKind: Integer;

    BEGIN
      FOR i := 1 TO ALFALEN DO UnitName[i] := Chr(NextByte);
      Junk := NextByte;
      UTextAddr := NextWord DIV 2;
      Junk := NextByte;
      Junk := NextByte;
      UTextSize := NextWord DIV 2;
      Junk := NextByte;
      UDataSize := NextWord;
      UKind := NextByte;

      { Unit Block: }

      SetObjInvar(OutBlock, UnitBlock, 0);
      OutBlock.bUnitBlock.UnitName := UnitName;
      OutBlock.bUnitBlock.CodeAddr := 30;
      OutBlock.bUnitBlock.TextAddr := 0;
      OutBlock.bUnitBlock.TextSize := UTextSize * 512;
      OutBlock.bUnitBlock.GlobalSize := UDataSize;
      OutBlock.bUnitBlock.UnitType := UKind;
      PutObjInvar(OutFile, OutBlock);

      Op := NextByte;
    END; {unitheader}

  PROCEDURE UnitTail(l: LongInt);

    VAR
      i, FromBlock: Integer;
      l2: LongInt;
      b: LongInt;

    BEGIN
      b := l DIV 512;
      IF (l MOD 512) <> 0 THEN b := b + 1;
      l2 := b * 512;
      SetObjPtr(OutFile, 0);
      SetObjBlockPtr(OutFile, 0);
      GetObjInvar(OutFile, OutBlock);
      IF OutBlock.BlockHeader <> UnitBlock THEN
        CodError(401)
      ELSE
        BEGIN
        OutBlock.bUnitBlock.TextAddr := l2;
        SetObjPtr(OutFile, 0);
        SetObjBlockPtr(OutFile, 0);
        PutObjInvar(OutFile, OutBlock);
        IF IOResult > 0 THEN CodError(408);
        SetObjPtr(OutFile, l2);
        SetObjBlockPtr(OutFile, l2);
        FromBlock := UTextAddr;
        FOR i := 1 TO UTextSize DO
          BEGIN
          IF BlockRead(InFile, InBuff, 1, FromBlock) <> 1 THEN CodError(409);
          PutObjSeq(OutFile, Pointer(Ord(@InBuff)), 512);
          IF IOResult > 0 THEN CodError(400);
          FromBlock := FromBlock + 1;
          END;
        END;
    END; {unittail}

  PROCEDURE Middleize;

    VAR
      LastBlock: LongInt;
      Line: SUStr;

    BEGIN {Middleize}
      Op := NextByte;
      IF Op = 244 {UNIT}
         THEN
        BEGIN
        UnitFlag := True;
        UnitHeader;
        END
      ELSE IF Op = 240 THEN
        UnitFlag := False
      ELSE
        BEGIN
        IF NOT FirstOnCons THEN WriteLn;
        WriteLn(Chr(7), '*** Input file is not an .I file ***');
        Aborted := True;
        GOTO 999;
        END;
      WHILE Op = 240 {MODULE} DO
        BEGIN
        GenProc;
        Op := NextByte;
        END;
      IF Op <> 255 {ENDICODE} THEN CodError(2000);

      SetObjInvar(OutBlock, EOFMark, 0);
      PutObjInvar(OutFile, OutBlock);
      GetObjPtr(OutFile, LastBlock);
      ZeroObjEnd(OutFile);
      IF UnitFlag THEN UnitTail(LastBlock);

      IF Listing THEN
        BEGIN
        WHILE GetLine(CListFile, @Line) DO ListLine(0, LineNumber, Line, True);
        IF AsmOnly THEN
          BEGIN
          PutLineS(ListFile, ';');
          PutLineS(ListFile, '         .END');
          END;
        END;
    END; {Middleize}

  {$S Init}

  PROCEDURE Initialize;

    VAR
      lCh: Char;
      i: Integer;
      OptionOk, Dummy, GotIFile, Ok: Boolean;
      WhatUserTyped: PromptState;
      lFName, InFName, FName, lName, OptsLine: SUStr;
      IfVol, IfName, IfExt, IfVolName: SUStr;
      OpFile: FILE OF RECORD
                        Opcode: Alfa8;
                        OpValue: Integer;
                        OpAttr: Integer;
                      END;

    FUNCTION OpenOpcodesFile(FName: SUStr): Boolean;

      VAR
        IORslt: Integer;

      BEGIN {OpenOpcodesFile}
        IORslt := 9999;
        SUInitSysVols;
        IF SUMyProcV <> '' THEN {try on the current process's volume}
          BEGIN
          Reset(OpFile, Concat(SUMyProcV, '-', FName));
          IORslt := IOResult;
          END;

        IF IORslt > 0 THEN
          IF SUOsBootV <> '' THEN {try on the OS boot volume}
            BEGIN
            Reset(OpFile, Concat(SUOsBootV, '-', FName));
            IORslt := IOResult;
            END;

        IF IORslt > 0 THEN
          BEGIN {finially try the current prefix}
          Reset(OpFile, FName);
          IORslt := IOResult;
          END;

        OpenOpcodesFile := IORslt <= 0;
      END; {OpenOpcodesFile}

    PROCEDURE EnterOpcode(VAR Opcode: Alfa8);

      VAR
        p, p1, Prev, Heap: pOpcode;
        Dup, lLeft: Boolean;

      BEGIN {EnterOpcode}
        Mark(Heap);
        New(p);
        p^.Llink := NIL; p^.Rlink := NIL; p^.Opcode := Opcode;

        IF OpcodeTbl = NIL THEN
          OpcodeTbl := p
        ELSE
          BEGIN
          p1 := OpcodeTbl; Dup := False;
          REPEAT
            Prev := p1;
            IF p1^.Opcode = Opcode THEN
              Dup := True
            ELSE IF p1^.Opcode < Opcode THEN
              BEGIN
              p1 := p1^.Rlink; lLeft := False;
              END
            ELSE
              BEGIN
              p1 := p1^.Llink; lLeft := True;
              END;
          UNTIL Dup OR (p1 = NIL);

          IF Dup THEN
            Release(Heap)
          ELSE IF lLeft THEN
            Prev^.Llink := p
          ELSE
            Prev^.Rlink := p;
          END;
      END; {EnterOpcode}

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

      VAR
        Len: Integer;

      BEGIN {ProcessOptions}
        Len := Length(OptsLine);
        IF Len > 2 THEN
          IF OptsLine[1] = '$' THEN
            BEGIN
            SUTrimBlanks(@OptsLine);
            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] = '+';
                         UseAsmIcode := False; {status "locked" as specified"}
                         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}

              'I': IF OptsLine[3] IN ['+', '-'] THEN
                     BEGIN {Icode delete}
                     DeleteI := OptsLine[3] = '+';
                     WhatUserTyped := SUInvalid;
                     END; {Icode delete}

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

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

    BEGIN
      SUInit;
      InitIO;
      InitPasDefs;
      InitObjFile(OutFile, 8); (*OIAllowAbort := False; {spring}*)

      GetTD(@DateStr);
      WriteLn(TITLE, VERSION, ' ': 9, DateStr);
      Copyrights;
      WriteLn;

      Aborted := True;
      InOpen := False; OutOpen := False; ListOpen := False; CListOpen := False;
      AltListing := False; ListingOk := True; UseAsmIcode := True;
      ShowAsmCode := False; Listing := False; ConsListing := False;
      AsmOnly := False; AsmProc := False;
      MacFlag := False;
      SaveA2D3 := False;
      DeleteI := False;

      GotIFile := False;                                                           {!03-06-84}
      PCInit;
      IF PCReset(PCText, 'For Code Gen') THEN
        BEGIN
        IF PCGetLine(lName) THEN
          IF Length(lName) > 0 THEN
            BEGIN
            Reset(InFile, lName);
            IF IOError(IOResult, Concat('Unable to open ', lName)) THEN
              KillExec
            ELSE IF NOT PCGetLine(FName) THEN
              BEGIN
              KillExec; Close(InFile);
              END
            ELSE IF Length(FName) = 0 THEN
              BEGIN
              KillExec; Close(InFile);
              END
            ELSE
              BEGIN
              SUSplitFN(@FName, @IfVol, @IfName, @IfExt);
              SUMakeFN(@FName, @IfVol, @IfName, '.OBJ', Dummy);
              OpenObjFile(OutFile, FName, True);
              IF IOError(IOResult, Concat('Unable to open ', FName)) THEN
                BEGIN
                KillExec; Close(InFile);
                END
              ELSE
                BEGIN
                InOpen := True; OutOpen := True;
                GotIFile := True;
                WHILE PCGetLine(OptsLine) DO
                  BEGIN
                  WhatUserTyped := SUValid;
                  ProcessOptions(OptsLine, WhatUserTyped);
                  IF WhatUserTyped = SUInvalid THEN
                    WriteLn('Input file - ', OptsLine);
                  END;
                SUSplitFN(@lName, @IfVol, @IfName, @IfExt);
                SUMakeFN(@lName, @IfVol, @IfName, '', Dummy);
                WriteLn('Input file - [.I] ', lName);
                SUSplitFN(@FName, @IfVol, @IfName, @IfExt);
                SUMakeFN(@FName, @IfVol, @IfName, '', Dummy);
                WriteLn('Output file - [', lName, '] [.OBJ] ', FName);
                END;
              END;
            END;
        Dummy := PCClose(True, 'For Code Gen');
        END;

      IF NOT GotIFile THEN
        BEGIN
        REPEAT
          REPEAT
            Write('Input file - ');
            SUGetFN(@lName, WhatUserTyped, '', '', '.I');
            IF WhatUserTyped IN [SUEscape, SUDefault, SUNone] THEN GOTO 999;
            IF WhatUserTyped = SUInvalid THEN WriteLn('Bad file name');
            ProcessOptions(lName, WhatUserTyped);
          UNTIL WhatUserTyped = SUValid;
          {$I-}
          Reset(InFile, lName);
          {$I+}
          IF IOError(IOResult, 'Unable to open input file.') THEN
            BEGIN
            WhatUserTyped := SUInvalid;
            KillExec;
            END;
        UNTIL WhatUserTyped = SUValid;
        InOpen := True;

        REPEAT
          Write('Output file - ');
          SUSplitFN(@lName, @IfVol, @IfName, @IfExt);
          SUMakeFN(@IfVolName, @IfVol, @IfName, '', Dummy);
          SUGetFN(@FName, WhatUserTyped, '', IfVolName, '.OBJ');
          IF WhatUserTyped = SUEscape THEN GOTO 999;
          IF WhatUserTyped = SUInvalid THEN WriteLn('Bad file name');
          IF WhatUserTyped IN [SUValid, SUNone, SUDefault] THEN
            BEGIN
            OpenObjFile(OutFile, FName, True);
            IF IOError(IOResult, 'Unable to open output file.') THEN
              WhatUserTyped := SUInvalid;
            END;
          IF WhatUserTyped = SUInvalid THEN KillExec;
        UNTIL WhatUserTyped IN [SUValid, SUNone, SUDefault];
        OutOpen := True;
        END;

      StartTimer;

      IF AsmOnly THEN
        BEGIN {load opcode table used to filter proc names by LkUp}
        OpcodeTbl := NIL;
        IF OpenOpcodesFile(OPFNAME) THEN
          BEGIN
          Get(OpFile);
          REPEAT
            i := 1;
            REPEAT
              Ok := OpFile^.Opcode[i] IN ['A'..'Z', '0'..'9', '%', '_', ' '];
              i := i + 1;
            UNTIL NOT Ok OR (i > 8);
            IF Ok THEN EnterOpcode(OpFile^.Opcode);
            Get(OpFile);
          UNTIL Eof(OpFile) OR (OpFile^.Opcode[1] = Chr(0));
          Close(OpFile);
          END;
        END; {loading opcodes}

      FOR i := 1 TO 5 DO ShortJumps[i] := 0;
      ShortCalls := True;
      CSizeHi := 0; CSizeLo := 0;
      InBlock := - 1; InByte := 32767;
      Hex := '0123456789ABCDEF';
      CurrSeg := '        '; PrevSeg := '        ';

      FirstLine := True; FirstOnCons := True;
      LNum := 0; LineNumber := 0; LnOvflo := False;
      FirstLNum := 0; EndLineNbr := 0;
      New(ListFile); New(CListFile);
      New(CListBufr); New(ListBufr);
      New(pLineNumber);
      New(pLblRef); New(pLblDef);
      Aborted := False;
    END; {initialize}

  {$S }

