! Copyright (C) 3L Ltd. 1987-1991
!
! FLATTEN.IMP
!
! Driver for Imp-to-Imp flattener using Imp77 pass1
!
! Rev 005 15-Feb-26 FC Forked from transputer Imp compiler driver
!
externalstring(255)fnspec Upper Case(string (255) M)
externalstring(255)fnspec Translate(string (255) M)
routine Pstr(string(255) s) ; print string(s) ; end
routine Psym(integer i) ; print symbol(i) ; end
externalstring(7) spec P1 Version
own string(31) Compiler Id = "IMP_transputer V1.4"
!%const %string (255) Home Dir = "¬ti1v4¬"
const string(255) Home Dir = "¬ti1v4¬"
!%const %string (255) Include Env = "3LI_INC"
const string(255) Include Env = "3LI_INC"
!%from LL %include Common
include "Common.inc"
!%from CG %include Option3L {option bits}
include "Option3L.inc"
!%from CG %include P2P3 {pass 2/3 interface, for stream identifiers}
include "P2P3.inc"
!%from CG %include Stream3L
include "Stream3L.inc"
!%from IMP %include Lognames
!%from IMP %include Diag IO
external routine spec Delete alias "IMP_DELETE" ( string(255) Filename )
external string(255) fn spec Get Env alias "IMP___GET_ENV"(string(255) s)
{
{ Misc
{
const integer Predef Stream = 2
const integer Listing Stream = 7
const integer Yes = 1, No = 0
const integer Debugs Enabled = Yes {Set to 'No' to inhibit the /? switch}
const integer IO Error = {IMP event number} 9,
Special P2 Diag Bit = 1 << 31
{ Default settings for various function flags
const integer Default Options = LL Warn ! LL Report ! LL Over ! LL Predef,
Default Keep = No,
Default Dump Dir = No,
Default Want Log = No,
Default Want Listing= No,
Default Want Obj = Yes,
Default Want Bin = Yes,
Default Want Hex = No
const integer NTemps = 3 { Number of temp files needed }
external routine spec PASS1 ( integer name Stats, Faults,
integer Flags )
external integer fn spec PASS2 ( integer Options, LL Options,
record(Global Fm) name Global )
own integer Pass 2 Result
external string(255) function Actual Include alias "ACTINC" ( string(255) M, F )
!
! Handle "current place" form, ie null M
!
result = F . ".INC" if M = ""
M = Upper Case(M) . "_INC"
M = Get Env(M)
M = M . "¬" if M # ""
result = M . F . ".INC"
end
{###############################################}
{###############################################}
{### ###}
{### P R E D E F I N I T I O N F I L E ###}
{### ###}
{###############################################}
{###############################################}
external routine spec Open Store Input alias "IMP_OPEN_STORE_INPUT" c
(integer Stream, Loc, Len)
include "IT4predef.inc"
!015!%include IT4predef
!015!%include IT4prede
integer fn First El (byte array name B)
result = Addr(B(1))
end
!T!%routine Show (%string(255) S)
!T! Pstr(S); Psym (NL)
!T!%end
{ ******************************************* }
{ Temporary file manipulation }
{ ******************************************* }
own byte array Existing Temps (1:NTemps) = No(*)
own integer Keep = Default Keep
{
{ Return name for temporary file N
string(12) fn Temp Fn (integer File)
result = "ITEMP." . Itos (File,0)
end
{
{ Delete temporary if exists and unless we are keeping them
routine Delete Temp (integer File)
if Existing Temps (File) = Yes and Keep = No start
Delete (Temp Fn(File))
Existing Temps (File) = No
finish
end
{
{ Open temporary file N for output
routine Open Temp Output (integer Stream, File)
on event IO Error start
Fatal Error ("unable to create temporary file")
finish
Open Binary Output (Stream, Temp Fn(File))
Existing Temps (File) = Yes
end
{
{ Open temporary file N for input
routine Open Temp Input (integer Stream, File)
on event IO Error start
Fatal Error ("unable to access temporary file")
finish
Open Binary Input (Stream, Temp Fn(File))
end
{ ******************************************* }
{ Main IMP driver routine. }
{ ******************************************* }
routine IMP
const integer Default Module Patch Sz = 2
const integer Default Code Patch Sz = 6
const integer Default Data Patch Sz = 6
const integer Max Patch Sz = 8
const string (255) Sz Error = "range for patch size is 2 to "
const integer Frag Array Unit Size = 4000
{ Things set up by processing command line }
external string(255) Source File = ""
external string(255) Module = ""
string(255) Object File = ""
string(255) Listing File = ""
string(255) Switch Line = ""
string(255) Requested Includes = ""
integer Options, P3 Switch, Dump Dir, Want Log, Want Obj, Want Hex,
Want Bin, Want Listing, Exclude Standard Includes
{ *** NB: this string is used by the second pass and mustn't *** }
{ *** be changed (for example, mustn't be changed to *** }
{ *** 'Imp'). (Not seen by humans, anyhow...) *** }
external string(7) Language Name = "IMP"
external integer Language = 1
record(Global Fm) Global Info = 0
Global Info_Compiler Id == Compiler Id
Global Info_Source File == Source File
Global Info_Module == Module
Global Info_Code Patch Sz = Default Code Patch Sz
Global Info_Data Patch Sz = Default Data Patch Sz
Global Info_Frag Array Size = Frag Array Unit Size * 1
Global Info_Module Patch Sz = Default Module Patch Sz
integer Stats = 0, Faults = 0, J, OK
routine Announce
Select Output(0)
Print String("Transputer Imp compiler, ")
Print String(Compiler Id); New Line
Print String("Copyright (C) 1989 3L Ltd"); New Line
end
routine Report (integer Stream)
return if Faults = 0 and Want Log = No
Select Output (Stream)
Write (Stats, 0)
Printstring (" statement"); Printsymbol ('s') if Stats # 1
Printstring (" analysed; ")
if Faults = 0 then Printstring ("no") c
else Write (Faults, 0)
Printstring (" fault"); Printsymbol ('s') if Faults # 1
Printstring (" detected")
Newline
end
routine Set Global Flags
const string (255) LLL Environ Name = "3L_FLAG"
string(255) Translated Name
integer Value = 0
on 4 start {Stoi string not-a-number}
Value = Global Flag Plumbing; -> L {Print out leak info}
finish
Translated Name = Translate(LLL Environ Name)
if Translated Name # LLL Environ Name start
Value = Stoi(Translated Name)
finish
Value = Value ! Global Flag Plumbing if Language = 1 {Imp}
L: Global Info_Flags = Global Info_Flags ! Value
end
{ ******************************************* }
{ Set up control locations in Passes 1 & 2 }
{ ******************************************* }
constinteger Max Cram = 1
integer array Crams (1 : Max Cram)
own string (27) array Cram Names (1 : Max Cram) = c
"Code fragment array size"
own integer array Cram Defaults (1 : Max Cram) = c
4096 {Values to put in the locations. Some variables use }
{'0' to mean some standard default (not this one, tho) }
own integer array Cram Actual Defaults (1 : Max Cram) = c
4096 {What they mean}
own integer array Cram Mins (1 : Max Cram) = c
16
own integer array Cram Maxes (1 : Max Cram) = c
16_7FFFFFFF
own integer array Cram Multipliers (1 : Max Cram) = c
256 {Multiply input (in Kb) by this before storing}
routine Initialise Crams
integer I
Crams(1) = Addr (Global Info_Frag Array Size)
Integer (Crams(I)) = Cram Defaults(I) for I = 1, 1, Max Cram
end
{ ******************************************* }
{ Process the Command Line. }
{ ******************************************* }
begin
integer N, Switch, G
string(255) Item, Value
routine Switch Error
Fatal Error ("unknown switch: " . Item)
end
{ Get next item from command line }
routine Next Item
external string(255) spec Command Line alias "IMP___PARAMETER"
own integer P init = 0
own byte integer name P
P == BYTEINTEGER(0) and P init = 1 if P init = 0
Item = ""
if P == Byte(0) start
!T! Show ("Command Line:<" . Command Line . ">")
{003} begin
{003} const string (255) Default Switches = "TI" {env. var. id}
{003} string(255) S = Translate(Default Switches)
{003} if S # Default Switches start
{003} Command Line = S . TOSTRING(' ') . Command Line
{003} finish
{003} end
Command Line = Command Line . TOSTRING(0)
P == Charno (Command Line, 1)
finish
P == P++1 {P[1]} while P = ' ' or P = ',' or P = ';'
if P # 0 start
Item = Item . TOSTRING(P) and P == P++1 {P[1]} c
until P = ' ' or P = ',' or P = ';' or P = '/' or P = 0
finish
!T! Show ("Item:<" . Item . ">")
end
string(255) function Rest of Item (integer Start)
if Start > Length (Item) c
then result = "" c
else result = Substring (Item, Start, Length(Item))
end
integer fn Excise (integer Ch)
if Ch > Length (Item) then result = 0
if 'a' <= Charno(Item,Ch) <= 'z' then c
Charno(Item,Ch) = Charno(Item,Ch) - 'a' + 'A'
result = Charno(Item,Ch)
end
integer fn Number(string(255) s)
on event 4 start
Fatal Error ("switch should contain a number: ".Item)
finish
if S = "" then result = 0 c
else result = S to I (S)
end
{ Routine to apply Microsoft-C standard File defaulting
string(255) fn File Def (string(*)name Supplied, Model, c
string(255) Ext )
string(255) S Disk, S Dirs, S Fn, S Ext,
M Disk, M Dirs, M Fn, M Ext
routine Split Filename (string(*)name All, Disk, Dirs, Fn, Ext)
string(*) name Elt
integer P, Ch
Disk = "" and Dirs = "" and Fn = "" and Ext = ""
Elt == Fn
! Have faith! Have Faith!
for P = 1, 1, Length (All) cycle
Ch = Charno (All, P)
if Ch = ':' start
Disk = Elt . TOSTRING(Ch); Elt = ""
elseif Ch = '¬'
Dirs = Dirs . Elt . TOSTRING(Ch); Elt = ""; Elt == Fn; Elt = ""
elseif Ch = '.'
Elt == Ext; Elt = Elt . TOSTRING(Ch)
else
Elt = Elt . TOSTRING(Ch)
finish
repeat
end
Split Filename (Supplied, S Disk, S Dirs, S Fn, S Ext)
Split Filename (Model, M Disk, M Dirs, M Fn, M Ext)
S Dirs = M Dirs if S Dirs = "" and S Disk = ""
S Disk = M Disk if S Disk = ""
S Fn = M Fn if S Fn = ""
S Ext = Ext if S Ext = ""
result = S Disk . S Dirs . S Fn . S Ext
end
routine Process Patch
integer Ch = Excise (3)
Switch Error unless ch = 'C' or ch = 'D' or ch = 'M'
N = Number (Rest of Item(4))
if ch = 'C' start
Global Info_Code Patch Sz = N
else if ch = 'M'
Global Info_Module Patch Sz = N
else
Global Info_Data Patch Sz = N
finish
unless 1 < N <= Max Patch Sz start
Fatal Error(Sz Error . Itos(Max Patch Sz, 0) . " bytes")
finish
end
routine Set Flag
Global Info_Flags = Global Info_Flags ! Number(Rest of Item(4))
end
routine Process Buffer Switch
string(63) Stuff, Val
integer ChP, Ch, P, V
routine Describe
integer I, J
Pstr ("Format of /B switch: /B(a)"); Psym(NL);
Pstr ("Parameters, current values and ranges:"); Psym(NL);
for I = 1, 1, Max Cram cycle
Pstr(" ")
Psym('a' + I - 1); Pstr(": ")
Pstr(Cram Names(I)); Pstr(" = ")
J = Integer (Crams(I))
if J = 0 then J = Cram Actual Defaults (I)
Pstr(Itos(J//Cram Multipliers(I),0))
Pstr(" ("); Pstr(Itos(Cram Mins(I),0))
Pstr(" to "); Pstr(Itos(Cram Maxes(I),0)); Psym(')')
Psym(NL)
repeat
Pstr("Values are expressed in kilobytes")
Psym(NL)
end
routine Berr
Describe
Fatal Error ("error in format of /B switch: " . Item)
end
Stuff = Rest of Item (3)
if Stuff = "" start
Describe
else
ChP = 1; P = 1
Berr unless Charno (Stuff, ChP) = '('
cycle
Val = ""
cycle
ChP = ChP + 1
Berr if ChP > Length(Stuff)
Ch = Charno (Stuff, ChP)
exit if Ch = ':' or Ch = ')'
Val = Val . TOSTRING(Ch)
repeat
V = Number (Val)
unless V = 0 start
unless Cram Mins(P) <= V <= Cram Maxes(P) start
Describe
Fatal Error (Val." is outwith the range for the ". c
Cram Names(P))
finish
Integer(Crams(P)) = V * Cram Multipliers(P)
finish
if Ch = ')' then exit
P = P + 1
if P > Max Cram then Berr
repeat
finish
end
{ Set up defaults }
Initialise Crams
Options = Default Options
P3 Switch = 0
Dump Dir = Default Dump Dir
Keep = Default Keep
Want Log = Default Want Log
Want Bin = No
Want Hex = No
Want Obj = Default Want Obj
Want Listing = Default Want Listing
Exclude Standard Includes = No
{ Process items one-by-one }
cycle
Next Item; exit if Item = ""
if Charno (Item, 1) # '/' start
{ It's a filename }
if Source File # "" then c
Fatal Error ("more than one source file specified")
Source File = Item
else
{ It's a switch }
Switch = Excise (2)
if Switch = 'I' start
Value = Rest of Item (3)
if Value = "" start
{ Identify: Say who we are }
Announce
else
Switch Error
finish
else if Switch = 'E'
Exclude Standard Includes = Yes
else if Switch = 'L'
{ (compatibility switch) }
Want Listing = Yes
else if Switch = 'Q'
{ Quiet: suppress warning messages }
Want Log = No
Options = Options !! LL Warn
else if Switch = 'C'
{ Check: suppress code generation }
Want Obj = No
else if Switch = 'H'
{ (compatibility switch) }
Want Hex = Yes
else if Switch = 'F'
{ Files: unified handling of output file specification }
Switch = Excise (3)
if Switch = 'B' or Switch = 'O' start
Want Bin = Yes
Object File = Rest of Item (4)
else if Switch = 'H'
Want Hex = Yes
Object File = Rest of Item (4)
else if Switch = 'L'
Want Listing = Yes
Listing File = Rest of Item (4)
else
Switch Error
finish
else if Switch = '?' and Debugs Enabled = Yes
{ Diagnostics }
Switch = Excise (3)
if Switch = '1' start
Options = Options ! LL Mon ! LL List ! LL Report
Want Listing = Yes
else if Switch = '2'
Options = Options ! Special P2 Diag Bit
else if Switch = '3'
P3 Switch = -1
else if Switch = '*'
{turn all diagnostics on}
Options = Options ! Special P2 Diag Bit ! LL Mon ! LL List ! c
LL Report
P3 Switch = -1
Want Listing = Yes
else if Switch = '?'
Options = Options ! LL Mon
else if Switch = 'D'
Dump Dir = Yes
else if Switch = 'K'
Keep = Yes
else if Switch = 'F' {Set Global Info_Flags}
Set Flag
else
Switch Error
finish
else if Switch = 'T'
{/T4, /T8, /T8A}
Switch = Excise (3)
if Switch = '4' start
Switch = Target T4
else if Switch = '8'
Switch = Target T8
if Excise (4) = 'A' then c
Global Info_Flags = Global Info_Flags ! Global Flag Bug 1
else
Fatal Error("target must be /T4 or /T8 only: ".Item)
finish
if Global Info_Target # 0 start
if Global Info_Target # Switch start
Fatal Error("target processor already specified: ".Item)
finish
finish
Global Info_Target = Switch
else if Switch = 'P'
Process Patch
else if Switch = 'B'
Process Buffer Switch
else if Switch = 'G' {control code-generator options}
constinteger GBS = 'B'<<8 ! 'S',
GBU = 'B'<<8 ! 'U',
GHS = 'H'<<8 ! 'S',
GHU = 'H'<<8 ! 'U'
G = Excise(3)<<8 ! Excise(4)
if G = GBS start {bytes signed}
Global Info_Flags = Global Info_Flags ! Global Flag BS
else if G = GBU {bytes unsigned}
Global Info_Flags = Global Info_Flags & (¬Global Flag BS)
else if G = GHS {shorts signed}
Global Info_Flags = Global Info_Flags & (¬Global Flag SU) c
! Global Flag SH
else if G = GHU {shorts unsigned}
Global Info_Flags = Global Info_Flags ! Global Flag SH c
! Global Flag SU
finish else Switch Error
{002} else if Switch = 'Z'
{002} Switch = Excise(3)
{002} if Switch = 'I' start
{002} Global Info_Flags = Global Info_Flags ! Global Flag Debug
{002} else if Switch = 'D'
{002} !no action just now: reserved for future use.
{002} else
{002} Switch Error
{002} finish
else
Switch Error
finish
Switch Line = Switch Line . " " . Item
finish
repeat
! Fatal Error("/T4 or /T8 required") %if Global Info_Target = 0
Global Info_Target = Target T4 if Global Info_Target = 0 {play safe}
Set Global Flags
{ Default source file extension, etc }
stop if Source file = ""
Source File = File Def (Source File, Source File, ".imp")
{ Check sensible object file requirements and default }
if Want Obj = Yes start
if Want Bin = Want Hex = No start
Want Bin = Default Want Bin
Want Hex = Default Want Hex
else if Want Bin = Want Hex = Yes
Fatal Error ("cannot produce both hex AND binary files")
finish
if Want Hex = Yes start
Object File = File Def (Object File, Source File, ".hex")
else
Global Info_Flags = Global Info_Flags ! Global Flag Binary
Object File = File Def (Object File, Source File, ".fla")
finish
finish
{ Sort out listing file, if any. }
if Want Listing = Yes start
Options = Options ! LL List
Listing File = File Def (Listing File, Source File, ".lis")
finish
end
{
{ Open Source File }
{
Select Input(0); Select Output(0)
begin
on IO Error start
Fatal Error ("unable to open " . Source File . " as source file")
finish
Open Input (1, Source File)
end
{ Derive module id
Module = Source File
{
{ Listing header (if any)
{
if Want Listing = Yes start
begin
on IO Error start
Fatal Error ("unable to open " . Listing File . " as listing file")
finish
Open Output (Listing Stream, Listing File)
end
Select Output(Listing Stream)
Print String("Source file: "); Print String(Source File); New Line
if Want Obj = Yes start
Print String("Object file: "); Print String(Object File); New Line
finish
if Length (Switch Line) > 1 then c
Print String ("Switches: " . Switch Line) and New Line
Print String("Compiled by: Imp77 pass1 V")
Print String(P1 Version); New Lines(2)
finish
{
{ Pass 1
{
Open Store Input(Predef Stream, First El(Predef data), Predef Size)
Open Temp Output (Icode Out, 1) {I-Code Temp file}
Select Output(Icode Out)
if Options & Special P2 Diag Bit # 0 start
{ This is a special I-code to turn on Pass 2 diags }
Print Symbol('y'); Print Symbol(16_8F); Print Symbol(16_FF)
finish
Pass1(Stats, Faults, Options)
Select Output(Icode Out); Close Output
Select Input(1); Close Input
Report (0)
Report (Listing Stream) if Want Listing = Yes
Select Output (Listing Stream); Close Output
if Faults = 0 and Want Obj = Yes start
{
{ Do the back end if no errors and required
{
{ Pass 2
{
Open Temp Input (Icode In, 1) {Main I-Code file}
! Open Temp Output (Code Stream, 2) {code}
! Open Temp Output (Blocks Stream, 3) {blocks info}
begin
on IO Error start
Fatal Error ("unable to open " . Object File . " as object file")
finish
Open Output(Object Stream, Object File)
end
Select Output (0)
Pass2 Result = Pass2 (0, Options, Global Info)
Select Input(Icode In); Close Input
! Select Output(Code Stream); Close Output
! Select Output(Blocks Stream); Close Output
! Delete Temp (1); !for now, always keep Icode file
! %if Pass2 Result & Pass2 Error = 0 %start
! {
! { Pass2 okay - on to Pass3
! {
! %begin
! %on IO Error %start
! Fatal Error ("unable to open " . Object File . " as object file")
! %finish
! %if Want Hex = No %start
! Open Binary Output(Object Stream, Object File)
! %else
! Open Output(Object Stream, Object File)
! %finish
! %end
! Open Temp Input (Code Stream, 2)
! Open Temp Input (Blocks Stream, 3)
! Select Output(Object Stream)
!
! Pass3(P3 Switch, Global Info)
!
! Select Output(Object Stream); Close Output
! Select Input(Code Stream); Close Input
! Select Input(Blocks Stream); Close Input
!
! %finish
!
! Delete Temp (2)
! Delete Temp (3)
finish
end
routine Compile with Traceback
Imp
end
routine Compile with no Traceback
integer I
on event * start
!*FC*! Delete Temp (I) %for I = 1, 1, NTemps
if Event_Event = IO Error start
Fatal Error ("file system failure: " . ItoS(Event_{Extra}Info,0))
else if Event_Event = 2 and Event_Sub = 1
Fatal Error ("not enough memory")
else if Event_Event = 0 = Event_Sub
stop
else
CSR ("event ".Itos(Event_Event,0).",".Itos(Event_Sub,0).",". c
Itos(Event_{Extra}Info,0))
finish
finish
Imp
end
{ Start here }
begin
if Translate ("3L_TRACEBACK") = "3L_TRACEBACK" c
then Compile with no Traceback c
else Compile with Traceback
endofprogram