## architecture-description.pkg -- derived from ~/src/sml/nj/smlnj-110.60/MLRISC/Tools/ADL/mdl-compile.sml
#
# See overview comments in
# src/lib/compiler/back/low/tools/arch/architecture-description.api# Compiled by:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.lib### "I visualize a time when we
### will be to robots what
### dogs are to humans, and I'm
### rooting for the machines."
###
### -- Claude Shannon
stipulate
package cst = adl_raw_syntax_constants; # adl_raw_syntax_constants is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-constants.pkg package err = adl_error; # adl_error is from src/lib/compiler/back/low/tools/line-number-db/adl-error.pkg package htb = hashtable; # hashtable is from src/lib/src/hashtable.pkg# package spp = simple_prettyprinter; # simple_prettyprinter is from src/lib/prettyprint/simple/simple-prettyprinter.pkg package rrs = adl_rewrite_raw_syntax_parsetree; # adl_rewrite_raw_syntax_parsetree is from src/lib/compiler/back/low/tools/adl-syntax/adl-rewrite-raw-syntax-parsetree.pkg package mst = adl_symboltable; # adl_symboltable is from src/lib/compiler/back/low/tools/arch/adl-symboltable.pkg package raw = adl_raw_syntax_form; # adl_raw_syntax_form is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-form.pkg package rsu = adl_raw_syntax_unparser; # adl_raw_syntax_unparser is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-unparser.pkg package rsj = adl_raw_syntax_junk; # adl_raw_syntax_junk is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-junk.pkg package rsp = adl_raw_syntax_predicates; # adl_raw_syntax_predicates is from src/lib/compiler/back/low/tools/arch/adl-raw-syntax-predicates.pkg# package rst = adl_raw_syntax_translation; # adl_raw_syntax_translation is from src/lib/compiler/back/low/tools/adl-syntax/adl-raw-syntax-translation.pkg# package mtj = adl_type_junk; # adl_type_junk is from src/lib/compiler/back/low/tools/arch/adl-type-junk.pkgherein
# This package is referenced in:
#
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages.pkg #
package architecture_description
: (weak) Architecture_Description # Architecture_Description is from src/lib/compiler/back/low/tools/arch/architecture-description.api {
Filename = String;
infix my ++ ;
++ = mst::(++);
Slot(X) = EMPTY String # One slot holds one architecture-description-file declaration.
| SLOT (String, X)
;
# architecture description:
#
Architecture_Description
=
ARCHITECTURE_DESCRIPTION
{ symboltable: Ref( mst::Symboltable ),
architecture_description_file: Filename, # Something like "src/lib/compiler/back/low/intel32/one_word_int.architecture-description".
#
debug: Ref( List( String ) ),
registersets: Ref( List( raw::Register_Set ) ),
special_registers: Ref( List( raw::Special_Register ) ),
instruction_formats: Ref( List( (Null_Or(Int), raw::Instruction_Format) )),
#
base_ops: Ref( Slot( List( raw::Constructor ) ) ),
endian: Ref( Slot( raw::Endian ) ), # LITTLE for intel32, BIG for pwrpc32 and sparc32.
#
asm_case: Ref( Slot( raw::Assemblycase ) ), # Should generated assembly code be UPPERCASE, LOWERCASE or VERBATIM?
architecture_name: Ref( Slot( String ) ), # Architecture name ("intel32"|"sparc32"|"pwrpc32") -- 'foo' from the 'architecture foo = ' line
#
cpus: Ref( Slot( List( raw::Cpu ) ) ),
pipelines: Ref( Slot( List( raw::Pipeline) ) ),
resources: Ref( Slot( List( raw::Id ) ) ),
latencies: Ref( Slot( List( raw::Latency ) ) )
};
fun get_slot (REF (EMPTY name)) => err::fail (name + " has not been declared");
get_slot (REF (SLOT(_, x))) => x;
end;
fun get_slot' (REF (EMPTY _)) => [];
get_slot' (REF (SLOT(_, x))) => x;
end;
fun set_slot (s as REF (EMPTY name), x) => s := SLOT (name, x);
set_slot (s as REF (SLOT (name, _)), x) => err::error("duplicate declaration of " + name);
end;
fun set_slot' (s as REF (EMPTY name), x) => s := SLOT (name, x);
set_slot' (s as REF (SLOT (name, _)), x) => s := SLOT (name, x);
end;
# Fetch slots from architecture description record:
#
fun endian_of (ARCHITECTURE_DESCRIPTION r ) = get_slot r.endian; # LITTLE for INTEL32 (x86), BIG for SPARC32 and PWRPC32.
fun asm_case_of (ARCHITECTURE_DESCRIPTION r ) = get_slot r.asm_case;
fun architecture_name_of (ARCHITECTURE_DESCRIPTION r ) = get_slot r.architecture_name; # "INTEL32"|"SPARC32"|"PWRPC32" -- 'foo' from 'architecture foo = ' line
fun architecture_description_file_of (ARCHITECTURE_DESCRIPTION r ) = r.architecture_description_file; # Something like "src/lib/compiler/back/low/intel32/one_word_int.architecture-description".
fun symboltable_of (ARCHITECTURE_DESCRIPTION r ) = *r.symboltable;
fun registersets_of (ARCHITECTURE_DESCRIPTION r ) = *r.registersets;
fun special_registers_of (ARCHITECTURE_DESCRIPTION r ) = *r.special_registers;
fun instruction_formats_of (ARCHITECTURE_DESCRIPTION r ) = *r.instruction_formats;
fun base_ops_of (ARCHITECTURE_DESCRIPTION r ) = get_slot r.base_ops;
fun resources_of (ARCHITECTURE_DESCRIPTION r ) = get_slot' r.resources;
fun latencies_of (ARCHITECTURE_DESCRIPTION r ) = get_slot' r.latencies;
fun cpus_of (ARCHITECTURE_DESCRIPTION r ) = get_slot' r.cpus;
fun pipelines_of (ARCHITECTURE_DESCRIPTION r ) = get_slot' r.pipelines;
#
fun debugging (ARCHITECTURE_DESCRIPTION r ) x = list::exists (\\ x' = x == x') *r.debug;
# fun registersets (ARCHITECTURE_DESCRIPTION { registersets, ... } )
# =
# list_mergesort::sort
# #
# (\\ ( REGISTER_SET { from=>f1, ... },
# REGISTER_SET { from=>f2, ... }
# )
# = *f1 > *f2
# )
# #
# (list::filter
# #
# \\ REGISTER_SET { registerset=>TRUE, alias=>NULL, ... } => TRUE;
# REGISTER_SET _ => FALSE;
# end
# #
# *registersets
# );
#
# fun registersets_aliases (ARCHITECTURE_DESCRIPTION { registersets, ... } )
# =
# list_mergesort::sort
# #
# (\\ ( REGISTER_SET { from=>f1, ... },
# REGISTER_SET { from=>f2, ... }
# )
# =
# *f1 > *f2
# )
# #
# (list::filter
# #
# \\ REGISTER_SET { registerset=>TRUE, ... } => TRUE;
# REGISTER_SET { alias=THE _, ... } => TRUE;
# _ => FALSE;
# end
# #
# *registersets
# );
# Find register-set named k by
# looping over ARCHITECTURE_DESCRIPTION.registersets:
#
fun find_registerset_by_name (ARCHITECTURE_DESCRIPTION { registersets, ... } ) name
=
loop *registersets
where
fun loop ((c as raw::REGISTER_SET r) ! cs)
=>
if (r.name == name or r.nickname == name) c;
else loop cs;
fi;
loop [] => err::fail ("registerkind " + name + " not found");
end;
end;
fun find_instruction_sumtype (ARCHITECTURE_DESCRIPTION { symboltable, ... } ) name # This is called (only) from src/lib/compiler/back/low/tools/arch/adl-rtl-comp-g.pkg =
# For query string "binaryOp" return sumtype named "binaryOp"
# from package Instruction in architecture description:
#
loop sumtypes
where
instruction_dict = mst::find_package *symboltable (raw::IDENT([], "Instruction"));
#
sumtypes = mst::sumtype_definitions instruction_dict;
fun loop ((sumtype as raw::SUMTYPE r) ! sumtypes)
=>
if (r.name == name) sumtype;
else loop sumtypes;
fi;
loop [] => err::fail ("Instruction sumtype " + name + " not found");
loop _ => err::fail "Bug: Unsupported case in find_instruction_sumtype";
end;
end;
fun has_copy_impl architecture_description # TRUE iff architecture description has an instruction named "COPY" whose type is a record with a field named "impl".
=
list::exists
#
\\ raw::CONSTRUCTOR { name => "COPY", type => THE (raw::RECORDTY fields), ... }
=>
list::exists (\\ (id, _) = id == "impl") fields;
_ => FALSE;
end
#
(base_ops_of architecture_description);
# Extract info from the symboltable:
#
my decl_of: Architecture_Description -> String -> raw::Declaration # Body of package.
=
mst::decl_of o symboltable_of;
#
my generic_arg_of: Architecture_Description -> String -> raw::Declaration # Generic argument.
=
mst::generic_arg_of o symboltable_of;
#
my type_of: Architecture_Description -> String -> raw::Declaration # Type definitions.
=
mst::type_of o symboltable_of;
# Require that contents of 'values' and 'types' lists
# be defined in given architecture description:
#
fun require architecture_description symboltable_name { values, types }
=
{ decls = decl_of architecture_description symboltable_name;
#
hash = hash_string::hash_string;
exception NOT_DEFINED;
value_table = htb::make_hashtable (hash, (==)) { size_hint => 32, not_found_exception => NOT_DEFINED };
type_table = htb::make_hashtable (hash, (==)) { size_hint => 32, not_found_exception => NOT_DEFINED };
fun enter_sumtype (raw::SUMTYPE { name, ... } ) => htb::set type_table (name, ());
enter_sumtype (raw::SUMTYPE_ALIAS { name, ... } ) => htb::set type_table (name, ());
end;
fun enter_type (raw::TYPE_ALIAS (id, _, _)) = htb::set type_table (id, ());
fun enter_fun (raw::FUN (id, _) ) = htb::set value_table (id, ());
fun rewrite_declaration_node _ (d as raw::SUMTYPE_DECL (dts, ts)) => { apply enter_sumtype dts; apply enter_type ts; d; };
rewrite_declaration_node _ (d as raw::FUN_DECL fbs) => { apply enter_fun fbs; d; };
rewrite_declaration_node _ d => { d; };
end;
fns.rewrite_declaration_parsetree decls # We abuse 'rewrite' as 'apply'.
where
fns = rrs::make_raw_syntax_parsetree_rewriters [ rrs::REWRITE_DECLARATION_NODE rewrite_declaration_node ];
end;
fun check kind table id
=
htb::look_up table id
except
_ = err::warning ("missing " + kind + " " + symboltable_name + "." + id);
apply (check "function" value_table) values;
apply (check "type" type_table) types ;
};
# Compile an architecture-description parsetree into internal form:
#
# We get called from make_sourcecode_for_backend_packages () in:
# src/lib/compiler/back/low/tools/arch/make-sourcecode-for-backend-packages-g.pkg #
fun translate_raw_syntax_to_architecture_description
(
architecture_description_file: String, # Something like "src/lib/compiler/back/low/intel32/one_word_int.architecture-description".
declarations: List( raw::Declaration ) # 'declarations' is the parsetree from the above architecture description file.
)
=
{ err::init ();
#
digest_declarations declarations;
#
architecture_description;
}
where
endian = REF (EMPTY "endian" );
asm_case = REF (EMPTY "assembly case" );
architecture_name = REF (EMPTY "architecture name" ); # This will be "pwrpc32" or "sparc32" or "intel32", from "architecture intel32 = ... " line
base_ops = REF (EMPTY "base instructions" );
pipelines = REF (EMPTY "pipelines" );
resources = REF (EMPTY "resources" );
latencies = REF (EMPTY "latencies" );
cpus = REF (EMPTY "cpus" );
symboltable = REF mst::empty;
registersets = REF [];
special_registers = REF [];
debug = REF [];
instruction_formats = REF [];
architecture_description
=
ARCHITECTURE_DESCRIPTION
{ symboltable,
endian,
asm_case,
architecture_name,
architecture_description_file,
registersets,
special_registers,
instruction_formats,
base_ops,
debug,
cpus,
resources,
pipelines,
latencies
};
fun note_declaration declaration # Add given declaration to *symboltable.
=
symboltable := mst::note_declaration *symboltable declaration;
fun digest_declarations [] => ();
#
digest_declarations (d ! ds) => { digest_declaration d;
digest_declarations ds;
};
end
also
fun digest_declaration d
=
case d
#
# Standard SML constructions:
#
raw::SUMTYPE_DECL _ => note_declaration d;
raw::FUN_DECL _ => note_declaration d;
raw::VAL_DECL _ => note_declaration d;
raw::VALUE_API_DECL _ => note_declaration d;
raw::TYPE_API_DECL _ => note_declaration d;
raw::LOCAL_DECL _ => note_declaration d;
raw::PACKAGE_DECL _ => note_declaration d;
raw::INFIX_DECL _ => note_declaration d;
raw::INFIXR_DECL _ => note_declaration d;
raw::NONFIX_DECL _ => note_declaration d;
raw::OPEN_DECL _ => note_declaration d;
#
raw::SEQ_DECL ds => digest_declarations ds;
raw::VERBATIM_CODE _ => ();
raw::SOURCE_CODE_REGION_FOR_DECLARATION (l, d)
=>
{ err::set_loc l;
#
digest_declaration d;
};
# Constructions special to architecture-description-language:
#
raw::INSTRUCTION_FORMATS_DECL (bits, f) => instruction_formats := *instruction_formats @ map (\\ f = (bits, f)) f;
raw::REGISTERS_DECL d => registersets := *registersets @ d;
raw::SPECIAL_REGISTERS_DECL d => special_registers := *special_registers @ d;
#
raw::BASE_OP_DECL c => { set_slot (base_ops, c); note_declaration d; };
raw::ARCHITECTURE_DECL (n, ds) => { set_slot (architecture_name, n); digest_declarations ds; };
#
raw::BITS_ORDERING_DECL _ => err::error "bitsordering";
#
raw::BIG_VS_LITTLE_ENDIAN_DECL e => set_slot (endian, e);
raw::ARCHITECTURE_NAME_DECL n => set_slot' (architecture_name, n);
raw::ASSEMBLY_CASE_DECL c => set_slot (asm_case, c);
raw::PIPELINE_DECL p => set_slot (pipelines, p);
raw::CPU_DECL c => set_slot (cpus, c);
raw::RESOURCE_DECL r => set_slot (resources, r);
raw::LATENCY_DECL l => set_slot (latencies, l);
#
raw::DEBUG_DECL id => debug := id ! *debug;
_ => err::error "compile";
esac;
end;
}; # package architecture_description
end; # stipulate