521 lines
16 KiB
C
521 lines
16 KiB
C
/* TIPC Scheme '84 -- Interactive Debug Utility
|
||
(C) Copyright 1984,1985 by Texas Instruments Incorporated.
|
||
All rights reserved.
|
||
|
||
Author: John C. Jensen
|
||
Installation: Texas Instruments Incorporated, Dallas, Texas
|
||
Division: Central Research Laboratories
|
||
Cost Center: Computer Science Laboratory
|
||
Project: Computer Architecture Branch
|
||
Date Written: 13 April 1984
|
||
Modification History:
|
||
?? 10/22/85 - ??
|
||
rb 9/23/87 - make screen output interruptible
|
||
*/
|
||
|
||
#include "ctype.h"
|
||
#include "scheme.h"
|
||
|
||
#define BUFSIZE 160
|
||
#define DEFAULT_LENGTH 64
|
||
#define QUIT 0
|
||
#define PROCEED 1
|
||
#define HALT 1
|
||
#define INTR_OUTPUT if (char_rdy()) {(void) getch(); break;}
|
||
|
||
extern char char_rdy();
|
||
|
||
/**********************************************************************/
|
||
/* TIPC Scheme '84 Interactive Debugger */
|
||
/* */
|
||
/* Purpose: This utility assists the compiler developer by allowing */
|
||
/* him or her to interactively display and modify the data */
|
||
/* structures of the Scheme Virtual Machine as a program */
|
||
/* executes. */
|
||
/**********************************************************************/
|
||
sdebug()
|
||
{
|
||
int after[NUMPAGES], before[NUMPAGES]; /* memory reclamation info */
|
||
char buffer[BUFSIZE];
|
||
int command = PROCEED;
|
||
int disp; /* displacement into a page */
|
||
int i,j,k;
|
||
int idx; /* index into character string buffer */
|
||
long ix; /* 32 bit integer temporary */
|
||
unsigned length; /* length (in bytes) of area to dump */
|
||
int page; /* page number */
|
||
int *reg_page,*reg_disp; /* current register pointers */
|
||
int sav_disp;
|
||
int pc; /* local copy of VM's PC */
|
||
|
||
long hex_word();
|
||
unsigned hex_val();
|
||
unsigned put_word();
|
||
ENTER(sdebug);
|
||
|
||
/* If we're not in VM debug mode, simply issue a SCHEME-RESET */
|
||
if (!VM_debug) {
|
||
reset:
|
||
printf("\nAttempting to execute SCHEME-RESET\n%s",
|
||
"[Returning to top level]\n");
|
||
CB_pag = SPECCODE*2;
|
||
CB_dis = 0;
|
||
S_pc = RST_ent - 1;
|
||
goto run_it;
|
||
}
|
||
|
||
/* Print Welcome to the Debugging World */
|
||
printf("\nPC Scheme Virtual Machine Debugger\n");
|
||
|
||
/* Read the next command from the user person */
|
||
while (command != QUIT) {
|
||
zcuron();
|
||
printf("\nCOMMAND: ");
|
||
i = 0;
|
||
ssetadr(ADJPAGE(IN_PAGE), IN_DISP);
|
||
while ((j = take_ch()) != '\r')
|
||
if (j != '\n') buffer[i++] = j;
|
||
buffer[i] = '\0';
|
||
|
||
/* decode instruction */
|
||
if (i > 0) {
|
||
switch(tolower(buffer[0])) {
|
||
case 'a': /* display accounting information */
|
||
accounting();
|
||
break;
|
||
|
||
case 'd': /* Dump Memory: Page:Offset [length] */
|
||
i = tolower(buffer[1]); /* save second character */
|
||
if (i != 'f') {
|
||
idx = 1;
|
||
if (check_page(buffer, &idx, &page, &disp))
|
||
break;
|
||
if ((length = hex_val(buffer, &idx)) == 0)
|
||
length = DEFAULT_LENGTH;
|
||
length = min (length, psize[page] - disp);
|
||
}
|
||
|
||
switch (i) {
|
||
case 'g': /* dump global environment */
|
||
page = CORRPAGE(GNV_pag);
|
||
disp = GNV_dis;
|
||
while (page) {
|
||
INTR_OUTPUT;
|
||
printf("\n\t*** NEW RIB ***\n\n");
|
||
sav_disp = disp;
|
||
disp += 6;
|
||
for (i = 0; i < HT_SIZE; i++,disp+=3) {
|
||
INTR_OUTPUT;
|
||
if (j = get_byte(page, disp))
|
||
dump_environment(j,
|
||
get_word(page, disp+1));
|
||
}
|
||
disp = get_word(page,sav_disp+4);
|
||
page = CORRPAGE(get_byte(page,sav_disp+3));
|
||
} /* end: while (page) */
|
||
break;
|
||
case 'f': /* dump fluid environment */
|
||
dump_environment(FNV_pag, FNV_dis);
|
||
break;
|
||
case 'h': /* hexadecimal dump */
|
||
dump_hex(page, disp, length);
|
||
break;
|
||
/***** case 'p': /* dump the property list */
|
||
dump_prop();
|
||
break;
|
||
*****/
|
||
case 's': /* dump the runtime stack */
|
||
dump_stk();
|
||
break;
|
||
default: /* regular ole dump of a page */
|
||
dump_memory(page, disp, length);
|
||
} /* end switch */
|
||
|
||
break;
|
||
|
||
case 'e': /* Execute this here program */
|
||
run_it:
|
||
if (run(&S_pc, 0x7fff) == HALT) {
|
||
command = QUIT;
|
||
}
|
||
else {
|
||
if (!VM_debug) goto reset;
|
||
}
|
||
break;
|
||
|
||
case 'g': /* invoke garbage collector */
|
||
if (ask("run garbage collector"))
|
||
{
|
||
sum_space(before);
|
||
garbage();
|
||
sum_space(after);
|
||
for (i = DEDPAGES; i < NUMPAGES; i++)
|
||
if (before[i] != after[i])
|
||
printf("Page %3x -- %d bytes recovered\n", i,
|
||
after[i] - before[i]);
|
||
if (ask("run compaction phase"))
|
||
{
|
||
for (i = DEDPAGES, j = 0; i < NUMPAGES; i++)
|
||
if (ptype[i] == FREETYPE*2) j++;
|
||
gcsquish(); /* go for memory compaction */
|
||
for (i = DEDPAGES, k = 0; i < NUMPAGES; i++)
|
||
if (ptype[i] == FREETYPE*2) k++;
|
||
printf("%d pages reclaimed\n", k-j);
|
||
}
|
||
}
|
||
break;
|
||
|
||
case '?': /* print out commands currently defined */
|
||
/* case 'h': */
|
||
printf("Valid Debugger Commands:\n\n%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s",
|
||
" A - display accounting information\n",
|
||
" DH [page:offset [length]] - dump memory hex\n",
|
||
" D [page:offset [length]] - dump memory formatted\n",
|
||
" DF,DG,DS - dump fluids, globals, stack\n",
|
||
" E - execute program (return to PC Scheme)\n",
|
||
" G - invoke Garbage collection\n",
|
||
/* " H - help (prints this information)\n", */
|
||
" I reg <CR> atom - input atom to register\n",
|
||
" IP [n] - set IP to n; if none, decrement IP by 1\n",
|
||
/* " M - run Mark phase of garbage collector\n", */
|
||
" O - display registers as s-expressions\n",
|
||
" P - dump page table\n",
|
||
" Q - quit (return to DOS)\n",
|
||
" R,RE - display registers, do scheme-reset\n",
|
||
/* " S - run Sweep phase of garbage collector\n", */
|
||
" T [n] - trace n instructions\n",
|
||
" WB [page:offset data ...] - write bytes\n",
|
||
" WW [page:offset data ...] - write words\n",
|
||
" X [n] - execute n instructions\n",
|
||
" ? - help (prints this information)\n");
|
||
break;
|
||
|
||
case 'i': /* input atom into register */
|
||
if (tolower(buffer[1]) == 'p') {
|
||
idx = 2;
|
||
i = hex_val(buffer, &idx);
|
||
S_pc = (i > 0 ? i : S_pc - 1);
|
||
}
|
||
else {
|
||
idx = 1;
|
||
i = int_val(buffer,&idx) % NUM_REGS;
|
||
sread_atom(®0 + i, ADJPAGE(IN_PAGE), IN_DISP);
|
||
} /* end else */
|
||
break;
|
||
|
||
/*****
|
||
case 'm': /* run mark phase of garbage collection */
|
||
if (ask("run mark phase of garbage collector"))
|
||
mark();
|
||
break;
|
||
*****/
|
||
|
||
case 'o': /* print s-expressions pointed by regs */
|
||
reg_page = ®0_page;
|
||
reg_disp = ®0_disp;
|
||
for (i = 0; i < NUM_REGS; i++, reg_page+=2, reg_disp+=2)
|
||
{
|
||
if (*reg_disp != UN_DISP || *reg_page != UN_PAGE*2)
|
||
sprint_reg(i, *reg_page, *reg_disp);
|
||
}
|
||
break;
|
||
|
||
case 'p': /* print page table and page control information */
|
||
dump_page_table();
|
||
break;
|
||
|
||
case 'q': /* quit */
|
||
command = QUIT;
|
||
break;
|
||
|
||
case 'r': if (tolower(buffer[1]) == 'e')
|
||
{
|
||
CB_pag = SPECCODE*2;
|
||
CB_dis = 0;
|
||
S_pc = RST_ent - 1;
|
||
}
|
||
else dump_regs(); /* dump registers */
|
||
break;
|
||
|
||
/*****
|
||
case 's': /* run sweep portion of garbage collector */
|
||
if (ask("run sweep phase of garbage collector"))
|
||
gcsweep();
|
||
break;
|
||
*****/
|
||
|
||
case 't': /* trace instruction execution */
|
||
idx = 1;
|
||
if ((length = hex_val(buffer, &idx)) <= 0) length = 1;
|
||
while (length > 0) {
|
||
if ((i = t_inst(CORRPAGE(CB_pag), &S_pc,
|
||
/* run= */ TRUE, /* display= */ TRUE))) break;
|
||
length--;
|
||
} /* end while */
|
||
pc = S_pc;
|
||
(void) t_inst(CORRPAGE(CB_pag), &pc,
|
||
/* run= */ FALSE, /* display= */ TRUE);
|
||
if (i == HALT) halt_exec();
|
||
break;
|
||
|
||
case 'w': /* write memory-- determine if byte or word */
|
||
idx = 2;
|
||
if (check_page(buffer, &idx, &page, &disp))
|
||
break;
|
||
switch (tolower(buffer[1]))
|
||
{
|
||
case 'b': /* write byte */
|
||
while ((i = hex_byte(buffer, &idx)) >= 0)
|
||
{
|
||
printf("%3x:%04x Previous contents: %02x Replaced by: %02x\n",
|
||
page, disp,
|
||
get_byte(page, disp), i);
|
||
put_byte(page, disp, i);
|
||
disp++;
|
||
}
|
||
break;
|
||
|
||
case 'w': /* write word */
|
||
while ((ix = hex_word(buffer, &idx)) >= 0L)
|
||
{
|
||
printf("%3x:%04x Previous contents: %04x Replaced by: %04lx\n",
|
||
page, disp,
|
||
get_word(page, disp), ix);
|
||
put_word(page, disp, ix);
|
||
disp += 2;
|
||
}
|
||
break;
|
||
|
||
default: goto bad_command;
|
||
} /* end: switch (buffer[1]) */
|
||
break;
|
||
|
||
case 'x': /* instruction execution */
|
||
idx = 1;
|
||
if ((length = hex_val(buffer, &idx)) <= 0) length = 1;
|
||
if (interp(&S_pc, length) == HALT) halt_exec();
|
||
break;
|
||
|
||
default: /* unrecognized command */
|
||
bad_command:
|
||
printf("? unrecognized command\n");
|
||
break;
|
||
} /* end: switch(tolower(buffer[0])) */
|
||
} /* end: if (i > 0) */
|
||
} /* end: while (command != QUIT) */
|
||
} /* end of function: sdebug() */
|
||
|
||
halt_exec()
|
||
{
|
||
printf("\n*** (exit) command executed ***\n");
|
||
}
|
||
|
||
/**********************************************************************/
|
||
/* extract a decimal value from a string */
|
||
/**********************************************************************/
|
||
int_val(str, idx)
|
||
char str[];
|
||
int *idx;
|
||
{
|
||
char ch;
|
||
unsigned ret_val = 0;
|
||
int i;
|
||
ENTER(int_val);
|
||
|
||
/* skip over any leading characters in string */
|
||
while (str[*idx] != '\0' && !isdigit(str[*idx])) (*idx)++;
|
||
|
||
/* continue to extract digits until end of string of delimiter */
|
||
while ((ch = str[*idx]))
|
||
{
|
||
if ((i = get_int(ch)) >= 0)
|
||
ret_val = (ret_val * 10) + i;
|
||
else break;
|
||
(*idx)++;
|
||
}
|
||
return((int) ret_val);
|
||
} /* end of function: int_val(str, idx) */
|
||
|
||
/**********************************************************************/
|
||
/* extract a hexadecimal value from a string */
|
||
/**********************************************************************/
|
||
unsigned hex_val(str, idx)
|
||
char str[];
|
||
int *idx;
|
||
{
|
||
char ch;
|
||
unsigned ret_val = 0;
|
||
int i;
|
||
ENTER(hex_val);
|
||
|
||
/* skip over any leading characters in string */
|
||
while (str[*idx] != '\0' && !isxdigit(str[*idx])) (*idx)++;
|
||
|
||
/* continue to extract digits until end of string of delimiter */
|
||
while ((ch = str[*idx]))
|
||
{
|
||
if ((i = get_hex(ch)) >= 0)
|
||
ret_val = (ret_val << 4) + i;
|
||
else break;
|
||
(*idx)++;
|
||
}
|
||
return(ret_val);
|
||
} /* end of function: hex_val(str, idx) */
|
||
|
||
/**********************************************************************/
|
||
/* Extract a byte value from a string */
|
||
/**********************************************************************/
|
||
hex_byte(str, idx)
|
||
char str[];
|
||
int *idx;
|
||
{
|
||
int first_digit, second_digit;
|
||
ENTER(hex_byte);
|
||
while (str[*idx] == ' ') (*idx)++; /* skip leading blanks */
|
||
if ((first_digit = get_hex(str[*idx])) < 0) return(-1);
|
||
(*idx)++;
|
||
if ((second_digit = get_hex(str[*idx])) < 0) return(first_digit);
|
||
(*idx)++;
|
||
return(first_digit * 16 + second_digit);
|
||
}
|
||
|
||
/**********************************************************************/
|
||
/* Extract a word value from a string */
|
||
/**********************************************************************/
|
||
long hex_word(str, idx)
|
||
char str[];
|
||
int *idx;
|
||
{
|
||
int digit,i;
|
||
long ret_val;
|
||
ENTER(hex_word);
|
||
|
||
while (str[*idx] == ' ') (*idx)++; /* skip leading blanks */
|
||
ret_val = -1L;
|
||
for (i = 0; i < 4; i++)
|
||
{
|
||
if (str[*idx] == '\0') return(ret_val);
|
||
if ((digit = get_hex(str[*idx])) < 0) return(ret_val);
|
||
ret_val = (ret_val == -1L? digit : (ret_val << 4) | digit);
|
||
(*idx)++;
|
||
}
|
||
return(ret_val);
|
||
}
|
||
|
||
/**********************************************************************/
|
||
/* Test for a hex digit-- if so, return its decimal value */
|
||
/**********************************************************************/
|
||
get_hex(ch)
|
||
char ch; /* the character to be tested */
|
||
{
|
||
int i;
|
||
static char hex_digit[16]={'0','1','2','3','4','5','6','7','8','9',
|
||
'A','B','C','D','E','F'};
|
||
ENTER(get_hex);
|
||
ch = toupper(ch);
|
||
for (i = 0; i < 16; i++) if (ch == hex_digit[i]) return(i);
|
||
return(-1);
|
||
} /* end of function: get_hex(ch) */
|
||
|
||
/**********************************************************************/
|
||
/* Test for a decimal digit-- if so, return its value */
|
||
/**********************************************************************/
|
||
get_int(ch)
|
||
char ch; /* the character to be tested */
|
||
{
|
||
ENTER(get_int);
|
||
return(isdigit(ch) ? ch - '0' : -1);
|
||
} /* end of function: get_int(ch) */
|
||
|
||
/**********************************************************************/
|
||
/* Verify page number, offset values */
|
||
/* */
|
||
/* Purpose: This routine checks the page number, displacement, and */
|
||
/* length parameters keyed in by the interactive debug user */
|
||
/* to make sure they are within acceptable bounds. */
|
||
/**********************************************************************/
|
||
check_page(buffer, idx, page, disp)
|
||
char buffer[];
|
||
int *idx, *page, *disp;
|
||
{
|
||
/*%% int len;*/
|
||
int ret_val = -1;
|
||
unsigned hex_val();
|
||
ENTER(check_page);
|
||
|
||
*page = hex_val(buffer, &(*idx));
|
||
*disp = hex_val(buffer, &(*idx));
|
||
|
||
/* Verify that page number is valid */
|
||
if (*page < 0 || *page >= NUMPAGES)
|
||
{
|
||
printf("***page numbers must be in the range 00 to %x (hex)***\n",
|
||
NUMPAGES-1);
|
||
}
|
||
else
|
||
{
|
||
if (attrib[*page].nomemory)
|
||
{
|
||
printf("***page %x (hex) has not been allocated***\n", *page);
|
||
}
|
||
else
|
||
{
|
||
if (*disp < 0 || *disp >= psize[*page])
|
||
printf("***displacements must be in the range 0000 to %04x (hex)***\n",
|
||
psize[*page]-1);
|
||
else ret_val = 0; /* valid page, displacement, length */
|
||
}
|
||
}
|
||
return(ret_val);
|
||
}
|
||
|
||
|
||
/**********************************************************************/
|
||
/* Check with the user before doing something */
|
||
/* */
|
||
/* Purpose: This routine is called before performing a potentially */
|
||
/* dangerous operation to make sure the interactive debug */
|
||
/* user has not entered the command in error. */
|
||
/* */
|
||
/* Calling Sequence: answer = ask(question); */
|
||
/* where: int answer - FALSE = question was answered "no" */
|
||
/* TRUE = question was answered "yes" */
|
||
/* char *question - a character string representing the */
|
||
/* question to be asked. A '?' will be */
|
||
/* appended to this string when it is */
|
||
/* displayed to the user. */
|
||
/**********************************************************************/
|
||
ask(str)
|
||
char *str;
|
||
{
|
||
int ch;
|
||
printf("%s?\nType Y to proceed, any other character to abort\n",str);
|
||
ch = getch();
|
||
if (ch == 'y' || ch == 'Y') return(TRUE);
|
||
printf("***command aborted***\n");
|
||
return(FALSE);
|
||
} /* end of function: ask(str) */
|
||
|
||
/* Print s-expressive line of register contents to standard output*/
|
||
static char digit[10] = {'0','1','2','3','4','5','6','7','8','9'};
|
||
sprint_reg(name,pg,ds)
|
||
int name,pg,ds;
|
||
{
|
||
extern int display;
|
||
extern int show;
|
||
|
||
ssetadr(ADJPAGE(OUT_PAGE),OUT_DISP);
|
||
outchar('R');
|
||
if (name >= 10) outchar(digit[name/10]);
|
||
outchar(digit[name%10]);
|
||
outchar(':');
|
||
outchar(' ');
|
||
|
||
display = show = 1;
|
||
ds = sprint(CORRPAGE(pg),ds,ADJPAGE(OUT_PAGE),OUT_DISP);
|
||
/***********
|
||
ds = sprint(CORRPAGE(pg),ds,OUT_PAGE,OUT_DISP,TRUE,TRUE,FALSE);
|
||
**********/
|
||
outchar('\n');
|
||
}
|
||
|