move extraneous symbols from :lisp to :si - gcl.git - GNU Common Lisp

diff --git a/gcl/cmpnew/gcl_cmputil.lsp b/gcl/cmpnew/gcl_cmputil.lsp
index 1aa7c1878..dfb6658dc 100755
--- a/gcl/cmpnew/gcl_cmputil.lsp
+++ b/gcl/cmpnew/gcl_cmputil.lsp

@@ -214,7 +214,7 @@

(defun cmp-toplevel-eval (form)

(let* ((si::*ihs-base* si::*ihs-top*)

(si::*ihs-top* (1- (si::ihs-top)))

- (*break-enable* *compiler-break-enable*)

+ (si::*break-enable* *compiler-break-enable*)

(si::*break-hidden-packages*

(cons (find-package 'compiler)

si::*break-hidden-packages*)))

diff --git a/gcl/cmpnew/gcl_lfun_list.lsp b/gcl/cmpnew/gcl_lfun_list.lsp
index 79611f978..6b16b8550 100755
--- a/gcl/cmpnew/gcl_lfun_list.lsp
+++ b/gcl/cmpnew/gcl_lfun_list.lsp

@@ -365,7 +365,7 @@

(DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL)

(DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL)

(DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL)

-(DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL)

+(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL)

(DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL)

(DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL)

(DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL)

diff --git a/gcl/h/att_ext.h b/gcl/h/att_ext.h
index ab5982a8b..6f194eda7 100755
--- a/gcl/h/att_ext.h
+++ b/gcl/h/att_ext.h

@@ -145,8 +145,8 @@ object simple_lispcall();

object simple_lispcall_no_event();

object simple_symlispcall();

object simple_symlispcall_no_event();

-EXTER object Vevalhook;

-EXTER object Vapplyhook;

+EXTER object siVevalhook;

+EXTER object siVapplyhook;

object ieval();

object ifuncall(object,int,...);

object ifuncall1();

@@ -301,13 +301,13 @@ EXTER object sLquote;

EXTER object sLlambda;

-EXTER object sLlambda_block;

-EXTER object sLlambda_closure;

-EXTER object sLlambda_block_closure;

+EXTER object sSlambda_block;

+EXTER object sSlambda_closure;

+EXTER object sSlambda_block_closure;

EXTER object sLfunction;

-EXTER object sLmacro;

-EXTER object sLtag;

+EXTER object sSmacro;

+EXTER object sStag;

EXTER object sLblock;

@@ -595,10 +595,10 @@ EXTER object sLvalues;

EXTER object sLmod;

EXTER object sLsigned_byte;

EXTER object sLunsigned_byte;

-EXTER object sLsigned_char;

-EXTER object sLunsigned_char;

-EXTER object sLsigned_short;

-EXTER object sLunsigned_short;

+EXTER object sSsigned_char;

+EXTER object sSunsigned_char;

+EXTER object sSsigned_short;

+EXTER object sSunsigned_short;

EXTER object sLA;

EXTER object sLplusp;

EXTER object TSor_symbol_string;

diff --git a/gcl/h/protoize.h b/gcl/h/protoize.h
index 8d879a696..bbfe3c495 100644
--- a/gcl/h/protoize.h
+++ b/gcl/h/protoize.h

@@ -467,7 +467,7 @@ typedef void (*funcvoid)(void);

/* regexp.c:1588:OF */ extern void regerror (char *s); /* (s) char *s; */

/* regexpr.c:48:OF */ extern object fSmatch_beginning (fixnum i); /* (i) int i; */

/* regexpr.c:57:OF */ extern object fSmatch_end (fixnum i); /* (i) int i; */

-/* save.c:17:OF */ extern void Lsave (void); /* () */

+/* save.c:17:OF */ extern void siLsave (void); /* () */

#include <unistd.h>

/* sbrk.c:9:OF */ /* extern void * sbrk (int n); */ /* (n) int n; */

/* strcspn.c:3:OF */ /* extern size_t strcspn (const char *s1, const char *s2); */ /* (s1, s2) char *s1; char *s2; */

diff --git a/gcl/h/symbol.h b/gcl/h/symbol.h
index aeffcf3e5..8baf2ca5f 100755
--- a/gcl/h/symbol.h
+++ b/gcl/h/symbol.h

@@ -23,6 +23,6 @@ object sLquote;

object sLlambda;

-object sLlambda_block;

-object sLlambda_closure;

-object sLlambda_block_closure;

+object sSlambda_block;

+object sSlambda_closure;

+object sSlambda_block_closure;

diff --git a/gcl/lsp/gcl_autoload.lsp b/gcl/lsp/gcl_autoload.lsp
index 53b9d9abb..a56c16600 100755
--- a/gcl/lsp/gcl_autoload.lsp
+++ b/gcl/lsp/gcl_autoload.lsp

@@ -128,13 +128,13 @@

;;; Allocator.

-(import 'si::allocate)

-(export '(allocate

+;(import 'si::allocate)

+;(export '(allocate

;allocated-pages maximum-allocatable-pages

;allocate-contiguous-pages

;allocated-contiguous-pages maximum-contiguous-pages

;allocate-relocatable-pages allocated-relocatable-pages

- sfun gfun cfun cclosure spice structure))

+; sfun gfun cfun cclosure spice structure))

;(defvar type-character-alist

; '((cons . #\.)

@@ -415,4 +415,4 @@ Good luck! The GCL Development Team")

(defvar *lib-directory* (namestring (truename "../")))

-(import '(*lib-directory* *load-path* *system-directory*) 'si::user)

+(import '(*lib-directory* *load-path* *system-directory*) :user)

diff --git a/gcl/lsp/gcl_mislib.lsp b/gcl/lsp/gcl_mislib.lsp
index d5b18c2e8..08e2e05a9 100755
--- a/gcl/lsp/gcl_mislib.lsp
+++ b/gcl/lsp/gcl_mislib.lsp

@@ -29,13 +29,13 @@

(let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym))

(gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym))

(child-run-start (gensym)) (child-run-end (gensym)))

- `(let (,real-start ,real-end (,gbc-time-start (si::gbc-time)) ,gbc-time ,x)

+ `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x)

(setq ,real-start (get-internal-real-time))

(multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time)

- (si::gbc-time 0)

+ (gbc-time 0)

(setq ,x (multiple-value-list ,form))

- (setq ,gbc-time (si::gbc-time))

- (si::gbc-time (+ ,gbc-time-start ,gbc-time))

+ (setq ,gbc-time (gbc-time))

+ (gbc-time (+ ,gbc-time-start ,gbc-time))

(multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time)

(setq ,real-end (get-internal-real-time))

(fresh-line *trace-output*)

@@ -131,7 +131,7 @@ x))

