(*****************************************************************************)
(*                                                                           *)
(*                           File: CODE.TEXT                                 *)
(*                                                                           *)
(*              (C) Copyright 1981 Silicon Valley Software, Inc.             *)
(*                            1983, 1984 Apple Computer, Inc.                *)
(*                                                                           *)
(*                            All rights reserved.                31-Aug-82  *)
(*                                                                           *)
(*   6-16-83  Code: initialize, mark and release heap                        *)
(*   6-24-83  copyrights procedure                                           *)
(*  23-09-83  Modified to compile & run on Monitor                           *)
(*  23-09-83  Modified for SaveA2D3,Macflag                                  *)
(*   1-14-84  StartLoc added to BigCRef for literal pool compaction          *)
(*   2-19-84  Changes to produce a listing with generated code               *)
(*****************************************************************************)
{[j=13-/40/80!]}

{$e err.log.text}
{$I Flags.text}

{$setc IULIB := true }

{$r-}

PROGRAM Code;

  USES
    {$ifc foros         }              {spring - delete Utility}
    {$U n/OBJIOLIB      } PasDefs, Utility, FileIO, ObjIO,

    {$U-}                              {Don't search INTRINSIC.LIB}
    {$U n/SULib         } StdUnit,
    {$U Primitives/IO   } IOPrimitives,{spring - change to $U n/SULib}
    {$U ProgComm/Stub   } ProgComm,    {spring - change to $U n/SULib}
    {$U gen/HideSysCall} HideSysCall,
    {$elsec}
    {$U PasDefs         } PasDefs,
    {$U Utility         } Utility,     {spring - delete Utility}
    {$U Fileio          } FileIO,
    {$U Objio           } ObjIO,

    {$U-}                              {Don't search INTRINSIC.LIB}
    {$U StdUnit         } StdUnit,     { 7-Apr-83 }                            {!?ILR?}
    {$U Primitives/IO   } IOPrimitives,{spring - change to $U n/SULib}
    {$U ProgComm/Stub   } ProgComm,    {spring - change to $U n/SULib}
    {$endc }

    {$U hwint.obj       } HWInt,
    {$U Pas/Dates       } Dates,
    {$U obj/times.obj   } Times;

  LABEL 999;

  CONST
    TITLE        = 'Lisa Pascal MC68000 Code Generator ';

    VERSION      = 'V2.61 (13-Apr-84)';

    D0           = 0;
    D3           = 3;
    D4           = 4;
    D7           = 7;

    A0           = 8;
    A2           = 10;
    A3           = 11;
    A4           = 12;
    A5           = 13;
    A6           = 14;
    SP           = 15;

    Dlow         = D0;
    Dhigh        = D3;
    Alow         = A0;
    Ahigh        = A2;
    A1st         = A3;
    Anth         = A4;
    D1st         = D4;
    Dnth         = D7;

    ByteOp       = 1;
    WordOp       = 2;
    LongOp       = 3;
    Quad         = 4;

    MAXUNITS     = 256;                {max nbr of units}
    MAXCODE      = 4000;               {max size of the code buffer for a proc}
    MAXEXT       = 200;                {max nbr of external refs}

    { max_pathname value should equal the value used in SYSCALL }
    { (name conflict inhibits direct USES of SYSCALL) }

    MAX_PATHNAME = 255;                {maximum length of a file system pathname}

    EMITDEPOSIT  = False;

    ALFALEN      = 8;

    MAXLNUM      = 65000;              {max listing line nbr, lower than Compiler}

   OPFNAME       = 'N68K.OPCODES';     {Assembler's opcode table}

  TYPE
    Alfa         = PACKED ARRAY [1..ALFALEN] OF Char;
    Alfa8        = PACKED ARRAY [1..8] OF Char;
    AlfaStr      = String[ALFALEN];
    Str8         = String[ALFALEN];
    Str80        = String[80];
    IntPtr       = ^Integer;

    (**************************************************)
    (*                                                *)
    (*     Register useage:                           *)
    (*                                                *)
    (*     D0 - D3:  Used to compute expressions.     *)
    (*     A0 - A2:  Used to compute addresses.       *)
    (*     A3 - A4:  Globally Allocated Registers     *)
    (*     D4 - D7:  Globally Allocated Registers     *)
    (*     (Globally allocated w/in a procedure only) *)
    (*     A5:       Global Base Register.            *)
    (*     A6:       Local Base Register.             *)
    (*     SP:       Top Of Stack pointer.            *)
    (*                                                *)
    (**************************************************)

    Register     = D0..SP;
    CAttrKind    = (NUL, EXPR, ADDR, INDX, CNST, COND, VARB, BOOL, STCK, BITZ);
    GCondition   = (LT, LE, GT, GE, EQ, NE, HI, LS);
    ConstKind    = (SCALCNST, REALCNST, STRCNST, PAOCCNST, SETCNST);

    CodeRange    = 0..MAXCODE;

    pStrCRec     = ^StrCRec;
    StrCRec      = RECORD
                     StrVal: Alfa8;
                     Next: pStrCRec;
                   END;

    pIntList     = ^IntList;
    IntList      = RECORD
                     Int: Integer;
                     Next: pIntList;
                   END;

    Valu         = RECORD
                     CASE CstKind: ConstKind OF
                       SCALCNST:
                         (CASE Boolean OF
                            True:
                              (IValu: ARRAY [0..1] OF Integer);
                            False:
                              (lInt: LongInt));
                       STRCNST, PAOCCNST:
                         (Len: Integer;
                          StrValu: pStrCRec);
                       SETCNST:
                         (SetBytes: Integer;
                          SetValu: pIntList;
                          FrontAddress: Boolean);
                   END;

    pBigCRef     = ^BigCRef;
    BigCRef      = RECORD
                     Loc: Integer;
                     StartLoc: Integer;                                        {!01-14-84}
                     BigVal: Valu;
                     Next: pBigCRef;
                   END;

    CAttr        = RECORD
                     CASE cKind: CAttrKind OF
                       EXPR, BOOL, BITZ:
                         (ExReg: Register);
                       ADDR:
                         (AOffset: Integer;
                          AdReg: Register);
                       VARB:
                         (VOffset: Integer;
                          VLev: Integer);
                       INDX:
                         (InOffset: Integer;
                          InxAReg: Register;
                          InxRReg: Register;
                          LongIndex: Boolean);
                       CNST:
                         (CValu: Valu);
                       COND:
                         (CC: GCondition);
                       {STCK: (); }
                   END;

    Flags        = (ABSI, JMPS, JMPL, NOPI, CASJ);

    pProcRef     = ^ProcRef;
    ProcRef      = RECORD
                     LinkName, UserName: Alfa8;
                     RefList: pIntList;
                     Next: pProcRef;
                     PFLev: Integer;
                   END;

    pLabelRec    = ^LabelRec;
    LabelRec     = RECORD
                     LabelNo: Integer;
                     Llink, Rlink: pLabelRec;
                     CASE Defined: Boolean OF
                       False:
                         (RefList: pIntList);
                       True:
                         (Loc: Integer);
                   END;

    pUserLabel   = ^UserLabel;
    UserLabel    = RECORD
                     UserNo, IntNo: Integer;
                     LinkerNo: Integer; {-1 = not global }
                     Next: pUserLabel;
                   END;

    pCommonRec   = ^CodComRec;
    CodComRec    = RECORD
                     Left, Right: pCommonRec;
                     HashNo, CommonNo, CommonKind: Integer;
                     Name: Alfa8;
                     RefList: pIntList;
                   END;

    ArryLNum     = ARRAY [CodeRange] OF LongInt;
    ArryLblRef   = ARRAY [CodeRange] OF Integer;
    ArryLblDef   = ARRAY [CodeRange] OF Integer;

    {$ifc not IULIB }
    Alfa         = PACKED ARRAY [1..ALFALEN] OF Char;
    Str80        = String[80];
    {$endc }

    {$ifc FOROS }
    Pathname     = String[MAX_PATHNAME]; {pathname type same as in SYSCALL (name
                                          conflict inhibits direct USES of
                                          SYSCALL)}
    {$endc }

    Pac81        = PACKED ARRAY [1..81] OF Char;

    StrValType   = ^StrValRec;
    StrValRec    = RECORD
                     StrPart: Alfa;
                     Next: StrValType;
                   END;

    pBuf         = ^CodBuffer;
    CodBuffer    = ARRAY [0..511] OF - 128..127;

    pOpcode      = ^Opcodes;
    Opcodes      = RECORD
                     Opcode: Alfa8;
                     Llink, Rlink: pOpcode;
                   END;
  VAR
    Ic:          Integer;              {instruction counter}
    Lc:          Integer;              {stack space for local data}
    LastCode:    Integer;              {highest value of Ic before data}
    ProcLvl:     Integer;              {proc or funct level}
    Funct:       Boolean;              {true ==> current module is a function} {!2-19-84}
    Op:          Integer;              {current I-code opcode}
    CurrCode:    Integer;              {most recently generated code ptr}
    CaPatchLoc:  Integer;              {loc for size of constant literal pool}
    DumpProcInfo:Integer;              {1 ==> generate proc info for Lisabug}

    gCAttr:      CAttr;                {current expression status}
    SavedPL, ProcList: pProcRef;       {ptrs to a proc's external refs}

    BigCList:    pBigCRef;             {ptr to a proc's literal pool}

    Reg:         ARRAY [D0..SP] OF
                   RECORD
                     Count: Integer;
                   END;

    CodeBuff:    ARRAY [CodeRange] OF Integer; {code buffer and its parallel info}
    Tags:        ARRAY [CodeRange] OF Flags;
    Delta:       ARRAY [CodeRange] OF Integer;
    pLineNumber: ^ArryLNum;                                                    {!2-19-84}
    pLblRef:     ^ArryLblRef;
    pLblDef:     ^ArryLblDef;

    RegSaveAttr: CAttr;

    RegMask:     RECORD
                   CASE Boolean OF
                     True:
                       (iMask: Integer);
                     False:
                       (sMask: SET OF D0..SP)
                 END;

    WithLevel:   Integer;
    WithCAttr:   ARRAY [1..10] OF
                   RECORD
                     Cat: CAttr;
                     Indirect: Boolean;
                   END;

    ExtTmp:      CAttr;                {extended temp for C real args}
    HaveExtTmp:  Boolean;              {true ==> ExtTemp is allocated}
    RealTmp:     CAttr;                {real temp for converting real constants}
    HaveRealTmp: Boolean;              {true ==> RealTemp is allocated}
    DblTmp:      CAttr;                {dbl real temp for converting C functions}
    HaveDblTmp:  Boolean;              {true ==> DblTmp is allocated}

    LabelTree:   pLabelRec;
    ULabelList:  pUserLabel;
    NextLabel:   Integer;

    UserProcs:   ARRAY [0..MAXEXT] OF pProcRef;

    FCAllLevel:  Integer;
    FCAllInfo:   ARRAY [1..10] OF
                   RECORD
                     Size, RegMask: Integer;
                     OnStack: Boolean;
                   END;

    GlobalLabels: Boolean;
    SaveA6CAttr, SaveSpCAttr, GotoCAttr: CAttr;

    CSizeHi, CSizeLo: Integer;         {total number of generated bytes}

    ShortJumps:  ARRAY [1..5] OF Integer;

    A2Used, D3Used: Boolean;                                                   {!9-23-83}
    ShortCalls:  Boolean;
    UnitFlag:    Boolean;

    UTextAddr:   Integer;              {start of interface section}
    UTextSize:   LongInt;              {size of Interface section in bytes}

    CommonTree:  pCommonRec;

    UserPNam:    Alfa8;                {user procedure name is global just for the
                                        error routine}

    CurrSeg:     AlfaStr;              {current segment name as a string}
    PrevSeg:     AlfaStr;              {previous segment name as a string}     {!2-19-84}

    MacFlag:     Boolean;              {true ==> gen code for Mac}

    SaveA2D3:    Boolean;              {SaveA2D3 is set to true if these registers
                                        are to be preserved across a procedure
                                        call. It does not affect their position
                                        as temporaries or permanent registers.
                                        Needed for Mac development}

    InFile:      FILE;                 {the i-code file}
    InOpen:      Boolean;              {true ==> i-code file is open}
    InBuff:      PACKED ARRAY [0..511] OF Char; {i-code input buffer}
    InBlock, InByte: Integer;          {current i-code block and byten nbr}
    DeleteI:     Boolean;              {true ==> delete I-code file when done}

    OutFile:     ObjHandle;            {handle to the .obj file}
    OutBlock:    ObjBlock;             {current .obj block ?}
    OutOpen:     Boolean;              {true ==> .obj file is open}

    LineNumber:  LongInt;              {most recent line nbr from Comp listing} {!2-19-84}
    EndLineNbr:  LongInt;              {line nbr of the last line of a proc}   {!2-19-84}
    FirstLNum:   LongInt;              {first line nbr of a proc}              {!2-19-84}
    LNum:        LongInt;              {sync. line nbr from the 205 i-code}    {!2-19-84}

    CListFile:   IOFCBP;               {Compiler listing file FCB ptr}         {!2-19-84}
    CListBufr:   IOBufrP;              {Compiler listing file buffer}          {!2-19-84}
    CListOpen:   Boolean;              {true ==> Compiler listing file is open} {!2-19-84}

    ListFile:    IOFCBP;               {output listing file FCB ptr}           {!2-19-84}
    ListBufr:    IOBufrP;              {output listing buffer ptr}             {!2-19-84}
    ListOpen:    Boolean;              {true ==> output listing file is open}  {!2-19-84}
    Listing:     Boolean;              {true ==> generate listing for a proc}  {!2-19-84}
    AsmOnly:     Boolean;              {true ==> generate listing as Asm input} {!2-19-84}
    AsmProc:     Boolean;              {true ==> gen disassembly after proc}   {!2-19-84}
    ShowAsmCode: Boolean;              {true ==> full listing (asm+ source)}   {!2-19-84}
    AltListing:  Boolean;              {true ==> $L+ to use different list file}{!2-19-84}
    ListingOk:   Boolean;              {true ==> listing allowed (master switch)}{!2-19-84}
    UseAsmIcode: Boolean;              {true ==> process $ASM+- 205 i-code}    {!2-19-84}
    ConsListing: Boolean;              {true ==> listing file is the console}  {!2-19-84}
    FirstLine:   Boolean;              {true ==> not yet 1st line to listing}  {!2-19-84}
    FirstOnCons: Boolean;              {true ==> nothing to console yet}       {!2-19-84}
    LnOvflo:     Boolean;              {true ==> line nbr overflow}            {!2-19-84}
    OpcodeTbl:   pOpcode;              {ptr to tree of Assembler opcodes}

    DateStr:     String[20];           {current date and time of execution}
    Line:        SUStr;                {used to report time}
    LkUpCalled:  Boolean;              {true ==> LkUp called by disassembler}
    Substituted: Boolean;              {true ==> LkUp found external name}     {!2-19-84}
    Hex:         PACKED ARRAY [1..16] OF Char; {chars 0..F for hex conversion}

    Aborted:     Boolean;              {true ==> generation aborted}
    ErrNum:      Integer;              {PLinitHeap param}
    RefNum:      Integer;              {PLinitHeap param}
                                                                               {!}{[j=0/0]}

  PROCEDURE Disassembler(FudgeDest: LongInt; AddrLink: IntPtr;
                         VAR NumBytes: Integer; VAR Binary: CodBuffer;
                         VAR Opcode: Str80; VAR Operand: Str80;
                         DestLookup: IntPtr);
    EXTERNAL;

  FUNCTION LookUpILabel(fLabelNo: Integer): pLabelRec;
    FORWARD;

  PROCEDURE MakeLName(fLabelNo: Integer; VAR FName: Alfa8);
    FORWARD;

  PROCEDURE Copyrights;

    CONST
      SVS = '1981 SVS, Inc.';
      COPY1 = 'Copyright';
      Apple = '1983, 1984 Apple Computer, Inc.';
      COPY2 = 'Copyright';

    BEGIN {Copyrights - This routine appears here to cause the Apple and SVS
           copyrights to appear physically in the linked code file. It is the
           first routine in the blank segment so that the copyrights appear early
           in the file. It is also called to display the copyright message on the
           screen. Note: the word "copyright" must appear verbatim in code}
      Write('(c)', SVS);
      IF COPY1 = '' THEN;
      WriteLn('  (c)', Apple);
      IF COPY2 = '' THEN;
    END; {Copyrights}

  {$IFC FOROS}
  {$I gen/code.1.text}
  {$I gen/code.2.text}
  {$I gen/code.3.text}
  {$I gen/code.4.text}
  {$I gen/code.5.text}

  {$ELSEC}

  {$I Pas:code.1.text}
  {$I Pas:code.2.text}
  {$I Pas:code.3.text}
  {$I Pas:code.4.text}
  {$I Pas:code.5.text}
  {$ENDC}

  {$S }

  PROCEDURE Finalize;

    VAR
      AnyWayFlag: Boolean;
      S1, S2, S3: String[10];
      S: SUStr;

    BEGIN {Finalize}
      IF OutOpen THEN
        BEGIN
        AnyWayFlag := False;
        IF NOT Aborted AND (Errors <> 0) THEN
          BEGIN
          WriteLn;
          WriteLn('*** There were ', Errors: 1, ' errors ***');
          Write('Do you want to save the code file anyway? ');
          AnyWayFlag := SUGetBool(False);
          END;

        IF NOT Aborted AND ((Errors = 0) OR AnyWayFlag) THEN
          BEGIN
          CloseObjFile(OutFile, True);
          S1 := PutIntP(CSizeHi, 1)^;
          S2 := PutIntP(CSizeLo DIV 10, 1)^;
          S3 := PutIntP(CSizeLo MOD 10, 1)^;
          S := Concat('Total code size = ', S1, S2, S3);
          IF Listing AND NOT AsmOnly THEN
            BEGIN
            PutcF(ListFile, IONewline); PutLineP(ListFile, @S);
            END;
          IF NOT ConsListing THEN
            BEGIN
            WriteLn; WriteLn(S);
            END;
          END
        ELSE
          CloseObjFile(OutFile, False);
        END;

      IF InOpen THEN
        IF DeleteI THEN
          Close(InFile, PURGE)
        ELSE
          Close(InFile);

      IF CListOpen THEN CloseF(CListFile, IONormal);
      IF ListOpen THEN CloseF(ListFile, IOLock); {do after CListFile}

      IF Aborted THEN
        BEGIN
        KillExec;
        WriteLn; WriteLn('Code generation aborted!');
        END;

      SUDone;
      EndIO;
    END; {Finalize}

  {$S SEG2}

  PROCEDURE LoadSeg2;

    BEGIN {LoadSeg2}
      Middleize;
    END; {LoadSeg2}

  {$S SEG1}

  PROCEDURE LoadSeg1;

    BEGIN {LoadSeg1}
      LoadSeg2;
    END; {LoadSeg1}

  {$S }

  PROCEDURE Main;

    BEGIN {Main}
      Initialize;
      LoadSeg1;
    END; {Main}

  BEGIN {Code}
    {$IFC ForOs}
    (*XPLInitHeap(ErrNum, RefNum, 50000, 16384 {delta} , 5 {default LDSN} , False);*)
    {$ENDC}

    Main;

    MarkTime;
    IF Listing AND NOT AsmOnly THEN
      BEGIN
      Line := ReportTime^;
      Insert('code generator ', Line, 9);
      PutcF(ListFile, IONewline); PutLineS(ListFile, Line);
      END;
    IF NOT ConsListing THEN
      BEGIN
      WriteLn; WriteLn(ReportTime^);
      END;

    IF MacFlag THEN
      BEGIN
      IF Listing AND NOT AsmOnly THEN
        BEGIN
        PutcF(ListFile, IONewline);
        PutLineS(ListFile, 'MACINTOSH code generated.');
        END;
      IF NOT ConsListing THEN
        BEGIN
        WriteLn; WriteLn('MACINTOSH code generated.');
        END;
      END;

  999:
    Finalize;
  END. {Code}

