common-lisp/roswell.roswell
1
0
Fork 0
mirror of https://github.com/roswell/roswell.git synced 2026-09-10 07:16:17 -04:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

changed parameter and add sample 'hello.ros'

Browse source
This commit is contained in:
SANO Masatoshi 2014-10-18 22:20:18 +09:00
parent 218068c77d
commit 181235bb3e
6 changed files with 114 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
samples/hello.ros Executable file
View file

@ -0,0 +1,5 @@
#!/usr/bin/env ros
(defun main (&rest argv)
(format t "Hello World!~%")
(format t "argv=~S~%" argv))

77
src/cmds/run/cmd.c
View file

@ -6,6 +6,9 @@
#include "util.h"
#include "opt.h"
#define ROS_RUN_REPL "run"
#define ROS_RUN_COMPILE "output"
#ifdef _WIN32
BOOL WINAPI ConsoleCtrlHandler(DWORD ctrlChar){
CHAR szPrintBuffer[512];
@ -20,40 +23,73 @@ BOOL WINAPI ConsoleCtrlHandler(DWORD ctrlChar){
LVal run_commands=NULL;
LVal run_options =NULL;
extern char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv);
extern char** cmd_run_sbcl(int argc,char** argv,struct sub_command* cmd);
int cmd_run(int argc,char **argv,struct sub_command* cmd)
{
char* current=get_opt("program");
if(verbose>0)
fprintf(stderr,"cmd_%s:argc=%d argv[0]=%s\n",cmd->name,argc,argv[0]);
if(argc==1 && !current) {
char* tmp[]={"help",(char*)cmd->name};
return proccmd(2,tmp,top_options,top_commands);
}else {
int i;
if(verbose>0)
fprintf(stderr,"cmd_run:argc=%d,cmd->name:%s argv[0]=%s\n",argc,cmd->name,argv[0]);
for(i=1;i<argc;i+=proccmd(argc-i,&argv[i],run_options,run_commands));
current=get_opt("program");
if(current&& strcmp((char*)cmd->name,"run")!=0) {
if(current&& strcmp((char*)cmd->name,ROS_RUN_REPL)!=0) {
char* tmp[]={"--"};
proccmd(1,tmp,run_options,run_commands);
}else {
char* tmp[]={"help","run"};
char* tmp[]={"help",ROS_RUN_REPL};
return proccmd(2,tmp,top_options,top_commands);
}
if(verbose>0) {
fprintf(stderr,"cmd_run ends here %d\n",i);
fprintf(stderr,"cmd_%s ends here %d\n",cmd->name,i);
}
return i;
}
}
int cmd_script(int argc,char **argv,struct sub_command* cmd)
{
char* current=get_opt("program");
if(verbose>0)
fprintf(stderr,"script_%s:argc=%d argv[0]=%s\n",cmd->name,argc,argv[0]);
if(argc==1 && !current &&
strcmp(argv[0],"--")==0) {
char* tmp[]={"help","--"};
if(verbose>0)
fprintf(stderr,"current=%s\n",current);
return proccmd(2,tmp,top_options,top_commands);
}else {
int i;
char* result=q("");
char* tmp[]={"script"};
if(strcmp(argv[0],"--")==0)
i=1;
else
i=0;
for (;i<argc;++i) {
char* val=escape_string(argv[i]);
result=cat(result,"\"",val,"\"",NULL);
s(val);
}
set_opt(&local_opt,"script",result,0);
s(result);
cmd_run_star(1,tmp,cmd);
}
}
int cmd_run_star(int argc,char **argv,struct sub_command* cmd)
{
int ret=1;
char* impl;
char* version;
int pos;
if(verbose>0) {
fprintf(stderr,"cmd_run_star:%s argc=%d argv[0]=%s \n",cmd->name,argc,argv[0]);
}
impl=get_opt("lisp");
if(impl && (pos=position_char("/",impl))!=-1) {
version=subseq(impl,pos+1,0);
@ -74,11 +110,13 @@ int cmd_run_star(int argc,char **argv,struct sub_command* cmd)
if(impl) {
char** arg=NULL;
int i;
if(strcmp(impl,"sbcl")==0 ||
strcmp(impl,"sbcl-bin")==0) {
arg=cmd_run_sbcl(impl,version,argc,argv);
struct sub_command cmd;
cmd.name=impl;
cmd.short_name=version;
arg=cmd_run_sbcl(argc,argv,&cmd);
}
if(file_exist_p(arg[0])) {
char* cmd;
@ -107,15 +145,22 @@ void register_cmd_run(void)
{
char* _help;
/*options*/
run_options=add_command(top_options,"",NULL,cmd_run_star,0,1,NULL,NULL);
run_options=register_runtime_options(run_options);
run_options=add_command(run_options,"",NULL,cmd_run_star,OPT_SHOW_NONE,1,NULL,NULL);
run_options=nreverse(run_options);
//run_commands=add_command(run_commands,"*",NULL,cmd_run_star,OPT_SHOW_NONE,1,NULL,NULL);
/*commands*/
top_commands=add_command(top_commands,"script" ,NULL,cmd_run,1,1,"Run lisp environment then quit (default)",NULL);
top_commands=add_command(top_commands,"run" ,NULL,cmd_run,1,1,"Run lisp environment",NULL);
top_commands=add_command(top_commands,"output" ,NULL,cmd_run,1,1,"Generate an executable script or binary from the software specification",NULL);
_help=cat("Usage: ",argv_orig[0]," [OPTIONS] run [OPTIONS] -- [implementation-native-options...]\n\n",NULL);
top_helps=add_help(top_helps,"run",_help,run_commands,run_options,NULL,NULL);
top_options=add_command(top_options,"" ,NULL,cmd_script,OPT_SHOW_NONE,1,"Run lisp environment then quit (default)",NULL);
// top_commands=add_command(top_commands,"output" ,NULL,cmd_run,1,1,"Generate an executable script or binary from the software specification",NULL);
top_commands=add_command(top_commands,ROS_RUN_REPL ,NULL,cmd_run,OPT_SHOW_NONE,1,"Run lisp environment",NULL);
top_commands=add_command(top_commands,"*" ,NULL,cmd_script,OPT_SHOW_NONE,1,"Run lisp environment then quit (default)",NULL);
_help=cat("Usage: ",argv_orig[0]," [OPTIONS] "ROS_RUN_REPL" [OPTIONS] -- [implementation-native-options...]\n\n",NULL);
top_helps=add_help(top_helps,ROS_RUN_REPL,_help,run_commands,run_options,NULL,NULL);
s(_help);
_help=cat("Usage: ",argv_orig[0]," OPTIONS [script] [OPTIONS] [-- implementation-native-options...]\n\n",NULL);
top_helps=add_help(top_helps,"script",_help,run_commands,run_options,NULL,NULL);
_help=cat("Usage: ",argv_orig[0]," [OPTIONS] [--] script-file arguments...\n\n",
NULL);
top_helps=add_help(top_helps,"--",_help,run_commands,run_options,NULL,NULL);
s(_help);
}

21
src/cmds/run/sbcl.c
View file

@ -2,24 +2,26 @@
#include "util.h"
#include "opt.h"
char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv)
char** cmd_run_sbcl(int argc,char** argv,struct sub_command* cmd)
{
char** arg=NULL;
char* home=homedir();
char* arch=uname_m();
char* os=uname();
char* impl=(char*)cmd->name;
char* version=(char*)cmd->short_name;
int offset=7; /*[binpath for sbcl] --noinform --core param
--no-sysinit --no-userinit [terminating NULL] that total 7 are default. */
int i;
char* impl_path= cat(home,"impls",SLASH,arch,SLASH,os,SLASH,impl,SLASH,version,NULL);
char* help=get_opt("help");
char* script=get_opt("script");
char* image=get_opt("image");
char* program=get_opt("program");
char* dynamic_space_size=get_opt("dynamic-space-size");
char* dynamic_stack_size=get_opt("dynamic-stack-size");
char* sbcl_version=get_opt("version");
int paramc=0;
int script=0;
char *bin= cat(impl_path,SLASH,"bin",SLASH,"sbcl",
#ifdef _WIN32
".exe",
@ -29,15 +31,15 @@ char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv)
if(help) {
offset++;
}
if(strcmp(firsts(subcommand_name),"script")==0)
offset+=1,script=1;
if(dynamic_space_size)
offset+=2;
if(dynamic_stack_size)
offset+=2;
if(sbcl_version)
offset+=1;
if(program)
if(script)
offset+=1;
if(program||script)
offset+=4;
arg=alloc(sizeof(char*)*(offset+argc));
@ -82,7 +84,7 @@ char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv)
if(script)
arg[paramc++]=q("--disable-debugger");
if(program) {
if(program || script) {
char *ros_bin=pathname_directory(truename(which(argv_orig[0])));
char* ros_bin_lisp=cat(ros_bin,"lisp",SLASH,NULL);
char* lisp_path;
@ -96,7 +98,7 @@ char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv)
arg[paramc++]=q("--load");
arg[paramc++]=s_cat2(lisp_path,q("init.lisp"));
arg[paramc++]=q("--eval");
arg[paramc++]=cat("(ros:run '(",program,script?"(:quit ())":"","))",NULL);
arg[paramc++]=cat("(ros:run '(",program?program:"",script?"(:script ":"",script?script:"",script?")":"",script?"(:quit ())":"","))",NULL);
}
s(impl_path);
@ -106,8 +108,9 @@ char** cmd_run_sbcl(char* impl,char* version,int argc,char** argv)
fprintf(stderr,"args=");
for(i=0;arg[i]!=NULL;++i)
fprintf(stderr,"%s ",arg[i]);
fprintf(stderr,"\n");
fprintf(stderr,"\nhelp=%s ",help?"t":"nil");
fprintf(stderr,"script=%s\n",script?script:"nil");
}
s(image),s(help),s(dynamic_space_size),s(dynamic_stack_size);
s(image),s(help),s(script),s(dynamic_space_size),s(dynamic_stack_size);
return arg;
}

19
src/lisp/init.lisp
View file

@ -9,6 +9,7 @@
(in-package :ros)
(push :ros-launched *features*)
(defvar *verbose* nil)
(export (defvar *argv* nil))
(defun load (cmd arg &rest rest)
(declare (ignorable cmd rest))
@ -40,11 +41,25 @@
(declare (ignorable cmd rest))
(cl:eval (read-from-string arg)))
(defun quit (cmd arg &rest rest)
(declare (ignorable cmd arg rest))
(defun quit (cmd &rest rest)
(declare (ignorable cmd rest))
#+sbcl
(sb-ext:exit))
(export
(defun script (cmd arg &rest rest)
(declare (ignorable cmd arg))
(setf *argv* rest)
(with-open-file (in arg)
(let ((line(read-line in)))
(cl:load (make-concatenated-stream
(make-string-input-stream
(if (equal (subseq line 0 (min (length line) 2)) "#!")
"" line))
in
(make-string-input-stream
"(cl:apply 'main ros:*argv*)")))))))
(export
(defun run (list)
(loop :for elt :in list

23
src/lsp.c
View file

@ -122,6 +122,15 @@ int opt_top_verbose(int argc,char** argv,struct sub_command* cmd) {
return 1;
}
int opt_top_build0(int argc,char** argv,struct sub_command* cmd) {
if(cmd->name) {
char* current=get_opt("program");
current=cat(current?current:"","(:",cmd->name,")",NULL);
set_opt(&local_opt,"program",current,0);
}
return 1;
}
int opt_top_build(int argc,char** argv,struct sub_command* cmd) {
if(cmd->name && argc>1) {
char* current=get_opt("program");
@ -144,6 +153,7 @@ LVal register_runtime_options(LVal opt) {
opt=add_command(opt,"system-package","-sp",opt_top_build,1,0,"combination of -s SP and -p SP","SP");
opt=add_command(opt,"eval","-e",opt_top_build,1,0,"evaluate FORM while building","FORM");
opt=add_command(opt,"require",NULL,opt_top_build,1,0,"require MODULE while building","MODULE");
opt=add_command(opt,"quit","-q",opt_top_build0,1,0,"quit lisp here",NULL);
opt=add_command(opt,"restart","-r",cmd_notyet,1,0,"restart from build by calling (FUNC)","FUNC");
opt=add_command(opt,"entry","-E",cmd_notyet,1,0,"restart from build by calling (FUNC argv)","FUNC");
@ -160,7 +170,7 @@ LVal register_runtime_options(LVal opt) {
opt=add_command(opt,"quicklisp","-Q",cmd_notyet,1,0,"use quicklisp",NULL);
opt=add_command(opt,"no-quicklisp","+Q",cmd_notyet,1,0,"do not use quicklisp",NULL);
opt=add_command(opt,"verbose","-v",opt_top_verbose,1,0,"be quite noisy while building",NULL);
opt=add_command(opt,"quiet","-q",opt_top_verbose,1,0,"be quite quiet while building (default)",NULL);
opt=add_command(opt,"quiet",NULL,opt_top_verbose,1,0,"be quite quiet while building (default)",NULL);
return opt;
}
@ -183,7 +193,6 @@ int main (int argc,char **argv) {
top_options=nreverse(top_options);
/*commands*/
register_cmd_run();
register_cmd_pull();
top_commands=add_command(top_commands,"config" ,NULL,cmd_config,1,1,"Get and set options",NULL);
@ -193,10 +202,10 @@ int main (int argc,char **argv) {
top_commands=add_command(top_commands,"tar" ,NULL,cmd_tar,0,1,NULL,NULL);
top_commands=add_command(top_commands,"download",NULL,cmd_download,0,1,NULL,NULL);
top_commands=add_command(top_commands,"help",NULL,cmd_help,0,1,NULL,NULL);
register_cmd_run();
top_commands=nreverse(top_commands);
_help=cat("Usage: ",argv_orig[0]," [OPTIONS] [Command] arguments... \n",
"Usage: ",argv_orig[0]," [OPTIONS] [--] programfile arguments... \n\n",NULL);
_help=cat("Usage: ",argv_orig[0]," [OPTIONS] [Command arguments...] \n",
"Usage: ",argv_orig[0]," [OPTIONS] [[--] script-path arguments...] \n\n",NULL);
top_helps=add_help(top_helps,NULL,_help,top_commands,top_options,NULL,NULL);
s(_help);
@ -211,8 +220,8 @@ int main (int argc,char **argv) {
}else
for(i=1;i<argc;i+=proccmd(argc-i,&argv[i],top_options,top_commands));
if(get_opt("program")) {
char* tmp[]={"script"};
proccmd(1,tmp,top_options,top_commands);
char* tmp[]={"run","--"};
proccmd(2,tmp,top_options,top_commands);
}
free_opts(global_opt);
}

4
src/opt.h
View file

@ -29,7 +29,9 @@ struct sub_command
char* description;
char* arg_example;
};
#define OPT_SHOW_NONE (0)
#define OPT_SHOW_HELP (1)
//#define OPT_SHOW_
struct command_help
{
const char* name;