*gcl-major-version* *gcl-minor-version* *gcl-extra-version*

(if (member :ansi-cl *features*) "ANSI" "CLtL1")

(if (member :gprof *features*) "profiling" "")

- (si::gcl-compile-time)

+ (gcl-compile-time)

"Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)"

"Binary License: "

(if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules)

@@ -142,13 +142,13 @@ x))

(defun lisp-implementation-version nil

(format nil "GCL ~a.~a.~a"

- si::*gcl-major-version*

- si::*gcl-minor-version*

- si::*gcl-extra-version*))

+ *gcl-major-version*

+ *gcl-minor-version*

+ *gcl-extra-version*))

(defun objlt (x y)

(declare (object x y))

- (let ((x (si::address x)) (y (si::address y)))

+ (let ((x (address x)) (y (address y)))

(declare (fixnum x y))

(if (< y 0)

(if (< x 0) (< x y) t)

@@ -156,10 +156,10 @@ x))

(defun reset-sys-paths (s)

(declare (string s))

- (setq si::*lib-directory* s)

- (setq si::*system-directory* (si::string-concatenate s "unixport/"))

+ (setq *lib-directory* s)

+ (setq *system-directory* (string-concatenate s "unixport/"))

(let (nl)

(dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/"))

- (push (si::string-concatenate s l) nl))

- (setq si::*load-path* nl))

+ (push (string-concatenate s l) nl))

+ (setq *load-path* nl))

nil)

diff --git a/gcl/o/array.c b/gcl/o/array.c
index 70362a1e7..b6fc1bf9f 100755
--- a/gcl/o/array.c
+++ b/gcl/o/array.c

@@ -457,15 +457,15 @@ static longfloat DFLT_aet_lf = 0.0;

static object Iname_t = sLt;

static struct { char * dflt; object *namep;} aet_types[] =

{ {(char *) &DFLT_aet_object, &Iname_t,}, /* t */

- {(char *) &DFLT_aet_ch, &sLstring_char,},/* string-char */

+ {(char *) &DFLT_aet_ch, &sLcharacter,},/* character */

{(char *) &DFLT_aet_fix, &sLbit,}, /* bit */

{(char *) &DFLT_aet_fix, &sLfixnum,}, /* fixnum */

{(char *) &DFLT_aet_sf, &sLshort_float,}, /* short-float */

{(char *) &DFLT_aet_lf, &sLlong_float,}, /* long-float */

- {(char *) &DFLT_aet_char,&sLsigned_char,}, /* signed char */

- {(char *) &DFLT_aet_char,&sLunsigned_char,}, /* unsigned char */

- {(char *) &DFLT_aet_short,&sLsigned_short,}, /* signed short */

- {(char *) &DFLT_aet_short, &sLunsigned_short}, /* unsigned short */

+ {(char *) &DFLT_aet_char,&sSsigned_char,}, /* signed char */

+ {(char *) &DFLT_aet_char,&sSunsigned_char,}, /* unsigned char */

+ {(char *) &DFLT_aet_short,&sSsigned_short,}, /* signed short */

+ {(char *) &DFLT_aet_short, &sSunsigned_short}, /* unsigned short */

};

DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"")

diff --git a/gcl/o/assignment.c b/gcl/o/assignment.c
index c592259ce..f4d04836b 100755
--- a/gcl/o/assignment.c
+++ b/gcl/o/assignment.c

@@ -172,7 +172,7 @@ DEFUNO_NEW("FSET",object,fSfset,SI

sym->s.s_mflag = FALSE;

} else if (car(function) == sLspecial)

FEerror("Cannot define a special form.", 0);

