/*
** parse_tag_var
*/
static BOOL parse_tag_var( HSCPRC *hp, HSCTAG *tag )
{
BOOL ok = FALSE;
HSCATTR *var = NULL;
/* define new attribute */
var = define_var( hp, tag->attr, VF_CONST | VF_GLOBAL );
/* set several values of tag structure, if attribute has
** some special flags set
*/
if ( var ) {
/* attribute is uri that tells the size */
if ( var->varflag & VF_GETSIZE )
tag->uri_size = var;
/* attribute is uri that tells if the tag should be stripped */
if ( var->varflag & VF_STRIPEXT )
tag->uri_stripext = var;
/* set macro attribute flag for macro tags */
if ( tag->option & HT_MACRO )
var->varflag |= VF_MACRO;
ok = TRUE;
}
return( ok );
}
/*
* define_attr_by_hp
*
* define a new attribute with obtaining data from hsc-process
*
* SEE ALSO:
* define_attr_by_text
*/
HSCATTR *define_attr_by_hp(HSCPRC * hp, STRPTR default_value, ULONG unmasked_flags)
{
HSCATTR *attr = define_var(hp, hp->defattr, 0);
if (attr)
{
/* set scope for local attribute */
attr->macro_id = ((attr->varflag & VF_GLOBAL) ?
MCI_GLOBAL : get_current_mci(hp));
/* see "attrib.h" why this */
attr->varflag |= VF_MACRO;
/* set new value (copy from default) if passed */
if (get_vardeftext(attr)) {
if (default_value)
panic("default value already set");
else
clr_vartext(attr);
}
/* set default value passed in function args */
if (default_value)
set_vartext(attr, default_value);
/* remove default value */
clr_attrdef(attr);
}
return (attr);
}
/*
**-------------------------------------
** <$LET> set a new global attribute
** or overwrite a defined one
**-------------------------------------
*/
BOOL handle_hsc_let( INFILE *inpf, HSCTAG *tag )
{
STRPTR varname = infgetw( inpf );
BOOL ok = FALSE;
/* create copy of varname */
if ( varname )
varname = strclone( varname );
else
err_eof( inpf, "missing attribute name" );
if ( varname ) {
ok = parse_wd( inpf, ":" );
if ( ok && define_var( varname, vars, inpf, 0 ) )
ok = TRUE;
if ( ok )
ok = parse_gt( inpf );
} else
err_mem( inpf );
/* release mem */
ufreestr( varname );
/* if error occured, skip rest of tag */
if ( !ok )
skip_until_eot( inpf );
return ( ok );
}
void local_array2(int start)//获取局部数组，并定义
{
char op[expr_size],fuc1[expr_size],fuc2[expr_size];
int i=0,size=0;
num_v=0;
for(i=start;i<num_inst;i++)
{
sscanf(inst[i],"%s",op);
if(strcmp(op,"ret")==0)
break;
if(strcmp(op,"array2")==0)//检测到辅助指令array
{
sscanf(inst[i],"%s %s %s %d",op,op,fuc1,&size);//array2 name type size
if(strcmp(fuc1,"FP")==0)
{
asize[num_v]=size;
strcpy(var_name[num_v++],op);
}
}
}
int list[expr_size],num=0;
define_var(var_name,num_v,list,num);
for(i=0;i<num;i++)
{
add_tab();
fprintf(fw,"long %s[%d][%d]; \n",var_name[list[i]],array_size,asize[list[i]]);
}
}
double declaration()
//
{
Token t = ts.get();
if (t.kind != name) error ("name expected in declaration");
string var_name = t.name;
Token t2 = ts.get();
if (t2.kind != '=') error("= missing in declaration of " ,var_name);
double d = expression();
define_var(var_name,d);
return d;
}
void global_def()//全局变量的定义，包括数组，结构体，变量
{
detect_two_array();
global_struct_array();
detect_array();//检测数组，并定义全局数组
global_struct();//检测结构体体，并定义
int list[1000],num=0;
define_var(var_name,num_v,list,num);//全局变量定义
for(int i=0;i<num;i++)
fprintf(fw,"long %s; \n",var_name[list[i]]);
}
int main()
try
{
define_var("k", 1000);
calculate();
return 0;
}
catch (exception& e) {
cerr << "exception: " << e.what() << endl;
char c;
while (cin >>c&& c!=';') ;
return 1;
}
catch (...) {
cerr << "exception\n";
char c;
while (cin>>c && c!=';');
return 2;
}
//one arg: exp
static cellpoint eval_definition(void)
{
//calls definition_variable
args_push(args_ref(1));
reg = definition_variable();
stack_push(&vars_stack, reg);
//compute definition value
args_push(args_ref(1));
reg = definition_value();
args_push(a_false);
args_push(reg);
reg = eval();
stack_push(&vars_stack, reg);
//calls define_var
args_push(current_env);
args_push(stack_pop(&vars_stack));
args_push(stack_pop(&vars_stack));
define_var();
args_pop(1);
return make_symbol("ok");
}
void detect_array()//检测数组，并定义
{
int i=0,j=0;
char op[expr_size],fuc1[expr_size],fuc2[expr_size],op1[expr_size],op2[expr_size];
num_v=0;
for(i=0;i<num_inst-2;i++)
{
sscanf(inst[i],"%s %s %s",op,fuc1,fuc2);//数组的格式mul，add，add
sscanf(inst[i+1],"%s %s %s",op1,fuc1,fuc2);
sscanf(inst[i+2],"%s %s %s",op2,fuc1,fuc2);
if(strcmp(op,"mul")==0&&strcmp(op1,"add")==0&&strcmp(op2,"add")==0)
{
transform_array(i);
i=i+2;
}
}
int list[expr_size],num=0;
define_var(var_name,num_v,list,num);
for(i=0;i<num;i++)
fprintf(fw,"long %s[%d]; \n",var_name[list[i]],array_size);
}
//TODO check number of arguments given to builtins
object_t *eval(object_t *exp, object_t *env) {
char comeback = 1;
while(comeback) {
comeback = 0;
if(is_self_evaluating(exp)) {
return exp;
}
if(list_begins_with(exp, quote_symbol)) {
return cadr(exp);
}
// (define... )
if(list_begins_with(exp, define_symbol)) {
object_t *var = cadr(exp);
// (define a b)
if(issymbol(var)) {
object_t *val = caddr(exp);
return define_var(env, var, val);
}
// (define (a ...) ...) TODO use scheme macro
if(ispair(var)) {
object_t *name = car(cadr(exp)),
*formals = cdr(cadr(exp)),
*body = cddr(exp),
*lambda = cons(lambda_symbol,
cons(formals, body));
exp = cons(define_symbol,
cons(name, cons(lambda, empty_list)));
comeback = 1;
continue;
}
fprintf(stderr, "Syntax error.\n");
exit(-1);
}
// (set! a b)
if(list_begins_with(exp, set_symbol)) {
object_t *var = cadr(exp);
object_t *val = caddr(exp);
return set_var(env, var, val);
}
// (if c a b)
if(list_begins_with(exp, if_symbol)) {
exp = eval_if(env, cadr(exp), caddr(exp), cadddr(exp));
comeback = 1;
continue;
}
// (cond ...)
if(list_begins_with(exp, cond_symbol)) {
object_t *tail = cons(void_symbol, empty_list);
object_t *ifs = tail; //empty_list;
object_t *rules = reverse_list(cdr(exp));
while(!isemptylist(rules)) {
object_t *rule = car(rules),
*condition = car(rule),
*consequence = cadr(rule);
if(isemptylist(consequence)) {
consequence = cons(void_obj, empty_list);
}
ifs = cons(if_symbol,
cons(condition,
cons(consequence,
cons(ifs, empty_list))));
rules = cdr(rules);
}
exp = ifs;
comeback = 1;
continue;
}
// (begin ...)
if(list_begins_with(exp, begin_symbol)) {
object_t *result = empty_list, *exps;
for(exps = cdr(exp); ! isemptylist(exps); exps = cdr(exps)) {
result = eval(car(exps), env);
}
return result;
}
if(list_begins_with(exp, lambda_symbol)) {
object_t *fn = cons(begin_symbol,
cdr(cdr(exp)));
return make_compound_proc(empty_list, cadr(exp),
fn,
env);
}
// (let ...)
if(list_begins_with(exp, let_symbol)) {
//if(! issymbol(cadr(exp)))
object_t *bindings = cadr(exp);
object_t *body = cddr(exp);
object_t *formals = empty_list;
object_t *values = empty_list;
while(!isemptylist(bindings)) {
formals = cons(caar(bindings), formals);
values = cons(cadr(car(bindings)), values);
bindings = cdr(bindings);
}
exp = cons(cons(lambda_symbol, cons(formals, body)),
values);
comeback = 1;
continue;
}
if(issymbol(exp)) {
return var_get_value(env, exp);
}
if(ispair(exp)) {
object_t *exp_car = car(exp);
object_t *fn = eval(exp_car, env); //var_get_value(env, car);
if(!iscallable(fn)) {
fprintf(stderr, "object_t is not callable\n");
exit(-1);
}
object_t *args = cdr(exp);
object_t *evaluated_args = evaluate_list(env, args, empty_list);
if(isprimitiveproc(fn)) {
return fn->value.prim_proc.fn(evaluated_args);
} else if(iscompoundproc(fn)) {
object_t *fn_formals = fn->value.compound_proc.formals;
object_t *fn_body = fn->value.compound_proc.body;
object_t *fn_env = fn->value.compound_proc.env;
ARGS_EQ(evaluated_args, list_size(fn_formals));
exp = fn_body;
env = extend_environment(fn_formals, evaluated_args, fn_env);
comeback = 1;
continue;
}
assert(0);
}
}
fprintf(stderr, "Unable to evaluate expression: \n");
write(exp);
exit(-1);
}
int
main(int argc, char *argv[], char *envp[])
{
#ifdef LISP_FEATURE_WIN32
/* Exception handling support structure. Evil Win32 hack. */
struct lisp_exception_frame exception_frame;
#endif
/* the name of the core file we're to execute. Note that this is
* a malloc'ed string which should be freed eventually. */
char *core = 0;
char **sbcl_argv = 0;
os_vm_offset_t embedded_core_offset = 0;
char *runtime_path = 0;
/* other command line options */
boolean noinform = 0;
boolean end_runtime_options = 0;
boolean disable_lossage_handler_p = 0;
lispobj initial_function;
const char *sbcl_home = getenv("SBCL_HOME");
interrupt_init();
block_blockable_signals(0, 0);
setlocale(LC_ALL, "");
runtime_options = NULL;
/* Check early to see if this executable has an embedded core,
* which also populates runtime_options if the core has runtime
* options */
runtime_path = os_get_runtime_executable_path();
if (runtime_path) {
os_vm_offset_t offset = search_for_embedded_core(runtime_path);
if (offset != -1) {
embedded_core_offset = offset;
core = runtime_path;
} else {
free(runtime_path);
}
}
/* Parse our part of the command line (aka "runtime options"),
* stripping out those options that we handle. */
if (runtime_options != NULL) {
dynamic_space_size = runtime_options->dynamic_space_size;
thread_control_stack_size = runtime_options->thread_control_stack_size;
sbcl_argv = argv;
} else {
int argi = 1;
runtime_options = successful_malloc(sizeof(struct runtime_options));
while (argi < argc) {
char *arg = argv[argi];
if (0 == strcmp(arg, "--script")) {
/* This is both a runtime and a toplevel option. As a
* runtime option, it is equivalent to --noinform.
* This exits, and does not increment argi, so that
* TOPLEVEL-INIT sees the option. */
noinform = 1;
end_runtime_options = 1;
disable_lossage_handler_p = 1;
lose_on_corruption_p = 1;
break;
} else if (0 == strcmp(arg, "--noinform")) {
noinform = 1;
++argi;
} else if (0 == strcmp(arg, "--core")) {
if (core) {
lose("more than one core file specified\n");
} else {
++argi;
if (argi >= argc) {
lose("missing filename for --core argument\n");
}
core = copied_string(argv[argi]);
++argi;
}
} else if (0 == strcmp(arg, "--help")) {
/* I think this is the (or a) usual convention: upon
* seeing "--help" we immediately print our help
* string and exit, ignoring everything else. */
print_help();
exit(0);
} else if (0 == strcmp(arg, "--version")) {
/* As in "--help" case, I think this is expected. */
print_version();
exit(0);
} else if (0 == strcmp(arg, "--dynamic-space-size")) {
++argi;
if (argi >= argc)
lose("missing argument for --dynamic-space-size");
errno = 0;
dynamic_space_size = strtol(argv[argi++], 0, 0) << 20;
if (errno)
lose("argument to --dynamic-space-size is not a number");
# ifdef MAX_DYNAMIC_SPACE_END
if (!((DYNAMIC_SPACE_START <
DYNAMIC_SPACE_START+dynamic_space_size) &&
(DYNAMIC_SPACE_START+dynamic_space_size <=
MAX_DYNAMIC_SPACE_END)))
lose("specified --dynamic-space-size too large");
# endif
} else if (0 == strcmp(arg, "--control-stack-size")) {
++argi;
if (argi >= argc)
lose("missing argument for --control-stack-size");
errno = 0;
thread_control_stack_size = strtol(argv[argi++], 0, 0) << 20;
if (errno)
lose("argument to --control-stack-size is not a number");
} else if (0 == strcmp(arg, "--debug-environment")) {
int n = 0;
printf("; Commandline arguments:\n");
while (n < argc) {
printf("; %2d: \"%s\"\n", n, argv[n]);
++n;
}
n = 0;
printf(";\n; Environment:\n");
while (ENVIRON[n]) {
printf("; %2d: \"%s\"\n", n, ENVIRON[n]);
++n;
}
++argi;
} else if (0 == strcmp(arg, "--disable-ldb")) {
disable_lossage_handler_p = 1;
++argi;
} else if (0 == strcmp(arg, "--lose-on-corruption")) {
lose_on_corruption_p = 1;
++argi;
} else if (0 == strcmp(arg, "--end-runtime-options")) {
end_runtime_options = 1;
++argi;
break;
} else {
/* This option was unrecognized as a runtime option,
* so it must be a toplevel option or a user option,
* so we must be past the end of the runtime option
* section. */
break;
}
}
/* This is where we strip out those options that we handle. We
* also take this opportunity to make sure that we don't find
* an out-of-place "--end-runtime-options" option. */
{
char *argi0 = argv[argi];
int argj = 1;
/* (argc - argi) for the arguments, one for the binary,
and one for the terminating NULL. */
sbcl_argv = successful_malloc((2 + argc - argi) * sizeof(char *));
sbcl_argv[0] = argv[0];
while (argi < argc) {
char *arg = argv[argi++];
/* If we encounter --end-runtime-options for the first
* time after the point where we had to give up on
* runtime options, then the point where we had to
* give up on runtime options must've been a user
* error. */
if (!end_runtime_options &&
0 == strcmp(arg, "--end-runtime-options")) {
lose("bad runtime option \"%s\"\n", argi0);
}
sbcl_argv[argj++] = arg;
}
sbcl_argv[argj] = 0;
}
}
/* Align down to multiple of page_table page size, and to the appropriate
* stack alignment. */
dynamic_space_size &= ~(PAGE_BYTES-1);
thread_control_stack_size &= ~(CONTROL_STACK_ALIGNMENT_BYTES-1);
/* Preserve the runtime options for possible future core saving */
runtime_options->dynamic_space_size = dynamic_space_size;
runtime_options->thread_control_stack_size = thread_control_stack_size;
/* KLUDGE: os_vm_page_size is set by os_init(), and on some
* systems (e.g. Alpha) arch_init() needs need os_vm_page_size, so
* it must follow os_init(). -- WHN 2000-01-26 */
os_init(argv, envp);
arch_init();
gc_init();
validate();
/* If no core file was specified, look for one. */
if (!core) {
core = search_for_core();
}
/* Make sure that SBCL_HOME is set and not the empty string,
unless loading an embedded core. */
if (!(sbcl_home && *sbcl_home) && embedded_core_offset == 0) {
char *envstring, *copied_core, *dir;
char *stem = "SBCL_HOME=";
copied_core = copied_string(core);
dir = dirname(copied_core);
envstring = (char *) calloc(strlen(stem) +
strlen(dir) +
1,
sizeof(char));
sprintf(envstring, "%s%s", stem, dir);
putenv(envstring);
free(copied_core);
}
if (!noinform && embedded_core_offset == 0) {
print_banner();
fflush(stdout);
}
#if defined(SVR4) || defined(__linux__)
tzset();
#endif
define_var("nil", NIL, 1);
define_var("t", T, 1);
if (!disable_lossage_handler_p)
enable_lossage_handler();
globals_init();
initial_function = load_core_file(core, embedded_core_offset);
if (initial_function == NIL) {
lose("couldn't find initial function\n");
}
#ifdef LISP_FEATURE_HPUX
/* -1 = CLOSURE_FUN_OFFSET, 23 = SIMPLE_FUN_CODE_OFFSET, we are
* not in LANGUAGE_ASSEMBLY so we cant reach them. */
return_from_lisp_stub = (void *) ((char *)*((unsigned long *)
((char *)initial_function + -1)) + 23);
#endif
gc_initialize_pointers();
arch_install_interrupt_handlers();
#ifndef LISP_FEATURE_WIN32
os_install_interrupt_handlers();
#else
/* wos_install_interrupt_handlers(handler); */
wos_install_interrupt_handlers(&exception_frame);
#endif
/* Pass core filename and the processed argv into Lisp. They'll
* need to be processed further there, to do locale conversion.
*/
core_string = core;
posix_argv = sbcl_argv;
FSHOW((stderr, "/funcalling initial_function=0x%lx\n",
(unsigned long)initial_function));
#ifdef LISP_FEATURE_WIN32
fprintf(stderr, "\n\
This is experimental prerelease support for the Windows platform: use\n\
at your own risk. \"Your Kitten of Death awaits!\"\n");
fflush(stdout);
fflush(stderr);
#endif
create_initial_thread(initial_function);
lose("CATS. CATS ARE NICE.\n");
return 0;
}
void global_struct_array()//结构体定义
{
int i=0;
char op[expr_size],fuc1[expr_size],type[expr_size],fuc2[expr_size],dst[expr_size];
for(i=2;i<num_inst-1;i++)//遍历所有指令，找到结构体的结构进行转换 结构体都变为单个变量
{
sscanf(inst[i-1],"%s %s %s",fuc2,op,op);
sscanf(inst[i+1],"%s %s %s",dst,op,op);
sscanf(inst[i],"%s %s %s",op,fuc1,type);
if(strcmp(fuc2,"mul")==0&&strcmp(dst,"add")==0&&strcmp(op,"add")==0&&find_base(fuc1,dst))//找到base，结构体的标志1
{
char temp[200];
strcpy(temp,dst);
int now=i;
for(i=i+2;i<num_inst;i++)//offset代表结构体的进一步访问
{
sscanf(inst[i],"%s %s %s",op,fuc1,fuc2);
int reg=0;
get_op(fuc2,dst,reg);
if(strcmp(op,"add")==0&&judge_offset(dst,fuc2))
{
strcat(temp,"_");
strcat(temp,fuc2);
}
else if(i>now+2)//如果有offset，则说明为结构体，使用辅助指令struct，指明是结构体
{
if(strcmp(type,"GP")==0)
strcpy(var_name[num_v++],temp);//将全局结构体保存下来
sscanf(inst[now-1],"%s %s %s",op,fuc1,fuc2);
int reg=0;
int t=get_op(fuc1,dst,reg);
if(t==1)
sprintf(inst[i-1]," array %s[%s] %s %s ",temp,dst,temp,type);
else if(t==3)
{
sprintf(inst[now-1]," var %s ",fuc1);
sprintf(inst[i-1]," array %s[%s] %s %s ",temp,dst,temp,type);
}
else if(t==2)
{
sprintf(inst[i-1]," array %s[(%s)] %s %s %s %d",temp,fuc1,temp,type,"reg",reg);
}
i--;
for(now;now<i;now++)
sprintf(inst[now],"nop ");
break;
}
else
break;
}
}
}
int list[1000],num=0;
define_var(var_name,num_v,list,num);//局部变量定义
for(i=0;i<num;i++)
{
add_tab();
fprintf(fw,"long %s[%d]; \n",var_name[list[i]],array_size);
}
}
void local_define(int start)//局部变量定义，变量，数组，结构体
{
char op[expr_size],fuc1[expr_size],fuc2[expr_size];
int i=0;
num_p=0;
num_v=0;
char v1[expr_size],v2[expr_size];
int t1,t2,reg1,reg2;
for(i=start;i<num_inst;i++)
{
sscanf(inst[i],"%s %s %s",op,fuc1,fuc2);
if(strcmp(op,"ret")==0)
break;
if(judge_two_op(op))//双操作数，其中也可能包含变量，需要检测是否有局部变量
{
t1=get_op(fuc1,v1,reg1);
t2=get_op(fuc2,v2,reg2);
if(t1==3)
{
if(reg1>0)
{
param_place[num_p]=reg1;
strcpy(param_name[num_p++],v1);
}
else
strcpy(var_name[num_v++],v1);
}
if(t2==3)
{
if(reg2>0)
{
param_place[num_p]=reg1;
strcpy(param_name[num_p++],v2);
}
else
strcpy(var_name[num_v++],v2);
}
}
else if(strcmp(op,"neg")==0||strcmp(op,"var")==0||strcmp(op,"param")==0||strcmp(op,"write")==0)//单操作数，其中可能包含变量，需要检测
{
t1=get_op(fuc1,v1,reg1);
if(t1==3)
{
if(reg1>0)
{
param_place[num_p]=reg1;
strcpy(param_name[num_p++],v1);
}
else
strcpy(var_name[num_v++],v1);
}
if(strcmp(op,"var")==0)
sprintf(inst[i]," nop ");
}
else if(strcmp(op,"struct")==0&&strcmp(fuc2,"FP")==0)//结构体定义
{
strcpy(var_name[num_v++],fuc1);
}
}
int list[1000],num=0;
define_var(param_name,num_p,list,num);//定义函数调用参数
sort_list(list,num);
for(i=0;i<num-1;i++)
fprintf(fw,"long %s,",param_name[list[i]]);
if(num-1>=0)
fprintf(fw,"long %s",param_name[list[num-1]]);
fprintf(fw,") \n{ \n");
num_big++;
num=0;
define_var(var_name,num_v,list,num);//局部变量定义
for(i=0;i<num;i++)
{
add_tab();
fprintf(fw,"long %s; \n",var_name[list[i]]);
}
local_array2(start);
local_array(start);//局部数组定义
}