Ejemplo n.º 1
0
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);
}
Ejemplo n.º 2
0
/* MakeResumeCont:
 *
 * 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 Lib7 state.
 *
 * At least 4K avail. heap assumed.
 *
 * This gets called from MakeHandlerArg() below,
 * and also from  src/runtime/main/run-runtime.c
 *
 */
lib7_val_t MakeResumeCont (lib7_state_t *lib7_state, lib7_val_t resume[])
{
    /* Allocate the resumption closure:
     */
    LIB7_AllocWrite(lib7_state,  0, MAKE_DESC(10, DTAG_record));
    LIB7_AllocWrite(lib7_state,  1, PTR_CtoLib7(resume));
    LIB7_AllocWrite(lib7_state,  2, lib7_state->lib7_argument);
    LIB7_AllocWrite(lib7_state,  3, lib7_state->lib7_fate);
    LIB7_AllocWrite(lib7_state,  4, lib7_state->lib7_closure);
    LIB7_AllocWrite(lib7_state,  5, lib7_state->lib7_link_register);
    LIB7_AllocWrite(lib7_state,  6, lib7_state->lib7_program_counter);
    LIB7_AllocWrite(lib7_state,  7, lib7_state->lib7_exception_fate);
    LIB7_AllocWrite(lib7_state,  8, lib7_state->lib7_calleeSave[0]); /* John Reppy says not to do: LIB7_AllocWrite(lib7_state,  8, lib7_state->lib7_current_thread); */
    LIB7_AllocWrite(lib7_state,  9, lib7_state->lib7_calleeSave[1]);
    LIB7_AllocWrite(lib7_state, 10, lib7_state->lib7_calleeSave[2]);
    /**/
    return LIB7_Alloc(lib7_state, 10);
}
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
Ejemplo n.º 4
0
void   allocate_globals   (lib7_state_t* lib7_state)
{
    lib7_val_t	RunVec;
    lib7_val_t    CStruct;

#ifdef SIZES_C64_LIB732
    PatchAddresses ();
#endif

    /* Allocate the RunVec: */
#define RUNVEC_SZ	12
    LIB7_AllocWrite(lib7_state,  0, MAKE_DESC(RUNVEC_SZ, DTAG_record));
    LIB7_AllocWrite(lib7_state,  1, PTR_CtoLib7(array_v+1));
    LIB7_AllocWrite(lib7_state,  2, PTR_CtoLib7(bind_cfun_v+1));
    LIB7_AllocWrite(lib7_state,  3, PTR_CtoLib7(callc_v+1));
    LIB7_AllocWrite(lib7_state,  4, PTR_CtoLib7(create_b_v+1));
    LIB7_AllocWrite(lib7_state,  5, PTR_CtoLib7(create_r_v+1));
    LIB7_AllocWrite(lib7_state,  6, PTR_CtoLib7(create_s_v+1));
    LIB7_AllocWrite(lib7_state,  7, PTR_CtoLib7(create_v_v+1));
    LIB7_AllocWrite(lib7_state,  8, PTR_CtoLib7(floor_v+1));
    LIB7_AllocWrite(lib7_state,  9, PTR_CtoLib7(logb_v+1));
    LIB7_AllocWrite(lib7_state, 10, PTR_CtoLib7(scalb_v+1));
    LIB7_AllocWrite(lib7_state, 11, PTR_CtoLib7(try_lock_v+1));
    LIB7_AllocWrite(lib7_state, 12, PTR_CtoLib7(unlock_v+1));
    RunVec = LIB7_Alloc(lib7_state, RUNVEC_SZ);

    /* Allocate the CStruct: */
#define CSTRUCT_SZ	12
    LIB7_AllocWrite(lib7_state,  0, MAKE_DESC(CSTRUCT_SZ, DTAG_record));
    LIB7_AllocWrite(lib7_state,  1, RunVec);
    LIB7_AllocWrite(lib7_state,  2, DivId);
    LIB7_AllocWrite(lib7_state,  3, OverflowId);
    LIB7_AllocWrite(lib7_state,  4, SysErrId);
    LIB7_AllocWrite(lib7_state,  5, ProfCurrent);		/* prof_current in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state,  6, PollEvent);			/* poll_event	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state,  7, PollFreq);			/* poll_freq	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state,  8, Lib7PollHandler);		/* poll_handler	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state,  9, ActiveProcs);		/* active_procs	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state, 10, PervasiveStruct);		/* pstruct	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state, 11, Lib7SignalHandler);		/* sighandler	in src/lib/core/init/runtime-system.api		*/
    LIB7_AllocWrite(lib7_state, 12, LIB7_vector0);		/* vector0	in src/lib/core/init/runtime-system.api		*/
    CStruct = LIB7_Alloc(lib7_state, CSTRUCT_SZ);

    /* Allocate 1-elem SRECORD just containing the CStruct: */
    REC_ALLOC1(lib7_state, runtimeCompileUnit, CStruct);

#ifdef ASM_MATH
#define MATHVEC_SZ	8
    LIB7_AllocWrite(lib7_state,  0, MAKE_DESC(MATHVEC_SZ, DTAG_record));
    LIB7_AllocWrite(lib7_state,  1, LnId);
    LIB7_AllocWrite(lib7_state,  2, SqrtId);
    LIB7_AllocWrite(lib7_state,  3, PTR_CtoLib7(arctan_v+1));
    LIB7_AllocWrite(lib7_state,  4, PTR_CtoLib7(cos_v+1));
    LIB7_AllocWrite(lib7_state,  5, PTR_CtoLib7(exp_v+1));
    LIB7_AllocWrite(lib7_state,  6, PTR_CtoLib7(ln_v+1));
    LIB7_AllocWrite(lib7_state,  7, PTR_CtoLib7(sin_v+1));
    LIB7_AllocWrite(lib7_state,  8, PTR_CtoLib7(sqrt_v+1));
    MathVec = LIB7_Alloc(lib7_state, MATHVEC_SZ);
#endif

}          /* allocate_globals */
Ejemplo n.º 5
0
Val   make_resumption_fate   (				// 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:
    //
    LIB7_AllocWrite(task,  0, MAKE_TAGWORD(10, PAIRS_AND_RECORDS_BTAG));
    LIB7_AllocWrite(task,  1, PTR_CAST( Val, resume));
    LIB7_AllocWrite(task,  2, task->argument);
    LIB7_AllocWrite(task,  3, task->fate);
    LIB7_AllocWrite(task,  4, task->current_closure);
    LIB7_AllocWrite(task,  5, task->link_register);
    LIB7_AllocWrite(task,  6, task->program_counter);
    LIB7_AllocWrite(task,  7, task->exception_fate);
    LIB7_AllocWrite(task,  8, task->callee_saved_registers[0]);				// John Reppy says not to do: LIB7_AllocWrite(task,  8, task->current_thread);
    LIB7_AllocWrite(task,  9, task->callee_saved_registers[1]);
    LIB7_AllocWrite(task, 10, task->callee_saved_registers[2]);
    //
    return LIB7_Alloc(task, 10);
}