- else if (function->c.c_car == sLmacro) {

+ else if (function->c.c_car == sSmacro) {

sym->s.s_gfdef = function->c.c_cdr;

sym->s.s_mflag = TRUE;

} else {

diff --git a/gcl/o/error.c b/gcl/o/error.c
index 70bb8e492..8417ff202 100755
--- a/gcl/o/error.c
+++ b/gcl/o/error.c

@@ -67,27 +67,27 @@ ihs_function_name(object x)

y = x->c.c_car;

if (y == sLlambda)

return(sLlambda);

- if (y == sLlambda_closure)

- return(sLlambda_closure);

- if (y == sLlambda_block || y == sSlambda_block_expanded) {

+ if (y == sSlambda_closure)

+ return(sSlambda_closure);

+ if (y == sSlambda_block || y == sSlambda_block_expanded) {

x = x->c.c_cdr;

if (type_of(x) != t_cons)

- return(sLlambda_block);

+ return(sSlambda_block);

return(x->c.c_car);

}

- if (y == sLlambda_block_closure) {

+ if (y == sSlambda_block_closure) {

x = x->c.c_cdr;

if (type_of(x) != t_cons)

- return(sLlambda_block_closure);

+ return(sSlambda_block_closure);

x = x->c.c_cdr;

if (type_of(x) != t_cons)

- return(sLlambda_block_closure);

+ return(sSlambda_block_closure);

x = x->c.c_cdr;

if (type_of(x) != t_cons)

- return(sLlambda_block_closure);

+ return(sSlambda_block_closure);

x = x->c.c_cdr;

if (type_of(x) != t_cons)

- return(sLlambda_block_closure);

+ return(sSlambda_block_closure);

return(x->c.c_car);

}

/* a general special form */

diff --git a/gcl/o/eval.c b/gcl/o/eval.c
index 0422721c9..9439c4a00 100755
--- a/gcl/o/eval.c
+++ b/gcl/o/eval.c

@@ -227,7 +227,7 @@ funcall(object fun)

c = FALSE;

fun = fun->c.c_cdr;

- }else if (x == sLlambda_block) {

+ }else if (x == sSlambda_block) {

b = TRUE;

c = FALSE;

if(sSlambda_block_expanded->s.s_dbind!=OBJNULL)

@@ -237,14 +237,14 @@ funcall(object fun)

- } else if (x == sLlambda_closure) {

+ } else if (x == sSlambda_closure) {

b = FALSE;

c = TRUE;

fun = fun->c.c_cdr;

} else if (x == sLlambda) {

b = c = FALSE;

fun = fun->c.c_cdr;

- } else if (x == sLlambda_block_closure) {

+ } else if (x == sSlambda_block_closure) {

b = c = TRUE;

fun = fun->c.c_cdr;

} else

@@ -644,13 +644,13 @@ EVAL:

vs_check;

- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)

+ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)

{

bds_ptr old_bds_top = bds_top;

- object hookfun = symbol_value(Vevalhook);

+ object hookfun = symbol_value(siVevalhook);

/* check if Vevalhook is unbound */

- bds_bind(Vevalhook, Cnil);

+ bds_bind(siVevalhook, Cnil);

form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2]));

bds_unwind(old_bds_top);

return form;

@@ -721,7 +721,7 @@ APPLICATION:

for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr)

if (x->c.c_car->c.c_car == fun) {

x = x->c.c_car;

- if (MMcadr(x) == sLmacro) {

+ if (MMcadr(x) == sSmacro) {

x = MMcaddr(x);

goto EVAL_MACRO;

}

@@ -755,10 +755,10 @@ EVAL_ARGS:

vs_top = ++top;

form = MMcdr(form);}

n =top - base; /* number of args */

- if (Vapplyhook->s.s_dbind != Cnil) {

+ if (siVapplyhook->s.s_dbind != Cnil) {

base[0]= (object)n;

base[0] = c_apply_n(list,n+1,base);

- x = Ifuncall_n(Vapplyhook->s.s_dbind,3,

+ x = Ifuncall_n(siVapplyhook->s.s_dbind,3,

x, /* the function */

base[0], /* the arg list */

list(3,lex_env[0],lex_env[1],lex_env[2]));

@@ -775,7 +775,7 @@ EVAL_ARGS:

LAMBDA:

if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) {

- x = listA(4,sLlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));

+ x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));

goto EVAL_ARGS;

}

FEinvalid_function(fun);

@@ -805,13 +805,13 @@ EVAL:

vs_check;

- if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)

+ if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)

