## registerkinds-junk.pkg -- derived from ~/src/sml/nj/smlnj-110.58/new/new/src/MLRISC/instructions/cells-basis.sig
#
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib### "At Group L, Stoffel oversees six first-rate programmers,
### a managerial challenge roughly comparable to herding cats."
###
### -- Washington Post Magazine, 1985
# Support for handling registers, register colors and register sets.
stipulate
package lem = lowhalf_error_message; # lowhalf_error_message is from src/lib/compiler/back/low/control/lowhalf-error-message.pkg package nt = note; # note is from src/lib/src/note.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkgherein
package registerkinds_junk
: (weak) Registerkinds_Junk # Registerkinds_Junk is from src/lib/compiler/back/low/code/registerkinds-junk.api {
Registerkind_Names
=
REGISTERKIND_NAMES
{
name: String,
nickname: String
};
Register_Size_In_Bits = Int; # Width in bits.
Universal_Register_Id = Int; # Small-int unique across all 'registers' of all kinds, including condition code bits etc.
Interkind_Register_Id = Int; # Small-int unique across all plain registers. These are our register 'colors' for register allocation purposes.
Intrakind_Register_Id = Int; # Small-int unique across all plain registers of one kind -- e.g. all float registers or all int registers.
Registerkind # This is an equality type.
#
= INT_REGISTER # General purpose register
| FLOAT_REGISTER # Floating point register
| RAM_BYTE #
#
| FLAGS_REGISTER # We treat each condition-codes register bit as a separate 1-bit register.
| CONTROL_DEPENDENCY # Simplifies our code to treat control dependencies like register dependencies.
| OTHER_REGISTER Ref( Registerkind_Names ) # Architecture-specific registers.
;
Registerkind_Info
=
REGISTERKIND_INFO
{
kind: Registerkind, # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api codetemps_made_count: Ref( Int ), # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api global_codetemps_created_so_far: Ref( Int ), # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api min_register_id: Int, # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api max_register_id: Int, # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api to_string: Interkind_Register_Id -> String,
sized_to_string: (Interkind_Register_Id, Register_Size_In_Bits) -> String,
hardware_registers: Ref( rwv::Rw_Vector(Codetemp_Info) ), # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api always_zero_register: Null_Or( Interkind_Register_Id )
}
also
Codetemp_Info
=
CODETEMP_INFO
{ id: Universal_Register_Id,
color: Ref( Codetemp_Color ),
kind: Registerkind_Info,
notes: Ref( nt::Notes )
}
also
Codetemp_Color
= MACHINE Interkind_Register_Id
| CODETEMP
| ALIASED Codetemp_Info
| SPILLED
;
array0
=
rwv::from_fn (0, \\ _ = raise exception MATCH): rwv::Rw_Vector( Codetemp_Info );
fun error msg
=
lem::error ("registerkinds-junk", msg);
fun name_of_registerkind INT_REGISTER => "REGISTER";
name_of_registerkind FLOAT_REGISTER => "FLOAT_REGISTER";
name_of_registerkind FLAGS_REGISTER => "FLAGS_REGISTER";
name_of_registerkind RAM_BYTE => "RAM_BYTE";
name_of_registerkind CONTROL_DEPENDENCY => "CONTROL_DEPENDENCY";
#
name_of_registerkind (OTHER_REGISTER (REF (REGISTERKIND_NAMES r ))) => r.name;
end;
fun nickname_of_registerkind INT_REGISTER => "r"; # Apparently invoked only in src/lib/compiler/back/low/treecode/treecode-hashing-equality-and-display-g.pkg nickname_of_registerkind FLOAT_REGISTER => "f";
nickname_of_registerkind FLAGS_REGISTER => "cc";
nickname_of_registerkind RAM_BYTE => "m"; # "m" for "main memory".
nickname_of_registerkind CONTROL_DEPENDENCY => "ctrl";
#
nickname_of_registerkind (OTHER_REGISTER (REF (REGISTERKIND_NAMES r ))) => r.nickname;
end;
fun make_registerkind { name=>"INT_REGISTER", ... } => INT_REGISTER; # Invoked in src/lib/compiler/back/low/intel32/code/registerkinds-intel32.codemade.pkg make_registerkind { name=>"FLOAT_REGISTER", ... } => FLOAT_REGISTER; # also in src/lib/compiler/back/low/pwrpc32/code/registerkinds-pwrpc32.codemade.pkg make_registerkind { name=>"FLAGS_REGISTER", ... } => FLAGS_REGISTER; # also in src/lib/compiler/back/low/sparc32/code/registerkinds-sparc32.codemade.pkg make_registerkind { name=>"RAM_BYTE", ... } => RAM_BYTE;
make_registerkind { name=>"CONTROL_DEPENDENCY", ... } => CONTROL_DEPENDENCY;
make_registerkind { name, nickname } => OTHER_REGISTER (REF (REGISTERKIND_NAMES { name, nickname } )); # This is the only case exercised by existing code.
end;
fun follow_register_alias_chain (CODETEMP_INFO { color => REF (ALIASED c), ... } ) => follow_register_alias_chain(c);
follow_register_alias_chain c => c;
end;
fun universal_register_id_of (CODETEMP_INFO r)
=
r.id;
fun interkind_register_id_of (CODETEMP_INFO { color=>REF (ALIASED c), ... } ) => interkind_register_id_of c;
interkind_register_id_of (CODETEMP_INFO { color=>REF (MACHINE r), ... } ) => r;
interkind_register_id_of (CODETEMP_INFO { color=>REF SPILLED, ... } ) => -1;
interkind_register_id_of (CODETEMP_INFO { color=>REF CODETEMP, id, ... } ) => id; # Note that CODETEMPs have idential interkind- and intra-kind IDs.
end;
fun intrakind_register_id_of (CODETEMP_INFO { color=>REF (ALIASED c), ... } ) => intrakind_register_id_of c;
intrakind_register_id_of (CODETEMP_INFO { color=>REF (MACHINE r), kind => REGISTERKIND_INFO k, ... } ) => r - k.min_register_id;
intrakind_register_id_of (CODETEMP_INFO { color=>REF SPILLED, ... } ) => -1;
intrakind_register_id_of (CODETEMP_INFO { color=>REF CODETEMP, id, ... } ) => id;
end;
fun hardware_register_id_of (CODETEMP_INFO { color=>REF (ALIASED c), ... } )
=>
hardware_register_id_of c;
hardware_register_id_of (CODETEMP_INFO { color => REF (MACHINE r),
kind => REGISTERKIND_INFO d,
...
}
)
=>
r - d.min_register_id;
hardware_register_id_of (CODETEMP_INFO { color=>REF SPILLED, id, ... } )
=>
error("hardware_register_id_of: SPILLED: " + int::to_string id);
hardware_register_id_of (CODETEMP_INFO { color=>REF CODETEMP, id, ... } )
=>
error("hardware_register_id_of: CODETEMP: " + int::to_string id);
end;
fun register_to_hashcode (CODETEMP_INFO { id, ... } )
=
unt::from_int id;
fun hash_color c
=
unt::from_int (interkind_register_id_of c);
fun same_id (r1, r2) = universal_register_id_of r1 == universal_register_id_of r2;
fun codetemps_are_same_color (r1, r2) = interkind_register_id_of r1 == interkind_register_id_of r2;
fun compare_registers_by_color (r1, r2)
=
int::compare ( interkind_register_id_of r1,
interkind_register_id_of r2
);
fun registerkind_of (CODETEMP_INFO { kind => REGISTERKIND_INFO { kind, ... }, ... } )
=
kind;
# Register prettyprinting:
#
fun register_to_string (CODETEMP_INFO { color=>REF (ALIASED c), ... } )
=>
register_to_string c;
register_to_string (c as CODETEMP_INFO { kind => REGISTERKIND_INFO { to_string, ... }, ... } )
=>
to_string (intrakind_register_id_of c);
end;
#
fun register_to_string' # Apparently called only once, in src/lib/compiler/back/low/intel32/emit/translate-machcode-to-asmcode-intel32-g.codemade.pkg {
my_register => c as CODETEMP_INFO { kind => REGISTERKIND_INFO { sized_to_string, ... }, ... },
size_in_bits => size
}
=
sized_to_string (intrakind_register_id_of c, size);
fun cnv (r, low, high)
=
if (low <= r and r <= high) r - low;
else r;
fi;
# See 'api Colorset' comments in
#
# src/lib/compiler/back/low/code/registerkinds-junk.api #
package cos { # Exported to client packages. "cos" == "colorset".
#
Codetemp_Info = Codetemp_Info; # Included for purely technical reasons -- Colorset api declaration won't work without it.
Colorset = List( Codetemp_Info );
empty_colorset = [];
size = list::length;
fun add_codetemp_to_colorset (codetemp, colorset)
=
f colorset
where
c = interkind_register_id_of codetemp;
fun f (l as (h ! t))
=>
{ ch = interkind_register_id_of h;
#
if (c < ch) codetemp ! l;
elif (c > ch) h ! f t;
else l;
fi;
};
f [] => [codetemp];
end;
end;
fun drop_codetemp_from_colorset (register, l)
=
f l
where
c = interkind_register_id_of register;
fun f (l as (h ! t))
=>
{ ch = interkind_register_id_of h;
if (c == ch) t;
elif (c < ch) l;
else h ! f l;
fi;
};
f [] => [];
end;
end;
fun make_colorset registers
=
list::fold_forward
add_codetemp_to_colorset
[]
(map follow_register_alias_chain registers);
fun difference_of_colorsets ([], _) => [];
difference_of_colorsets (l, []) => l;
difference_of_colorsets
(
l1 as x ! xs,
l2 as y ! ys
)
=>
{ cx = interkind_register_id_of x;
cy = interkind_register_id_of y;
if (cx == cy) difference_of_colorsets (xs, ys);
elif (cx < cy) x ! difference_of_colorsets (xs, l2);
else difference_of_colorsets (l1, ys);
fi;
};
end;
fun union_of_colorsets (a, []) => a;
union_of_colorsets ([], a) => a;
union_of_colorsets (l1 as x ! xs, l2 as y ! ys)
=>
{ cx = interkind_register_id_of x;
cy = interkind_register_id_of y;
if (cx == cy) x ! union_of_colorsets (xs, ys);
elif (cx < cy) x ! union_of_colorsets (xs, l2);
else y ! union_of_colorsets (l1, ys);
fi;
};
end;
fun intersection_of_colorsets (a, []) => [];
intersection_of_colorsets ([], a) => [];
intersection_of_colorsets
(
l1 as x ! xs,
l2 as y ! ys
)
=>
{ cx = interkind_register_id_of x;
cy = interkind_register_id_of y;
if (cx == cy) x ! intersection_of_colorsets (xs, ys);
elif (cx < cy) intersection_of_colorsets (xs, l2);
else intersection_of_colorsets (l1, ys);
fi;
};
end;
fun not_same_colorset ([], []) => FALSE;
not_same_colorset([], l) => TRUE;
not_same_colorset(_, []) => TRUE;
not_same_colorset (x ! l1, y ! l2)
=>
interkind_register_id_of x != interkind_register_id_of y
or
not_same_colorset (l1, l2);
end;
fun same_colorset ([], [])
=>
TRUE;
same_colorset (x ! l1, y ! l2)
=>
interkind_register_id_of x == interkind_register_id_of y
or
same_colorset (l1, l2);
same_colorset (_, _)
=>
FALSE;
end;
fun get_codetemps_in_colorset cs
=
cs;
fun colorset_is_empty [] => TRUE;
colorset_is_empty _ => FALSE;
end;
fun colorsets_intersection_is_empty (_, []) => TRUE;
colorsets_intersection_is_empty ([], _) => TRUE;
colorsets_intersection_is_empty (l1 as x ! xs, l2 as y ! ys)
=>
{ cx = interkind_register_id_of x;
cy = interkind_register_id_of y;
if (cx == cy)
#
FALSE;
else
if (cx < cy) colorsets_intersection_is_empty (xs, l2);
else colorsets_intersection_is_empty (l1, ys);
fi;
fi;
};
end;
# fun is_in_colorset (x, l) # Commented out because never used -- 2011-06-25 CrT
# =
# { x = interkind_register_id_of x;
#
# list::exists
# (\\ y = interkind_register_id_of y == x)
# l;
# };
};
# A common idiom -- sort a codetemps list
# by color and drop duplicated colors:
#
sortuniq_colored_codetemps
=
cos::get_codetemps_in_colorset
o
cos::make_colorset;
package id_indexed_hashtable
=
typelocked_hashtable_g ( # typelocked_hashtable_g is from src/lib/src/typelocked-hashtable-g.pkg Hash_Key = Codetemp_Info;
hash_value = register_to_hashcode;
same_key = same_id;
);
package iih = id_indexed_hashtable; # Abbreviation.
package color_indexed_hashtable
=
typelocked_hashtable_g (
#
Hash_Key = Codetemp_Info;
hash_value = hash_color;
same_key = codetemps_are_same_color;
);
package cih = color_indexed_hashtable; # Abbreviation.
################################################## # This package should have its own file. XXX SUCKO FIXME.
# Lists of codetemps segregated by kind -- in
# practice, floats vs ints. This is a workhorse
# datastructure used to track which codetemps are
# live, dead, spilled, etc:
#
package cls { # Exports to client packages. "cls" == "codetemplists".
#
Codetemp_Info = Codetemp_Info; # These two included only to make Registerkind api declaration work.
Registerkind_Info = Registerkind_Info;
Codetemplists
=
List( (Registerkind_Info, List(Codetemp_Info)) );
empty_codetemplists = [];
stipulate
fun kind_of (CODETEMP_INFO r)
=
r.kind;
fun same_kind
( REGISTERKIND_INFO { codetemps_made_count=>x, ... },
REGISTERKIND_INFO { codetemps_made_count=>y, ... }
)
=
x == y; # We're comparing the refcells themselves -- not their contents!
herein
fun add_codetemp_to_appropriate_kindlist
(
codetemp,
codetemplists: Codetemplists
)
=
loop codetemplists
where
kind = kind_of codetemp;
fun loop ((x as (kind', s)) ! codetemplists)
=>
if (same_kind (kind, kind')) (kind', codetemp ! s) ! codetemplists;
else x ! loop codetemplists;
fi;
loop [] => [ (kind, [codetemp]) ];
end;
end;
fun drop_codetemp_from_codetemplists (r, codetemplists: Codetemplists)
=
loop codetemplists
where
kind = kind_of r;
c = interkind_register_id_of r;
fun filter (r ! rs)
=>
if (interkind_register_id_of r == c) filter rs;
else r ! filter rs;
fi;
filter [] => [];
end;
fun loop((x as (kind', s)) ! codetemplists)
=>
if (same_kind (kind, kind')) (kind', filter s) ! codetemplists;
else x ! loop codetemplists;
fi;
loop [] => [];
end;
end;
fun get_codetemps_for_kindinfo (k: Registerkind_Info)
=
loop
where
fun loop ((k', s) ! codetemplists)
=>
if (same_kind (k, k')) s;
else loop codetemplists;
fi;
loop ([] : Codetemplists) => [];
end;
end;
fun replace_codetemps_for_kindinfo
#
(k: Registerkind_Info)
#
(codetemplists: Codetemplists, codetemps)
=
loop codetemplists
where
fun loop ((x as (k', _)) ! codetemplists)
=>
if (same_kind (k, k')) (k', codetemps) ! codetemplists;
else x ! loop codetemplists;
fi;
loop [] => [ (k, codetemps) ];
end;
end;
fun replace_this_by_that_in_codetemplists { this, that } (codetemplists: Codetemplists) # No-op if 'this' and 'that' are different kinds.
=
loop codetemplists
where
this -> CODETEMP_INFO { kind => this_kind, ... };
this_id = interkind_register_id_of this;
fun replace_this_by_that' r
=
if (interkind_register_id_of r == this_id) that;
else r;
fi;
# Find the codetemps list for this_kind
# and do the substitute in it:
#
fun loop ((x as (kind', codetemps)) ! codetemplists)
=>
if (same_kind (this_kind, kind')) (kind', list::map replace_this_by_that' codetemps) ! codetemplists;
else x ! loop codetemplists;
fi;
loop [] => [];
end;
end;
end;
get_all_codetemps_from_codetemplists
=
list::fold_backward
(\\ ((_, s), s') = s @ s')
[]
:
Codetemplists -> List(Codetemp_Info)
;
# Prettyprint codetemplists:
#
fun print_set (f, set, s)
=
"{ " ! loop (set, s)
where
fun loop ([], s) => "}" ! s;
loop ([x], s) => f (follow_register_alias_chain x) ! "}" ! s;
loop (x ! xs, s)
=>
f (follow_register_alias_chain x) ! " " ! loop (xs, s);
end;
end;
fun to_string' codetemplists
=
pr codetemplists
where
fun pr codetemplists
=
string::cat (loop (codetemplists, []))
where
fun loop ((REGISTERKIND_INFO { kind, ... }, s) ! rest, sss)
=>
case s
#
[] => loop (rest, sss);
_ => name_of_registerkind kind
!
"="
!
print_set (
register_to_string, s, " "
!
loop (rest, sss)
);
esac;
loop ([], sss) => sss;
end;
end;
end;
codetemplists_to_string = to_string';
}; # package codetemplists
# These annotations specify
# definitions and uses for
# a codetemp:
#
exception DEF_USE { registerkind: Registerkind,
defs: List(Codetemp_Info),
uses: List(Codetemp_Info)
};
def_use = nt::make_notekind'
{
x_to_note => DEF_USE,
#
get => \\ DEF_USE x => x;
other => raise exception other;
end,
to_string => \\ { registerkind, defs, uses }
=
"def_use" + name_of_registerkind registerkind
};
# Hack for generating memory aliasing registers
#
ram_registerkind_info
=
REGISTERKIND_INFO
{
kind => RAM_BYTE,
codetemps_made_count => REF 0,
min_register_id => 0,
max_register_id => -1,
to_string => \\ m = "m" + int::to_string m,
sized_to_string => \\ (m, _) = "m" + int::to_string m,
hardware_registers => REF array0,
always_zero_register => NULL,
global_codetemps_created_so_far => REF 0 # See comment in src/lib/compiler/back/low/code/registerkinds-junk.api };
#######################################################################################################################
# These three are for INTERNAL USE ONLY,
# for alias analysis:
#
fun show (REGISTERKIND_INFO { to_string, min_register_id, max_register_id, ... } ) r
=
to_string (cnv (r, min_register_id, max_register_id));
fun show_with_size (REGISTERKIND_INFO { sized_to_string, min_register_id, max_register_id, ... } ) (r, size)
=
sized_to_string (cnv (r, min_register_id, max_register_id), size);
fun make_ram_register id
=
CODETEMP_INFO
{
id,
notes => REF [],
kind => ram_registerkind_info,
color => REF( MACHINE id )
};
zero_length_rw_vector
=
rwv::from_fn (0, \\ _ = raise exception MATCH): rwv::Rw_Vector(Codetemp_Info);
#######################################################################################################################
# The rest of this stuff is never referenced, so I've commented it out.
# I have no idea which parts are past mistakes that were being phased out,
# and which parts were future mistakes being phased in. -- 2011-03-13 CrT
#
# fun same_kind_of_register (c1, c2) = same_kind (kind_of c1, kind_of c2); # Commented out because unused -- 2011-03-12 CrT
# fun same_register_up_to_aliasing (c1, c2) = same_id ( follow_register_alias_chain c1, # Commented out because unused -- 2011-03-12 CrT
# follow_register_alias_chain c2
# );
# fun notes_of_register (CODETEMP_INFO { notes, ... } ) = notes; # Commented out because unused -- 2011-03-12 CrT
# fun set_color_alias_of_from_pseudoregister { from, to } # Commented out because unused -- 2011-03-12 CrT
# #
# # Set the color of the 'from' register to be the same as
# # the 'to' register. The 'from' register MUST be a pseudo register,
# # and cannot be of kind CONST.
# =
# { (follow_register_alias_chain from) -> CODETEMP_INFO { color => color_from, id, kind=>REGISTERKIND_INFO { kind, ... }, ... };
# (follow_register_alias_chain to ) -> to as CODETEMP_INFO { color => color_to, ... };
#
#
# if (color_from != color_to)
# # prevent self-loops
# if (id < 0)
# #
# error "set_color_aliase_of_from_pseudoregister: constant";
# else
# case (*color_from, kind)
# #
# (CODETEMP, _) => color_from := ALIASED to;
# _ => error "setAlias: non-pseudo";
# esac;
# fi; fi;
# };
# fun register_is_constant (CODETEMP_INFO { id, ... } ) # Commented out because unused -- 2011-03-12 CrT
# =
# id < 0;
};
end;