{###################################}
                {#       Copyright (C) 1985        #}
                {#           3L Limited            #}
                {#       All rights reserved       #}
                {###################################}

   %external %string(31)  Version  = "2",
                          Release  = "2",
                          Revision = "0",
                          Fname    = "IMP",
                      Product Code = "IMP_ARM"

! Revision history
! 002 22-Jun-88 PSR Modified to run native on the A310
!                   version changed to 2.2
!                   "not enough memory error added 
! 001  1-FEB-88 PSR Added code to set the -DEBUG option. This also inhibits
!                   IMP-style diagnostics (i.e., -NODIAG)
!                   Version changed to 2.1
!                   Springboard compiler sent to Acorn
!                 - inserted deletion of temporary files

%from IMP %include Interfac, Option3l, Stream3l
%from IMP %include Cliparse, OpenLL, Heap, Mcode, SysSpecs, TextUtil

%externalbyteintegerspec Spring %alias "3L_SPRING"
%externalintegerfnspec Free Store %alias "3L___free_store"
%externalroutinespec Opensi %alias "3L_IMP_OPEN_STORE_INPUT"(%integer S,L,B)
%externalroutinespec Openso %alias "3L_IMP_OPEN_STORE_OUTPUT"(%integer S,L,B)
%externalroutinespec OpenLi %alias "3L_IMP_OPEN_LOCAL_INPUT"(%integer S, %string(15) F)
%externalroutinespec OpenLo %alias "3L_IMP_OPEN_LOCAL_OUTPUT"(%integer S, %string(15) F)
%externalstring(255)%fnspec LL File Name %alias "3L_LL_FILE_NAME" -
                            (%integer type, %string(255) File Name, Rel Name)

%owninteger File A = 0, File Size, Store Files
%owninteger Object Addr = 0, Object Size = 0
%ownrecord(Commfm) If = 0
%ownstring(255) Object File = "", File

%externalroutine Open Object File(%integer Size)
   Object File = LL File Name(LL Object File, Object File, File)
   %if Store Files = 0 %or Size > Free Store-12000 %start     {can't}
      Open Binary Output(Object Out, Object File)
      Select Output(Object Out)
   %else
      Object Size = Size
      Object Addr = Get Space(Size)
      Openso(Object Out, Size, Object Addr)
   %finish
%end

%begin                   {ARM IMP driver}
   %externalinteger Debug Options %alias "3L_DEBUG_OPTIONS" = 0

   %externalinteger Language = 0

   %externalroutinespec Delete %alias "3L_IMP_DELETE"(%string(255) File)
   %externalpredicatespec Exists %alias "3L_IMP_EXISTS"(%string(255) S)
   %externalroutinespec PASS1(%integername Log, Faults, %integer Options)
   %externalroutinespec PASS 2(%record(Commfm)%name Interface)
   %externalroutinespec PASS 3(%record(Commfm)%name Interface)
   %externalintegerfnspec Encoded Value
   %externalroutinespec   Dump Encoded(%integer N)

   %externalstring(255)  Module

   %integer Dump Dir = 0, Keep = 0, J
   %integer x

   %integer Log, Prim = 0, Processor = 0
   %string(255) Lfile="", Pfile="", Ifile="",
                DoFile = "", Dfile, Prim File = "", Actual = ""

   %include "inc.prim" %endoflist
   %include "inc.pred" %endoflist

   %routine Open Special Input(%integer St, %bytearrayname A, %integer Size)
      Opensi(St, Size, Addr(A(1)))
   %end

   %routine Open Complete Input(%integer Stream, %string(255) File)
      %integer Size, A, X
      %integer Handle
      %string(255) F
      %label Ok
      F = File.Tostring(13)
      X = Addr(F)+1

      *MOV   _ R0, #16_40     {input}
      *LDR   _ R1, X          {address of string}
      *SWI   _ Brasil Open
      *CMPS  _ R0, #0
      *BNE   _ Ok

      Event_Message = "cannot open ".File." for input"
      %signal 9, 3, 0

Ok:   *STR   _ R0, Handle

      *MOV _ R0, #2       {get file length}
      *LDR _ R1, Handle
      *SWI _ Brasil Args
      *STR _ R2, Size

      *MOV _ R0, #0       {close command}
      *LDR _ R1, Handle   {file handle}
      *SWI _ Brasil Open

      FileSize = Size
      A = Get Space(Size);  FileA = A

      *MOV _ R0, #255         {load whole file}
      *LDR _ R1, X
      *LDR _ R2, A
      *MOV _ R3, #0           {show use address in R2}
      *SWI _ Brasil File

      Opensi(Stream, Size, A)
   %end

   %predicate QualP(%string(63) Opt)
      %false %unless Qualifier Present(Opt)
      Actual = Actual." ".Opt
      %true
   %end

   %integerfn QualI(%string(63) Opt)
      %integer N = 0
      %if Qualifier Present(Opt) %start
         N = Qualifier I(Opt)
         Actual = Actual." ".Opt."=".ItoS(N,0)
      %finish
      %result = N
   %end

   %string(255)%fn QualS(%string(63) Opt)
      %string(255) S
      S = Qualifier S(Opt)
      %if S # "" %start
         Actual = Actual." ".Opt."=".S
      %finish
      %result = S
   %end

   %on * %start
      Select Output(0)
      Newline
      Printstring("IMP fails -- ")
      %if Event_Event = 2 %start
         Printstring("not enough memory to compile the program")
      %else
         %if Event_Message = "" %start
            Printstring("event ")
            Write(Event_Event, 1);  Printsymbol(',')
            Write(Event_Sub,   1);  Printsymbol(',')
            Write(Event_Extra, 1);  Space
         %finish
         Printstring(Event_Message)
      %finish
      Newline
      %return
   %finish

   If_Language = 0
   File = Qualifier S("FILE")

   %if QualP("IDENTIFY") %start
      Printstring("IMP version ".Version.".".Release.".".Revision)
      Newline
   %finish

   %return %if File = ""

   If_Options = If_Options ! LL Debug %if QualP("DEBUG")                   {1}

   %if QualP("TRUSTED") %start
      If_Options = If_Options!LL Trusted
   %else
      %if If_Options&LL Debug = 0 %and %not QualP("NODIAGNOSTICS") %start  {1}
         If_Options = If_Options!LL Trace   %unless QualP("NOTRACE")
         If_Options = If_Options!LL Vars    %unless QualP("NOVARS")
         If_Options = If_Options!LL Lines   %unless QualP("NOLINES")
         If_Options = If_Options!LL Records %unless QualP("NORECORDS")
      %finish
      %unless QualP("NOCHECKS") %start
         If_Options = If_Options!LL Assigned %unless QualP("NOASSIGNED")
         If_Options = If_Options!LL Array    %unless QualP("NOARRAY")
!<omit>  If_Options = If_Options!LL Stack    %unless QualP("NOSTACK")
         If_Options = If_Options!LL Range    %unless QualP("NORANGE")
      %finish
   %finish

   If_Options = If_Options!LL Warn  %unless QualP("NOWARN")
   If_Options = If_Options!LL Mon       %if QualP("MONITOR")
   If_Options = If_Options!LL Reference %if QualP("REFER")
   If_Options = If_Options!LL Notify    %if QualP("NOTIFY")
   If_Options = If_Options!LL Warn  %unless QualP("NOWARN")
   If_Options = If_Options!LL Extend    %if QualP("EXTEND")
   If_Options = If_Options!LL Report
   Log = 0;  Log = 1 %if QualP("LOG")

   %if Qualifier Present("DECODE") %start
      If_Options = If_Options!LL Decode
      Dfile = QualS("DECODE")
   %finish

   ObjectFile = QualS("OBJECT")
   If_Source File = LL File Name(LL IMP Source File, File, "")

   %if QualP("STORE") %start
      Store Files = 1
      Open Complete Input(Source, If_Source File)
   %else
      Store Files = 0
      Open Input(Source, If_Source File)
   %finish
   Select Input(Source)

   Pfile     = QualS("PREDEF")
   Prim File = QualS("NEWPRIM")

   Keep     = 1 %if QualP("KEEP")
   Dump Dir = 1 %if QualP("DIR")

   %if QualP("PRIM") %start
      If_Prim = 1
      Prim = 1
      Prim File = "prim.dat" %if Prim File = ""
   %else
      If_Prim = 0
      If_Options = If_Options!LL Predef
   %finish

   Module = QualS("MODULE");  Module = File %if Module = ""
   If_Module = Module

   Open Special Input(2, Predef Data, Predef Length) %if Prim = 0

   %if Qualifier Present("LISTING") %start
      If_Options = If_Options ! LL List
      Lfile = QualS("LISTING")
      Actual = Actual." LISTING" %if Lfile = ""

      ToUpper(Lfile)
      %if Spring = 0 %start         {Archimedes}
         %if Lfile = "" %or Lfile = "TT:" %start
            Lfile = "TT:"
            If_Options = If_Options !! LL Report
         %finish
      %else                         {Springboard}
         If_Options = If_Options !! LL Report %if Lfile = "CON"
      %finish

      Open LL Output(Listing, LL Listing File, 0, Lfile, File)
      Select Output(Listing)
      Printstring( -
              "Source file: ".If_Source File."   Compiled on ".Date." at ".Time)
      %if Actual # "" %start
         Newline
         Printstring("Options:    ");  Printstring(Actual);  Newline
      %finish
      Newlines(2)
      Printstring("      3L ARM IMP Compiler")
      Printstring("  version ".version.".".release)
      Printstring(".".revision) %if Revision # "0"
      %if Spring = 0 %then Printstring(" (Archimedes)") -
                     %else Printstring(" (Springboard)")
      Newlines(2)
   %finish

   %if Store Files = 0 %start
      Open LL Output(Icode Out, LL Temp File, 0, "", "temp1")
   %else
      Open Lo(Icode Out, "temp1")
   %finish
   Select Output(Icode Out);  Ifile = Output Name
   Pass1(If_Statements, If_Faults, If_Options)

   Select Output(Listing) %and Close Output %if If_Options&LL List # 0
   Select  Input(Source);      Close  Input
   Select Output(Icode Out);   Close Output
   Free Space(FileSize, FileA) %if FileA # 0
   ->FF %if If_Faults # 0

   %if Store Files = 0 %start
      Open LL Input(Icode In, LL Temp File, 0, "", "temp1")
      Open LL Output(Directives Out, LL Temp File, 0, "", "temp2")
   %else
      Open Li(Icode In, "temp1")
      Open Lo(Directives Out, "temp2")
   %finish
   Select Output(Directives Out);  DoFile = Output Name
   Pass2(If)
   Select  Input(Icode In);        Close  Input
   Select Output(Directives Out);  Close Output
   ->FF %if If_Faults # 0

   %if Store Files = 0 %start
      Open LL Input(Directives In, LL Temp File, 0, "", "temp2")
   %else
      Open Lo(1, "temp1")               {delete the old one}
      Select Output(1);  Close Output
      Open Li(Directives In, "temp2")
   %finish

   %if Prim # 0 %start
      Open Binary Output(Directives Out, "prim-bin")
      Select Output(Directives Out)
      Select Input(Directives In)
      Dump Encoded(If_Ref Count)
      Dump Encoded(If_Def Count)
      Dump Encoded(If_Block Count)
      Dump Encoded(If_External Count)
      Dump Encoded(If_Global Size)
      Dump Encoded(If_Formats)
      %begin
         %integer s
         %on 9 %start
            Close Output
            %return
         %finish
         %cycle
            Readsymbol(S)
            Printsymbol(S)
         %repeat
      %end
      ->FF
   %finish

   Open Special Input(PrimDir In, Prim Data, Prim Length)
   Select Input(PrimDir In)
   If_Prim Ref Count      = Encoded Value
   If_Prim Def Count      = Encoded Value
   If_Prim Block Count    = Encoded Value
   If_Prim External Count = Encoded Value
   If_Prim Global Size    = Encoded Value
   If_Prim Formats        = Encoded Value

   If_Total Items     = If_     Ref Count + If_     Def Count +  -
                        If_Prim Ref Count + If_Prim Def Count + 1
   If_Total Blocks    = If_Block Count + If_Prim Block Count + 1
   If_Total Formats   = If_Formats + If_Prim Formats
   If_Total Externals = If_External Count + If_Prim External Count

   %if If_Options&LL Decode # 0 %start
      Open LL Output(Decode Out, LL Decode File, 0, Dfile, File)
   %finish
   Pass3(If)
   %if Object Addr # 0 %start
      %begin
         %label Ok
         %integer A, X, F
         %string(255) File = Object File.Tostring(13)
         F = Addr(File)+1
         A = Object Addr
         X = Object Size
         *MOV _ R0, #0           {write memory}
         *LDR _ R1, F            {pointer to file name}
         *MOV _ R2, #0           {load address}
         *MOV _ R3, #0           {execution address}
         *LDR _ R4, A            {start address of memory}
         *LDR _ R5, X            {size of file}
         *ADD _ R5, R5, R4
         *SWI _ Brasil File X
         *BVC _ Ok
         Event_Message = "cannot create object file ".Object File
         %signal  9
Ok:
      %end
   %finish

FF:Select Input(Directives In);  Close Input
   Select Output(Object Out);    Close Output

   %if Store Files = 0 %start
      Delete(Ifile)  %if Exists(Ifile)
      Delete(DoFile) %if Exists(DoFile)
   %finish

   %routine Tell(%integer Stream)
      Select Output(Stream)
      %if If_Faults # 0 %start
         Printstring("Program contains");  Write(If_Faults, 1)
         Printstring(" fault");  Printsymbol('s') %if If_Faults # 1
      %else
         Write(If_Statements, 5)
         Printstring(" primitive") %if Prim # 0
         Printstring(" statement")
         printsymbol('s') %if If_Statements # 1
         Printstring(" compiled")
      %finish
      Newline
   %end

   Tell(Listing)
   Tell(Report) %if Log # 0 %or If_Faults # 0 %or Prim # 0
%end