{

bds_ptr old_bds_top = bds_top;

- object hookfun = symbol_value(Vevalhook);

- /* check if Vevalhook is unbound */

+ object hookfun = symbol_value(siVevalhook);

+ /* check if siVevalhook is unbound */

- bds_bind(Vevalhook, Cnil);

+ bds_bind(siVevalhook, Cnil);

vs_base = vs_top;

vs_push(form);

vs_push(lex_env[0]);

@@ -903,7 +903,7 @@ APPLICATION:

for (x = lex_env[1]; type_of(x) == t_cons; x = x->c.c_cdr)

if (x->c.c_car->c.c_car == fun) {

x = x->c.c_car;

- if (MMcadr(x) == sLmacro) {

+ if (MMcadr(x) == sSmacro) {

x = MMcaddr(x);

goto EVAL_MACRO;

}

@@ -940,7 +940,7 @@ EVAL_ARGS:

form = MMcdr(form);

}

vs_base = base;

- if (Vapplyhook->s.s_dbind != Cnil) {

+ if (siVapplyhook->s.s_dbind != Cnil) {

call_applyhook(fun);

return;

}

@@ -959,7 +959,7 @@ LAMBDA:

temporary = make_cons(lex_env[2], fun->c.c_cdr);

temporary = make_cons(lex_env[1], temporary);

temporary = make_cons(lex_env[0], temporary);

- x = make_cons(sLlambda_closure, temporary);

+ x = make_cons(sSlambda_closure, temporary);

vs_push(x);

goto EVAL_ARGS;

}

@@ -972,7 +972,7 @@ call_applyhook(object fun)

object ah;

object *v;

- ah = symbol_value(Vapplyhook);

+ ah = symbol_value(siVapplyhook);

v = vs_base + 1;

vs_push(Cnil);

while (vs_top > v)

@@ -1040,7 +1040,7 @@ DEFUNOM_NEW("EVAL",object,fLeval,LISP

return Ivs_values();

}

-LFD(Levalhook)(void)

+LFD(siLevalhook)(void)

{

object env;

bds_ptr old_bds_top = bds_top;

@@ -1062,15 +1062,15 @@ LFD(Levalhook)(void)

vs_push(car(env));

} else

too_many_arguments();

- bds_bind(Vevalhook, vs_base[1]);

- bds_bind(Vapplyhook, vs_base[2]);

+ bds_bind(siVevalhook, vs_base[1]);

+ bds_bind(siVapplyhook, vs_base[2]);

eval1 = 1;

eval(vs_base[0]);

lex_env = lex;

bds_unwind(old_bds_top);

}

-LFD(Lapplyhook)(void)

+LFD(siLapplyhook)(void)

{

object env;

@@ -1094,8 +1094,8 @@ LFD(Lapplyhook)(void)

vs_push(car(env));

} else

too_many_arguments();

- bds_bind(Vevalhook, vs_base[2]);

- bds_bind(Vapplyhook, vs_base[3]);

+ bds_bind(siVevalhook, vs_base[2]);

+ bds_bind(siVapplyhook, vs_base[3]);

z = vs_top;

for (l = vs_base[1]; !endp(l); l = l->c.c_cdr)

vs_push(l->c.c_car);

@@ -1392,15 +1392,15 @@ gcl_init_eval(void)

make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64));

- Vevalhook = make_special("*EVALHOOK*", Cnil);

- Vapplyhook = make_special("*APPLYHOOK*", Cnil);

+ siVevalhook = make_si_special("*EVALHOOK*", Cnil);

+ siVapplyhook = make_si_special("*APPLYHOOK*", Cnil);

three_nils.nil3_self[0] = Cnil;

three_nils.nil3_self[1] = Cnil;

three_nils.nil3_self[2] = Cnil;

- make_function("EVALHOOK", Levalhook);

- make_function("APPLYHOOK", Lapplyhook);

+ make_si_function("EVALHOOK", siLevalhook);

+ make_si_function("APPLYHOOK", siLapplyhook);

}

diff --git a/gcl/o/file.d b/gcl/o/file.d
index 5f4b62e21..165796722 100755
--- a/gcl/o/file.d
+++ b/gcl/o/file.d

@@ -1800,7 +1800,7 @@ LFD(Lfile_length)()

vs_base[0] = make_fixnum(i);

}

-object sSAload_pathnameA;

+object sLAload_pathnameA;

DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,"");

DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");

@@ -1861,7 +1861,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");

}

package = symbol_value(sLApackageA);

bds_bind(sLApackageA, package);

- bds_bind(sSAload_pathnameA,fasl_filename);

+ bds_bind(sLAload_pathnameA,fasl_filename);

if (sSAcollect_binary_modulesA->s.s_dbind==Ct) {

object _x=sSAbinary_modulesA->s.s_dbind;

object _y=Cnil;

@@ -1920,7 +1920,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");

flush_stream(PRINTstream);

}

package = symbol_value(sLApackageA);

- bds_bind(sSAload_pathnameA,pathname);

+ bds_bind(sLAload_pathnameA,pathname);

bds_bind(sLApackageA, package);

bds_bind(sLAstandard_inputA, strm);

frs_push(FRS_PROTECT, Cnil);

@@ -2571,7 +2571,7 @@ gcl_init_file(void)

}

DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,"");

-DEFVAR("*LOAD-PATHNAME*",sSAload_pathnameA,SI,Cnil,"");

+DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,"");

DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,"");

DEF_ORDINARY("ABORT",sKabort,KEYWORD,"");

diff --git a/gcl/o/funlink.c b/gcl/o/funlink.c
index 5a09d4763..8a6738c99 100755
--- a/gcl/o/funlink.c
+++ b/gcl/o/funlink.c

@@ -19,7 +19,7 @@ typedef object (*object_func)();

static int

vpush_extend(void *,object);

-object sLAlink_arrayA;

+object sSAlink_arrayA;

int Rset = 0;

DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,"");

