static int run_argv(int *argcp, const char ***argv)
{
int done_alias = 0;
while (1) {
/* See if it's a builtin */
handle_builtin(*argcp, *argv);
/* .. then try the external ones */
execv_dashed_external(*argv);
/* It could be an alias -- this works around the insanity
* of overriding "git log" with "git show" by having
* alias.log = show
*/
if (done_alias)
break;
save_env();
if (!handle_alias(argcp, argv))
break;
done_alias = 1;
}
return done_alias;
}
obj fn_eval (obj args)
{
obj *argv = get_header (args) -> u.array_val;
switch (*argv)
{
case 1:
return (eval_internal (argv [1]));
case 2:
{
bool unprotect = save_env ();
obj keep_env = current_environment;
current_environment = argv [2];
obj res = eval_internal (argv [1]);
current_environment = keep_env;
if (unprotect)
get_header (current_environment) -> flags &= ~gc_fixed;
return (res);
}
default:
throw_error (bad_argc);
return (obj_NIL);
}
}
/* When save = 0, just parse. The input is unchanged
When save = 1, parse and do the save. The input is changed */
static int parse_env(void *ptn, char *err_string, int save, int debug)
{
int ret = 1;
unsigned int sets = 0;
unsigned int comment_start = 0;
char *var = NULL;
char *var_end = NULL;
char *val = NULL;
char *val_end = NULL;
unsigned int i;
char *buff = (char *)interface.transfer_buffer;
//unsigned int size = download_bytes_unpadded;
unsigned int size = download_bytes;
/* The input does not have to be null terminated.
This will cause a problem in the corner case
where the last line does not have a new line.
Put a null after the end of the input.
WARNING : Input buffer is assumed to be bigger
than the size of the input */
if (save)
buff[size] = 0;
for (i = 0; i < size; i++) {
if (NULL == var) {
/*
* Check for comments, comment ok only on
* mostly empty lines
*/
if (buff[i] == '#')
comment_start = 1;
if (comment_start) {
if ((buff[i] == '\r') ||
(buff[i] == '\n')) {
comment_start = 0;
}
} else {
if (!((buff[i] == ' ') ||
(buff[i] == '\t') ||
(buff[i] == '\r') ||
(buff[i] == '\n'))) {
/*
* Normal whitespace before the
* variable
*/
var = &buff[i];
}
}
} else if (((NULL == var_end) || (NULL == val)) &&
((buff[i] == '\r') || (buff[i] == '\n'))) {
/* This is the case when a variable
is unset. */
if (save) {
/* Set the var end to null so the
normal string routines will work
WARNING : This changes the input */
buff[i] = '\0';
save_env(ptn, var, val);
if (debug)
printf("Unsetting %s\n", var);
}
/* Clear the variable so state is parse is back
to initial. */
var = NULL;
var_end = NULL;
sets++;
} else if (NULL == var_end) {
if ((buff[i] == ' ') ||
(buff[i] == '\t'))
var_end = &buff[i];
} else if (NULL == val) {
if (!((buff[i] == ' ') ||
(buff[i] == '\t')))
val = &buff[i];
} else if (NULL == val_end) {
if ((buff[i] == '\r') ||
(buff[i] == '\n')) {
/* look for escaped cr or ln */
if ('\\' == buff[i - 1]) {
/* check for dos */
if ((buff[i] == '\r') &&
(buff[i+1] == '\n'))
buff[i + 1] = ' ';
buff[i - 1] = buff[i] = ' ';
} else {
val_end = &buff[i];
}
}
} else {
sprintf(err_string, "Internal Error");
if (debug)
printf("Internal error at %s %d\n",
__FILE__, __LINE__);
return 1;
}
/* Check if a var / val pair is ready */
if (NULL != val_end) {
if (save) {
/* Set the end's with nulls so
normal string routines will
work.
WARNING : This changes the input */
*var_end = '\0';
*val_end = '\0';
save_env(ptn, var, val);
if (debug)
printf("Setting %s %s\n", var, val);
}
/* Clear the variable so state is parse is back
to initial. */
var = NULL;
var_end = NULL;
val = NULL;
val_end = NULL;
sets++;
}
}
/* Corner case
Check for the case that no newline at end of the input */
if ((NULL != var) &&
(NULL == val_end)) {
if (save) {
/* case of val / val pair */
if (var_end)
*var_end = '\0';
/* else case handled by setting 0 past
the end of buffer.
Similar for val_end being null */
save_env(ptn, var, val);
if (debug) {
if (var_end)
printf("Trailing Setting %s %s\n", var, val);
else
printf("Trailing Unsetting %s\n", var);
}
}
sets++;
}
/* Did we set anything ? */
if (0 == sets)
sprintf(err_string, "No variables set");
else
ret = 0;
return ret;
}
int
main(int argc, char **argv)
#endif /* WIN32 */
{
#ifdef WIN32
struct arg_param *p = (struct arg_param *)pv;
int argc;
char **argv;
SERVICE_STATUS ss;
#endif /* WIN32 */
char *name = NULL;
struct tpp_config conf;
int rpp_fd;
char *pc;
int numthreads;
char lockfile[MAXPATHLEN + 1];
char path_log[MAXPATHLEN + 1];
char svr_home[MAXPATHLEN + 1];
char *log_file = 0;
char *host;
int port;
char *routers = NULL;
int c, i, rc;
extern char *optarg;
int are_primary;
int num_var_env;
#ifndef WIN32
struct sigaction act;
struct sigaction oact;
#endif
#ifndef WIN32
/*the real deal or just pbs_version and exit*/
execution_mode(argc, argv);
#endif
/* As a security measure and to make sure all file descriptors */
/* are available to us, close all above stderr */
#ifdef WIN32
_fcloseall();
#else
i = sysconf(_SC_OPEN_MAX);
while (--i > 2)
(void)close(i); /* close any file desc left open by parent */
#endif
/* If we are not run with real and effective uid of 0, forget it */
#ifdef WIN32
argc = p->argc;
argv = p->argv;
ZeroMemory(&ss, sizeof(ss));
ss.dwCheckPoint = 0;
ss.dwServiceType = SERVICE_WIN32_OWN_PROCESS;
ss.dwCurrentState = g_dwCurrentState;
ss.dwControlsAccepted = SERVICE_ACCEPT_STOP | SERVICE_ACCEPT_SHUTDOWN;
ss.dwWaitHint = 6000;
if (g_ssHandle != 0)
SetServiceStatus(g_ssHandle, &ss);
if (!isAdminPrivilege(getlogin())) {
fprintf(stderr, "%s: Must be run by root\n", argv[0]);
return (2);
}
#else
if ((getuid() != 0) || (geteuid() != 0)) {
fprintf(stderr, "%s: Must be run by root\n", argv[0]);
return (2);
}
#endif /* WIN32 */
/* set standard umask */
#ifndef WIN32
umask(022);
#endif
/* load the pbs conf file */
if (pbs_loadconf(0) == 0) {
fprintf(stderr, "%s: Configuration error\n", argv[0]);
return (1);
}
umask(022);
#ifdef WIN32
save_env();
#endif
/* The following is code to reduce security risks */
/* start out with standard umask, system resource limit infinite */
if ((num_var_env = setup_env(pbs_conf.pbs_environment)) == -1) {
#ifdef WIN32
g_dwCurrentState = SERVICE_STOPPED;
ss.dwCurrentState = g_dwCurrentState;
ss.dwWin32ExitCode = ERROR_INVALID_ENVIRONMENT;
if (g_ssHandle != 0) SetServiceStatus(g_ssHandle, &ss);
return (1);
#else
exit(1);
#endif /* WIN32 */
}
#ifndef WIN32
i = getgid();
(void)setgroups(1, (gid_t *)&i); /* secure suppl. groups */
#endif
log_event_mask = &pbs_conf.pbs_comm_log_events;
tpp_set_logmask(*log_event_mask);
#ifdef WIN32
winsock_init();
#endif
routers = pbs_conf.pbs_comm_routers;
numthreads = pbs_conf.pbs_comm_threads;
server_host[0] = '\0';
if (pbs_conf.pbs_comm_name) {
name = pbs_conf.pbs_comm_name;
host = tpp_parse_hostname(name, &port);
if (host)
snprintf(server_host, sizeof(server_host), "%s", host);
free(host);
host = NULL;
} else if (pbs_conf.pbs_leaf_name) {
char *endp;
snprintf(server_host, sizeof(server_host), "%s", pbs_conf.pbs_leaf_name);
endp = strchr(server_host, ','); /* find the first name */
if (endp)
*endp = '\0';
endp = strchr(server_host, ':'); /* cut out the port */
if (endp)
*endp = '\0';
name = server_host;
} else {
if (gethostname(server_host, (sizeof(server_host) - 1)) == -1) {
#ifndef WIN32
sprintf(log_buffer, "Could not determine my hostname, errno=%d", errno);
#else
sprintf(log_buffer, "Could not determine my hostname, errno=%d", WSAGetLastError());
#endif
fprintf(stderr, "%s\n", log_buffer);
return (1);
}
if ((get_fullhostname(server_host, server_host, (sizeof(server_host) - 1)) == -1)) {
sprintf(log_buffer, "Could not determine my hostname");
fprintf(stderr, "%s\n", log_buffer);
return (1);
}
name = server_host;
}
if (server_host[0] == '\0') {
sprintf(log_buffer, "Could not determine server host");
fprintf(stderr, "%s\n", log_buffer);
return (1);
}
while ((c = getopt(argc, argv, "r:t:e:N")) != -1) {
switch (c) {
case 'e': *log_event_mask = strtol(optarg, NULL, 0);
break;
case 'r':
routers = optarg;
break;
case 't':
numthreads = atol(optarg);
if (numthreads == -1) {
usage(argv[0]);
return (1);
}
break;
case 'N':
stalone = 1;
break;
default:
usage(argv[0]);
return (1);
}
}
(void)strcpy(daemonname, "Comm@");
(void)strcat(daemonname, name);
if ((pc = strchr(daemonname, (int)'.')) != NULL)
*pc = '\0';
if(set_msgdaemonname(daemonname)) {
fprintf(stderr, "Out of memory\n");
return 1;
}
(void) snprintf(path_log, sizeof(path_log), "%s/%s", pbs_conf.pbs_home_path, PBS_COMM_LOGDIR);
#ifdef WIN32
/*
* let SCM wait 10 seconds for log_open() to complete
* as it does network interface query which can take time
*/
ss.dwCheckPoint++;
ss.dwWaitHint = 60000;
if (g_ssHandle != 0) SetServiceStatus(g_ssHandle, &ss);
#endif
(void) log_open(log_file, path_log);
/* set pbs_comm's process limits */
set_limits(); /* set_limits can call log_record, so call only after opening log file */
/* set tcp function pointers */
set_tpp_funcs(log_tppmsg);
(void) snprintf(svr_home, sizeof(svr_home), "%s/%s", pbs_conf.pbs_home_path, PBS_SVR_PRIVATE);
if (chdir(svr_home) != 0) {
(void) sprintf(log_buffer, msg_init_chdir, svr_home);
log_err(-1, __func__, log_buffer);
return (1);
}
(void) sprintf(lockfile, "%s/%s/comm.lock", pbs_conf.pbs_home_path, PBS_SVR_PRIVATE);
if ((are_primary = are_we_primary()) == FAILOVER_SECONDARY) {
strcat(lockfile, ".secondary");
} else if (are_primary == FAILOVER_CONFIG_ERROR) {
sprintf(log_buffer, "Failover configuration error");
log_err(-1, __func__, log_buffer);
#ifdef WIN32
g_dwCurrentState = SERVICE_STOPPED;
ss.dwCurrentState = g_dwCurrentState;
ss.dwWin32ExitCode = ERROR_SERVICE_NOT_ACTIVE;
if (g_ssHandle != 0) SetServiceStatus(g_ssHandle, &ss);
#endif
return (3);
}
if ((lockfds = open(lockfile, O_CREAT | O_WRONLY, 0600)) < 0) {
(void) sprintf(log_buffer, "pbs_comm: unable to open lock file");
log_err(errno, __func__, log_buffer);
return (1);
}
if ((host = tpp_parse_hostname(name, &port)) == NULL) {
sprintf(log_buffer, "Out of memory parsing leaf name");
log_err(errno, __func__, log_buffer);
return (1);
}
rc = 0;
if (pbs_conf.auth_method == AUTH_RESV_PORT) {
rc = set_tpp_config(&pbs_conf, &conf, host, port, routers, pbs_conf.pbs_use_compression,
TPP_AUTH_RESV_PORT, NULL, NULL);
} else {
/* for all non-resv-port based authentication use a callback from TPP */
rc = set_tpp_config(&pbs_conf, &conf, host, port, routers, pbs_conf.pbs_use_compression,
TPP_AUTH_EXTERNAL, get_ext_auth_data, validate_ext_auth_data);
}
if (rc == -1) {
(void) sprintf(log_buffer, "Error setting TPP config");
log_err(-1, __func__, log_buffer);
return (1);
}
free(host);
i = 0;
if (conf.routers) {
while (conf.routers[i]) {
sprintf(log_buffer, "Router[%d]:%s", i, conf.routers[i]);
fprintf(stdout, "%s\n", log_buffer);
log_event(PBSEVENT_SYSTEM | PBSEVENT_FORCE, PBS_EVENTCLASS_SERVER, LOG_INFO, msg_daemonname, log_buffer);
i++;
}
}
#ifndef DEBUG
#ifndef WIN32
if (stalone != 1)
go_to_background();
#endif
#endif
#ifdef WIN32
ss.dwCheckPoint = 0;
g_dwCurrentState = SERVICE_RUNNING;
ss.dwCurrentState = g_dwCurrentState;
if (g_ssHandle != 0) SetServiceStatus(g_ssHandle, &ss);
#endif
if (already_forked == 0)
lock_out(lockfds, F_WRLCK);
/* go_to_backgroud call creates a forked process,
* thus print/log pid only after go_to_background()
* has been called
*/
sprintf(log_buffer, "%s ready (pid=%d), Proxy Name:%s, Threads:%d", argv[0], getpid(), conf.node_name, numthreads);
fprintf(stdout, "%s\n", log_buffer);
log_event(PBSEVENT_SYSTEM | PBSEVENT_FORCE, PBS_EVENTCLASS_SERVER, LOG_INFO, msg_daemonname, log_buffer);
#ifndef DEBUG
pbs_close_stdfiles();
#endif
#ifdef WIN32
signal(SIGINT, stop_me);
signal(SIGTERM, stop_me);
#else
sigemptyset(&act.sa_mask);
act.sa_flags = 0;
act.sa_handler = hup_me;
if (sigaction(SIGHUP, &act, &oact) != 0) {
log_err(errno, __func__, "sigaction for HUP");
return (2);
}
act.sa_handler = stop_me;
if (sigaction(SIGINT, &act, &oact) != 0) {
log_err(errno, __func__, "sigaction for INT");
return (2);
}
if (sigaction(SIGTERM, &act, &oact) != 0) {
log_err(errno, __func__, "sigactin for TERM");
return (2);
}
if (sigaction(SIGQUIT, &act, &oact) != 0) {
log_err(errno, __func__, "sigactin for QUIT");
return (2);
}
#ifdef SIGSHUTDN
if (sigaction(SIGSHUTDN, &act, &oact) != 0) {
log_err(errno, __func__, "sigactin for SHUTDN");
return (2);
}
#endif /* SIGSHUTDN */
act.sa_handler = SIG_IGN;
if (sigaction(SIGPIPE, &act, &oact) != 0) {
log_err(errno, __func__, "sigaction for PIPE");
return (2);
}
if (sigaction(SIGUSR1, &act, &oact) != 0) {
log_err(errno, __func__, "sigaction for USR1");
return (2);
}
if (sigaction(SIGUSR2, &act, &oact) != 0) {
log_err(errno, __func__, "sigaction for USR2");
return (2);
}
#endif /* WIN32 */
conf.node_type = TPP_ROUTER_NODE;
conf.numthreads = numthreads;
if ((rpp_fd = tpp_init_router(&conf)) == -1) {
log_err(-1, __func__, "tpp init failed\n");
return 1;
}
/* Protect from being killed by kernel */
daemon_protect(0, PBS_DAEMON_PROTECT_ON);
/* go in a while loop */
while (get_out == 0) {
if (hupped == 1) {
struct pbs_config pbs_conf_bak;
int new_logevent;
hupped = 0; /* reset back */
memcpy(&pbs_conf_bak, &pbs_conf, sizeof(struct pbs_config));
if (pbs_loadconf(1) == 0) {
log_tppmsg(LOG_CRIT, NULL, "Configuration error, ignoring");
memcpy(&pbs_conf, &pbs_conf_bak, sizeof(struct pbs_config));
} else {
/* restore old pbs.conf */
new_logevent = pbs_conf.pbs_comm_log_events;
memcpy(&pbs_conf, &pbs_conf_bak, sizeof(struct pbs_config));
pbs_conf.pbs_comm_log_events = new_logevent;
log_tppmsg(LOG_INFO, NULL, "Processed SIGHUP");
log_event_mask = &pbs_conf.pbs_comm_log_events;
tpp_set_logmask(*log_event_mask);
}
}
sleep(3);
}
tpp_router_shutdown();
log_event(PBSEVENT_SYSTEM | PBSEVENT_FORCE, PBS_EVENTCLASS_SERVER, LOG_NOTICE, msg_daemonname, "Exiting");
log_close(1);
lock_out(lockfds, F_UNLCK); /* unlock */
(void)close(lockfds);
(void)unlink(lockfile);
return 0;
}
int do_stage_boot(cmd_tbl_t * cmdtb, int flag, int argc, char *argv[])
{
char *path_to_image, *path_to_scr, *path_to_initrd, *all_partions;
ulong addr;
int j,i=1,step=0,len,index,device,initrd=0;
char * kernel_addr, *bootargs;
char * args_to_func[5];
char device_prt[4];
if(argc < 2){
printf("No args, try help stage_boot\n");
return 0;
}
path_to_initrd = (char *)malloc((strlen(SCRIPT_PATH)+strlen(getenv("initrd_name")))*sizeof(char));
strcpy(path_to_initrd,SCRIPT_PATH);
strcat(path_to_initrd,getenv("initrd_name"));
path_to_image = (char *)malloc((strlen(SCRIPT_PATH)+strlen(getenv("image_name")))*sizeof(char));
strcpy(path_to_image,SCRIPT_PATH);
strcat(path_to_image,getenv("image_name"));
path_to_scr = (char *)malloc((strlen(SCRIPT_PATH)+strlen(getenv("script_name")))*sizeof(char));
strcpy(path_to_scr,SCRIPT_PATH);
strcat(path_to_scr,getenv("script_name"));
all_partions = (char *)malloc(strlen(getenv("device_partition"))*sizeof(char));
strcpy(all_partions,getenv("device_partition"));
kernel_addr = getenv("kernel_addr_r");
#if !defined(CONFIG_MACH_AVANTA_LP_FPGA)
ide_init();
#endif
for(device=1;device<argc;device++)
{
#if !defined(CONFIG_MACH_AVANTA_LP_FPGA)
/* step 1 load script from ide */
len=strlen(all_partions);
for(index=0;index<len && i==1 && strcmp(argv[device],"hd_scr")==0 ;index++)
{
step=1;
for(j=0;j<3;j++,index++)
device_prt[j]=all_partions[index];
device_prt[3]='\0';
printf("\ntry to load script from ide %s\n",device_prt);
args_to_func[0]="ext2load";
args_to_func[1]=INTERFACE_HD;
args_to_func[2]=device_prt;
args_to_func[3]=LOAD_ADDR;
args_to_func[4]=path_to_scr;
i = do_ext2load(cmdtb, 1, 5 , args_to_func);
addr = simple_strtoul(args_to_func[3], NULL, 16);
}
/* finish step 1 */
/* step 2 boot PXE */
if (i== 1 && strcmp(argv[device],"pxe") == 0)
{
step = 2;
save_env();
setenv("boot_from_pxe","1");
setenv("autoload","no");
setenv("pxefile_addr_r",LOAD_ADDR);
args_to_func[0]="dhcp";
args_to_func[1]=getenv("pxefile_addr_r");
i = do_dhcp(cmdtb, 1, 1, args_to_func);
if(i==0)
i = do_pxe_get(cmdtb, 1 , 1, args_to_func);
setenv("boot_from_pxe","0");
if(i==1)
restore_env();
}
/* finish step 2 */
/* step 3 load linux image from ide */
if( i == 1 && strcmp(argv[device],"hd_img")==0 )
{
step = 3;
len=strlen(all_partions);
for(index=0;index<len && i==1 ;index++)
{
for(j=0;j<3;j++,index++)
device_prt[j]=all_partions[index];
device_prt[3]='\0';
printf("\ntry to load image from ide %s\n", device_prt);
args_to_func[0]="ext2load";
args_to_func[1]=INTERFACE_HD;
args_to_func[2]=device_prt;
args_to_func[3]=getenv("kernel_addr_r");
args_to_func[4]=path_to_image;
i = do_ext2load(cmdtb, 1, 5 , args_to_func);
addr = simple_strtoul(args_to_func[3], NULL, 16);
if( i==0 ){
int temp;
args_to_func[3]=getenv("ramdisk_addr_r");
args_to_func[4]=path_to_initrd;
temp = do_ext2load(cmdtb, 1, 5 , args_to_func);
if(temp == 0)
{
initrd = 1;
args_to_func[1] = getenv("kernel_addr_r");
args_to_func[2] = getenv("ramdisk_addr_r");
}
}
}
}
/* finish step 3 */
/*step 4 load script from tftp */
if( i == 1 && strcmp(argv[device],"net_scr")==0 )
{
printf("\ntry to load script from tftp\n");
step = 4;
args_to_func[0]="tftp";
args_to_func[1]=LOAD_ADDR;
args_to_func[2]=getenv("script_name");
i = do_tftpb(cmdtb, 1, 3,args_to_func);
addr = simple_strtoul(args_to_func[1], NULL, 16);
}
#endif
/* finish step 4 */
/*step 5 load linux image from tftp */
if( i == 1 && strcmp(argv[device],"net_img")==0 )
{
printf("\ntry to load image from tftp\n");
step = 5;
args_to_func[0]="tftp";
args_to_func[1]=getenv("kernel_addr_r");
args_to_func[2]=getenv("image_name");
i = do_tftpb(cmdtb, 1, 3,args_to_func);
addr = simple_strtoul(args_to_func[1], NULL, 16);
}
/* finish step 5 */
}
free(path_to_image);
free(path_to_scr);
path_to_image = getenv("bootargs_dflt");
if(!path_to_image) {
printf("missing environment variable: bootargs_dflt\n");
return 0;
}
if (step == 3 && initrd ==1){
setenv("bootargs_dflt","console=ttyS0,115200 earlyprintk=ttyS0 root=/dev/sda2 ro pm_disable");
}
bootargs = (char *)malloc(sizeof(char)*(strlen(getenv("bootargs_dflt"))+17));
strcpy(bootargs,"setenv bootargs ");
#ifndef CONFIG_SYS_HUSH_PARSER
if (run_command(strcat(bootargs,getenv("bootargs_dflt")), flag) < 0) {
printf("missing environment variable: bootargs_dflt\n");
return 0;
}
#else
marvell_recursive_parse = 1;
if (parse_string_outer(strcat(bootargs,getenv("bootargs_dflt")),
FLAG_PARSE_SEMICOLON | FLAG_EXIT_FROM_LOOP) != 0){
printf("missing environment variable: bootargs_dflt\n");
marvell_recursive_parse = 0;
return 0;
}
marvell_recursive_parse = 0;
#endif
if(i==0)
{
if(step == 1 || step == 4)
source(addr,NULL);
else if ((step == 3 && initrd ==0 )|| step == 5)
do_bootm(cmdtb, 1,1,(char * const*)kernel_addr);
else if (step ==2)
do_pxe_boot(cmdtb, 2, 1,(char * const *)NULL);
else if (step == 3 && initrd ==1){
do_bootm(cmdtb, 1,2,args_to_func);
}
}
else {
printf("Unable to load image/script\n");
}
return 1;
}
obj apply_internal (obj fn, obj args)
{
switch (get_type (fn))
{
case rom_symbol_type:
{
const rom_object *p = get_rom_header (fn);
built_in_fn f = (built_in_fn) pgm_read_word_near (&p -> global_fn);
if (! f)
throw_error (no_fdefn);
obj argv = make_argv (args, pgm_read_byte_near (&p -> is_fexpr));
objhdr *argv_hdr = get_header (argv);
argv_hdr -> flags |= gc_fixed;
obj res = f (argv);
argv_hdr -> flags &= ~ gc_fixed;
return (res);
}
case symbol_type:
{
objhdr *fn_hdr = get_header (fn);
fn = fn_hdr -> u.symbol_val.global_fn;
if (! fn)
throw_error (no_fdefn);
// fall through to "apply closure"
}
case closure_type:
{
objhdr *fn_hdr = get_header (fn);
obj code = fn_hdr -> u.closure_val.code;
obj new_env;
{
obj type_sym, params;
decons (code, &type_sym, &code);
decons (code, ¶ms, &code);
if (type_sym == obj_LAMBDA)
new_env = make_lambda_binding (params, args);
else
new_env = make_fexpr_binding (params, args);
}
if (new_env)
{
objhdr *env_hdr = NULL;
env_hdr = get_header (new_env);
env_hdr -> u.array_val [1] = fn_hdr -> u.closure_val.environment;
}
else
new_env = fn_hdr -> u.closure_val.environment;
bool unprotect = save_env ();
obj keep_env = current_environment;
current_environment = new_env;
obj res = eval_progn (code, obj_NIL);
current_environment = keep_env;
if (unprotect)
get_header (current_environment) -> flags &= ~gc_fixed;
return (res);
}
default:
return (obj_NIL);
}
}
