Val make_posthandler_resumption_fate_from_task ( // Called once from this file, once from src/c/main/run-mythryl-code-and-runtime-eventloop.c
//==========================================
//
Task* task,
Val* resume // Either resume_after_handling_signal or resume_after_handling_software_generated_periodic_event
){ // from a platform-dependent assembly file like src/c/machine-dependent/prim.intel32.asm
//
// Build the resume fate for a signal or poll event handler.
// This closure contains the address of the resume entry-point and
// the registers from the Mythryl state.
//
// Caller guarantees us roughly 4KB available space.
//
// This gets called from make_mythryl_signal_handler_arg() below,
// and also from src/c/main/run-mythryl-code-and-runtime-eventloop.c
// Allocate the resumption closure:
//
set_slot_in_nascent_heapchunk(task, 0, MAKE_TAGWORD(10, PAIRS_AND_RECORDS_BTAG));
set_slot_in_nascent_heapchunk(task, 1, PTR_CAST( Val, resume));
set_slot_in_nascent_heapchunk(task, 2, task->argument);
set_slot_in_nascent_heapchunk(task, 3, task->fate);
set_slot_in_nascent_heapchunk(task, 4, task->current_closure);
set_slot_in_nascent_heapchunk(task, 5, task->link_register);
set_slot_in_nascent_heapchunk(task, 6, task->program_counter);
set_slot_in_nascent_heapchunk(task, 7, task->exception_fate);
set_slot_in_nascent_heapchunk(task, 8, task->callee_saved_registers[0]); // John Reppy says not to do: set_slot_in_nascent_heapchunk(task, 8, task->current_thread);
set_slot_in_nascent_heapchunk(task, 9, task->callee_saved_registers[1]);
set_slot_in_nascent_heapchunk(task, 10, task->callee_saved_registers[2]);
//
return commit_nascent_heapchunk(task, 10);
}
void save_c_state (Task* task, ...) {
// ============
//
// Build a return closure that will save
// a collection of Mythryl values being
// used by C. The Mythryl values are
// passed by reference with NULL as termination.
//
// This fn is called only in:
//
// src/c/main/load-compiledfiles.c
va_list ap;
Val* vp;
va_start (ap, task);
int n;
for (n = 0; (vp = va_arg(ap, Val *)) != NULL; n++) {
continue;
}
va_end (ap);
va_start (ap, task);
LIB7_AllocWrite (task, 0, MAKE_TAGWORD(n, PAIRS_AND_RECORDS_BTAG));
for (int i = 1; i <= n; i++) {
vp = va_arg (ap, Val *);
LIB7_AllocWrite (task, i, *vp);
}
task->callee_saved_registers[0] = LIB7_Alloc(task, n);
task->fate = PTR_CAST( Val, return_to_c_level_c);
va_end (ap);
}
Val _lib7_P_TTY_tcgetattr (Task* task, Val arg) {
//=====================
//
// Mythryl type: Int -> (Unt, Unt, Unt, Unt, String, Unt, Unt)
//
// Get parameters associated with tty.
//
// NOTE: the calls to cfget[io] speed by making the code more OS-dependent
// and using the package of struct termios.
//
// This fn gets bound as tcgetattr in:
//
// src/lib/std/src/psx/posix-tty.pkg
ENTER_MYTHRYL_CALLABLE_C_FN(__func__);
int fd = TAGGED_INT_TO_C_INT( arg );
struct termios data;
RELEASE_MYTHRYL_HEAP( task->hostthread, __func__, NULL);
//
int status = tcgetattr( fd, &data );
//
RECOVER_MYTHRYL_HEAP( task->hostthread, __func__ );
if (status < 0) return RAISE_SYSERR__MAY_HEAPCLEAN(task, status, NULL);
Val iflag = make_one_word_unt(task, data.c_iflag ); Roots roots1 = { &iflag, NULL };
Val oflag = make_one_word_unt(task, data.c_oflag ); Roots roots2 = { &oflag, &roots1 };
Val cflag = make_one_word_unt(task, data.c_cflag ); Roots roots3 = { &cflag, &roots2 };
Val lflag = make_one_word_unt(task, data.c_lflag ); Roots roots4 = { &lflag, &roots3 };
Val ispeed = make_one_word_unt(task, cfgetispeed (&data) ); Roots roots5 = { &ispeed, &roots4 };
Val ospeed = make_one_word_unt(task, cfgetospeed (&data) ); Roots roots6 = { &ospeed, &roots5 };
Val cc = allocate_nonempty_ascii_string__may_heapclean (task, NCCS, &roots6 );
memcpy(
GET_VECTOR_DATACHUNK_AS( void*, cc ),
data.c_cc,
NCCS
);
// Construct the result vector:
//
set_slot_in_nascent_heapchunk (task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 7));
set_slot_in_nascent_heapchunk (task, 1, iflag);
set_slot_in_nascent_heapchunk (task, 2, oflag);
set_slot_in_nascent_heapchunk (task, 3, cflag);
set_slot_in_nascent_heapchunk (task, 4, lflag);
set_slot_in_nascent_heapchunk (task, 5, cc);
set_slot_in_nascent_heapchunk (task, 6, ispeed);
set_slot_in_nascent_heapchunk (task, 7, ospeed);
Val result = commit_nascent_heapchunk (task, 7);
EXIT_MYTHRYL_CALLABLE_C_FN(__func__);
return result;
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Bool)
//
Val _lib7_Opengl_get_queued_bool_callback (Task *task, Val arg) {
//==================================
//
Callback_Queue_Entry e = get_next_queued_callback ();
//
if (e.callback_type != QUEUED_BOOL_CALLBACK) {
strcpy( text_buf, "get_queued_bool_callback: Next callback not Bool." );
moan_and_die();
}
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 2));
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, e.entry.bool_value ? HEAP_TRUE : HEAP_FALSE );
//
return commit_nascent_heapchunk(task, 2);
}
static Val allocate_heap_ram_for_pickle (Task* task, Vunt bytesize) {
// ============================
//
// Allocate a bytevector to hold the pickled datastructure.
// Heap* heap = task->heap;
int size_in_words = BYTES_TO_WORDS( bytesize );
Val tagword = MAKE_TAGWORD( size_in_words, FOUR_BYTE_ALIGNED_NONPOINTER_DATA_BTAG );
// We probably should allocate space in the hugechunk region for these chunks. XXX BUGGO FIXME
//
if (bytesize >= agegroup0_buffer_size_in_bytes(task)-(8*ONE_K_BINARY)) die ("Pickling %d bytes not supported -- increase agegroup0 buffer size.", bytesize); // XXX BUGGO FIXME
set_slot_in_nascent_heapchunk( task, 0, tagword );
return commit_nascent_heapchunk( task, size_in_words );
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Int)
// callback x y
//
static Val do__get_queued_int_pair_callback (Task *task, Val arg) {
// ================================
Callback_Queue_Entry e = get_next_queued_callback ();
printf("do__get_queued_int_pair_callback called\n");
if (e.callback_type != QUEUED_INT_PAIR_CALLBACK) {
strcpy( text_buf, "get_queued_int_pair_callback: Next callback not Int_Pair." );
moan_and_die();
}
printf("do__get_queued_int_pair_callback called returning a record.\n");
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 3) );
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, TAGGED_INT_FROM_C_INT( e.entry.int_pair.x ));
set_slot_in_nascent_heapchunk( task, 3, TAGGED_INT_FROM_C_INT( e.entry.int_pair.y ));
//
return commit_nascent_heapchunk(task, 3);
}
// opengl-client.api type: (None -- not exported to opengl-client.api level.)
// opengl-client-driver.api type: Void -> (Int, Float)
//
Val _lib7_Opengl_get_queued_float_callback (Task* task, Val arg) {
//===================================
//
Callback_Queue_Entry e = get_next_queued_callback ();
//
if (e.callback_type != QUEUED_FLOAT_CALLBACK) {
strcpy( text_buf, "get_queued_float_callback: Next callback not Float." );
moan_and_die();
}
double d = e.entry.float_value;
Val boxed_double = make_float64(task, d ); // make_float64 is from src/c/h/make-strings-and-vectors-etc.h
set_slot_in_nascent_heapchunk( task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 2));
set_slot_in_nascent_heapchunk( task, 1, TAGGED_INT_FROM_C_INT( e.callback_number ));
set_slot_in_nascent_heapchunk( task, 2, boxed_double );
return commit_nascent_heapchunk(task, 2);
}
Val _lib7_Date_greanwich_mean_time (Task* task, Val arg) {
//==============================
//
// Mythryl type: one_word_int::Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int)
//
// Takes a UTC time value (in seconds), and converts it to a 9-tuple with
// the fields: tm_sec, tm_min, tm_hour, tm_mday, tm_mon, tm_year, tm_wday,
// tm_yday, and tm_isdst.
//
// This fn gets bound to gm_time' in:
//
// src/lib/std/src/date.pkg
ENTER_MYTHRYL_CALLABLE_C_FN("_lib7_Date_greanwich_mean_time");
time_t t = (time_t) INT1_LIB7toC(arg);
RELEASE_MYTHRYL_HEAP( task->pthread, "_lib7_Date_greanwich_mean_time", NULL );
//
struct tm* tm = gmtime( &t );
//
RECOVER_MYTHRYL_HEAP( task->pthread, "_lib7_Date_greanwich_mean_time" );
if (tm == NULL) return RAISE_SYSERR__MAY_HEAPCLEAN(task,0,NULL);
set_slot_in_nascent_heapchunk(task, 0, MAKE_TAGWORD(PAIRS_AND_RECORDS_BTAG, 9));
set_slot_in_nascent_heapchunk(task, 1, TAGGED_INT_FROM_C_INT(tm->tm_sec));
set_slot_in_nascent_heapchunk(task, 2, TAGGED_INT_FROM_C_INT(tm->tm_min));
set_slot_in_nascent_heapchunk(task, 3, TAGGED_INT_FROM_C_INT(tm->tm_hour));
set_slot_in_nascent_heapchunk(task, 4, TAGGED_INT_FROM_C_INT(tm->tm_mday));
set_slot_in_nascent_heapchunk(task, 5, TAGGED_INT_FROM_C_INT(tm->tm_mon));
set_slot_in_nascent_heapchunk(task, 6, TAGGED_INT_FROM_C_INT(tm->tm_year));
set_slot_in_nascent_heapchunk(task, 7, TAGGED_INT_FROM_C_INT(tm->tm_wday));
set_slot_in_nascent_heapchunk(task, 8, TAGGED_INT_FROM_C_INT(tm->tm_yday));
set_slot_in_nascent_heapchunk(task, 9, TAGGED_INT_FROM_C_INT(tm->tm_isdst));
return commit_nascent_heapchunk(task, 9);
}
static void load_compiled_file__may_heapclean (
// =================================
//
Task* task,
char* filename,
Roots* extra_roots
){
///////////////////////////////////////////////////////
// Loading an compiledfile is a five-step process:
//
// 1. Read the header, which holds various
// numbers we need such as the number of
// code segments in the compiledfile.
//
// 2. Locate all the values imported by this
// compiledfile from the export lists of
// previously loaded compiled_files.
// For subsequent ease of access, we
// construct an 'import record' (a vector)
// holding all these values packed
// consecutively.
//
///////////////////////////////////////////////////////
FILE* file;
int i;
int bytes_of_code_remaining;
int bytes_of_exports = 0;
Compiledfile_Header header;
Picklehash export_picklehash;
Int1 segment_bytesize;
Int1 entrypoint_offset_in_bytes;
size_t archive_offset;
char* compiledfile_filename = filename;
// If 'filename' is a "library@offset:compiledfile" triple,
// parse it into its three parts:
//
{ char* at_ptr
=
strchr (filename, '@');
if (!at_ptr) {
archive_offset = 0; // We're loading a bare .compiled, not one packed within a library archive.
} else {
char* colon_ptr = strchr (at_ptr + 1, ':');
if (colon_ptr) {
*colon_ptr = '\0';
compiledfile_filename = colon_ptr + 1;
}
archive_offset = strtoul (at_ptr + 1, NULL, 0); // XXX SUCKO FIXME Needs more sanity checking.
*at_ptr = '\0';
}
}
// Log all files loaded, for diagnostic/information purposes:
//
if (!archive_offset) {
//
fprintf (
log_fd ? log_fd : stderr,
" load-compiledfiles.c: Loading object file %s\n",
filename
);
} else {
fprintf (
log_fd ? log_fd : stderr,
" load-compiledfiles.c: Loading offset %8d in lib %s \tnamely object file %s\n",
archive_offset,
filename,
compiledfile_filename
);
}
// Open the file:
//
file = open_file( filename, TRUE ); if (!file) print_stats_and_exit( 1 );
// If an offset is given (which is to say, if we are loading
// an compiledfile packed within a library archive) then
// then seek to the beginning of the section that contains
// the image of our compiledfile:
//
if (archive_offset) {
//
if (fseek (file, archive_offset, SEEK_SET) == -1) {
//
die ("Cannot seek on archive file \"%s@%ul\": %s", filename, (unsigned long) archive_offset, strerror(errno) );
}
}
// Get the header:
//
read_n_bytes_from_file( file, &header, sizeof(Compiledfile_Header), filename );
// The integers in the header are kept in big-endian byte
// order, so convert them if we're on a little-endian box:
//
header.number_of_imported_picklehashes = BIGENDIAN_TO_HOST( header.number_of_imported_picklehashes );
header.number_of_exported_picklehashes = BIGENDIAN_TO_HOST( header.number_of_exported_picklehashes );
header.bytes_of_import_tree = BIGENDIAN_TO_HOST( header.bytes_of_import_tree );
header.bytes_of_dependency_info = BIGENDIAN_TO_HOST( header.bytes_of_dependency_info );
header.bytes_of_inlinable_code = BIGENDIAN_TO_HOST( header.bytes_of_inlinable_code );
header.reserved = BIGENDIAN_TO_HOST( header.reserved );
header.pad = BIGENDIAN_TO_HOST( header.pad );
header.bytes_of_compiled_code = BIGENDIAN_TO_HOST( header.bytes_of_compiled_code );
header.bytes_of_symbolmapstack = BIGENDIAN_TO_HOST( header.bytes_of_symbolmapstack );
// XXX SUCKO FIXME These days 99% of the market is little-endian,
// so should either change to always little-endian, or else
// (better) always use host system's native byte ordering.
// Ideally we should be able to just mmap the .compiledfile into
// memory and be ready to go, with no bit-fiddling needed at all.
// Read the 'import tree' and locate all the thus-specified
// needed values located in the export tree of previously-
// loaded compiled_files:
//
int imports_record_slot_count
=
header.number_of_imported_picklehashes + 1;
// Make sure we have enough free heap space to allocate
// our 'import record' vector of imported values:
//
if (need_to_call_heapcleaner (task, REC_BYTESIZE(imports_record_slot_count))) {
//
call_heapcleaner_with_extra_roots (task, 0, extra_roots );
}
// Write the header for our 'import record', which will be
// a Mythryl record with 'imports_record_slot_count' slots:
//
set_slot_in_nascent_heapchunk (task, 0, MAKE_TAGWORD(imports_record_slot_count, PAIRS_AND_RECORDS_BTAG));
// Locate all the required import values and
// save them in our nascent on-heap 'import record':
//
{ int next_imports_record_slot_to_fill = 1;
// Over all previously loaded .compiled files
// from which we import values:
//
while (next_imports_record_slot_to_fill < imports_record_slot_count) {
//
Picklehash picklehash_naming_previously_loaded_compiled_file;
read_n_bytes_from_file( file, &picklehash_naming_previously_loaded_compiled_file, sizeof(Picklehash), filename );
// Locate all needed imports exported by that
// particular pre-loaded compiledfile:
//
next_imports_record_slot_to_fill
=
fetch_imports (
task,
file,
filename,
next_imports_record_slot_to_fill,
picklehash_to_exports_tree( &picklehash_naming_previously_loaded_compiled_file )
);
}
}
// Put a dummy valid value (NIL) in the last slot,
// just so the cleaner won't go bananas if it
// looks at that slot:
//
set_slot_in_nascent_heapchunk( task, imports_record_slot_count, HEAP_NIL );
// Complete the above by actually allocating
// the 'import record' on the Mythryl heap:
//
Val import_record = commit_nascent_heapchunk( task, imports_record_slot_count ); // Contains all the values we import from other compiled_files.
Roots roots1 = { &import_record, extra_roots };
// Get the export picklehash for this compiledfile.
// This is the name by which other compiled_files will
// refer to us in their turn as they are loaded.
//
// Some compiled_files may not have such a name, in
// which case they have no directly visible exported
// values. (This typically means that they are a
// plug-in which installs pointers to itself in some
// other module's datastructures, as a side-effect
// during loading.)
//
if (header.number_of_exported_picklehashes == 1) {
bytes_of_exports = sizeof( Picklehash );
read_n_bytes_from_file( file, &export_picklehash, bytes_of_exports, filename );
} else if (header.number_of_exported_picklehashes != 0) {
die ("Number of exported picklehashes is %d (should be 0 or 1)",
(int)header.number_of_exported_picklehashes
);
}
// Seek to the first "code segment" within our compiledfile image.
// This contains bytecoded instructions interpretable by
// make-package-literals-via-bytecode-interpreter.c which construct all the needed constant
// lists etc for this compiledfile. (If we stored them as actual
// lists, we'd have to do relocations on all the pointers in
// those structures at this point. The bytecode solution seems
// simpler.)
{
// XXX BUGGO FIXME A 'long' is 32 bits on 32-bit Linux,
// but files longer than 2GB (signed long!) are often
// supported. We probably should use fseeko in those
// cases and then
// #define _FILE_OFFSET_BITS 64
// so as to support large (well, *huge* :) library files.
// See the manpage for details.
// This probably won't be a frequent problem in practice
// for a few years yet, and by then we'll probably be
// running 64-bit Linux anyhow, so not a high priority.
//
long file_offset = archive_offset
+ sizeof(Compiledfile_Header)
+ header.bytes_of_import_tree
+ bytes_of_exports
+ header.bytes_of_dependency_info
+ header.bytes_of_inlinable_code
+ header.reserved
+ header.pad;
if (fseek(file, file_offset, SEEK_SET) == -1) {
//
die ("cannot seek on .compiled file \"%s\": %s", filename, strerror(errno) );
}
}
////////////////////////////////////////////////////////////////
// In principle, a .compiled file can contain any number of
// code segments, so we track the number of bytes of code
// left to process: When it hits zero, we've done all
// the code segments.
//
// In practice, we currently always have exactly two
// code segments, the first of which contains the byte-
// coded logic constructing our literals (constants
// -- see src/c/heapcleaner/make-package-literals-via-bytecode-interpreter.c)
// and the second of which contains all our compiled
// native code for the compiledfile, including that
// which constructs our tree of exported (directly externally
// visible) values.
////////////////////////////////////////////////////////////////
bytes_of_code_remaining
=
header.bytes_of_compiled_code;
// Read the size and the dummy entry point for the
// first code segment (literal-constructing bytecodes).
// The entrypoint offset of this first segment is always
// zero, which is why we ignore it here:
//
read_n_bytes_from_file( file, &segment_bytesize, sizeof(Int1), filename );
//
segment_bytesize = BIGENDIAN_TO_HOST( segment_bytesize );
//
read_n_bytes_from_file( file, &entrypoint_offset_in_bytes, sizeof(Int1), filename );
//
// entrypoint_offset_in_bytes = BIGENDIAN_TO_HOST( entrypoint_offset_in_bytes );
bytes_of_code_remaining -= segment_bytesize + 2 * sizeof(Int1);
//
if (bytes_of_code_remaining < 0) {
//
die ("format error (data size mismatch) in .compiled file \"%s\"", filename);
}
Val mythryl_result = HEAP_VOID;
if (segment_bytesize > 0) {
//
Unt8* data_chunk = MALLOC_VEC( Unt8, segment_bytesize );
read_n_bytes_from_file( file, data_chunk, segment_bytesize, filename );
mythryl_result = make_package_literals_via_bytecode_interpreter__may_heapclean (task, data_chunk, segment_bytesize, &roots1);
FREE(data_chunk);
}
// Do a functional update of the last element of the import_record:
//
for (i = 0; i < imports_record_slot_count; i++) {
//
set_slot_in_nascent_heapchunk(task, i, PTR_CAST(Val*, import_record)[i-1]); // <============ last use of import_record
}
set_slot_in_nascent_heapchunk( task, imports_record_slot_count, mythryl_result );
mythryl_result = commit_nascent_heapchunk( task, imports_record_slot_count );
Roots roots2 = { &mythryl_result, extra_roots }; // 'extra_roots' not '&roots1' because import_record is dead here.
// Do a garbage collection, if necessary:
//
if (need_to_call_heapcleaner( task, PICKLEHASH_BYTES + REC_BYTESIZE(5)) ) {
//
call_heapcleaner_with_extra_roots (task, 0, &roots2 );
}
while (bytes_of_code_remaining > 0) { // In practice, we always execute this loop exactly once.
//
// Read the size and entry point for this code chunk:
read_n_bytes_from_file( file, &segment_bytesize, sizeof(Int1), filename );
segment_bytesize = BIGENDIAN_TO_HOST( segment_bytesize );
read_n_bytes_from_file( file, &entrypoint_offset_in_bytes, sizeof(Int1), filename );
entrypoint_offset_in_bytes = BIGENDIAN_TO_HOST( entrypoint_offset_in_bytes );
// How much more?
//
bytes_of_code_remaining -= segment_bytesize + 2 * sizeof(Int1);
//
if (bytes_of_code_remaining < 0) die ("format error (code size mismatch) in .compiled file \"%s\"", filename);
// Allocate heap space and read code chunk:
//
Val code_chunk = allocate_nonempty_code_chunk (task, segment_bytesize);
//
read_n_bytes_from_file( file, PTR_CAST(char*, code_chunk), segment_bytesize, filename );
// Flush the instruction cache, so CPU will see
// our newly loaded code. (To gain speed, and
// simplify the hardware design, most modern CPUs
// assume that code is never modified on the fly,
// or at least not without manually flushing the
// instruction cache this way.)
//
flush_instruction_cache (PTR_CAST(char*, code_chunk), segment_bytesize);
// Create closure, taking entry point into account:
//
{ Val closure = make_one_slot_record( task, PTR_CAST( Val, PTR_CAST (char*, code_chunk) + entrypoint_offset_in_bytes) );
// Apply the closure to the import picklehash vector.
//
// This actually executes all the top-level code for
// the compile unit, which is to say that if the
// source for our compiledfile looked something like
//
// package my_pkg {
// my _ = file::print "Hello, world!\n";
// };
//
// then when we do the following 'apply' call, you'd see
//
// Hello, world!
//
// printed on the standard output.
//
// In addition, invisible compiler-generated code
// constructs and returns the tree of exports from
// our compiledfile.
//
save_c_state (task, extra_roots); // We do NOT want mythryl_result on the extra_roots list here.
mythryl_result = run_mythryl_function__may_heapclean (task, closure, mythryl_result, TRUE, NULL); // run_mythryl_function__may_heapclean def in src/c/main/run-mythryl-code-and-runtime-eventloop.c
restore_c_state (task, extra_roots);
}
if (need_to_call_heapcleaner (task, PICKLEHASH_BYTES+REC_BYTESIZE(5))) {
//
call_heapcleaner_with_extra_roots (task, 0, &roots2 );
}
}
// Publish this compiled_file's exported-values tree
// for the benefit of compiled_files loaded later:
//
if (bytes_of_exports) {
//
register_compiled_file_exports__may_heapclean (
task,
&export_picklehash, // key -- the 16-byte picklehash naming this compiledfile.
mythryl_result, // val -- the tree of exported Mythryl values.
extra_roots
);
}
fclose( file );
} // load_compiled_file__may_heapclean
Val make_package_literals_via_bytecode_interpreter (Task* task, Unt8* bytecode_vector, int bytecode_vector_length_in_bytes) {
//==============
//
// NOTE: We allocate all of the chunks in agegroup 1,
// but allocate the vector of literals in agegroup0.
//
// This fn gets exported to the Mythryl level as
//
// make_package_literals_via_bytecode_interpreter
// in
// src/lib/compiler/execution/code-segments/code-segment.pkg
// via
// src/c/lib/heap/make-package-literals-via-bytecode-interpreter.c
//
// Our ultimate invocation is in
//
// src/lib/compiler/execution/main/execute.pkg
int pc = 0;
// Check that sufficient space is available for the
// literal chunk that we are about to allocate.
// Note that the cons cell has already been accounted
// for in space_available (but not in space_needed).
//
#define GC_CHECK \
do { \
if (space_needed > space_available \
&& need_to_call_heapcleaner( task, space_needed + LIST_CONS_CELL_BYTESIZE) \
){ \
call_heapcleaner_with_extra_roots (task, 0, (Val *)&bytecode_vector, &stk, NULL); \
space_available = 0; \
\
} else { \
\
space_available -= space_needed; \
} \
} while (0)
#ifdef DEBUG_LITERALS
debug_say("make_package_literals_via_bytecode_interpreter: bytecode_vector = %#x, bytecode_vector_length_in_bytes = %d\n", bytecode_vector, bytecode_vector_length_in_bytes);
#endif
if (bytecode_vector_length_in_bytes <= 8) return HEAP_NIL;
Val_Sized_Unt magic
=
GET32(bytecode_vector); pc += 4;
Val_Sized_Unt max_depth /* This variable is currently unused, so suppress 'unused var' compiler warning: */ __attribute__((unused))
=
GET32(bytecode_vector); pc += 4;
if (magic != V1_MAGIC) {
die("bogus literal magic number %#x", magic);
}
Val stk = HEAP_NIL;
int space_available = 0;
for (;;) {
//
ASSERT(pc < bytecode_vector_length_in_bytes);
space_available -= LIST_CONS_CELL_BYTESIZE; // Space for stack cons cell.
if (space_available < ONE_K_BINARY) {
//
if (need_to_call_heapcleaner(task, 64*ONE_K_BINARY)) {
//
call_heapcleaner_with_extra_roots (task, 0, (Val *)&bytecode_vector, &stk, NULL);
}
space_available = 64*ONE_K_BINARY;
}
switch (bytecode_vector[ pc++ ]) {
//
case I_INT:
{ int i = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: INT(%d)\n", pc-5, i);
#endif
LIST_CONS(task, stk, TAGGED_INT_FROM_C_INT(i), stk);
}
break;
case I_RAW32:
{
int i = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RAW32[%d]\n", pc-5, i);
#endif
Val result;
INT1_ALLOC(task, result, i);
LIST_CONS(task, stk, result, stk);
space_available -= 2*WORD_BYTESIZE;
}
break;
case I_RAW32L:
{
int n = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RAW32L(%d) [...]\n", pc-5, n);
#endif
ASSERT(n > 0);
int space_needed = 4*(n+1);
GC_CHECK;
LIB7_AllocWrite (task, 0, MAKE_TAGWORD(n, FOUR_BYTE_ALIGNED_NONPOINTER_DATA_BTAG));
for (int j = 1; j <= n; j++) {
//
int i = GET32(bytecode_vector); pc += 4;
LIB7_AllocWrite (task, j, (Val)i);
}
Val result = LIB7_Alloc(task, n );
LIST_CONS(task, stk, result, stk);
}
break;
case I_RAW64:
{
double d = get_double(&(bytecode_vector[pc])); pc += 8;
Val result;
REAL64_ALLOC(task, result, d);
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RAW64[%f] @ %#x\n", pc-5, d, result);
#endif
LIST_CONS(task, stk, result, stk);
space_available -= 4*WORD_BYTESIZE; // Extra 4 bytes for alignment padding.
}
break;
case I_RAW64L:
{
int n = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RAW64L(%d) [...]\n", pc-5, n);
#endif
ASSERT(n > 0);
int space_needed = 8*(n+1);
GC_CHECK;
#ifdef ALIGN_FLOAT64S
// Force FLOAT64_BYTESIZE alignment (descriptor is off by one word)
//
task->heap_allocation_pointer = (Val*)((Punt)(task->heap_allocation_pointer) | WORD_BYTESIZE);
#endif
int j = 2*n; // Number of words.
LIB7_AllocWrite (task, 0, MAKE_TAGWORD(j, EIGHT_BYTE_ALIGNED_NONPOINTER_DATA_BTAG));
Val result = LIB7_Alloc(task, j );
for (int j = 0; j < n; j++) {
//
PTR_CAST(double*, result)[j] = get_double(&(bytecode_vector[pc])); pc += 8;
}
LIST_CONS(task, stk, result, stk);
}
break;
case I_STR:
{
int n = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: STR(%d) [...]", pc-5, n);
#endif
if (n == 0) {
#ifdef DEBUG_LITERALS
debug_say("\n");
#endif
LIST_CONS(task, stk, ZERO_LENGTH_STRING__GLOBAL, stk);
break;
}
int j = BYTES_TO_WORDS(n+1); // '+1' to include space for '\0'.
// The space request includes space for the data-chunk header word and
// the sequence header chunk.
//
int space_needed = WORD_BYTESIZE*(j+1+3);
GC_CHECK;
// Allocate the data chunk:
//
LIB7_AllocWrite(task, 0, MAKE_TAGWORD(j, FOUR_BYTE_ALIGNED_NONPOINTER_DATA_BTAG));
LIB7_AllocWrite (task, j, 0); // So word-by-word string equality works.
Val result = LIB7_Alloc (task, j);
#ifdef DEBUG_LITERALS
debug_say(" @ %#x (%d words)\n", result, j);
#endif
memcpy (PTR_CAST(void*, result), &bytecode_vector[pc], n); pc += n;
// Allocate the header chunk:
//
SEQHDR_ALLOC(task, result, STRING_TAGWORD, result, n);
// Push on stack:
//
LIST_CONS(task, stk, result, stk);
}
break;
case I_LIT:
{
int n = GET32(bytecode_vector); pc += 4;
Val result = stk;
for (int j = 0; j < n; j++) {
//
result = LIST_TAIL(result);
}
#ifdef DEBUG_LITERALS
debug_say("[%2d]: LIT(%d) = %#x\n", pc-5, n, LIST_HEAD(result));
#endif
LIST_CONS(task, stk, LIST_HEAD(result), stk);
}
break;
case I_VECTOR:
{
int n = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: VECTOR(%d) [", pc-5, n);
#endif
if (n == 0) {
#ifdef DEBUG_LITERALS
debug_say("]\n");
#endif
LIST_CONS(task, stk, ZERO_LENGTH_VECTOR__GLOBAL, stk);
break;
}
// The space request includes space
// for the data-chunk header word and
// the sequence header chunk.
//
int space_needed = WORD_BYTESIZE*(n+1+3);
GC_CHECK;
// Allocate the data chunk:
//
LIB7_AllocWrite(task, 0, MAKE_TAGWORD(n, RO_VECTOR_DATA_BTAG));
// Top of stack is last element in vector:
//
for (int j = n; j > 0; j--) {
//
LIB7_AllocWrite(task, j, LIST_HEAD(stk));
stk = LIST_TAIL(stk);
}
Val result = LIB7_Alloc(task, n );
// Allocate the header chunk:
//
SEQHDR_ALLOC(task, result, TYPEAGNOSTIC_RO_VECTOR_TAGWORD, result, n);
#ifdef DEBUG_LITERALS
debug_say("...] @ %#x\n", result);
#endif
LIST_CONS(task, stk, result, stk);
}
break;
case I_RECORD:
{
int n = GET32(bytecode_vector); pc += 4;
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RECORD(%d) [", pc-5, n);
#endif
if (n == 0) {
#ifdef DEBUG_LITERALS
debug_say("]\n");
#endif
LIST_CONS(task, stk, HEAP_VOID, stk);
break;
} else {
int space_needed = 4*(n+1);
GC_CHECK;
LIB7_AllocWrite(task, 0, MAKE_TAGWORD(n, PAIRS_AND_RECORDS_BTAG));
}
// Top of stack is last element in record:
//
for (int j = n; j > 0; j--) {
//
LIB7_AllocWrite(task, j, LIST_HEAD(stk));
stk = LIST_TAIL(stk);
}
Val result = LIB7_Alloc(task, n );
#ifdef DEBUG_LITERALS
debug_say("...] @ %#x\n", result);
#endif
LIST_CONS(task, stk, result, stk);
}
break;
case I_RETURN:
ASSERT(pc == bytecode_vector_length_in_bytes);
#ifdef DEBUG_LITERALS
debug_say("[%2d]: RETURN(%#x)\n", pc-5, LIST_HEAD(stk));
#endif
return LIST_HEAD( stk );
break;
default:
die ("bogus literal opcode #%x @ %d", bytecode_vector[pc-1], pc-1);
} // switch
} // while
} // fun make_package_literals_via_bytecode_interpreter