@@ -67,8 +67,8 @@ call_or_link(object sym, void **link) {

if (Rset==0)

funcall(fun);

else if (type_of(fun) == t_cfun) {

- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);

- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);

+ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);

+ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);

*link = (void *) (fun->cf.cf_self);

(*(void (*)())(fun->cf.cf_self))();

} else {

@@ -89,8 +89,8 @@ call_or_link_closure(object sym, void **link, void **ptr) {

}

if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) {

if (Rset) {

- (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);

- (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);

+ (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);

+ (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);

*ptr = (void *)fun;

*link = (void *) (fun->cf.cf_self);

MMccall(fun);

@@ -105,8 +105,8 @@ call_or_link_closure(object sym, void **link, void **ptr) {

/* can't do this if invoking foo(a) is illegal when foo is not defined

to take any arguments. In the majority of C's this is legal */

else if (type_of(fun) == t_cfun) {

- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);

- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);

*link = (void *)fun->cf.cf_self;

(*(void (*)())fun->cf.cf_self)();

} else {

@@ -180,8 +180,8 @@ is supplied and FLAG is nil, then this function is deleted from the fast links")

LDEFAULT2: sym = Cnil ;

LEND_VARARG: va_end(ap);}

- if (sLAlink_arrayA ==0) RETURN1(Cnil);

- link_ar = sLAlink_arrayA->s.s_dbind;

+ if (sSAlink_arrayA ==0) RETURN1(Cnil);

+ link_ar = sSAlink_arrayA->s.s_dbind;

if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil);

check_type_array(&link_ar);

if (type_of(link_ar) != t_string)

@@ -339,8 +339,8 @@ call_proc(object sym, void **link, int argd, va_list ll) {

}

- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);

- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);

*link = (void *)fn;

AFTER_LINK:

@@ -443,8 +443,8 @@ call_proc_new(object sym, void **link, int argd, object first, va_list ll) {

}

- (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);

- (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);

+ (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);

*link = (void *)fn;

AFTER_LINK:

@@ -607,7 +607,7 @@ FFN(mv_ref)(unsigned int i)

#include "xdrfuns.c"

DEF_ORDINARY("CDEFN",sScdefn,SI,"");

-DEFVAR("*LINK-ARRAY*",sLAlink_arrayA,LISP,Cnil,"");

+DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,"");

void

gcl_init_links(void)

diff --git a/gcl/o/gbc.c b/gcl/o/gbc.c
index 6be9f5fef..934fb0d67 100755
--- a/gcl/o/gbc.c
+++ b/gcl/o/gbc.c

