void
define_type (symbol_t * type_symbol,
unsigned block_level,
pascal_type type,
void * type_ptr)
{
translate_type (type, type_ptr);
out_s (" ");
#if 1 // experimental
if (type == POINTER_NODE)
{
out_s ("*");
}
#endif
out_s (type_symbol->s_repr);
if (type == ARRAY_NODE)
{
out_dimensions (reinterpret_cast<array_node*>(type_ptr));
}
if (type == NAMED_TYPE_NODE)
{
if (NT->name->s_kind != TYPE_IDENTIFIER)
{
c4p_error ("`%s' is no a type identifier", NT->name->s_repr);
}
type = NT->name->s_type;
type_ptr = NT->name->s_type_ptr;
}
define_symbol (type_symbol, TYPE_IDENTIFIER, block_level, type, type_ptr, 0);
}
// define quad-k variable illustrating alt-keybaord layout
// type quad with alt-l
void init_quad_k(symtab st){
//alt-keyboard
//
//-> iterate over string
char *rows[] = {
"~!@#$%^&*()_+",
"`1234567890-=",
"QWERTYUIOP{}|",
"qwertyuiop[]\\",
"ASDFGHJKL:\"",
"asdfghjkl;'",
"ZXCVBNM<>?",
"zxcvbnm,./",
};
array qk = array_new_dims(8,13);
for (int i=0,j; i<8; ++i){
for (j=0; j<13; ++j){
if (!rows[i][j]) break;
*elem(qk,i,j) = newdata(PCHAR, inputtobase(rows[i][j],1));
}
for (; j<13; ++j){
*elem(qk,i,j) = newdata(PCHAR, inputtobase(' ',0));
}
}
define_symbol(st,newdata(PCHAR, 0x2395),newdata(PCHAR, 'k'), cache(ARRAY, qk));
//normal keyboard
array qa = array_new_dims(8,13);
for (int i=0,j; i<8; ++i){
for (j=0; j<13; ++j){
if (!rows[i][j]) break;
*elem(qa, i, j) = newdata(PCHAR, inputtobase(rows[i][j],0));
}
for (; j<13; ++j){
*elem(qa, i, j) = newdata(PCHAR, inputtobase(' ',0));
}
}
define_symbol(st,newdata(PCHAR, 0x2395),newdata(PCHAR, 'a'), cache(ARRAY, qa));
}
void cg_lab (mlabel *l, int4 base)
{
mstr glob_name;
lab_tabent lent;
if (l->ml && l->gbl)
{
lent.lab_name.len = l->mvname.len;
lent.lab_name.addr = (char *)(l->mvname.addr - (char *)stringpool.base);
lent.LABENT_LNR_OFFSET = (SIZEOF(lnr_tabent) * l->ml->line_number) + base;
lent.has_parms = (NO_FORMALLIST != l->formalcnt); /* Flag to indicate a formallist */
emit_immed((char *)&lent, SIZEOF(lent));
mlabel2xtern(&glob_name, &int_module_name, &l->mvname);
define_symbol(GTM_CODE, &glob_name, lent.LABENT_LNR_OFFSET);
}
}
void
declare_var_list (declarator_node * vars,
unsigned kind,
unsigned block_level,
pascal_type type,
void * type_ptr)
{
declarator_node * start = vars;
const char * translated_type = translate_type(type, type_ptr);
out_s (" ");
while (vars != 0)
{
if (is_fast_var (vars->name->s_repr))
{
vars->name->s_flags |= S_FAST;
}
if (type == POINTER_NODE)
{
out_s ("*");
}
if (block_level == 0 && kind == VARIABLE_IDENTIFIER)
{
out_s (var_name_prefix.c_str());
}
out_s (vars->name->s_repr);
if (type == ARRAY_NODE)
{
out_dimensions (reinterpret_cast<array_node*>(type_ptr));
}
vars->name->s_translated_type = translated_type;
vars = vars->next;
if (vars != 0)
{
out_s (", ");
}
}
type = flatten_type(type, type_ptr, &type_ptr);
vars = start;
while (vars != 0)
{
vars->name = define_symbol(vars->name, kind, block_level,
type, type_ptr, 0);
vars = vars->next;
}
}
void obj_code (uint4 src_lines, void *checksum_ctx)
{
int status;
rhdtyp rhead;
mline *mlx, *mly;
var_tabent *vptr;
int4 lnr_pad_len;
intrpt_state_t prev_intrpt_state;
DCL_THREADGBL_ACCESS;
SETUP_THREADGBL_ACCESS;
assert(!run_time);
obj_init();
/* Define the routine name global symbol. */
define_symbol(GTM_MODULE_DEF_PSECT, (mstr *)&int_module_name, 0);
memset(&rhead, 0, SIZEOF(rhead));
alloc_reg();
jmp_opto();
curr_addr = SIZEOF(rhdtyp);
cg_phase = CGP_APPROX_ADDR;
cg_phase_last = CGP_NOSTATE;
code_gen();
code_size = curr_addr;
cg_phase = CGP_ADDR_OPT;
shrink_jmps();
comp_lits(&rhead);
if ((cmd_qlf.qlf & CQ_MACHINE_CODE))
{
cg_phase = CGP_ASSEMBLY;
code_gen();
}
if (!(cmd_qlf.qlf & CQ_OBJECT))
return;
rhead.ptext_ptr = SIZEOF(rhead);
set_rtnhdr_checksum(&rhead, (gtm_rtn_src_chksum_ctx *)checksum_ctx);
rhead.vartab_ptr = code_size;
rhead.vartab_len = mvmax;
code_size += mvmax * SIZEOF(var_tabent);
rhead.labtab_ptr = code_size;
rhead.labtab_len = mlmax;
code_size += mlmax * SIZEOF(lab_tabent);
rhead.lnrtab_ptr = code_size;
rhead.lnrtab_len = src_lines;
rhead.compiler_qlf = cmd_qlf.qlf;
if (cmd_qlf.qlf & CQ_EMBED_SOURCE)
{
rhead.routine_source_offset = TREF(routine_source_offset);
rhead.routine_source_length = (uint4)(stringpool.free - stringpool.base) - TREF(routine_source_offset);
}
rhead.temp_mvals = sa_temps[TVAL_REF];
rhead.temp_size = sa_temps_offset[TCAD_REF];
code_size += src_lines * SIZEOF(int4);
lnr_pad_len = PADLEN(code_size, SECTION_ALIGN_BOUNDARY);
code_size += lnr_pad_len;
DEFER_INTERRUPTS(INTRPT_IN_OBJECT_FILE_COMPILE, prev_intrpt_state);
create_object_file(&rhead);
ENABLE_INTERRUPTS(INTRPT_IN_OBJECT_FILE_COMPILE, prev_intrpt_state);
cg_phase = CGP_MACHINE;
code_gen();
/* Variable table: */
vptr = (var_tabent *)mcalloc(mvmax * SIZEOF(var_tabent));
if (mvartab)
walktree(mvartab, cg_var, (char *)&vptr);
else
assert(0 == mvmax);
emit_immed((char *)vptr, mvmax * SIZEOF(var_tabent));
/* Label table: */
if (mlabtab)
walktree((mvar *)mlabtab, cg_lab, (char *)rhead.lnrtab_ptr);
else
assert(0 == mlmax);
/* External entry definitions: */
emit_immed((char *)&(mline_root.externalentry->rtaddr), SIZEOF(mline_root.externalentry->rtaddr)); /* line 0 */
for (mlx = mline_root.child; mlx; mlx = mly)
{
if (mlx->table)
emit_immed((char *)&(mlx->externalentry->rtaddr), SIZEOF(mlx->externalentry->rtaddr));
if (0 == (mly = mlx->child)) /* note assignment */
if (0 == (mly = mlx->sibling)) /* note assignment */
for (mly = mlx; ; )
{
if (0 == (mly = mly->parent)) /* note assignment */
break;
if (mly->sibling)
{
mly = mly->sibling;
break;
}
}
}
if (0 != lnr_pad_len) /* emit padding so literal text pool starts on proper boundary */
emit_immed(PADCHARS, lnr_pad_len);
# if !defined(__MVS__) && !defined(__s390__) /* assert not valid for instructions on OS390 */
assert(code_size == psect_use_tab[GTM_CODE]);
# endif
emit_literals();
DEFER_INTERRUPTS(INTRPT_IN_OBJECT_FILE_COMPILE, prev_intrpt_state);
finish_object_file();
ENABLE_INTERRUPTS(INTRPT_IN_OBJECT_FILE_COMPILE, prev_intrpt_state);
CLOSE_OBJECT_FILE(object_file_des, status);
if (-1 == status)
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(8) ERR_SYSCALL, 5, RTS_ERROR_LITERAL("close()"), CALLFROM, errno);
/* Ready to make object visible. Rename from tmp name to real routine name */
RENAME_TMP_OBJECT_FILE(object_file_name);
}
bool is_definition(object *exp) {
return is_tagged_list(exp, define_symbol());
}
// quad-neg variable controls minus/hi-minus semantics in
// the lexical analysis
void init_quad_neg(symtab st){
define_symbol(st, newdata(PCHAR, 0x2395),newdata(PCHAR, '-'), 0);
}
void obj_code (uint4 src_lines, uint4 checksum)
{
rhdtyp rhead;
mline *mlx, *mly;
var_tabent *vptr;
int4 lnr_pad_len;
assert(!run_time);
obj_init();
/* Define the routine name global symbol. */
define_symbol(GTM_MODULE_DEF_PSECT, (mstr *)&int_module_name, 0);
memset(&rhead, 0, SIZEOF(rhead));
alloc_reg();
jmp_opto();
curr_addr = SIZEOF(rhdtyp);
cg_phase = CGP_APPROX_ADDR;
cg_phase_last = CGP_NOSTATE;
code_gen();
code_size = curr_addr;
cg_phase = CGP_ADDR_OPT;
shrink_jmps();
comp_lits(&rhead);
if ((cmd_qlf.qlf & CQ_MACHINE_CODE))
{
cg_phase = CGP_ASSEMBLY;
code_gen();
}
if (!(cmd_qlf.qlf & CQ_OBJECT))
return;
rhead.ptext_ptr = SIZEOF(rhead);
rhead.checksum = checksum;
rhead.vartab_ptr = code_size;
rhead.vartab_len = mvmax;
code_size += mvmax * SIZEOF(var_tabent);
rhead.labtab_ptr = code_size;
rhead.labtab_len = mlmax;
code_size += mlmax * SIZEOF(lab_tabent);
rhead.lnrtab_ptr = code_size;
rhead.lnrtab_len = src_lines;
rhead.compiler_qlf = cmd_qlf.qlf;
rhead.temp_mvals = sa_temps[TVAL_REF];
rhead.temp_size = sa_temps_offset[TCAD_REF];
code_size += src_lines * SIZEOF(int4);
lnr_pad_len = PADLEN(code_size, SECTION_ALIGN_BOUNDARY);
code_size += lnr_pad_len;
create_object_file(&rhead);
cg_phase = CGP_MACHINE;
code_gen();
/* Variable table: */
vptr = (var_tabent *)mcalloc(mvmax * SIZEOF(var_tabent));
if (mvartab)
walktree(mvartab, cg_var, (char *)&vptr);
else
assert(0 == mvmax);
emit_immed((char *)vptr, mvmax * SIZEOF(var_tabent));
/* Label table: */
if (mlabtab)
walktree((mvar *)mlabtab, cg_lab, (char *)rhead.lnrtab_ptr);
else
assert(0 == mlmax);
/* External entry definitions: */
emit_immed((char *)&(mline_root.externalentry->rtaddr), SIZEOF(mline_root.externalentry->rtaddr)); /* line 0 */
for (mlx = mline_root.child; mlx; mlx = mly)
{
if (mlx->table)
emit_immed((char *)&(mlx->externalentry->rtaddr), SIZEOF(mlx->externalentry->rtaddr));
if (0 == (mly = mlx->child)) /* note assignment */
if (0 == (mly = mlx->sibling)) /* note assignment */
for (mly = mlx; ; )
{
if (0 == (mly = mly->parent)) /* note assignment */
break;
if (mly->sibling)
{
mly = mly->sibling;
break;
}
}
}
if (0 != lnr_pad_len) /* emit padding so literal text pool starts on proper boundary */
emit_immed(PADCHARS, lnr_pad_len);
#if !defined(__MVS__) && !defined(__s390__) /* assert not valid for instructions on OS390 */
assert(code_size == psect_use_tab[GTM_CODE]);
#endif
emit_literals();
close_object_file();
}
static void test_symtab( void )
{
Symbol *sym;
SymbolHash *symtab, *symtab2;
list_open("test.lst");
opts.symtable = TRUE;
opts.list = TRUE;
warn("Create current module\n");
set_cur_module( new_module() );
warn("Create symbol\n");
sym = Symbol_create(S("Var1"), 123, TYPE_CONSTANT, 0, NULL, NULL);
dump_Symbol(sym);
OBJ_DELETE(sym);
sym = Symbol_create(S("Var1"), 123, TYPE_CONSTANT, 0, CURRENTMODULE, NULL);
dump_Symbol(sym);
CURRENTMODULE->modname = "MODULE";
dump_Symbol(sym);
warn("Delete symbol\n");
OBJ_DELETE(sym);
warn("Global symtab\n");
dump_SymbolHash(global_symtab, "global");
dump_SymbolHash(static_symtab, "static");
warn("check case insensitive - CH_0024\n");
symtab = OBJ_NEW(SymbolHash);
assert( symtab );
_define_sym(S("Var1"), 1, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("var1"), 2, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("VAR1"), 3, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
dump_SymbolHash(symtab, "tab1");
assert( find_symbol(S("Var1"), symtab)->value == 1 );
assert( find_symbol(S("var1"), symtab)->value == 2 );
assert( find_symbol(S("VAR1"), symtab)->value == 3 );
dump_SymbolHash(symtab, "tab1");
warn("Concat symbol tables\n");
symtab = OBJ_NEW(SymbolHash);
assert( symtab );
_define_sym(S("Var1"), 1, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("Var2"), 2, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("Var3"), -3, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
dump_SymbolHash(symtab, "tab1");
symtab2 = OBJ_NEW(SymbolHash);
assert( symtab2 );
_define_sym(S("Var3"), 3, TYPE_CONSTANT, 0, NULL, NULL, &symtab2); inc_page_nr();
_define_sym(S("Var4"), 4, TYPE_CONSTANT, 0, NULL, NULL, &symtab2); inc_page_nr();
_define_sym(S("Var5"), 5, TYPE_CONSTANT, 0, NULL, NULL, &symtab2); inc_page_nr();
dump_SymbolHash(symtab2, "tab2");
SymbolHash_cat( &symtab, symtab2 );
dump_SymbolHash(symtab, "merged_tab");
OBJ_DELETE( symtab );
OBJ_DELETE( symtab2 );
warn("Sort\n");
symtab = OBJ_NEW(SymbolHash);
assert( symtab );
_define_sym(S("One"), 1, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("Two"), 2, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("Three"), 3, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
_define_sym(S("Four"), 4, TYPE_CONSTANT, 0, NULL, NULL, &symtab); inc_page_nr();
dump_SymbolHash(symtab, "tab");
SymbolHash_sort(symtab, SymbolHash_by_name);
dump_SymbolHash(symtab, "tab by name");
SymbolHash_sort(symtab, SymbolHash_by_value);
dump_SymbolHash(symtab, "tab by value");
OBJ_DELETE( symtab );
warn("Use local symbol before definition\n");
_define_sym(S("WIN32"), 1, TYPE_CONSTANT, 0, NULL, NULL, &static_symtab); inc_page_nr();
SymbolHash_cat( & CURRENTMODULE->local_symtab, static_symtab ); inc_page_nr();
_define_sym(S("PC"), 0, TYPE_CONSTANT, 0, NULL, NULL, &global_symtab); inc_page_nr();
find_symbol( S("PC"), global_symtab )->value += 3; inc_page_nr();
find_symbol( S("PC"), global_symtab )->value += 3; inc_page_nr();
sym = get_used_symbol(S("NN")); inc_page_nr();
assert( sym != NULL );
assert( ! sym->is_defined );
find_symbol( S("PC"), global_symtab )->value += 3; inc_page_nr();
sym = get_used_symbol(S("NN")); inc_page_nr();
assert( sym != NULL );
assert( ! sym->is_defined );
find_symbol( S("PC"), global_symtab )->value += 3; inc_page_nr();
sym = define_symbol(S("NN"), find_symbol( "PC", global_symtab )->value, TYPE_ADDRESS);
sym->is_touched = TRUE;
sym = get_used_symbol(S("NN")); inc_page_nr();
assert( sym != NULL );
dump_Symbol(sym);
assert( sym->is_defined );
dump_symtab();
warn("Delete Local\n");
remove_all_local_syms();
dump_symtab();
warn("Delete Static\n");
remove_all_static_syms();
dump_symtab();
warn("Delete Global\n");
remove_all_global_syms();
dump_symtab();
warn("End\n");
}
int main(int argc, char *argv[])
{
/*
[ Executable file format ]
+-------------------------------------------------+ <-+
| Bss size in bytes (4 bytes) | |
+-------------------------------------------------+ |
| Data size in bytes (4 bytes) | |
+-------------------------------------------------+ |
| Text size in bytes (4 bytes) | |-> Header
+-------------------------------------------------+ |
| Number of entries in data relocation table | |
+-------------------------------------------------+ |
| Number of entries in text relocation table | |
+-------------------------------------------------+ <-+
| Data |
+-------------------------------------------------+
| Text |
+-------------------------------------------------+
| Data relocation table |
+-------------------------------------------------+
| Text relocation table |
+-------------------------------------------------+
Each entry of the relocation tables:
- offset: the offset from the start of the segment (data or text) where the fix
must be made.
- segment: indicates if the runtime start address of the bss, data, or text segment
must be added to do the fix.
*/
int i;
FILE *fout;
char *outpath;
char *infiles[64];
int ninf;
int print_stats;
prog_name = argv[0];
if (argc == 1)
err_no_input();
ninf = 0;
print_stats = FALSE;
outpath = "a.out.vme";
for (i = 1; i < argc; i++) {
if (argv[i][0] != '-') {
infiles[ninf++] = argv[i];
continue;
}
switch (argv[i][1]) {
case 'o':
if (argv[i][2] != '\0') {
outpath = argv[i]+2;
} else if (argv[i+1] == NULL) {
fprintf(stderr, "%s: option `o' requires an argument\n", prog_name);
exit(1);
} else {
outpath = argv[++i];
}
break;
case 's':
print_stats = TRUE;
break;
case 'v':
if (equal(argv[i]+1, "vm64"))
targeting_vm64 = TRUE;
else if (equal(argv[i]+1, "vm32"))
;
else
unk_opt(argv[i]);
break;
case 'h':
printf("usage: %s [ options ] <input-file> ...\n"
" The available options are:\n"
" -o<file> write output to <file>\n"
" -s print linking stats\n"
" -vm32 output a 32-bit executable (default)\n"
" -vm64 output a 64-bit executable\n"
" -h print this help\n", prog_name);
exit(0);
break;
case '\0':
break;
default:
unk_opt(argv[i]);
break;
}
}
if (ninf == 0)
err_no_input();
init_local_table();
text_max = 65536;
text_seg = malloc(text_max);
data_max = 65536;
data_seg = malloc(data_max);
dreloc_max = 8192;
data_relocation_table = malloc(sizeof(Reloc)*dreloc_max);
treloc_max = 8192;
text_relocation_table = malloc(sizeof(Reloc)*treloc_max);
/*
* crt.o must be the first file (crt.o's code must be physically at the
* beginning of the resulting executable). An alternative would be to label
* crt.o's code as, say, `_start:' and emit an "jmp _start;" before the
* program's code.
* crt.o has code to initialize some variables and call main.
*/
for (i = 0; i < ninf; i++) {
FILE *fin;
char name[MAX_SYM_LEN], *cp;
int j;
int nsym;
int curr_bss_size;
int curr_text_size;
int curr_data_size;
int curr_nreloc;
int segment, offset, kind;
if ((fin=fopen(infiles[i], "rb")) == NULL)
TERMINATE("%s: error reading file `%s'", prog_name, infiles[i]);
/* header */
fread(&nsym, sizeof(int), 1, fin);
fread(&curr_bss_size, sizeof(int), 1, fin);
fread(&curr_data_size, sizeof(int), 1, fin);
fread(&curr_text_size, sizeof(int), 1, fin);
fread(&curr_nreloc, sizeof(int), 1, fin);
/* symbol table entries */
for (j = 0; j < nsym; j++) {
for (cp = name; ; cp++) {
if ((*cp=(char)fgetc(fin)) == '\0')
break;
}
fread(&segment, sizeof(int), 1, fin);
fread(&offset, sizeof(int), 1, fin);
fread(&kind, sizeof(int), 1, fin);
if (kind == LOCAL_SYM)
define_local_symbol(name, segment, SEG_SIZ(segment)+offset);
else
define_symbol(name, kind, segment, SEG_SIZ(segment)+offset);
// if (segment == TEXT_SEG)
// printf("%s, %d\n", name, SEG_SIZ(segment)+offset);
}
/* data&text */
if (data_size+curr_data_size > data_max) {
char *p;
data_max = data_max*2+curr_data_size;
if ((p=realloc(data_seg, data_max)) == NULL)
TERMINATE("out of memory");
data_seg = p;
}
fread(data_seg+data_size, curr_data_size, 1, fin);
if (text_size+curr_text_size > text_max) {
char *p;
text_max = text_max*2+curr_text_size;
if ((p=realloc(text_seg, text_max)) == NULL)
TERMINATE("out of memory");
text_seg = p;
}
fread(text_seg+text_size, curr_text_size, 1, fin);
/* relocation table entries */
for (j = 0; j < curr_nreloc; j++) {
Symbol *s;
fread(&segment, sizeof(int), 1, fin);
fread(&offset, sizeof(int), 1, fin);
for (cp = name; ; cp++) {
if ((*cp=(char)fgetc(fin)) == '\0')
break;
}
s = lookup_symbol(name);
if (s->kind != EXTERN_SYM) {
if (segment == TEXT_SEG) {
if (targeting_vm64)
*(long long *)&text_seg[SEG_SIZ(segment)+offset] += s->offset;
else
*(int *)&text_seg[SEG_SIZ(segment)+offset] += s->offset;
append_text_reloc(s->segment, SEG_SIZ(segment)+offset, NULL);
} else {
if (targeting_vm64)
*(long long *)&data_seg[SEG_SIZ(segment)+offset] += s->offset;
else
*(int *)&data_seg[SEG_SIZ(segment)+offset] += s->offset;
append_data_reloc(s->segment, SEG_SIZ(segment)+offset, NULL);
}
} else {
/*
* The file that contains the symbol definition
* has not been seen yet. Mark it to fix later.
*/
if (segment == TEXT_SEG)
append_text_reloc(0, SEG_SIZ(segment)+offset, strdup(name));
else
append_data_reloc(0, SEG_SIZ(segment)+offset, strdup(name));
}
}
if (targeting_vm64) {
bss_size += round_up(curr_bss_size, MAX_ALIGN64);
data_size += round_up(curr_data_size, MAX_ALIGN64);
text_size += round_up(curr_text_size, MAX_ALIGN64);
} else {
bss_size += round_up(curr_bss_size, MAX_ALIGN32);
data_size += round_up(curr_data_size, MAX_ALIGN32);
text_size += round_up(curr_text_size, MAX_ALIGN32);
}
reset_local_table();
fclose(fin);
}
/*
* Try to fix the relocs that couldn't be fixed before
* because they depended on not-yet-defined extern symbols.
* Fail if a symbol is still undefined.
*/
for (i = 0; i < ntreloc; i++) {
if (text_relocation_table[i].symbol != NULL) {
Symbol *s;
if ((s=lookup_global_symbol(text_relocation_table[i].symbol))->kind == EXTERN_SYM)
TERMINATE("%s: undefined reference to `%s'", prog_name, s->name);
if (targeting_vm64)
*(long long *)&text_seg[text_relocation_table[i].offset] += s->offset;
else
*(int *)&text_seg[text_relocation_table[i].offset] += s->offset;
text_relocation_table[i].segment = s->segment;
}
}
for (i = 0; i < ndreloc; i++) {
if (data_relocation_table[i].symbol != NULL) {
Symbol *s;
if ((s=lookup_global_symbol(data_relocation_table[i].symbol))->kind == EXTERN_SYM)
TERMINATE("%s: undefined reference to `%s'", prog_name, s->name);
if (targeting_vm64)
*(long long *)&data_seg[data_relocation_table[i].offset] += s->offset;
else
*(int *)&data_seg[data_relocation_table[i].offset] += s->offset;
data_relocation_table[i].segment = s->segment;
}
}
/* Write the final executable file. */
fout = fopen(outpath, "wb");
/* header */
fwrite(&bss_size, sizeof(int), 1, fout);
fwrite(&data_size, sizeof(int), 1, fout);
fwrite(&text_size, sizeof(int), 1, fout);
fwrite(&ndreloc, sizeof(int), 1, fout);
fwrite(&ntreloc, sizeof(int), 1, fout);
/* data&text */
fwrite(data_seg, data_size, 1, fout);
fwrite(text_seg, text_size, 1, fout);
/* data relocation table */
for (i = 0; i < ndreloc; i++) {
fwrite(&data_relocation_table[i].segment, sizeof(int), 1, fout);
fwrite(&data_relocation_table[i].offset, sizeof(int), 1, fout);
}
/* text relocation table */
for (i = 0; i < ntreloc; i++) {
fwrite(&text_relocation_table[i].segment, sizeof(int), 1, fout);
fwrite(&text_relocation_table[i].offset, sizeof(int), 1, fout);
}
fclose(fout);
if (print_stats) {
printf("Text size: %d\n", text_size);
printf("Data size: %d\n", data_size);
printf("Bss size: %d\n", bss_size);
printf("Number of text relocations: %d\n", ntreloc);
printf("Number of data relocations: %d\n", ndreloc);
}
free(data_seg);
free(text_seg);
free(data_relocation_table);
free(text_relocation_table);
return 0;
}
void emit_trip(generic_op op, oprtype *opr, bool val_output, unsigned char use_reg)
{
unsigned char base_reg, temp_reg;
int4 offset, literal;
triple *ct;
if (opr->oprclass == TRIP_REF)
{
ct = opr->oprval.tref;
if (ct->destination.oprclass)
{
opr = &ct->destination;
}
/* else lit or error */
}
switch (cg_phase)
{
case CGP_ADDR_OPT:
case CGP_APPROX_ADDR:
switch (opr->oprclass)
{
case TRIP_REF:
assert(ct->destination.oprclass == 0);
assert(val_output);
switch (ct->opcode)
{
case OC_LIT:
if (run_time)
{
int4 pc_value_idx;
switch (op)
{
case LOAD_ADDRESS:
temp_reg = use_reg;
break;
case PUSH:
case PUSH_ADDRESS:
temp_reg = I386_REG_ECX;
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
pc_value_idx = code_idx + 5;
code_idx += 1 + SIZEOF(int4) + 1;
emit_addr(0, (int4)ct->operand[0].oprval.mlit->rt_addr, &offset);
offset -= pc_value_idx;
force_32 = 1;
emit_op_base_offset(op, temp_reg, offset, temp_reg);
force_32 = 0;
}
else
{
emit_op_alit(op, use_reg);
code_idx += SIZEOF(int4);
}
if (cg_phase == CGP_APPROX_ADDR)
txtrel_cnt++;
break;
case OC_CDLIT:
if (cg_phase == CGP_APPROX_ADDR)
define_symbol(GTM_LITERALS, ct->operand[0].oprval.cdlt, 0);
emit_op_alit(op, use_reg);
code_idx += SIZEOF(int4);
break;
case OC_ILIT:
literal = ct->operand[0].oprval.ilit;
switch(op)
{
case COMPARE: /* 1byte(opcode) + 1byte(ModR/M) + 4byte(literal) */
code_idx += 2 + SIZEOF(int4);
break;
case LOAD:
code_idx += 1 + SIZEOF(int4);
break;
case PUSH:
if (literal >= -128 && literal <= 127)
code_idx += 2;
else
code_idx += 1 + SIZEOF(int4);
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
break;
default:
assertpro(FALSE && ct->opcode);
break;
}
break;
case TINT_REF:
case TVAL_REF:
assert(val_output);
offset = sa_temps_offset[opr->oprclass];
offset -= (sa_temps[opr->oprclass] - opr->oprval.temp) * sa_class_sizes[opr->oprclass];
assertpro((0 <= offset) && (65535 >= offset));
emit_op_base_offset(op, I386_REG_EDI, offset, use_reg);
break;
case TCAD_REF:
case TVAD_REF:
case TVAR_REF:
offset = sa_temps_offset[opr->oprclass];
offset -= (sa_temps[opr->oprclass] - opr->oprval.temp) * sa_class_sizes[opr->oprclass];
assertpro((0 <= offset) && (65535 >= offset));
if (opr->oprclass == TVAR_REF)
base_reg = I386_REG_ESI;
else
base_reg = I386_REG_EDI;
switch (op)
{
case JUMP:
if (val_output)
{
code_idx++;
emit_base_offset(I386_REG_EAX, base_reg, offset);
}
code_idx++;
if (val_output)
emit_base_offset(I386_INS_JMP_Ev, I386_REG_EAX, 0);
else
emit_base_offset(I386_INS_JMP_Ev, base_reg, offset);
break;
case LOAD_ADDRESS:
code_idx++;
emit_base_offset(use_reg, base_reg, offset);
if (opr->oprclass == TVAR_REF)
{
code_idx++;
emit_base_offset(use_reg, use_reg, offsetof(ht_ent_mname, value));
}
break;
case PUSH:
if (!val_output)
{
code_idx++;
emit_base_offset(I386_INS_PUSH_Ev, base_reg, offset);
}
else
{
code_idx++;
emit_base_offset(I386_REG_ECX, base_reg, offset);
code_idx++;
emit_base_offset(I386_INS_PUSH_Ev, I386_REG_ECX, 0);
}
break;
case PUSH_ADDRESS:
if (val_output)
{
if (opr->oprclass == TVAR_REF)
{
code_idx++;
emit_base_offset(use_reg, base_reg, offset);
code_idx++;
emit_base_offset(I386_INS_PUSH_Ev, use_reg, offsetof(ht_ent_mname, value));
}
else
{
code_idx++;
emit_base_offset(I386_INS_PUSH_Ev, base_reg, offset);
}
}
else
{
code_idx++;
emit_base_offset(I386_REG_ECX, base_reg, offset);
code_idx++;
}
break;
case STORE:
if (val_output)
{
if (use_reg == I386_REG_EAX)
temp_reg = I386_REG_EDX;
else
temp_reg = I386_REG_EAX;
code_idx++;
emit_base_offset(temp_reg, base_reg, offset);
}
code_idx++;
if (val_output)
emit_base_offset(use_reg, temp_reg, 0);
else
emit_base_offset(use_reg, base_reg, offset);
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
break;
}
break;
case CGP_MACHINE:
switch (opr->oprclass)
{
case TRIP_REF:
assert(ct->destination.oprclass == 0);
assert(val_output);
switch (ct->opcode)
{
case OC_LIT:
assert(ct->operand[0].oprclass == MLIT_REF);
if (run_time)
{
int4 pc_value_idx;
switch(op)
{
case LOAD_ADDRESS:
temp_reg = use_reg;
break;
case PUSH:
case PUSH_ADDRESS:
temp_reg = I386_REG_ECX;
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
code_buf[code_idx++] = I386_INS_CALL_Jv;
*((int4 *)&code_buf[code_idx]) = 0;
code_idx += SIZEOF(int4);
pc_value_idx = code_idx;
code_buf[code_idx++] = I386_INS_POP_eAX + temp_reg;
emit_addr(0, (int4)ct->operand[0].oprval.mlit->rt_addr, &offset);
offset -= pc_value_idx;
force_32 = 1;
emit_op_base_offset(op, temp_reg, offset, temp_reg);
force_32 = 0;
}
else
{
emit_op_alit(op, use_reg);
emit_addr(code_reference + (code_idx * SIZEOF(unsigned char)),
(int4)ct->operand[0].oprval.mlit->rt_addr, (int4 *)&code_buf[code_idx]);
code_idx += SIZEOF(int4);
}
break;
case OC_CDLIT:
emit_op_alit(op, use_reg);
emit_reference(code_reference + (code_idx * SIZEOF(unsigned char)),
ct->operand[0].oprval.cdlt, (uint4 *)&code_buf[code_idx]);
code_idx += SIZEOF(int4);
break;
case OC_ILIT:
literal = ct->operand[0].oprval.ilit;
switch (op)
{
case COMPARE: /* cmpl $literal,use_reg - 1byte(opcode) + 1byte(ModR/M) + 4byte(literal) */
code_buf[code_idx++] = I386_INS_Grp1_Ev_Iv_Prefix;
modrm_byte.modrm.reg_opcode = I386_INS_CMP__;
modrm_byte.modrm.mod = I386_MOD32_REGISTER;
modrm_byte.modrm.r_m = use_reg;
code_buf[code_idx++] = modrm_byte.byte;
*((int4 *)&code_buf[code_idx]) = literal;
code_idx += SIZEOF(int4);
break;
case LOAD:
code_buf[code_idx++] = I386_INS_MOV_eAX + use_reg;
*((int4 *)&code_buf[code_idx]) = literal;
code_idx += SIZEOF(int4);
break;
case PUSH:
if (literal >= -128 && literal <= 127)
{
code_buf[code_idx++] = I386_INS_PUSH_Ib;
code_buf[code_idx++] = literal & 0xff;
}
else
{
code_buf[code_idx++] = I386_INS_PUSH_Iv;
*((int4 *)&code_buf[code_idx]) = literal;
code_idx += SIZEOF(int4);
}
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
break;
default:
assertpro(FALSE && ct->opcode);
break;
}
break;
case TINT_REF:
case TVAL_REF:
assert(val_output);
offset = sa_temps_offset[opr->oprclass];
offset -= (sa_temps[opr->oprclass] - opr->oprval.temp) * sa_class_sizes[opr->oprclass];
assertpro((0 <= offset) && (65535 >= offset));
emit_op_base_offset(op, I386_REG_EDI, offset, use_reg);
break;
case TCAD_REF:
case TVAD_REF:
case TVAR_REF:
offset = sa_temps_offset[opr->oprclass];
offset -= (sa_temps[opr->oprclass] - opr->oprval.temp) * sa_class_sizes[opr->oprclass];
assertpro((0 <= offset) && (65535 >= offset));
if (opr->oprclass == TVAR_REF)
base_reg = I386_REG_ESI;
else
base_reg = I386_REG_EDI;
switch (op)
{
case JUMP:
assert(use_reg == 0);
if (val_output)
{
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
emit_base_offset(I386_REG_EAX, base_reg, offset);
}
code_buf[code_idx++] = I386_INS_Grp5_Prefix;
if (val_output)
emit_base_offset(I386_INS_JMP_Ev, I386_REG_EAX, 0);
else
emit_base_offset(I386_INS_JMP_Ev, base_reg, offset);
break;
case LOAD_ADDRESS:
if (val_output)
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
else
code_buf[code_idx++] = I386_INS_LEA_Gv_M;
emit_base_offset(use_reg, base_reg, offset);
if (opr->oprclass == TVAR_REF)
{
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
emit_base_offset(use_reg, use_reg, offsetof(ht_ent_mname, value));
}
break;
case PUSH:
if (val_output)
{
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
emit_base_offset(I386_REG_ECX, base_reg, offset);
code_buf[code_idx++] = I386_INS_Grp5_Prefix;
emit_base_offset(I386_INS_PUSH_Ev, I386_REG_ECX, 0);
}
else
{
code_buf[code_idx++] = I386_INS_Grp5_Prefix;
emit_base_offset(I386_INS_PUSH_Ev, base_reg, offset);
}
break;
case PUSH_ADDRESS:
if (val_output)
{
if (opr->oprclass == TVAR_REF)
{
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
emit_base_offset(use_reg, base_reg, offset);
code_buf[code_idx++] = I386_INS_Grp5_Prefix;
emit_base_offset(I386_INS_PUSH_Ev, use_reg, offsetof(ht_ent_mname, value));
}
else
{
code_buf[code_idx++] = I386_INS_Grp5_Prefix;
emit_base_offset(I386_INS_PUSH_Ev, base_reg, offset);
}
}
else
{
code_buf[code_idx++] = I386_INS_LEA_Gv_M;
emit_base_offset(I386_REG_ECX, base_reg, offset);
code_buf[code_idx++] = I386_INS_PUSH_eCX;
}
break;
case STORE:
if (val_output)
{
if (use_reg == I386_REG_EAX)
temp_reg = I386_REG_EDX;
else
temp_reg = I386_REG_EAX;
assert(temp_reg != use_reg);
code_buf[code_idx++] = I386_INS_MOV_Gv_Ev;
emit_base_offset(temp_reg, base_reg, offset);
}
code_buf[code_idx++] = I386_INS_MOV_Ev_Gv;
if (val_output)
emit_base_offset(use_reg, temp_reg, 0);
else
emit_base_offset(use_reg, base_reg, offset);
break;
default:
rts_error_csa(CSA_ARG(NULL) VARLSTCNT(1) ERR_UNIMPLOP);
break;
}
break;
default:
assertpro(FALSE && opr->oprclass);
break;
}
break;
default:
assertpro(FALSE && cg_phase);
break;
}
}
int cmain ()
{
define_symbol (sym_monitor, "monitor");
int i;
programme_identification = cons (sym_monitor, make_integer (2));
#if defined(have_sys_setsid)
sys_setsid();
#endif
initialise_kyu_script_commands ();
multiplex_add_kyu_callback (on_ipc_read, (void *)0);
global_environment = kyu_sx_default_environment ();
global_environment =
lx_environment_bind
(global_environment, sym_on_event,
lx_foreign_mu (sym_on_event, on_event));
global_environment =
lx_environment_bind
(global_environment, sym_power_on,
lx_foreign_mu (sym_power_on, power_on));
global_environment =
lx_environment_bind
(global_environment, sym_power_down,
lx_foreign_mu (sym_power_down, power_down));
global_environment =
lx_environment_bind
(global_environment, sym_power_reset,
lx_foreign_mu (sym_power_reset, power_reset));
global_environment =
lx_environment_bind
(global_environment, sym_ctrl_alt_del,
lx_foreign_mu (sym_ctrl_alt_del, ctrl_alt_del));
for (i = 1; curie_argv[i] != (char *)0; i++)
{
sexpr n = make_string (curie_argv[i]);
if (truep(filep(n)))
{
open_script_files++;
multiplex_add_sexpr
(sx_open_i (io_open_read (curie_argv[i])),
on_script_read, (void *)0);
}
else
{
native_system = make_symbol (curie_argv[i]);
}
}
kyu_sd_add_listener_stdio ();
while (multiplex() == mx_ok);
return 21;
}
