Add a name mangler to the lisp runtime. Use this mangler in the compiler to

optimize access to symbols and functions which are defined in the C runtime.

src/c/all_functions.d

@@ -3,17 +3,11 @@
 #include "ecls.h"
 #include "page.h"
 
-struct function_info {
-  const char *name;
-  cl_object (*f)(int, ...);
-  short type;
-};
-
 #define form 2
 #define cl 0
 #define si 1
 
-static const struct function_info all_functions[] = {
+const struct function_info all_functions[] = {
 
 	/* alloc.c */
 
@@ -35,6 +29,10 @@ static const struct function_info all_functions[] = {
 	{"GC", clLgc, cl},
 #endif
 
+	/* all_symbols.c */
+
+	{"MANGLE-NAME", siLmangle_name, si},
+
 	/* array.c */
 
 	{"MAKE-PURE-ARRAY", siLmake_pure_array, si},
@@ -332,7 +330,7 @@ static const struct function_info all_functions[] = {
 	{"COPY-TREE", clLcopy_tree, cl},
 	{"REVAPPEND", clLrevappend, cl},
 	{"NCONC", clLnconc, cl},
-	{"NRECONC", clLreconc, cl},
+	{"NRECONC", clLnreconc, cl},
 
 	{"BUTLAST", clLbutlast, cl},
 	{"NBUTLAST", clLnbutlast, cl},
@@ -410,7 +408,7 @@ static const struct function_info all_functions[] = {
 	{"ARGC", siLargc, si},
 	{"ARGV", siLargv, si},
 	{"GETENV", siLgetenv, si},
-	{"POINTER", siLaddress, si},
+	{"POINTER", siLpointer, si},
 #if !defined(MSDOS) && !defined(__NeXT)
 	{"MACHINE-INSTANCE", clLmachine_instance, cl},
 	{"MACHINE-VERSION", clLmachine_version, cl},
@@ -439,12 +437,12 @@ static const struct function_info all_functions[] = {
 
 	/* num-arith.c */
 
-	{"+", clLplus, cl},
-	{"-", clLminus, cl},
-	{"*", clLtimes, cl},
-	{"/", clLdivide, cl},
-	{"1+", clLone_plus, cl},
-	{"1-", clLone_minus, cl},
+	{"+", clLP, cl},
+	{"-", clLM, cl},
+	{"*", clLX, cl},
+	{"/", clLN, cl},
+	{"1+", clL1P, cl},
+	{"1-", clL1M, cl},
 	{"CONJUGATE", clLconjugate, cl},
 	{"GCD", clLgcd, cl},
 	{"LCM", clLlcm, cl},
@@ -474,12 +472,12 @@ static const struct function_info all_functions[] = {
 
 	/* num_comp.c */
 
-	{"=", clLall_the_same, cl},
-	{"/=", clLall_different, cl},
-	{"<", clLmonotonically_increasing, cl},
-	{">", clLmonotonically_decreasing, cl},
-	{"<=", clLmonotonically_nondecreasing, cl},
-	{">=", clLmonotonically_nonincreasing, cl},
+	{"=", clLE, cl},
+	{"/=", clLNE, cl},
+	{"<", clLL, cl},
+	{">", clLG, cl},
+	{"<=", clLLE, cl},
+	{">=", clLGE, cl},
 	{"MAX", clLmax, cl},
 	{"MIN", clLmin, cl},
 
@@ -627,7 +625,7 @@ static const struct function_info all_functions[] = {
 	{"WRITE-STRING", clLwrite_string, cl},
 	{"WRITE-LINE", clLwrite_line, cl},
 	{"WRITE-BYTE", clLwrite_byte, cl},
-	{"WRITE-BYTES", clLwrite_bytes, si},
+	{"WRITE-BYTES", siLwrite_bytes, si},
 	{"TERPRI", clLterpri, cl},
 	{"FRESH-LINE", clLfresh_line, cl},
 	{"FINISH-OUTPUT", clLforce_output, cl},
@@ -668,7 +666,7 @@ static const struct function_info all_functions[] = {
 	{"PARSE-INTEGER", clLparse_integer, cl},
 
 	{"READ-BYTE", clLread_byte, cl},
-	{"READ-BYTES", clLread_bytes, si},
+	{"READ-BYTES", siLread_bytes, si},
 
 	{"COPY-READTABLE", clLcopy_readtable, cl},
 	{"READTABLEP", clLreadtablep, cl},
@@ -797,8 +795,8 @@ static const struct function_info all_functions[] = {
 	{"SLEEP", clLsleep, cl},
 	{"GET-INTERNAL-RUN-TIME", clLget_internal_run_time, cl},
 	{"GET-INTERNAL-REAL-TIME", clLget_internal_real_time, cl},
-	{"GET-LOCAL-TIME-ZONE", clLget_local_time_zone, si},
-	{"DAYLIGHT-SAVING-TIME-P", clLdaylight_saving_timep, si},
+	{"GET-LOCAL-TIME-ZONE", siLget_local_time_zone, si},
+	{"DAYLIGHT-SAVING-TIME-P", siLdaylight_saving_time_p, si},
 
 	/* toplevel.c */
 

src/c/all_symbols.d

@@ -38,7 +38,7 @@ const struct symbol_info all_symbols[] = {
 #endif
 
 /* compiler.c */
-{&siSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY},
+{&clSlambda_block, "LAMBDA-BLOCK", CL_ORDINARY},
 
 /* conditional.c */
 {&clSotherwise, "OTHERWISE", CL_ORDINARY},
@@ -310,6 +310,110 @@ const struct symbol_info all_symbols[] = {
 
 {NULL, (const char*)NULL, CL_ORDINARY}};
 
+@(defun si::mangle-name (symbol &optional as_symbol)
+	int l;
+	char c, *source, *dest;
+	cl_object output;
+	cl_object package;
+	cl_object found = Cnil;
+	bool is_symbol;
+@
+	assert_type_symbol(symbol);
+	is_symbol = (as_symbol == Cnil);
+	if (is_symbol) {
+		if (symbol == Cnil)
+			@(return Ct make_simple_string("Cnil"))
+		else if (symbol == Ct)
+			@(return Ct make_simple_string("Ct"))
+		for (l = 0; all_symbols[l].loc != NULL; l++) {
+			if (symbol == *(all_symbols[l].loc)) {
+				found = Ct;
+				break;
+			}
+		}
+	} else {
+		cl_object fun;
+		fun = symbol->symbol.gfdef;
+		if (fun != OBJNULL && type_of(fun) == t_cfun) {
+			for (l = 0; all_functions[l].name != NULL; l++)
+				if (fun->cfun.entry == all_functions[l].f) {
+					if (fun->cfun.name != Cnil)
+						symbol = fun->cfun.name;
+					found = Ct;
+					break;
+				}
+		}
+	}
+	package= symbol->symbol.hpack;
+	symbol = symbol->symbol.name;
+	l      = symbol->string.fillp;
+	source = symbol->string.self;
+	output = alloc_simple_string(l+1); array_allocself(output);
+	dest   = output->string.self;
+	if (is_symbol && source[0] == '*') {
+		if (l > 2 && source[l-1] == '*') l--;
+		c = 'V';
+		l--;
+		source++;
+	} else if (is_symbol && l > 2 && source[0] == '+' && source[l-1] == '+') {
+		c = 'C';
+		l-= 2;
+		source++;
+	} else if (!is_symbol) {
+		c = 'L';
+	} else if (package == keyword_package) {
+		c = 'K';
+	} else {
+		c = 'S';
+	}
+	if (package == lisp_package)
+		package = make_simple_string("cl");
+	else if (package == system_package)
+		package = make_simple_string("si");
+	else if (package == keyword_package)
+		package = Cnil;
+	else
+		package = lisp_package->pack.name;
+	*(dest++) = c;
+	output->string.fillp = 1;
+	while (l--) {
+		c = *(source++);
+		if (isalpha(c))
+			c = tolower(c);
+		else if (isnumber(c))
+			;
+		else if (c == '-' || c == '_') {
+			c = '_';
+		} else if (c == '&') {
+			c = 'A';
+		} else if (c == '*') {
+			c = 'X';
+		} else if (c == '+') {
+			c = 'P';
+		} else if (c == '<') {
+			c = 'L';
+		} else if (c == '>') {
+			c = 'G';
+		} else if (c == '=') {
+			c = 'E';
+		} else if (c == '/') {
+			c = 'N';
+		} else if (c == ':') {
+			c = 'X';
+		} else {
+			@(return Cnil Cnil)
+		}
+		*(dest++) = c;
+		output->string.fillp++;
+	}
+	if (dest[-1] == '_')
+		dest[-1] = 'M';
+	*(dest++) = '\0';
+	if (!Null(package))
+		output = @si::string-concatenate(2,package,output);
+	@(return found output)
+@)
+
 void
 init_all_symbols(void) {
   const struct symbol_info *s = all_symbols;

src/c/compiler.d

@@ -18,7 +18,7 @@
 
 /********************* EXPORTS *********************/
 
-cl_object @'si::lambda-block';
+cl_object @'lambda-block';
 cl_object @'declare';
 cl_object @'defun';
 cl_object @'compile', @'load', @'eval', @'progn', @'warn', @'typep', @'otherwise';
@@ -906,7 +906,7 @@ c_function(cl_object args) {
 	} else if (CONSP(function) && CAR(function) == @'lambda') {
 		asm_op(OP_CLOSE);
 		asm1(make_lambda(Cnil, CDR(function)));
-	} else if (CONSP(function) && CAR(function) == @'si::lambda-block') {
+	} else if (CONSP(function) && CAR(function) == @'lambda-block') {
 		cl_object name = CADR(function);
 		cl_object body = CDDR(function);
 		asm_op(OP_CLOSE);

src/c/dpp.c

@@ -286,6 +286,8 @@ read_name(int is_symbol)
 		poolp--;
 	if (l > 2 && oneC && poolp[-1] == 'P')
 		poolp--;
+	if (poolp[-1] == '_')
+		poolp[-1] = 'M';
 	if (colon == NULL) {
 		char buf[256];
 		poolp[0] = buf[0] = '\0';

src/c/list.d

@@ -596,7 +596,7 @@ nconc(cl_object l, cl_object y)
 	return l;
 }
 
-@(defun reconc (l y)
+@(defun nreconc (l y)
 	cl_object x, z;
 @
 	/* INV: when a circular list is "reconc'ed", the pointer ends

src/c/main.d

@@ -153,7 +153,7 @@ main(int argc, char **argv)
 	@(return ((value == NULL)? Cnil : make_string_copy(value)))
 @)
 
-@(defun si::address (x)
+@(defun si::pointer (x)
 @
 	@(return MAKE_FIXNUM((int)x))
 @)

src/c/num_arith.d

@@ -18,7 +18,7 @@
 
 /*  (*		)  */
 
-@(defun times (&rest nums)
+@(defun * (&rest nums)
 	int i;
 	cl_object numi, prod = MAKE_FIXNUM(1);
 @
@@ -208,7 +208,7 @@ number_times(cl_object x, cl_object y)
 }
 
 /* (+          )   */
-@(defun plus (&rest nums)
+@(defun + (&rest nums)
         int i;
 	cl_object numi, sum = MAKE_FIXNUM(0);
 @
@@ -363,7 +363,7 @@ number_plus(cl_object x, cl_object y)
 }
 
 /*  (-		)  */
-@(defun minus (num &rest nums)
+@(defun - (num &rest nums)
 	int i;
 	cl_object diff;
 @
@@ -586,7 +586,7 @@ number_negate(cl_object x)
 }
 
 /*  (/		)  */
-@(defun divide (num &rest nums)
+@(defun / (num &rest nums)
 	int i;
 @
 	/* INV: type check is in number_divide() */
@@ -802,7 +802,7 @@ get_gcd(cl_object x, cl_object y)
 }
 
 /*  (1+ x)  */
-@(defun one_plus (x)
+@(defun 1+ (x)
 @	/* INV: type check is in one_plus() */
 	@(return one_plus(x))
 @)
@@ -848,7 +848,7 @@ one_plus(cl_object x)
 }
 
 /*  (1-	x)  */
-@(defun one_minus (x)
+@(defun 1- (x)
 @	/* INV: type check is in one_minus() */
 	@(return one_minus(x))
 @)

src/c/num_comp.d

@@ -23,7 +23,7 @@
 */
 
 
-@(defun all_the_same (num &rest nums)
+@(defun = (num &rest nums)
 	int i;
 	cl_object numi;
 @
@@ -259,7 +259,7 @@ number_compare(cl_object x, cl_object y)
 	}
 }
 
-@(defun all_different (&rest nums)
+@(defun /= (&rest nums)
 	int i, j;
 	va_list numb;
 @
@@ -281,14 +281,10 @@ number_compare(cl_object x, cl_object y)
 { va_list nums; va_start(nums, narg); \
   return monotonic(i, j, narg, (cl_object *)nums); }
 
-cl_object
-@monotonically-nondecreasing	MONOTONIC( 1, 0)
-cl_object
-@monotonically-nonincreasing	MONOTONIC(-1, 0)
-cl_object
-@monotonically-increasing	MONOTONIC( 1, 1)
-cl_object
-@monotonically-decreasing	MONOTONIC(-1, 1)
+cl_object @<= MONOTONIC( 1, 0)
+cl_object @>= MONOTONIC(-1, 0)
+cl_object @<  MONOTONIC( 1, 1)
+cl_object @>  MONOTONIC(-1, 1)
 
 cl_object
 monotonic(int s, int t, int narg, cl_object *nums)

src/c/pathname.d

@@ -983,7 +983,7 @@ coerce_to_from_pathname(cl_object x, cl_object host)
 		  FEerror("~S is not a valid to-pathname translation", 1, from);
 		set = CONS(CONS(from, CONS(to, Cnil)), set);
 	}
-	CADR(pair) = @reconc(2, set, Cnil);
+	CADR(pair) = @nreconc(2, set, Cnil);
 	@(return set)
 @)
 
@@ -1101,7 +1101,7 @@ translate_pathname(cl_object source, cl_object from, cl_object to)
 		a = CDR(a);
 		b = CDR(b);
 	}
-	@reconc(2, wilds, Cnil);
+	@nreconc(2, wilds, Cnil);
 	if (a != Cnil || b != Cnil)
 		goto error;
 	for (c = Cnil, pc = &c, b = to->pathname.directory; !endp(b); b = CDR(b)) {

src/c/print.d

@@ -2063,7 +2063,7 @@ RETRY:	if (type_of(strm) == t_stream) {
 	@(return integer)
 @)
 
-@(defun write_bytes (stream string start end)
+@(defun si::write_bytes (stream string start end)
         cl_index is, ie; FILE *fp;
 	int written, sofarwritten, towrite;
 @

src/c/read.d

@@ -1947,7 +1947,7 @@ CANNOT_PARSE:
 	@(return MAKE_FIXNUM(c))
 @)
 
-@(defun read_bytes (stream string start end)
+@(defun si::read_bytes (stream string start end)
 	int is, ie, c; FILE *fp;
 @
 	assert_type_stream(stream);

src/c/time.d

@@ -95,7 +95,7 @@ UTC_time_to_universal_time(int i)
  *
  * Based on Lott's get_timezone() function from CMU Common Lisp.
  */
-@(defun get_local_time_zone ()
+@(defun si::get_local_time_zone ()
   struct tm ltm, gtm;
   int mw;
   time_t when = 0L;
@@ -118,7 +118,7 @@ UTC_time_to_universal_time(int i)
  * defaults to current time.
  *
  */
-@(defun daylight_saving_timep (&rest args)
+@(defun si::daylight-saving-time-p (&rest args)
   struct tm *ltm;
   time_t when;
 @