/* Print a ref */
void
debug_print_ref(ref *pref)
{ unsigned size = pref->size;
printf("(%x)", pref->type_attrs);
switch ( r_type(pref) )
{
case t_array:
printf("array(%u)0x%lx", size, (ulong)pref->value.refs); break;
case t_boolean: printf("boolean %x", pref->value.index); break;
case t_device:
printf("device 0x%lx", (ulong)pref->value.pdevice); break;
case t_dictionary:
printf("dict(%u/%u)0x%lx",
dict_length(pref), dict_maxlength(pref),
(ulong)pref->value.pdict); break;
case t_file: printf("file 0x%lx", (ulong)pref->value.pfile); break;
case t_integer: printf("int %ld", pref->value.intval); break;
case t_mark: printf("mark"); break;
case t_name:
printf("name(0x%lx#%x)", (ulong)pref->value.pname,
pref->value.pname->index);
debug_print_string(pref->value.pname->string_bytes,
pref->value.pname->string_size);
break;
case t_null: printf("null"); break;
case t_operator:
printf("op(%u)0x%lx", size, (ulong)pref->value.opproc); break;
case t_packedarray:
printf("packedarray(%u)0x%lx", size, (ulong)pref->value.refs); break;
case t_real: printf("real %f", pref->value.realval); break;
case t_string:
printf("string(%u)0x%lx", size, (ulong)pref->value.bytes); break;
default: printf("type 0x%x", r_type(pref));
}
}
int main(int argc, char* argv[]) {
VirtualCPU cpu0;
initCPU(&cpu0);
//initialise the program
Settings* set = setup(argc,argv);
header(set->htmloutput);
list_Job* list=FileToJobList(set->jobinput); // list would be sorted on arrival time
list_Job_sort(list, compare_Job_Arrival);
setSchedulingMode(&cpu0,set->mode);
setRoundRobinCPUQuanta(&cpu0,set->rr_quanta);
setMemoryManagement(&cpu0,set->mem_management);
int clock=cpu0.current_clock;
int totalclocks=0;
int startclocks=clock;
list_iterator_Job* it = malloc(sizeof(*it));
list_Job_iterator_init(it, list);
Job* current = list_Job_examine(it);
while(current!=NULL){
while(current!=NULL && clock==current->arrival_time){
if(current->arrival_time < clock){
//Error when process is behind the clock
fprintf(stderr,"Process to be scheduled in the past- ERROR\n");
exit(EXIT_FAILURE);
}
if(totalclocks==0)
startclocks=clock;
totalclocks+=current->length_time;
debug_print("%s: %d @ %d \n",current->jobname,current->arrival_time,clock);
addJobToCPU(&cpu0,current);
current= list_Job_next(it);
}
clock=incrementClock(&cpu0);
dumpMemory(clock,set,&cpu0);
}
free(list);
while(isCPUIdle(&cpu0)==false){
debug_print("Incrementing clock %d\n",clock);
clock=incrementClock(&cpu0);
dumpMemory(clock,set,&cpu0);
}
debug_print_string("Complete!\n");
list_JobScheduleResult* results = getResults(&cpu0);
printResultsCompressed(results);
footer(set->htmloutput);
return 0;
}
bool assignPage(Memory* mem,JobInMemory* job,int index,int clock){
Page* thispage = list_Page_pop(mem->freepages);
if(thispage==NULL) {
debug_print_string("Memory full, will perform LRU\n");
if(!LRU(mem,1))
return false;
thispage = list_Page_pop(mem->freepages);
}
debug_print("Available empty page: %d\n",PAGELOC(thispage,mem->pages[0]));
thispage->job = job->job;
thispage->last_accessed_at = clock;
job->pages[index]=thispage;
list_Page_append(mem->LRU_list, thispage);
return true;
}
static void
trace_array_data(const gs_memory_t * mem, const char *label,
const px_value_t * pav)
{
px_data_type_t type = pav->type;
const byte *ptr = pav->value.array.data;
uint count = pav->value.array.size;
bool big_endian = (type & pxd_big_endian) != 0;
bool text = (type & pxd_ubyte) != 0;
uint i;
dmputs(mem, label);
dmputs(mem, (type & pxd_ubyte ? " <" : " {"));
for (i = 0; i < count; ++i) {
if (!(i & 15) && i) {
const char *p;
dmputs(mem, "\n ");
for (p = label; *p; ++p)
dmputc(mem, ' ');
}
if (type & pxd_ubyte) {
dmprintf1(mem, "%02x ", ptr[i]);
if (ptr[i] < 32 || ptr[i] > 126)
text = false;
} else if (type & pxd_uint16)
dmprintf1(mem, "%u ", uint16at(ptr + i * 2, big_endian));
else if (type & pxd_sint16)
dmprintf1(mem, "%d ", sint16at(ptr + i * 2, big_endian));
else if (type & pxd_uint32)
dmprintf1(mem, "%lu ", (ulong) uint32at(ptr + i * 4, big_endian));
else if (type & pxd_sint32)
dmprintf1(mem, "%ld ", (long)sint32at(ptr + i * 4, big_endian));
else if (type & pxd_real32)
dmprintf1(mem, "%g ", real32at(ptr + i * 4, big_endian));
else
dmputs(mem, "? ");
}
dmputs(mem, (type & pxd_ubyte ? ">\n" : "}\n"));
if (text) {
dmputs(mem, "%chars: \"");
debug_print_string(mem, ptr, count);
dmputs(mem, "\"\n");
}
}
int
auth_cram_md5_server(auth_instance *ablock, uschar *data)
{
auth_cram_md5_options_block *ob =
(auth_cram_md5_options_block *)(ablock->options_block);
uschar *challenge = string_sprintf("<%d.%ld@%s>", getpid(),
(long int) time(NULL), primary_hostname);
uschar *clear, *secret;
uschar digest[16];
int i, rc, len;
/* If we are running in the test harness, always send the same challenge,
an example string taken from the RFC. */
if (running_in_test_harness)
challenge = US"<*****@*****.**>";
/* No data should have been sent with the AUTH command */
if (*data != 0) return UNEXPECTED;
/* Send the challenge, read the return */
if ((rc = auth_get_data(&data, challenge, Ustrlen(challenge))) != OK) return rc;
if ((len = b64decode(data, &clear)) < 0) return BAD64;
/* The return consists of a user name, space-separated from the CRAM-MD5
digest, expressed in hex. Extract the user name and put it in $auth1 and $1.
The former is now the preferred variable; the latter is the original one. Then
check that the remaining length is 32. */
auth_vars[0] = expand_nstring[1] = clear;
while (*clear != 0 && !isspace(*clear)) clear++;
if (!isspace(*clear)) return FAIL;
*clear++ = 0;
expand_nlength[1] = clear - expand_nstring[1] - 1;
if (len - expand_nlength[1] - 1 != 32) return FAIL;
expand_nmax = 1;
/* Expand the server_secret string so that it can compute a value dependent on
the user name if necessary. */
debug_print_string(ablock->server_debug_string); /* customized debugging */
secret = expand_string(ob->server_secret);
/* A forced fail implies failure of authentication - i.e. we have no secret for
the given name. */
if (secret == NULL)
{
if (expand_string_forcedfail) return FAIL;
auth_defer_msg = expand_string_message;
return DEFER;
}
/* Compute the CRAM-MD5 digest that we should have received from the client. */
compute_cram_md5(secret, challenge, digest);
HDEBUG(D_auth)
{
uschar buff[64];
debug_printf("CRAM-MD5: user name = %s\n", auth_vars[0]);
debug_printf(" challenge = %s\n", challenge);
debug_printf(" received = %s\n", clear);
Ustrcpy(buff," digest = ");
for (i = 0; i < 16; i++) sprintf(CS buff+22+2*i, "%02x", digest[i]);
debug_printf("%.54s\n", buff);
}
/* We now have to compare the digest, which is 16 bytes in binary, with the
data received, which is expressed in lower case hex. We checked above that
there were 32 characters of data left. */
for (i = 0; i < 16; i++)
{
int a = *clear++;
int b = *clear++;
if (((((a >= 'a')? a - 'a' + 10 : a - '0') << 4) +
((b >= 'a')? b - 'a' + 10 : b - '0')) != digest[i]) return FAIL;
}
/* Expand server_condition as an authorization check */
return auth_check_serv_cond(ablock);
}
int
main(int argc, const char *argv[])
{
char achar = '0';
gs_memory_t *mem;
gs_state *pgs;
const gx_device *const *list;
gx_device *dev;
gx_device_bbox *bbdev;
int code;
gp_init();
mem = gs_malloc_init();
gs_lib_init1(mem);
if (argc < 2 || (achar = argv[1][0]) < '1' ||
achar > '0' + countof(tests) - 1
) {
lprintf1("Usage: gslib 1..%c\n", '0' + (char)countof(tests) - 1);
gs_abort(mem);
}
gs_debug['@'] = 1;
gs_debug['?'] = 1;
/*gs_debug['B'] = 1; *//****** PATCH ******/
/*gs_debug['L'] = 1; *//****** PATCH ******/
/*
* gs_iodev_init must be called after the rest of the inits, for
* obscure reasons that really should be documented!
*/
gs_iodev_init(mem);
/****** WRONG ******/
gs_lib_device_list(&list, NULL);
gs_copydevice(&dev, list[0], mem);
check_device_separable(dev);
gx_device_fill_in_procs(dev);
bbdev =
gs_alloc_struct_immovable(mem, gx_device_bbox, &st_device_bbox,
"bbox");
gx_device_bbox_init(bbdev, dev, mem);
code = dev_proc(dev, get_profile)(dev, &bbdev->icc_struct);
rc_increment(bbdev->icc_struct);
/* Print out the device name just to test the gsparam.c API. */
{
gs_c_param_list list;
gs_param_string nstr;
gs_c_param_list_write(&list, mem);
code = gs_getdeviceparams(dev, (gs_param_list *) & list);
if (code < 0) {
lprintf1("getdeviceparams failed! code = %d\n", code);
gs_abort(mem);
}
gs_c_param_list_read(&list);
code = param_read_string((gs_param_list *) & list, "Name", &nstr);
if (code < 0) {
lprintf1("reading Name failed! code = %d\n", code);
gs_abort(mem);
}
dputs("Device name = ");
debug_print_string(nstr.data, nstr.size);
dputs("\n");
gs_c_param_list_release(&list);
}
/*
* If this is a device that takes an OutputFile, set the OutputFile
* to "-" in the copy.
*/
{
gs_c_param_list list;
gs_param_string nstr;
gs_c_param_list_write(&list, mem);
param_string_from_string(nstr, "-");
code = param_write_string((gs_param_list *)&list, "OutputFile", &nstr);
if (code < 0) {
lprintf1("writing OutputFile failed! code = %d\n", code);
gs_abort(mem);
}
gs_c_param_list_read(&list);
code = gs_putdeviceparams(dev, (gs_param_list *)&list);
gs_c_param_list_release(&list);
if (code < 0 && code != gs_error_undefined) {
lprintf1("putdeviceparams failed! code = %d\n", code);
gs_abort(mem);
}
}
dev = (gx_device *) bbdev;
pgs = gs_state_alloc(mem);
gs_setdevice_no_erase(pgs, dev); /* can't erase yet */
{
gs_point dpi;
gs_screen_halftone ht;
gs_dtransform(pgs, 72.0, 72.0, &dpi);
ht.frequency = min(fabs(dpi.x), fabs(dpi.y)) / 16.001;
ht.angle = 0;
ht.spot_function = odsf;
gs_setscreen(pgs, &ht);
}
/* gsave and grestore (among other places) assume that */
/* there are at least 2 gstates on the graphics stack. */
/* Ensure that now. */
gs_gsave(pgs);
gs_erasepage(pgs);
code = (*tests[achar - '1']) (pgs, mem);
gs_output_page(pgs, 1, 1);
{
gs_rect bbox;
gx_device_bbox_bbox(bbdev, &bbox);
dprintf4("Bounding box: [%g %g %g %g]\n",
bbox.p.x, bbox.p.y, bbox.q.x, bbox.q.y);
}
if (code)
dprintf1("**** Test returned code = %d.\n", code);
dputs("Done. Press <enter> to exit.");
fgetc(mem->gs_lib_ctx->fstdin);
gs_lib_finit(0, 0, mem);
return 0;
#undef mem
}
int
auth_spa_server(auth_instance *ablock, uschar *data)
{
auth_spa_options_block *ob = (auth_spa_options_block *)(ablock->options_block);
uint8x lmRespData[24];
uint8x ntRespData[24];
SPAAuthRequest request;
SPAAuthChallenge challenge;
SPAAuthResponse response;
SPAAuthResponse *responseptr = &response;
uschar msgbuf[2048];
uschar *clearpass;
/* send a 334, MS Exchange style, and grab the client's request,
unless we already have it via an initial response. */
if ((*data == '\0') &&
(auth_get_no64_data(&data, US"NTLM supported") != OK))
{
/* something borked */
return FAIL;
}
if (spa_base64_to_bits((char *)(&request), sizeof(request), (const char *)(data)) < 0)
{
DEBUG(D_auth) debug_printf("auth_spa_server(): bad base64 data in "
"request: %s\n", data);
return FAIL;
}
/* create a challenge and send it back */
spa_build_auth_challenge(&request,&challenge);
spa_bits_to_base64 (msgbuf, (unsigned char*)&challenge,
spa_request_length(&challenge));
if (auth_get_no64_data(&data, msgbuf) != OK)
{
/* something borked */
return FAIL;
}
/* dump client response */
if (spa_base64_to_bits((char *)(&response), sizeof(response), (const char *)(data)) < 0)
{
DEBUG(D_auth) debug_printf("auth_spa_server(): bad base64 data in "
"response: %s\n", data);
return FAIL;
}
/***************************************************************
PH 07-Aug-2003: The original code here was this:
Ustrcpy(msgbuf, unicodeToString(((char*)responseptr) +
IVAL(&responseptr->uUser.offset,0),
SVAL(&responseptr->uUser.len,0)/2) );
However, if the response data is too long, unicodeToString bombs out on
an assertion failure. It uses a 1024 fixed buffer. Bombing out is not a good
idea. It's too messy to try to rework that function to return an error because
it is called from a number of other places in the auth-spa.c module. Instead,
since it is a very small function, I reproduce its code here, with a size check
that causes failure if the size of msgbuf is exceeded. ****/
{
int i;
char *p = ((char*)responseptr) + IVAL(&responseptr->uUser.offset,0);
int len = SVAL(&responseptr->uUser.len,0)/2;
if (len + 1 >= sizeof(msgbuf)) return FAIL;
for (i = 0; i < len; ++i)
{
msgbuf[i] = *p & 0x7f;
p += 2;
}
msgbuf[i] = 0;
}
/***************************************************************/
/* Put the username in $auth1 and $1. The former is now the preferred variable;
the latter is the original variable. These have to be out of stack memory, and
need to be available once known even if not authenticated, for error messages
(server_set_id, which only makes it to authenticated_id if we return OK) */
auth_vars[0] = expand_nstring[1] = string_copy(msgbuf);
expand_nlength[1] = Ustrlen(msgbuf);
expand_nmax = 1;
debug_print_string(ablock->server_debug_string); /* customized debug */
/* look up password */
clearpass = expand_string(ob->spa_serverpassword);
if (clearpass == NULL)
{
if (expand_string_forcedfail)
{
DEBUG(D_auth) debug_printf("auth_spa_server(): forced failure while "
"expanding spa_serverpassword\n");
return FAIL;
}
else
{
DEBUG(D_auth) debug_printf("auth_spa_server(): error while expanding "
"spa_serverpassword: %s\n", expand_string_message);
return DEFER;
}
}
/* create local hash copy */
spa_smb_encrypt (clearpass, challenge.challengeData, lmRespData);
spa_smb_nt_encrypt (clearpass, challenge.challengeData, ntRespData);
/* compare NT hash (LM may not be available) */
if (memcmp(ntRespData,
((unsigned char*)responseptr)+IVAL(&responseptr->ntResponse.offset,0),
24) == 0)
/* success. we have a winner. */
{
return auth_check_serv_cond(ablock);
}
/* Expand server_condition as an authorization check (PH) */
return FAIL;
}
int
auth_check_some_cond(auth_instance *ablock,
uschar *label, uschar *condition, int unset)
{
uschar *cond;
HDEBUG(D_auth)
{
int i;
debug_printf("%s authenticator %s:\n", ablock->name, label);
for (i = 0; i < AUTH_VARS; i++)
{
if (auth_vars[i] != NULL)
debug_printf(" $auth%d = %s\n", i + 1, auth_vars[i]);
}
for (i = 1; i <= expand_nmax; i++)
debug_printf(" $%d = %.*s\n", i, expand_nlength[i], expand_nstring[i]);
debug_print_string(ablock->server_debug_string); /* customized debug */
}
/* For the plaintext authenticator, server_condition is never NULL. For the
rest, an unset condition lets everything through. */
/* For server_condition, an unset condition lets everything through.
For plaintext/gsasl authenticators, it will have been pre-checked to prevent
this. We return the unset scenario value given to us, which for
server_condition will be OK and otherwise will typically be FAIL. */
if (condition == NULL) return unset;
cond = expand_string(condition);
HDEBUG(D_auth)
{
if (cond == NULL)
debug_printf("expansion failed: %s\n", expand_string_message);
else
debug_printf("expanded string: %s\n", cond);
}
/* A forced expansion failure causes authentication to fail. Other expansion
failures yield DEFER, which will cause a temporary error code to be returned to
the AUTH command. The problem is at the server end, so the client should try
again later. */
if (cond == NULL)
{
if (expand_string_forcedfail) return FAIL;
auth_defer_msg = expand_string_message;
return DEFER;
}
/* Return FAIL for empty string, "0", "no", and "false"; return OK for
"1", "yes", and "true"; return DEFER for anything else, with the string
available as an error text for the user. */
if (*cond == 0 ||
Ustrcmp(cond, "0") == 0 ||
strcmpic(cond, US"no") == 0 ||
strcmpic(cond, US"false") == 0)
return FAIL;
if (Ustrcmp(cond, "1") == 0 ||
strcmpic(cond, US"yes") == 0 ||
strcmpic(cond, US"true") == 0)
return OK;
auth_defer_msg = cond;
auth_defer_user_msg = string_sprintf(": %s", cond);
return DEFER;
}
// Initializes the specified timer:
void timer_reset(int timer, timer_mode_t mode, uint32_t usec, timer_callback_func callback)
{
debug_print_string("Initializing timer");
debug_print_dec(timer);
debug_print_string(": ");
debug_print_newline();
mmu_map_interval(
(void *) TIMER_ADDR(timers[timer].memspace),
(void *) TIMER_ADDR(timers[timer].memspace) + 4096,
(void *) timers[timer].memspace, MMU_MODE_DEVICE, MMU_PERM_RW_NONE,
NULL);
timers[timer].mode = mode;
timers[timer].usec = usec;
timers[timer].callback = callback;
// Reset the timer:
timers[timer].memspace[REG_32(TIMER_TIOCP_CFG)] |= TIMER_SOFTRESET;
while(!(timers[timer].memspace[REG_32(TIMER_TISTAT)] & TIMER_RESETDONE));
// Print hardware revision:
debug_print_string("\tHardware revision: ");
debug_print_dec(IP_REV_MAJOR(timers[timer].memspace[REG_32(TIMER_TIDR)]));
debug_print_char('.');
debug_print_dec(IP_REV_MINOR(timers[timer].memspace[REG_32(TIMER_TIDR)]));
debug_print_newline();
// Set idle-mode to smart mode:
timers[timer].memspace[REG_32(TIMER_TIOCP_CFG)] |= TIMER_IDLE_MODE_SMART;
// Calculate the value to store in the timer registers:
uint32_t timer_value = UNSIGNED_DIFF(0xffffffff, usec * TIMER_USEC);
// Set timer parameters:
debug_print_string("\tMode: ");
switch(mode)
{
case TIMER_MODE_NONE:
debug_print_string("invalid! Timer disabled.");
debug_print_newline();
return;
case TIMER_MODE_ONESHOT:
timers[timer].memspace[REG_32(TIMER_TCLR)] |= TIMER_TRG_OV;
debug_print_string("one-shot");
break;
case TIMER_MODE_AUTORELOAD:
timers[timer].memspace[REG_32(TIMER_TCLR)] |= TIMER_TRG_OV|TIMER_AR;
debug_print_string("autoreload");
break;
}
debug_print_newline();
debug_print_string("\tInterval: ");
debug_print_dec(usec);
debug_print_string(" microseconds");
debug_print_newline();
timers[timer].memspace[REG_32(TIMER_TLDR)] = timer_value;
timers[timer].memspace[REG_32(TIMER_TTGR)] = 1;
// Set up the IRQ interrupt handler:
irq_register_handler(timer + 37, timer_irq_handler);
// Enable the overflow interrupt:
timers[timer].memspace[REG_32(TIMER_TIER)] = 2;
}
//------------------------------------------------------------------------------
// debug_print_settings function
//
// Print settings object.
//
void debug_print_settings ()
{
debug_print_title ("SLCC Settings");
debug_print_bool ("quiet", settings_.quiet);
debug_print_bool ("verbose", settings_.verbose);
debug_print_bool ("copyright", settings_.copyright_only);
debug_print_bool ("license", settings_.license_only);
debug_print_bool ("usage", settings_.usage_only);
debug_print_bool ("warrantee", settings_.warrantee_only);
debug_print_bool ("compile only", settings_.compile_only);
debug_print_bool ("dependencies only", settings_.dependencies_only);
debug_print_bool ("preprocess only", settings_.preprocess_only);
debug_print_string ("out file", settings_.out_file);
debug_print_string ("source file", settings_.source_file);
debug_print_source_file_type ("source file type", settings_.source_type);
debug_print_size ("number of object files", settings_.object_files->used_);
if (settings_.object_files->used_ > 0)
debug_print_string_array (
"object files",
settings_.object_files->data_,
settings_.object_files->used_
);
debug_print_size ("number of library files", settings_.object_files->used_);
if (settings_.library_files->used_ > 0)
debug_print_string_array (
"library files",
settings_.library_files->data_,
settings_.library_files->used_
);
debug_print_language ("language", settings_.language);
debug_print_language_standard ("standard", settings_.standard);
debug_print_bool ("use deprecated", settings_.use_deprecated);
debug_print_bool ("use standard library", settings_.use_stdlib);
debug_print_size ("number of include paths", settings_.include_paths->used_);
if (settings_.include_paths->used_ > 0)
debug_print_string_array (
"include paths",
settings_.include_paths->data_,
settings_.include_paths->used_
);
debug_print_size ("number of library paths", settings_.library_paths->used_);
if (settings_.library_paths->used_ > 0)
debug_print_string_array (
"library paths",
settings_.library_paths->data_,
settings_.library_paths->used_
);
debug_print_size ("number of source paths", settings_.source_paths->used_);
if (settings_.source_paths->used_ > 0)
debug_print_string_array (
"source paths",
settings_.source_paths->data_,
settings_.source_paths->used_
);
debug_print_bool ("use concepts", settings_.use_concepts);
debug_print_bool ("use export", settings_.use_export);
fprintf (stderr, "\n");
}
lref_t debug_print_object(lref_t obj, lref_t port, bool machine_readable)
{
_TCHAR buf[STACK_STRBUF_LEN];
if (DEBUG_FLAG(DF_PRINT_ADDRESSES))
scwritef("#@~c&=", port, obj);
lref_t tmp;
size_t ii;
lref_t slots;
const _TCHAR *fast_op_name;
switch (TYPE(obj))
{
case TC_NIL:
WRITE_TEXT_CONSTANT(port, _T("()"));
break;
case TC_BOOLEAN:
if (TRUEP(obj))
WRITE_TEXT_CONSTANT(port, _T("#t"));
else
WRITE_TEXT_CONSTANT(port, _T("#f"));
break;
case TC_CONS:
write_char(port, _T('('));
debug_print_object(lcar(obj), port, machine_readable);
for (tmp = lcdr(obj); CONSP(tmp); tmp = lcdr(tmp))
{
write_char(port, _T(' '));
debug_print_object(lcar(tmp), port, machine_readable);
}
if (!NULLP(tmp))
{
WRITE_TEXT_CONSTANT(port, _T(" . "));
debug_print_object(tmp, port, machine_readable);
}
write_char(port, _T(')'));
break;
case TC_FIXNUM:
_sntprintf(buf, STACK_STRBUF_LEN, _T("%" SCAN_PRIiFIXNUM), FIXNM(obj));
write_text(port, buf, _tcslen(buf));
break;
case TC_FLONUM:
debug_print_flonum(obj, port, machine_readable);
break;
case TC_CHARACTER:
if (machine_readable)
{
if (CHARV(obj) < CHARNAMECOUNT)
scwritef(_T("#\\~cs"), port, charnames[(size_t) CHARV(obj)]);
else if (CHARV(obj) >= CHAREXTENDED - 1)
scwritef(_T("#\\<~cd>"), port, (int) CHARV(obj));
else
scwritef(_T("#\\~cc"), port, (int) CHARV(obj));
}
else
scwritef(_T("~cc"), port, (int) CHARV(obj));
break;
case TC_SYMBOL:
if (NULLP(SYMBOL_HOME(obj)))
{
if (DEBUG_FLAG(DF_PRINT_FOR_DIFF))
scwritef("#:<uninterned-symbol>", port);
else
scwritef("#:~a@~c&", port, SYMBOL_PNAME(obj), obj);
}
else if (SYMBOL_HOME(obj) == interp.control_fields[VMCTRL_PACKAGE_KEYWORD])
scwritef(":~a", port, SYMBOL_PNAME(obj));
else
{
/* With only a minimal c-level package implementation, we
* just assume every symbol is private. */
scwritef("~a::~a", port, SYMBOL_HOME(obj)->as.package.name, SYMBOL_PNAME(obj));
}
break;
case TC_VECTOR:
WRITE_TEXT_CONSTANT(port, _T("["));
for (ii = 0; ii < obj->as.vector.dim; ii++)
{
debug_print_object(obj->as.vector.data[ii], port, true);
if (ii + 1 < obj->as.vector.dim)
write_char(port, _T(' '));
}
write_char(port, _T(']'));
break;
case TC_STRUCTURE:
WRITE_TEXT_CONSTANT(port, _T("#S("));
debug_print_object(CAR(STRUCTURE_LAYOUT(obj)), port, true);
for (ii = 0, slots = CAR(CDR(STRUCTURE_LAYOUT(obj)));
ii < STRUCTURE_DIM(obj); ii++, slots = CDR(slots))
{
WRITE_TEXT_CONSTANT(port, _T(" "));
debug_print_object(CAR(CAR(slots)), port, true);
WRITE_TEXT_CONSTANT(port, _T(" "));
debug_print_object(STRUCTURE_ELEM(obj, ii), port, true);
}
WRITE_TEXT_CONSTANT(port, _T(")"));
break;
case TC_STRING:
debug_print_string(obj, port, machine_readable);
break;
case TC_HASH:
debug_print_hash(obj, port, machine_readable);
break;
case TC_PACKAGE:
scwritef("~u ~a", port, (lref_t) obj, obj->as.package.name);
break;
case TC_SUBR:
scwritef("~u,~cd:~a", port, (lref_t) obj, SUBR_TYPE(obj), SUBR_NAME(obj));
break;
case TC_CLOSURE:
if (DEBUG_FLAG(DF_PRINT_CLOSURE_CODE))
scwritef("~u\n\tcode:~s\n\tenv:~s\n\tp-list:~s", port,
(lref_t) obj, CLOSURE_CODE(obj), CLOSURE_ENV(obj),
CLOSURE_PROPERTY_LIST(obj));
else
scwritef("~u", port, (lref_t) obj);
break;
case TC_VALUES_TUPLE:
scwritef("~u ~s", port, (lref_t) obj, obj->as.values_tuple.values);
break;
case TC_MACRO:
if (DEBUG_FLAG(DF_PRINT_CLOSURE_CODE))
scwritef("~u ~s", port, (lref_t) obj, obj->as.macro.transformer);
else
scwritef("~u", port, (lref_t) obj);
break;
case TC_END_OF_FILE:
scwritef("~u", port, (lref_t) obj);
break;
case TC_PORT:
scwritef(_T("~u~cs~cs~cs ~cs ~s"), port,
obj,
PORT_INPUTP(obj) ? " (input)" : "",
PORT_OUTPUTP(obj) ? " (output)" : "",
BINARY_PORTP(obj) ? " (binary)" : "",
PORT_CLASS(obj)->name,
PORT_PINFO(obj)->port_name);
break;
case TC_FAST_OP:
fast_op_name = fast_op_opcode_name(obj->header.opcode);
if (fast_op_name)
scwritef("#<FOP@~c&:~cs ~s ~s => ~s>", port, (lref_t) obj,
fast_op_name,
obj->as.fast_op.arg1,
obj->as.fast_op.arg2,
obj->as.fast_op.next);
else
scwritef("#<FOP@~c&:~cd ~s ~s => ~s>", port, (lref_t) obj,
obj->header.opcode,
obj->as.fast_op.arg1,
obj->as.fast_op.arg2,
obj->as.fast_op.next);
break;
case TC_FASL_READER:
scwritef(_T("~u~s"), port,
obj,
FASL_READER_PORT(obj));
break;
case TC_UNBOUND_MARKER:
scwritef("#<UNBOUND-MARKER>", port);
break;
case TC_FREE_CELL:
scwritef("#<FREE CELL -- Forget a call to gc_mark? ~c&>", port, obj);
break;
default:
scwritef("#<INVALID OBJECT - UNKNOWN TYPE ~c&>", port, obj);
}
return port;
}