@@ -336,15 +336,15 @@ mark_link_array(void *v,void *ve) {

if (NULL_OR_ON_C_STACK(v))

return;

- if (sLAlink_arrayA->s.s_dbind==Cnil)

+ if (sSAlink_arrayA->s.s_dbind==Cnil)

return;

- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;

- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;

+ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;

+ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;

- if (is_marked(sLAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P

+ if (is_marked(sSAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P

#ifdef SGC

- && (!sgc_enabled || SGC_RELBLOCK_P(sLAlink_arrayA->s.s_dbind->v.v_self))

+ && (!sgc_enabled || SGC_RELBLOCK_P(sSAlink_arrayA->s.s_dbind->v.v_self))

#endif

) {

fixnum j=rb_pointer1-rb_pointer;

@@ -368,11 +368,11 @@ prune_link_array(void) {

void **p,**pe,**n,**ne;

- if (sLAlink_arrayA->s.s_dbind==Cnil)

+ if (sSAlink_arrayA->s.s_dbind==Cnil)

return;

- ne=n=p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;

- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;

+ ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;

+ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;

while (p<pe) {

if (*p) {

@@ -382,7 +382,7 @@ prune_link_array(void) {

p+=2;

}

- sLAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);

+ sSAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);

}

@@ -392,11 +392,11 @@ sweep_link_array(void) {

void ***p,***pe;

- if (sLAlink_arrayA->s.s_dbind==Cnil)

+ if (sSAlink_arrayA->s.s_dbind==Cnil)

return;

- p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;

- pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;

+ p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;

+ pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;

for (;p<pe;p+=2)

if (*p) {

if (LINK_ARRAY_MARKED(p))

@@ -1604,7 +1604,7 @@ mark_contblock(void *p, int s) {

set_mark_bits(v,x,y);

}

-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") {

+DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") {

/* 1 args */

diff --git a/gcl/o/let.c b/gcl/o/let.c
index d3b59306b..a225d40b1 100755
--- a/gcl/o/let.c
+++ b/gcl/o/let.c

@@ -191,7 +191,7 @@ is an illegal function definition in FLET.",

top[0] = MMcons(lex[2], def);

top[0] = MMcons(lex[1], top[0]);

top[0] = MMcons(lex[0], top[0]);

- top[0] = MMcons(sLlambda_block_closure, top[0]);

+ top[0] = MMcons(sSlambda_block_closure, top[0]);

lex_fun_bind(MMcar(def), top[0]);

def_list = MMcdr(def_list);

}

@@ -227,7 +227,7 @@ is an illegal function definition in LABELS.",

top[0] = MMcons(Cnil, top[0]);

top[1] = MMcons(top[0], top[1]);

top[0] = MMcons(lex[0], top[0]);

- top[0] = MMcons(sLlambda_block_closure, top[0]);

+ top[0] = MMcons(sSlambda_block_closure, top[0]);

lex_fun_bind(MMcar(def), top[0]);

def_list = MMcdr(def_list);

}

diff --git a/gcl/o/lex.c b/gcl/o/lex.c
index a0ecac852..c698506d3 100755
--- a/gcl/o/lex.c
+++ b/gcl/o/lex.c

@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_fun)

{

object *top = vs_top;

vs_push(make_cons(exp_fun, Cnil));

- top[0] = make_cons(sLmacro, top[0]);

+ top[0] = make_cons(sSmacro, top[0]);

top[0] = make_cons(name, top[0]);

lex_env[1]=make_cons(top[0], lex_env[1]);

vs_top = top;

@@ -70,7 +70,7 @@ lex_tag_bind(object tag, object id)

object *top = vs_top;

vs_push(make_cons(id, Cnil));

- top[0] = make_cons(sLtag, top[0]);

+ top[0] = make_cons(sStag, top[0]);

top[0] = make_cons(tag, top[0]);

lex_env[2] =make_cons(top[0], lex_env[2]);

vs_top = top;

@@ -95,7 +95,7 @@ lex_tag_sch(object tag)

object alist = lex_env[2];

while (!endp(alist)) {

- if (eql(MMcaar(alist), tag) && MMcadar(alist) == sLtag)

+ if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag)

return(MMcar(alist));

alist = MMcdr(alist);

}

@@ -120,10 +120,10 @@ gcl_init_lex(void)

{

/* sLfunction = make_ordinary("FUNCTION"); */

/* enter_mark_origin(&sLfunction); */

- sLmacro = make_ordinary("MACRO");

- enter_mark_origin(&sLmacro);

- sLtag = make_ordinary("TAG");

- enter_mark_origin(&sLtag);

+ sSmacro = make_si_ordinary("MACRO");

+ enter_mark_origin(&sSmacro);

+ sStag = make_si_ordinary("TAG");

+ enter_mark_origin(&sStag);

sLblock = make_ordinary("BLOCK");

enter_mark_origin(&sLblock);

}

diff --git a/gcl/o/main.c b/gcl/o/main.c
index 29cf5af87..710a91101 100755
--- a/gcl/o/main.c
+++ b/gcl/o/main.c

@@ -549,22 +549,10 @@ initlisp(void) {

import(Ct, lisp_package);

export(Ct, lisp_package);

-#ifdef ANSI_COMMON_LISP

-/* Cnil->s.s_hpack = common_lisp_package; */

- import(Cnil, common_lisp_package);

- export(Cnil, common_lisp_package);

-

-/* Ct->s.s_hpack = common_lisp_package; */

- import(Ct, common_lisp_package);

- export(Ct, common_lisp_package);

-#endif

-

-/* sLquote = make_ordinary("QUOTE"); */

-/* sLfunction = make_ordinary("FUNCTION"); */

sLlambda = make_ordinary("LAMBDA");

- sLlambda_block = make_ordinary("LAMBDA-BLOCK");

- sLlambda_closure = make_ordinary("LAMBDA-CLOSURE");

- sLlambda_block_closure = make_ordinary("LAMBDA-BLOCK-CLOSURE");

+ sSlambda_block = make_si_ordinary("LAMBDA-BLOCK");

+ sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE");

+ sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE");

sLspecial = make_ordinary("SPECIAL");

@@ -702,7 +690,7 @@ segmentation_catcher(int i) {

/* error("end of file"); */

/* } */

-DEFUNO_NEW("BYE",object,fLbye,LISP

+DEFUNO_NEW("BYE",object,fSbye,SI

,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"")

{ int n=VFUN_NARGS;

int exit_code;

@@ -714,9 +702,9 @@ DEFUNO_NEW("BYE",object,fLbye,LISP

}

-DEFUN_NEW("QUIT",object,fLquit,LISP

+DEFUN_NEW("QUIT",object,fSquit,SI

,0,1,NONE,OO,OO,OO,OO,(object exitc),"")

-{ return FFN(fLbye)(exitc); }

+{ return FFN(fSbye)(exitc); }

/* DEFUN_NEW("EXIT",object,fLexit,LISP */

/* ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */

@@ -976,7 +964,7 @@ FFN(siLsave_system)(void) {

saving_system = FALSE;

- Lsave();

+ siLsave();

alloc_page(-(holepage+nrbpage));

}

@@ -990,7 +978,7 @@ DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,"");

static void

init_main(void) {

- make_function("BY", Lby);

+ make_si_function("BY", Lby);

make_si_function("ARGC", siLargc);

make_si_function("ARGV", siLargv);

diff --git a/gcl/o/predicate.c b/gcl/o/predicate.c
index 4c983bdcc..abb04ddf3 100755
--- a/gcl/o/predicate.c
+++ b/gcl/o/predicate.c

@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunctionp,LISP

x0 = Cnil; }

else if (t == t_cons) {

x = x0->c.c_car;

- if (x == sLlambda || x == sLlambda_block ||

+ if (x == sLlambda || x == sSlambda_block ||

x == sSlambda_block_expanded ||

- x == sLlambda_closure || x == sLlambda_block_closure)

+ x == sSlambda_closure || x == sSlambda_block_closure)

x0 = Ct;

else

x0 = Cnil;

@@ -379,18 +379,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP

x0 = Cnil;

RETURN1(x0);}

-DEFUNO_NEW("COMMONP",object,fLcommonp,LISP

- ,1,1,NONE,OO,OO,OO,OO,void,Lcommonp,(object x0),"")

-

-{

- /* 1 args */;

-

- if (type_of(x0) != t_spice)

- x0 = Ct;

- else

- x0 = Cnil;

-RETURN1(x0);}

-

DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") {

RETURN1(x0==x1 ? Ct : Cnil);

}

diff --git a/gcl/o/reference.c b/gcl/o/reference.c
index 479f99dea..555208936 100755
--- a/gcl/o/reference.c
+++ b/gcl/o/reference.c

@@ -82,7 +82,7 @@ LFD(Lsymbol_function)(void)

FEundefined_function(sym);

if (sym->s.s_mflag) {

vs_push(sym->s.s_gfdef);

- vs_base[0] = sLmacro;

+ vs_base[0] = sSmacro;

stack_cons();

return;

}

@@ -131,7 +131,7 @@ FFN(Ffunction)(object form)

vs_base[0] = MMcons(lex_env[2], vs_base[0]);

vs_base[0] = MMcons(lex_env[1], vs_base[0]);

vs_base[0] = MMcons(lex_env[0], vs_base[0]);

- vs_base[0] = MMcons(sLlambda_closure, vs_base[0]);

+ vs_base[0] = MMcons(sSlambda_closure, vs_base[0]);

} else

FEinvalid_function(fun);

}

diff --git a/gcl/o/save.c b/gcl/o/save.c
index 08e605eb5..31c704abd 100755
--- a/gcl/o/save.c
+++ b/gcl/o/save.c

@@ -16,7 +16,7 @@ memory_save(char *original_file, char *save_file)

extern void _cleanup();

#endif

-LFD(Lsave)(void) {

+LFD(siLsave)(void) {

char filename[256];

extern char *kcl_self;

diff --git a/gcl/o/structure.c b/gcl/o/structure.c
index f71d8ae88..5ea5194a3 100755
--- a/gcl/o/structure.c
+++ b/gcl/o/structure.c

@@ -257,7 +257,7 @@ LFD(siLmake_structure)(void)

}

static void

-FFN(siLcopy_structure)(void)

+FFN(Lcopy_structure)(void)

{

object x, y;

struct s_data *def;

@@ -452,7 +452,7 @@ gcl_init_structure_function(void)

make_si_function("MAKE-STRUCTURE", siLmake_structure);

make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure);

- make_si_function("COPY-STRUCTURE", siLcopy_structure);

+ make_function("COPY-STRUCTURE", Lcopy_structure);

make_si_function("STRUCTURE-NAME", siLstructure_name);

/* make_si_function("STRUCTURE-REF", siLstructure_ref); */

/* make_si_function("STRUCTURE-DEF", siLstructure_def); */

diff --git a/gcl/o/toplevel.c b/gcl/o/toplevel.c
index 2d5907579..48a462eb6 100755
--- a/gcl/o/toplevel.c
+++ b/gcl/o/toplevel.c

@@ -68,12 +68,12 @@ FFN(Fdefun)(object args)

}

vs_base = vs_top;

if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) {

- vs_push(MMcons(sLlambda_block, args));

+ vs_push(MMcons(sSlambda_block, args));

} else {

vs_push(MMcons(lex_env[2], args));

vs_base[0] = MMcons(lex_env[1], vs_base[0]);

vs_base[0] = MMcons(lex_env[0], vs_base[0]);

- vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]);

+ vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]);

}

