\f
static DOESNT_RETURN
-syntax_error (CONST char *string)
+read_syntax_error (const char *string)
{
signal_error (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
}
static Lisp_Object
-continuable_syntax_error (CONST char *string)
+continuable_read_syntax_error (const char *string)
{
return Fsignal (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
#ifdef DEBUG_XEMACS /* testing Mule */
static int testing_mule = 0; /* Change via debugger */
- if (testing_mule) {
- if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
- else if (c == '\n') fprintf (stderr, "\\n\n");
- else fprintf (stderr, "\\%o ", c);
- }
-#endif
+ if (testing_mule)
+ {
+ if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
+ else if (c == '\n') stderr_out ("\\n\n");
+ else stderr_out ("\\%o ", c);
+ }
+#endif /* testing Mule */
return c;
}
else if (MARKERP (readcharfun))
Lisp_Object list = Vload_force_doc_string_list;
Lisp_Object tail;
int fd = XINT (XCAR (Vload_descriptor_list));
- /* NOTE: If purify_flag is true, we're in-place modifying objects that
- may be in purespace (and if not, they will be). Therefore, we have
- to be VERY careful to make sure that all objects that we create
- are purecopied -- objects in purespace are not marked for GC, and
- if we leave any impure objects inside of pure ones, we're really
- screwed. */
GCPRO1 (list);
/* restore the old value first just in case an error occurs. */
ivan = Fread (juan);
if (!CONSP (ivan))
signal_simple_error ("invalid lazy-loaded byte code", ivan);
- /* Remember to purecopy; see above. */
- XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
+ XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
/* v18 or v19 bytecode file. Need to Ebolify. */
if (XCOMPILED_FUNCTION (john)->flags.ebolified
&& VECTORP (XCDR (ivan)))
ebolify_bytecode_constants (XCDR (ivan));
- XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
+ XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
NUNGCPRO;
}
doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
general be different from CODESYS if CODESYS specifies automatic
encoding detection or end-of-line detection.
*/
- (file, no_error, nomessage, nosuffix, codesys, used_codesys))
+ (file, noerror, nomessage, nosuffix, codesys, used_codesys))
{
/* This function can GC */
int fd = -1;
/* If file name is magic, call the handler. */
handler = Ffind_file_name_handler (file, Qload);
if (!NILP (handler))
- RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
+ RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
nomessage, nosuffix));
/* Do this after the handler to avoid
if (fd < 0)
{
- if (NILP (no_error))
+ if (NILP (noerror))
signal_file_error ("Cannot open load file", file);
else
{
int result;
/* temporarily hack the 'c' off the end of the filename */
foundstr[foundlen - 1] = '\0';
- result = stat (foundstr, &s2);
+ result = xemacs_stat (foundstr, &s2);
if (result >= 0 &&
(unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
{
{
/* Lisp_Object's must be malloc'ed, not stack-allocated */
Lisp_Object lispstream = Qnil;
- CONST int block_size = 8192;
+ const int block_size = 8192;
struct gcpro ngcpro1;
NGCPRO1 (lispstream);
nil, a list, or a string (for backward compatibility), with the
following semantics:
- a) nil - no suffix, just search for file name intact (semantically
- different from "empty suffix list")
+ a) nil - no suffix, just search for file name intact
+ (semantically different from "empty suffix list", which
+ would be meaningless.)
b) list - list of suffixes to append to file name. Each of these
must be a string.
c) string - colon-separated suffixes to append to file name (backward
compatibility).
- All of this got hairy, so I decided to use write a mapper. Calling
- a function for each suffix shouldn't slow things down, since
- locate_file is rarely call with enough suffixes for it to make a
- difference. */
+ All of this got hairy, so I decided to use a mapper. Calling a
+ function for each suffix shouldn't slow things down, since
+ locate_file is rarely called with enough suffixes for funcalls to
+ make any difference. */
/* Map FUN over SUFFIXES, as described above. FUN will be called with a
char * containing the current file name, and ARG. Mapping stops when
FUN returns non-zero. */
-void
+static void
locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
int (*fun) (char *, void *),
void *arg)
else
{
/* Case c) */
- CONST char *nsuffix = XSTRING_DATA (suffixes);
+ const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
while (1)
{
char *esuffix = (char *) strchr (nsuffix, ':');
- int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+ int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);
/* Concatenate path element/specified name with the suffix. */
strncpy (fn + fn_len, nsuffix, lsuffix);
struct stat st;
/* Ignore file if it's a directory. */
- if (stat (fn, &st) >= 0
+ if (xemacs_stat (fn, &st) >= 0
&& (st.st_mode & S_IFMT) != S_IFDIR)
{
/* Check that we can access or open it. */
if (closure->storeptr)
*closure->storeptr = build_string (fn);
-#ifndef WINDOWSNT
+#ifndef WIN32_NATIVE
/* If we actually opened the file, set close-on-exec flag
on the new descriptor so that subprocesses can't whack
at it. */
MODE nonnegative means don't open the files,
just look for one for which access(file,MODE) succeeds. In this case,
- returns 1 on success.
+ returns a nonnegative value on success. On failure, returns -1.
If STOREPTR is nonzero, it points to a slot where the name of
the file actually found should be stored as a Lisp string.
int found = 0;
/* If this path element is relative, we have to look by hand. */
- if (NILP (Ffile_name_absolute_p (pathel)))
+ if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
{
val = locate_file_in_directory (pathel, str, suffixes, storeptr,
mode);
Programs can pass two arguments, BUFFER and PRINTFLAG.
BUFFER is the buffer to evaluate (nil means use current buffer).
PRINTFLAG controls printing of output:
-nil means discard it; anything else is stream for print.
+nil means discard it; anything else is a stream for printing.
If there is no error, point does not move. If there is an error,
point remains at the end of the last character read from the buffer.
-Execute BUFFER as Lisp code.
*/
- (bufname, printflag))
+ (buffer, printflag))
{
/* This function can GC */
int speccount = specpdl_depth ();
Lisp_Object tem, buf;
- if (NILP (bufname))
+ if (NILP (buffer))
buf = Fcurrent_buffer ();
else
- buf = Fget_buffer (bufname);
+ buf = Fget_buffer (buffer);
if (NILP (buf))
error ("No such buffer.");
DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
Execute the region as Lisp code.
-When called from programs, expects two arguments,
+When called from programs, expects two arguments START and END
giving starting and ending indices in the current buffer
of the text to be executed.
-Programs can pass third argument PRINTFLAG which controls output:
+Programs can pass third optional argument STREAM which controls output:
nil means discard it; anything else is stream for printing it.
If there is no error, point does not move. If there is an error,
If the code being eval'd should happen to trigger a redisplay you may
see some text temporarily disappear because of this.
*/
- (b, e, printflag))
+ (start, end, stream))
{
/* This function can GC */
int speccount = specpdl_depth ();
Lisp_Object tem;
Lisp_Object cbuf = Fcurrent_buffer ();
- if (NILP (printflag))
+ if (NILP (stream))
tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
else
- tem = printflag;
+ tem = stream;
specbind (Qstandard_output, tem);
- if (NILP (printflag))
+ if (NILP (stream))
record_unwind_protect (save_excursion_restore, save_excursion_save ());
record_unwind_protect (save_restriction_restore, save_restriction_save ());
- /* This both uses b and checks its type. */
- Fgoto_char (b, cbuf);
- Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
+ /* This both uses start and checks its type. */
+ Fgoto_char (start, cbuf);
+ Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
- !NILP (printflag));
+ !NILP (stream));
return unbind_to (speccount, Qnil);
}
return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
}
-static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
+static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
static Lisp_Object
read_atom (Lisp_Object readcharfun,
else if (sizeof (long) == sizeof (EMACS_INT))
number = atol (read_buffer);
else
- abort ();
+ ABORT ();
return make_int (number);
}
#else
sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
else
{
- /* intern will purecopy pname if necessary */
Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
sym = Fintern (name, Qnil);
}
static Lisp_Object
-parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
+parse_integer (const Bufbyte *buf, Bytecount len, int base)
{
- CONST Bufbyte *lim = buf + len;
- CONST Bufbyte *p = buf;
+ const Bufbyte *lim = buf + len;
+ const Bufbyte *p = buf;
EMACS_UINT num = 0;
int negativland = 0;
read_bit_vector (Lisp_Object readcharfun)
{
unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
- Emchar c;
+ Lisp_Object val;
while (1)
{
- c = readchar (readcharfun);
- if (c != '0' && c != '1')
- break;
- Dynarr_add (dyn, (unsigned char) (c - '0'));
+ unsigned char bit;
+ Emchar c = readchar (readcharfun);
+ if (c == '0')
+ bit = 0;
+ else if (c == '1')
+ bit = 1;
+ else
+ {
+ if (c >= 0)
+ unreadchar (readcharfun, c);
+ break;
+ }
+ Dynarr_add (dyn, bit);
}
- if (c >= 0)
- unreadchar (readcharfun, c);
+ val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+ Dynarr_length (dyn));
+ Dynarr_free (dyn);
- return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
- Dynarr_length (dyn));
+ return val;
}
\f
GCPRO2 (orig_list, already_seen);
if (c != '(')
- RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
+ RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
list = read_list (readcharfun, ')', 0, 0);
orig_list = list;
{
int len = XINT (Flength (list));
if (len == 0)
- RETURN_UNGCPRO (continuable_syntax_error
+ RETURN_UNGCPRO (continuable_read_syntax_error
("structure type not specified"));
if (!(len & 1))
RETURN_UNGCPRO
- (continuable_syntax_error
+ (continuable_read_syntax_error
("structures must have alternating keyword/value pairs"));
}
case '+':
case '-':
{
- Lisp_Object fexp, obj, tem;
+ Lisp_Object feature_exp, obj, tem;
struct gcpro gcpro1, gcpro2;
- fexp = read0(readcharfun);
+ feature_exp = read0(readcharfun);
obj = read0(readcharfun);
/* the call to `featurep' may GC. */
- GCPRO2 (fexp, obj);
- tem = call1 (Qfeaturep, fexp);
+ GCPRO2 (feature_exp, obj);
+ tem = call1 (Qfeaturep, feature_exp);
UNGCPRO;
if (c == '+' && NILP(tem)) goto retry;
#define EXP_INT 16
int
-isfloat_string (CONST char *cp)
+isfloat_string (const char *cp)
{
int state = 0;
- CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
+ const Bufbyte *ucp = (const Bufbyte *) cp;
if (*ucp == '+' || *ucp == '-')
ucp++;
unreadchar (readcharfun, ch);
#ifdef FEATUREP_SYNTAX
if (ch == ']')
- syntax_error ("\"]\" in a list");
+ read_syntax_error ("\"]\" in a list");
else if (ch == ')')
- syntax_error ("\")\" in a vector");
+ read_syntax_error ("\")\" in a vector");
#endif
state = ((conser) (readcharfun, state, len));
}
goto done;
}
else if (ch == ']')
- syntax_error ("']' in a list");
+ read_syntax_error ("']' in a list");
else if (ch == ')')
- syntax_error ("')' in a vector");
+ read_syntax_error ("')' in a vector");
else
#endif
if (ch != '.')
signal_simple_error ("BUG! Internal reader error", elt);
else if (!s->allow_dotted_lists)
- syntax_error ("\".\" in a vector");
+ read_syntax_error ("\".\" in a vector");
else
{
if (!NILP (s->tail))
goto done;
}
}
- syntax_error (". in wrong context");
+ read_syntax_error (". in wrong context");
}
}
i < len;
i++, p++)
{
- struct Lisp_Cons *otem = XCONS (tem);
-#if 0 /* FSFmacs defun hack */
- if (read_pure)
- tem = Fpurecopy (Fcar (tem));
- else
-#endif
- tem = Fcar (tem);
+ Lisp_Cons *otem = XCONS (tem);
+ tem = Fcar (tem);
*p = tem;
tem = otem->cdr;
free_cons (otem);
len = XINT (Flength (stuff));
if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
return
- continuable_syntax_error ("#[...] used with wrong number of elements");
+ continuable_read_syntax_error ("#[...] used with wrong number of elements");
for (iii = 0; CONSP (stuff); iii++)
{
- struct Lisp_Cons *victim = XCONS (stuff);
+ Lisp_Cons *victim = XCONS (stuff);
make_byte_code_args[iii] = Fcar (stuff);
if ((purify_flag || load_force_doc_strings)
&& CONSP (make_byte_code_args[iii])
}
void
+reinit_vars_of_lread (void)
+{
+ Vread_buffer_stream = Qnil;
+ staticpro_nodump (&Vread_buffer_stream);
+}
+
+void
vars_of_lread (void)
{
+ reinit_vars_of_lread ();
+
DEFVAR_LISP ("values", &Vvalues /*
List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological.
with values saved when the image is dumped. */
staticpro (&Vload_descriptor_list);
- Vread_buffer_stream = Qnil;
- staticpro (&Vread_buffer_stream);
-
/* Initialized in init_lread. */
staticpro (&Vload_force_doc_string_list);
projects / chise / xemacs-chise.git.1 / blobdiff