Commit 9b4bd625 authored by jjgarcia's avatar jjgarcia

+The compiler produced wrong code for RETURN-FROM forms inside an UNWIND-PROTECT.

+Deftype BIT-VECTOR would not expand to a vector type.
+Each compiled file has an entry point whose name is either
 init_CODE() or another name based on the name of the source file.
 The algorithm for computing these names has been slightly changed
 so that the entry points of ECLS's own library do not conflict with
 user defined entry points.
+A LET/LET* form in which the initializers for a variable have not
 the expected type produce a warning, but the code is accepted. For
 instance (LET (V) (DECLARE (TYPE FIXNUM V)) (SETQ V 1)) now
 compiles.
+(SETF name), where name is a symbol, is now a valid function name in all
 contexts. It is accepted by DEFUN, FUNCTION, FBOUNDP, FMAKUNBOUND, etc,
 and it can be the on the function position in any form.
+New specialized arrays for (UNSIGNED-BYTE 8) and (SIGNED-BYTE 8).
parent 9f28615d
......@@ -816,10 +816,21 @@ ECLS 0.5
- The compiler produced wrong code for CATCH forms in which the tag
is not constant.
- The compiler produced wrong code for RETURN-FROM forms inside an
UNWIND-PROTECT.
- Deftype BIT-VECTOR would not expand to a vector type.
* System design and portability:
- Remove function_entry_table.
- Each compiled file has an entry point whose name is either
init_CODE() or another name based on the name of the source file.
The algorithm for computing these names has been slightly changed
so that the entry points of ECLS's own library do not conflict with
user defined entry points.
* Visible changes and ANSI compatibility:
- The value of *package* is correctly set and restored while loading
......@@ -845,7 +856,7 @@ ECLS 0.5
the interpreter and the compiler.
- New, undocumented implementation of documentation strings which
uses hash tables instead of property lists. The gloal variable
uses hash tables instead of property lists. The global variable
si::*keep-documentation* determines whether documentation strings
are stored in memory. It is possible to dump documentation strings
to a help file.
......@@ -858,6 +869,17 @@ ECLS 0.5
- Symbolic's update of the MIT LOOP macro imported.
- A LET/LET* form in which the initializers for a variable have not
the expected type produce a warning, but the code is accepted. For
instance (LET (V) (DECLARE (TYPE FIXNUM V)) (SETQ V 1)) now
compiles.
- (SETF name), where name is a symbol, is now a valid function name in all
contexts. It is accepted by DEFUN, FUNCTION, FBOUNDP, FMAKUNBOUND, etc,
and it can be the on the function position in any form.
- New specialized arrays for (UNSIGNED-BYTE 8) and (SIGNED-BYTE 8).
TODO:
=====
......
......@@ -47,8 +47,8 @@ all: $(TARGETS) doc
%Makefile: $(srcdir)/%Makefile.in config.status
./config.status
eclx$(EXE): ecls$(EXE) compile_rest.lsp
./ecls < compile_rest.lsp
eclx$(EXE): ecls_min$(EXE) compile_rest.lsp
./ecls_min < compile_rest.lsp
ecls$(EXE): ecls_min$(EXE) compile.lsp
./ecls_min < compile.lsp
......
......@@ -22,7 +22,7 @@ ecls_min:
echo '(setf (logical-pathname-translations "SYS")'; \
echo " '"'(("*.*" "../*.*")))'; \
echo '(sys::chdir "ansi-tests")'; \
echo '(in-package "CL-USER"); \
echo '(in-package "CL-USER")'; \
echo '(load "$(srcdir)/tests")'; \
echo "(run-all-tests \"$(srcdir)/\")"; \
echo "(quit)") | (cd ..; ./ecls_min)
......
......@@ -32,7 +32,7 @@ HFILES = ../h/config.h $(HDIR)/ecls.h $(HDIR)/ecls-cmp.h\
$(HDIR)/lwp.h $(HDIR)/critical.h
OBJS = main.o symbol.o package.o list.o\
apply.o eval.o interpreter.o compiler.o disassembler.o \
clos.o instance.o gfun.o lex.o reference.o character.o\
clos.o instance.o gfun.o reference.o character.o\
file.o read.o print.o error.o string.o cfun.o\
typespec.o assignment.o \
predicate.o big.o number.o\
......
......@@ -243,6 +243,7 @@ const struct function_info all_functions[] = {
/* interpreter.c */
{"INTERPRETER-STACK", siLinterpreter_stack, si},
{"MAKE-LAMBDA", siLmake_lambda, si},
{"FUNCTION-BLOCK-NAME", siLfunction_block_name, si},
/* iteration.c */
......@@ -251,10 +252,6 @@ const struct function_info all_functions[] = {
{"DOLIST", NULL, form},
{"DOTIMES", NULL, form},
/* lex.c */
{"LEX-ENV", siLlex_env, si},
/* let.c */
{"LET", NULL, form},
......@@ -484,6 +481,7 @@ const struct function_info all_functions[] = {
{"LOGANDC2", clLlogandc1, cl},
{"LOGORC1", clLlogorc1, cl},
{"LOGORC2", clLlogorc2, cl},
{"LOGNOT", clLlognot, cl},
{"BOOLE", clLboole, cl},
{"LOGBITP", clLlogbitp, cl},
{"ASH", clLash, cl},
......
......@@ -53,6 +53,11 @@ const struct keyword_info all_keywords[] = {
{&Krehash_size, "REHASH-SIZE"},
{&Krehash_threshold, "REHASH-THRESHOLD"},
/* lex.c */
{&Kfunction, "FUNCTION"},
{&Ktag, "TAG"},
{&Kblock, "BLOCK"},
/* list.c */
{&Ktest, "TEST"},
{&Ktest_not, "TEST-NOT"},
......
......@@ -2,10 +2,17 @@
#include "page.h"
const struct symbol_info all_symbols[] = {
/* array.c */
{&clSbyte8, "BYTE8", CL_ORDINARY},
{&clSinteger8, "INTEGER8", CL_ORDINARY},
/* assignment.c */
{&clSsetf, "SETF", CL_ORDINARY},
{&clSpsetf, "PSETF", CL_ORDINARY},
{&siSsetf_symbol, "SETF-SYMBOL", SI_ORDINARY},
{&siSsetf_lambda, "SETF-LAMBDA", SI_ORDINARY},
{&siSsetf_method, "SETF-METHOD", SI_ORDINARY},
{&siSsetf_update, "SETF-UPDATE", SI_ORDINARY},
{&siSclear_compiler_properties, "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY},
#ifdef PDE
{&siVrecord_source_pathname_p, "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL},
......@@ -127,6 +134,9 @@ const struct symbol_info all_symbols[] = {
{&clVload_verbose, "*LOAD-VERBOSE*", CL_SPECIAL},
{&clVload_print, "*LOAD-PRINT*", CL_SPECIAL},
{&siVload_hooks, "*LOAD-HOOKS*", SI_SPECIAL},
#ifdef ENABLE_DLOPEN
{&siVinit_function_prefix, "*INIT-FUNCTION-PREFIX*", SI_SPECIAL},
#endif
#ifdef PDE
{&siVsource_pathname, "*SOURCE-PATHNAME*", CL_SPECIAL},
#endif
......
......@@ -164,6 +164,8 @@ init_alloc(void)
if (alloc_initialized) return;
alloc_initialized = TRUE;
GC_no_dls = 1;
init_tm(t_shortfloat, "SHORT-FLOAT", /* 8 */
sizeof(struct shortfloat_struct));
init_tm(t_cons, "CONS", sizeof(struct cons)); /* 12 */
......
......@@ -20,6 +20,9 @@
#define CHAR_BIT (sizeof(char)*8)
#endif
cl_object @'byte8';
cl_object @'integer8';
static void displace (cl_object from, cl_object to, cl_object offset);
static void check_displaced (cl_object dlist, cl_object orig, cl_index newdim);
extern cl_elttype get_elttype (cl_object x);
......@@ -118,6 +121,12 @@ aref(cl_object x, cl_index index)
case aet_lf:
return(make_longfloat(x->array.self.lf[index]));
case aet_b8:
return(MAKE_FIXNUM(x->array.self.b8[index]));
case aet_i8:
return(MAKE_FIXNUM(x->array.self.i8[index]));
default:
internal_error("aref");
}
......@@ -219,6 +228,19 @@ aset(cl_object x, cl_index index, cl_object value)
case aet_lf:
x->array.self.lf[index] = object_to_double(value);
break;
case aet_b8: {
cl_index i = fixnnint(value);
if (i > 0xFF) FEerror("~S is not a (INTEGER 0 255)",1,value);
x->array.self.b8[index] = i;
break;
}
case aet_i8: {
cl_fixnum i = fixint(value);
if (i > 127 || i < -128) FEerror("~S is not a (INTEGER -128 127)",1,value);
x->array.self.i8[index] = i;
break;
}
}
return(value);
}
......@@ -370,7 +392,7 @@ array_allocself(cl_object x)
}
case aet_fix: {
cl_fixnum *elts;
elts = alloc_atomic_align(sizeof(cl_fixnum)*d, sizeof(cl_fixnum));
elts = alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
for (i = 0; i < d; i++)
elts[i] = 0;
x->array.self.fix = elts;
......@@ -378,7 +400,7 @@ array_allocself(cl_object x)
}
case aet_sf: {
float *elts;
elts = alloc_atomic_align(sizeof(float)*d, sizeof(float));
elts = alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
for (i = 0; i < d; i++)
elts[i] = 0.0;
x->array.self.sf = elts;
......@@ -386,12 +408,28 @@ array_allocself(cl_object x)
}
case aet_lf: {
double *elts;
elts = alloc_atomic_align(sizeof(double)*d, sizeof(double));
elts = alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
for (i = 0; i < d; i++)
elts[i] = 0.0;
x->array.self.lf = elts;
break;
}
case aet_b8: {
u_int8_t *elts;
elts = alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
for (i = 0; i < d; i++)
elts[i] = 0;
x->array.self.b8 = elts;
break;
}
case aet_i8: {
int8_t *elts;
elts = alloc_atomic_align(sizeof(*elts)*d, sizeof(*elts));
for (i = 0; i < d; i++)
elts[i] = 0;
x->array.self.i8 = elts;
break;
}
}
#ifdef THREADS
end_critical_section();
......@@ -411,11 +449,11 @@ get_elttype(cl_object x)
return(aet_sf);
else if (x == @'long-float' || x == @'double-float')
return(aet_lf);
/* else if (x == @'signed-char')
return(aet_char);
else if (x == @'unsigned-char')
return(aet_uchar);
else if (x == @'signed-short')
else if (x == @'byte8')
return(aet_b8);
else if (x == @'integer8')
return(aet_i8);
/* else if (x == @'signed-short')
return(aet_short);
else if (x == @'unsigned-short')
return(aet_ushort);
......@@ -437,7 +475,10 @@ array_address(cl_object x, cl_index inc)
return x->string.self + inc;
case aet_lf:
return x->array.self.lf + inc;
case aet_b8:
return x->array.self.b8 + inc;
case aet_i8:
return x->array.self.i8 + inc;
default:
FEerror("Bad array type", 0);
}
......@@ -453,6 +494,8 @@ array_address(cl_object x, cl_index inc)
case aet_fix: output = @'fixnum'; break;
case aet_sf: output = @'short-float'; break;
case aet_lf: output = @'long-float'; break;
case aet_b8: output = @'byte8'; break;
case aet_i8: output = @'integer8'; break;
}
@(return output)
@)
......
......@@ -20,6 +20,9 @@
cl_object @'setf';
cl_object @'psetf';
cl_object @'si::setf-symbol';
cl_object @'si::setf-lambda';
cl_object @'si::setf-method';
cl_object @'si::setf-update';
cl_object @'si::clear-compiler-properties';
#ifdef PDE
cl_object @'si::*record-source-pathname-p*';
......@@ -46,23 +49,17 @@ setf_namep(cl_object fun_spec)
{ cl_object cdr;
if (CONSP(fun_spec) && !endp(cdr = CDR(fun_spec)) &&
endp(CDR(cdr)) && CAR(fun_spec) == @'setf') {
cl_object fn_name, sym;
fn_name = CAR(cdr);
sym = getf(fn_name->symbol.plist, @'si::setf-symbol', Cnil);
if (Null(sym) || !SYMBOLP(sym)) {
cl_object fn_str = fn_name->symbol.name;
int l = fn_str->string.fillp + 7;
cl_object string = alloc_simple_string(l);
char *str = alloc_atomic(l+1);
string->string.self = str;
strncpy(str, "(SETF ", 6);
strncpy(str + 6, fn_str->string.self, fn_str->string.fillp);
str[l-1] = ')';
str[l] = '\0';
sym = intern(string, fn_name->symbol.hpack);
fn_name->symbol.plist =
putf(fn_name->symbol.plist, sym, @'si::setf-symbol');
}
cl_object sym, fn_name = CAR(cdr);
cl_object fn_str = fn_name->symbol.name;
int l = fn_str->string.fillp + 7;
cl_object string = alloc_simple_string(l);
char *str = alloc_atomic(l+1);
string->string.self = str;
strncpy(str, "(SETF ", 6);
strncpy(str + 6, fn_str->string.self, fn_str->string.fillp);
str[l-1] = ')';
str[l] = '\0';
sym = intern(string, fn_name->symbol.hpack);
return(sym);
} else return(OBJNULL);
}
......@@ -78,11 +75,15 @@ setf_namep(cl_object fun_spec)
cl_type t;
@
if (!SYMBOLP(fun)) {
cl_object sym;
if ((sym=setf_namep(fun)) != OBJNULL)
fun = sym;
else
FEtype_error_symbol(fun);
cl_object sym = setf_namep(fun);
if (sym == OBJNULL)
FEtype_error_symbol(fun);
fun = CADR(fun);
putprop(fun, sym, @'si::setf-symbol');
remprop(fun, @'si::setf-lambda');
remprop(fun, @'si::setf-method');
remprop(fun, @'si::setf-update');
fun = sym;
}
if (fun->symbol.isform) {
if (fun->symbol.mflag) {
......@@ -124,11 +125,15 @@ setf_namep(cl_object fun_spec)
@(defun fmakunbound (sym)
@
if (!SYMBOLP(sym)) {
cl_object sym1;
if ((sym1=setf_namep(sym)) != OBJNULL)
sym = sym1;
else
cl_object sym1 = setf_namep(sym);
if (sym1 == OBJNULL)
FEtype_error_symbol(sym);
sym = CADR(sym);
remprop(sym, @'si::setf-lambda');
remprop(sym, @'si::setf-method');
remprop(sym, @'si::setf-update');
@fmakunbound(1, sym1);
@(return sym)
}
if (sym->symbol.isform) {
if (sym->symbol.mflag) {
......
This diff is collapsed.
......@@ -291,19 +291,6 @@ disassemble_progv(cl_object *vector) {
return vector;
}
static cl_object *
disassemble_pushenv(cl_object *vector) {
cl_object lex_old = lex_env;
lex_copy();
printf("PUSHENV");
vector = disassemble(vector);
printf("\t\t\t; pushenv");
lex_env = lex_old;
return vector;
}
/* OP_TAGBODY n-tags
tag1 addr1
tag2 addr2
......@@ -315,17 +302,15 @@ disassemble_pushenv(cl_object *vector) {
static cl_object *
disassemble_tagbody(cl_object *vector) {
cl_index ntags = get_oparg(vector[-1]);
cl_index i, ntags = get_oparg(vector[-1]);
cl_object lex_old = lex_env;
lex_copy();
printf("TAGBODY");
while (ntags--) {
for (i=0; i<ntags; i++, vector++) {
@terpri(0);
printf("\tTAG\t'");
@prin1(1, vector[0]);
printf(" @@ %d", simple_label(vector+1));
vector+=2;
printf("\tTAG\t%d",i);
printf(" @@ %d", simple_label(vector));
}
vector = disassemble(vector);
printf("\t\t\t; tagbody");
......@@ -391,6 +376,12 @@ disassemble(cl_object *vector) {
n = get_oparg(s);
s = next_code(vector);
goto OPARG_ARG;
case OP_CALLG: string = "FCALL";
n = get_oparg(s);
goto OPARG;
case OP_PCALLG: string = "PFCALL";
n = get_oparg(s);
goto OPARG;
case OP_FCALL: string = "FCALL";
n = get_oparg(s);
goto OPARG;
......@@ -437,6 +428,8 @@ disassemble(cl_object *vector) {
s = next_code(vector);
n = packed_label(vector-2);
goto OPARG_ARG;
case OP_UNBIND: string = "UNBIND"; n = get_oparg(s); goto OPARG;
case OP_UNBINDS: string = "UNBINDS"; n = get_oparg(s); goto OPARG;
case OP_BIND: string = "BIND"; goto QUOTE;
case OP_BINDS: string = "BINDS"; goto QUOTE;
case OP_PBIND: string = "PBIND"; goto QUOTE;
......@@ -455,8 +448,6 @@ disassemble(cl_object *vector) {
break;
case OP_PROGV: vector = disassemble_progv(vector);
break;
case OP_PUSHENV: vector = disassemble_pushenv(vector);
break;
case OP_VALUES: string = "VALUES";
n = get_oparg(s);
goto OPARG;
......
......@@ -228,6 +228,12 @@ BEGIN:
case aet_lf:
j = x->array.dim * sizeof(double);
break;
case aet_b8:
j = x->array.dim * sizeof(u_int8_t);
break;
case aet_i8:
j = x->array.dim * sizeof(int8_t);
break;
default:
error("Allocation botch: unknown array element type");
}
......
......@@ -82,7 +82,6 @@ init_lisp(void)
init_compiler();
init_interpreter();
init_eval();
/* init_lex(); */
/* init_reference(); */
init_assignment();
/* init_stacks(); */
......@@ -104,7 +103,8 @@ init_lisp(void)
#ifdef RUNTIME
SYM_VAL(@'*features*') = CONS(make_keyword("RUNTIME"), SYM_VAL(@'*features*'));
#endif
ihs_push(_intern("TOP-LEVEL", system_package), Cnil);
lex_env = Cnil;
ihs_push(_intern("TOP-LEVEL", system_package));
init_LSP();
init_CLOS();
}
This diff is collapsed.
/*
lex.c -- Lexical environment.
*/
/*
Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
Copyright (c) 1990, Giuseppe Attardi.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECLS is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include "ecls.h"
/******** EXPORTS ********/
#ifndef THREADS
cl_object lex_env = OBJNULL;
#endif
cl_object @'si::symbol-macro';
cl_object @'macro';
cl_object @'block';
cl_object @'tag';
/******** ------- ********/
void
lex_fun_bind(cl_object name, cl_object fun)
{
CDR(lex_env) = CONS(list(3, name, @'function', fun), CDR(lex_env));
}
void
lex_tag_bind(cl_object tag, cl_object id)
{
CDR(lex_env) = CONS(list(3, tag, @'tag', id), CDR(lex_env));
}
void
lex_block_bind(cl_object name, cl_object id)
{
CDR(lex_env) = CONS(list(3, name, @'block', id), CDR(lex_env));
}
cl_object
lex_sch(cl_object alist, cl_object name, cl_object type)
{
while (!endp(alist)) {
if (CAAR(alist) == name && CADAR(alist) == type)
return(CADDAR(alist));
alist = CDR(alist);
}
return(Cnil);
}
@(defun si::lex_env ()
@
@(return lex_env)
@)
......@@ -29,6 +29,9 @@ cl_object @'si::*load-hooks*';
#ifdef PDE
cl_object @'si::*source-pathname*';
#endif PDE
#ifdef ENABLE_DLOPEN
cl_object @'si::*init-function-prefix*';
#endif
/******************************* ------- ******************************/
......@@ -36,6 +39,7 @@ cl_object @'si::*source-pathname*';
@(defun si::load_binary (filename verbose print)
cl_object block;
cl_object basename;
cl_object prefix;
@
/* We need the full pathname */
filename = coerce_to_filename(truename(filename));
......@@ -55,17 +59,25 @@ cl_object @'si::*source-pathname*';
goto GO_ON;
/* Next try to call "init_FILE()" where FILE is the file name */
prefix = symbol_value(@'si::*init-function-prefix*');
if (Null(prefix))
prefix = make_simple_string("init_");
else
prefix = @si::string-concatenate(3,
make_simple_string("init_"),
prefix,
make_simple_string("_"));
basename = coerce_to_pathname(filename);
basename = @pathname-name(1,basename);
basename = @si::string-concatenate(2,
make_simple_string("init_"),
@string-upcase(1,basename));
basename = @si::string-concatenate(2, prefix, @string-upcase(1,basename));
block->cblock.entry = dlsym(block->cblock.handle, basename->string.self);
if (block->cblock.entry == "NULL") {
if (block->cblock.entry == NULL) {
dlclose(block->cblock.handle);
@(return make_string_copy(dlerror()))
}
if (1 || !Null(verbose)) {
if (!Null(verbose)) {
setupPRINT(filename, symbol_value(@'*standard-output*'));
write_str(";;; Address = ");
PRINTescape = FALSE;
......@@ -229,5 +241,6 @@ init_load(void)
#ifdef ENABLE_DLOPEN
if (dlopen(NULL, RTLD_NOW|RTLD_GLOBAL) == NULL)
printf(";;; Error dlopening self file\n;;; Error: %s\n", dlerror());
SYM_VAL(@'si::*init-function-prefix*') = Cnil;
#endif
}
......@@ -45,7 +45,10 @@ search_symbol_macro(cl_object name, cl_object env)
cl_object
search_macro(cl_object name, cl_object env)
{
return lex_sch(CDR(env), name, @'macro');
cl_object record = assq(name, CDR(env));
if (CONSP(record) && CADR(record) == @'macro')
return CADDR(record);
return Cnil;
}
cl_object
......
......@@ -254,7 +254,7 @@ b_c2_op(cl_fixnum i, cl_fixnum j)
@(defun lognot (x)
@
return @logxor(1,x,MAKE_FIXNUM(-1));
return @logxor(2,x,MAKE_FIXNUM(-1));
@)
static cl_fixnum
......
......@@ -211,7 +211,7 @@ coerce_to_package(cl_object p)
pp = find_package(p);
if (!Null(pp))
return (pp);
FEwrong_type_argument(@'*package*', p);
FEwrong_type_argument(@'package', p);
}
cl_object
......
......@@ -69,10 +69,9 @@ symbol_function(cl_object sym)
@
if (!SYMBOLP(sym)) {
cl_object sym1 = setf_namep(sym);
if (sym1 != OBJNULL)
sym = sym1;
else
if (sym1 == OBJNULL)
FEtype_error_symbol(sym);
sym = sym1;
}
if (sym->symbol.isform)
output = @'special';
......@@ -89,10 +88,7 @@ symbol_function(cl_object sym)
cl_type t = type_of(fun);
@
if (t == t_symbol) {
cl_object fd = lex_fun_sch(fun);
if (!Null(fd))
return CADDR(fd);
else if (FBOUNDP(fun) || fun->symbol.mflag)
if (FBOUNDP(fun) || fun->symbol.mflag)
FEundefined_function(fun);
else
@(return SYM_FUN(fun))
......
......@@ -335,11 +335,18 @@ reverse(cl_object seq)
for (j = k - 1, i = 0; j >=0; --j, i++)
y->vector.self.t[j] = x->vector.self.t[i];
break;
case aet_lf:
for (j = k - 1, i = 0; j >=0; --j, i++)
y->array.self.lf[j] = x->array.self.lf[i];
break;
case aet_b8:
for (j = k - 1, i = 0; j >=0; --j, i++)
y->array.self.b8[j] = x->array.self.b8[i];
break;
case aet_i8:
for (j = k - 1, i = 0; j >=0; --j, i++)
y->array.self.i8[j] = x->array.self.i8[i];
break;
default:
internal_error("reverse");
}
......@@ -428,6 +435,20 @@ nreverse(cl_object seq)
x->array.self.lf[j] = y;
}
return(seq);
case aet_b8:
for (i = 0, j = k - 1; i < j; i++, --j) {
u_int8_t y = x->array.self.b8[i];
x->array.self.b8[i] = x->array.self.b8[j];
x->array.self.b8[j] = y;
}
return(seq);
case aet_i8:
for (i = 0, j = k - 1; i < j; i++, --j) {
int8_t y = x->array.self.i8[i];
x->array.self.i8[i] = x->array.self.i8[j];
x->array.self.i8[j] = y;
}
return(seq);
default:
internal_error("subseq");
}
......
......@@ -120,10 +120,10 @@ ihs_function_name(cl_object x)
}
void
ihs_push(cl_object function, cl_object env)
ihs_push(cl_object function)
{
cl_stack_push(function);
cl_stack_push(env);
cl_stack_push(lex_env);
cl_stack_push(MAKE_FIXNUM(ihs_top));
ihs_top = cl_stack_index();
}
......@@ -133,6 +133,7 @@ ihs_pop()
{
cl_stack_set_index(ihs_top);
ihs_top = fix(cl_stack_top[-1]);
lex_env = cl_stack_top[-2];
cl_stack_pop_n(3);
}
......@@ -154,6 +155,19 @@ ihs_prev(cl_index n)
return n;
}