{object fname = clear_compiler_properties(name,vs_base[0]);

fname->s.s_gfdef = vs_base[0];

diff --git a/gcl/o/typespec.c b/gcl/o/typespec.c
index 69bc7879c..5ca72acd4 100755
--- a/gcl/o/typespec.c
+++ b/gcl/o/typespec.c

@@ -176,7 +176,6 @@ LFD(Ltype_of)(void)

DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,"");

DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,"");

DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,"");

-DEF_ORDINARY("COMMON",sLcommon,LISP,"");

DEF_ORDINARY("NULL",sLnull,LISP,"");

DEF_ORDINARY("CONS",sLcons,LISP,"");

DEF_ORDINARY("LIST",sLlist,LISP,"");

@@ -204,7 +203,6 @@ DEF_ORDINARY("SHORT-FLOAT",sLshort_float,LISP,"");

DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,"");

DEF_ORDINARY("BOOLEAN",sLboolean,LISP,"");

DEF_ORDINARY("FIXNUM",sLfixnum,LISP,"");

-DEF_ORDINARY("POSITIVE-FIXNUM",sLpositive_fixnum,LISP,"");

DEF_ORDINARY("COMPLEX",sLcomplex,LISP,"");

DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,"");

DEF_ORDINARY("PACKAGE",sLpackage,LISP,"");

@@ -227,10 +225,10 @@ DEF_ORDINARY("VALUES",sLvalues,LISP,"");

DEF_ORDINARY("MOD",sLmod,LISP,"");

DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,"");

DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,"");

-DEF_ORDINARY("SIGNED-CHAR",sLsigned_char,LISP,"");

-DEF_ORDINARY("UNSIGNED-CHAR",sLunsigned_char,LISP,"");

-DEF_ORDINARY("SIGNED-SHORT",sLsigned_short,LISP,"");

-DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned_short,LISP,"");

+DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,"");

+DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,"");

+DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,"");

+DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,"");

DEF_ORDINARY("*",sLA,LISP,"");

DEF_ORDINARY("PLUSP",sLplusp,LISP,"");

DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,"");

diff --git a/gcl/o/unixsave.c b/gcl/o/unixsave.c
index 6a2610090..9b003c24a 100755
--- a/gcl/o/unixsave.c
+++ b/gcl/o/unixsave.c

@@ -140,7 +140,7 @@ char *original_file, *save_file;

extern void _cleanup();

-LFD(Lsave)() {

+LFD(siLsave)() {

char filename[256];

check_arg(1);

@@ -159,6 +159,6 @@ LFD(Lsave)() {

void

gcl_init_unixsave(void)

{

- make_function("SAVE", Lsave);

+ make_si_function("SAVE", siLsave);

}

diff --git a/gcl/o/unixsys.c b/gcl/o/unixsys.c
index 30560dd02..98a9ff2b3 100755
--- a/gcl/o/unixsys.c
+++ b/gcl/o/unixsys.c

@@ -169,7 +169,7 @@ msystem(const char *s) {

}

static void

-FFN(Lsystem)(void)

+FFN(siLsystem)(void)

{

char command[32768];

int i;

@@ -284,6 +284,6 @@ un_mmap(void *v1,void *ve) {

void

gcl_init_unixsys(void) {

- make_function("SYSTEM", Lsystem);

+ make_si_function("SYSTEM", siLsystem);

}

diff --git a/gcl/pcl/defsys.lisp b/gcl/pcl/defsys.lisp
index 9980298cf..93aee2386 100644
--- a/gcl/pcl/defsys.lisp
+++ b/gcl/pcl/defsys.lisp

@@ -675,7 +675,7 @@ and load your system with:

;; 3.0 it's in the LUCID-COMMON-LISP package.

;;

#+LUCID (or lucid::*source-pathname* (bad-time))

- #+akcl si:*load-pathname*

+ #+akcl *load-pathname*

#+cmu17 *load-truename*

#-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil))

diff --git a/gcl/pcl/gcl_pcl_pkg.lisp b/gcl/pcl/gcl_pcl_pkg.lisp
index 493f8e19f..115044d18 100644
--- a/gcl/pcl/gcl_pcl_pkg.lisp
+++ b/gcl/pcl/gcl_pcl_pkg.lisp

@@ -176,11 +176,8 @@

nil))

-#+kcl

-(progn

-(import '(si:structurep si:structure-def si:structure-ref))

-(shadow 'lisp:dotimes)

-)

+#+kcl(import '(si:structurep si:structure-def si:structure-ref))

+

#+kcl

(in-package "SI")

#+kcl

diff --git a/gcl/pcl/gcl_pcl_walk.lisp b/gcl/pcl/gcl_pcl_walk.lisp
index 62e4c0354..19c928b01 100644
--- a/gcl/pcl/gcl_pcl_walk.lisp
+++ b/gcl/pcl/gcl_pcl_walk.lisp

@@ -608,7 +608,7 @@

(push `(,(car f) . (function . (,#'unbound-lexical-function . nil)))

lexicals))

(dolist (m macros)

- (push `(,(car m) . (macro . ( ,(cadr m) . nil)))

+ (push `(,(car m) . (si::macro . ( ,(cadr m) . nil)))

lexicals))

(list first lexicals third)))

@@ -623,7 +623,7 @@

(when env

(let ((entry (assoc macro (second env))))

(and entry

- (eq (cadr entry) 'macro)

+ (eq (cadr entry) 'si::macro)

(caddr entry)))))

);#+(or KCL IBCL)

@@ -1202,7 +1202,7 @@

#+(or KCL IBCL)

(progn

- (define-walker-template lambda-block walk-named-lambda);Not really right,

+ (define-walker-template si::lambda-block walk-named-lambda);Not really right,

;we don't hack block

;names anyways.

)

diff --git a/gcl/xgcl-2/gcl_init_xgcl.lsp b/gcl/xgcl-2/gcl_init_xgcl.lsp
index bf10ca0ff..cc89f2d04 100644
--- a/gcl/xgcl-2/gcl_init_xgcl.lsp
+++ b/gcl/xgcl-2/gcl_init_xgcl.lsp

@@ -36,8 +36,8 @@

(progn (allocate 'cons 100) (allocate 'string 40)

(system:init-system) (gbc t)

(si::multiply-bignum-stack 25)

- (or lisp::*link-array*

- (setq lisp::*link-array*

+ (or si::*link-array*

+ (setq si::*link-array*

(make-array 500 :element-type 'fixnum :fill-pointer 0)))

(use-fast-links t)

(setq compiler::*cmpinclude* "<cmpinclude.h>") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")