Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ecl
ecl
Commits
36a9c95c
Commit
36a9c95c
authored
Mar 12, 2021
by
Marius Gerbershagen
Browse files
tree-wide: use new dpp @"" specifier for constant base strings where appropriate
parent
aad1edbf
Changes
19
Hide whitespace changes
Inline
Side-by-side
src/c/all_symbols.d
View file @
36a9c95c
...
...
@@ -96,17 +96,17 @@ mangle_name(cl_object output, unsigned char *source, int l)
if
(
is_symbol
)
{
cl_fixnum
p
;
if
(
symbol
==
ECL_NIL
)
{
@
(
return
ECL_T
ecl_make_constant_base_string
(
"ECL_NIL"
,-
1
)
minarg
maxarg
);
@
(
return
ECL_T
@
"ECL_NIL"
minarg
maxarg
);
}
else
if
(
symbol
==
ECL_T
)
{
@
(
return
ECL_T
ecl_make_constant_base_string
(
"ECL_T"
,-
1
)
minarg
maxarg
);
@
(
return
ECL_T
@
"ECL_T"
minarg
maxarg
);
}
p
=
(
cl_symbol_initializer
*)
symbol
-
cl_symbols
;
if
(
p
>=
0
&&
p
<=
cl_num_symbols_in_core
)
{
found
=
ECL_T
;
output
=
cl_format
(
4
,
ECL_NIL
,
ecl_make_constant_base_string
(
"ECL_SYM(~S,~D)"
,
-
1
),
@
"ECL_SYM(~S,~D)"
,
name
,
ecl_make_fixnum
(
p
));
#
ifndef
ECL_FINAL
/* XXX to allow the Lisp compiler to check that the narg
...
...
@@ -161,11 +161,11 @@ mangle_name(cl_object output, unsigned char *source, int l)
;
}
else
if
(
package
==
cl_core
.
lisp_package
)
package
=
ecl_make_constant_base_string
(
"cl"
,-
1
)
;
package
=
@
"cl"
;
else
if
(
package
==
cl_core
.
system_package
)
package
=
ecl_make_constant_base_string
(
"si"
,-
1
)
;
package
=
@
"si"
;
else
if
(
package
==
cl_core
.
ext_package
)
package
=
ecl_make_constant_base_string
(
"si"
,-
1
)
;
package
=
@
"si"
;
else
if
(
package
==
cl_core
.
keyword_package
)
package
=
ECL_NIL
;
else
...
...
src/c/alloc_2.d
View file @
36a9c95c
...
...
@@ -149,7 +149,7 @@ out_of_memory(size_t requested_bytes)
switch
(
method
)
{
case
0
:
cl_error
(
1
,
@
'
ext
::
storage
-
exhausted
'
);
break
;
case
1
:
cl_cerror
(
2
,
ecl_make_constant_base_string
(
"Extend heap size"
,
-
1
),
case
1
:
cl_cerror
(
2
,
@
"Extend heap size"
,
@
'
ext
::
storage
-
exhausted
'
);
break
;
case
2
:
...
...
src/c/cfun.d
View file @
36a9c95c
...
...
@@ -25,8 +25,8 @@ ecl_make_cfun(cl_objectfn_fixed c_function, cl_object name, cl_object cblock, in
if
(
ecl_unlikely
(
narg
<
0
||
narg
>
ECL_C_ARGUMENTS_LIMIT
))
{
FEprogram_error
(
"ecl_make_cfun: ~a"
,
1
,
(
narg
<
0
)
?
ecl_make_constant_base_string
(
"number of arguments must be greater than 0."
,-
1
)
:
ecl_make_constant_base_string
(
"function requires too many arguments."
,-
1
)
);
?
@
"number of arguments must be greater than 0."
:
@
"function requires too many arguments."
);
}
cf
=
ecl_alloc_object
(
t_cfunfixed
);
...
...
@@ -48,8 +48,8 @@ ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object cblock, int n
if
(
ecl_unlikely
(
narg_fixed
<
0
||
narg_fixed
>
ECL_C_ARGUMENTS_LIMIT
))
{
FEprogram_error
(
"ecl_make_cfun_va: ~a"
,
1
,
(
narg_fixed
<
0
)
?
ecl_make_constant_base_string
(
"number of arguments must be greater than 0."
,-
1
)
:
ecl_make_constant_base_string
(
"function requires too many arguments."
,-
1
)
);
?
@
"number of arguments must be greater than 0."
:
@
"function requires too many arguments."
);
}
cf
=
ecl_alloc_object
(
t_cfun
);
...
...
@@ -75,8 +75,8 @@ ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block, int
if
(
ecl_unlikely
(
narg_fixed
<
0
||
narg_fixed
>
ECL_C_ARGUMENTS_LIMIT
))
{
FEprogram_error
(
"ecl_make_cclosure_va: ~a"
,
1
,
(
narg_fixed
<
0
)
?
ecl_make_constant_base_string
(
"number of arguments must be greater than 0."
,-
1
)
:
ecl_make_constant_base_string
(
"function requires too many arguments."
,-
1
)
);
?
@
"number of arguments must be greater than 0."
:
@
"function requires too many arguments."
);
}
cc
=
ecl_alloc_object
(
t_cclosure
);
...
...
src/c/disassembler.d
View file @
36a9c95c
...
...
@@ -172,7 +172,7 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
cl_object
line_no
;
if
(
cl_fboundp
(
@
'
si
::
formatter
-
aux
'
)
!=
ECL_NIL
)
line_format
=
ecl_make_constant_base_string
(
"~%~4d\t"
,-
1
)
;
line_format
=
@
"~%~4d\t"
;
else
line_format
=
ECL_NIL
;
BEGIN
:
...
...
src/c/error.d
View file @
36a9c95c
...
...
@@ -172,7 +172,7 @@ FEprogram_error(const char *s, int narg, ...)
cl_object
stmt
=
ecl_symbol_value
(
@
'
si
::*
current
-
form
*
'
);
if
(
stmt
!=
ECL_NIL
)
{
real_args
=
@list
(
3
,
stmt
,
text
,
real_args
);
text
=
ecl_make_constant_base_string
(
"In form~%~S~%~?"
,-
1
)
;
text
=
@
"In form~%~S~%~?"
;
}
}
si_signal_simple_error
(
4
,
...
...
@@ -217,8 +217,7 @@ FEreader_error(const char *s, cl_object stream, int narg, ...)
args_list
);
}
else
{
/* Actual reader error */
cl_object
prefix
=
ecl_make_constant_base_string
(
"Reader error in file ~S, "
"position ~D:~%"
,-
1
);
cl_object
prefix
=
@
"Reader error in file ~S, position ~D:~%"
;
cl_object
position
=
cl_file_position
(
1
,
stream
);
message
=
si_base_string_concatenate
(
2
,
prefix
,
message
);
args_list
=
cl_listX
(
3
,
stream
,
position
,
args_list
);
...
...
@@ -240,7 +239,7 @@ FEcannot_open(cl_object file)
si_signal_simple_error
(
6
,
@
'
file
-
error
'
,
/* condition */
ECL_NIL
,
/* continuable */
ecl_make_constant_base_string
(
"Cannot open ~S.~%C library error: ~A"
,
-
1
),
/* format */
@
"Cannot open ~S.~%C library error: ~A"
,
/* format */
cl_list
(
2
,
file
,
c_error
),
/* format args */
@
'
:
pathname
'
,
/* file-error options */
file
);
...
...
@@ -458,7 +457,7 @@ void
FEinvalid_function_name
(
cl_object
fname
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Not a valid function name ~D."
,
-
1
),
@
"Not a valid function name ~D."
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
fname
),
@
'
:
expected
-
type
'
,
cl_list
(
2
,
@
'
satisfies
'
,
@
'
si
::
valid
-
function
-
name
-
p
'
),
@
'
:
datum
'
,
fname
);
...
...
src/c/ffi/backtrace.d
View file @
36a9c95c
...
...
@@ -97,20 +97,20 @@ si_dump_c_backtrace(cl_object size)
pSymbol
->
MaxNameLen
=
MAX_SYMBOL_LENGTH
;
#
endif
int
i
;
cl_format
(
2
,
ECL_T
,
ecl_make_constant_base_string
(
"~&C Backtrace:~%"
,-
1
)
);
cl_format
(
2
,
ECL_T
,
@
"~&C Backtrace:~%"
);
for
(
i
=
0
;
i
<
nframes
;
i
++)
{
#
if
defined
(
ECL_UNIX_BACKTRACE
)
cl_format
(
3
,
ECL_T
,
ecl_make_constant_base_string
(
" > ~a~%"
,
-
1
),
cl_format
(
3
,
ECL_T
,
@
" > ~a~%"
,
ecl_make_constant_base_string
(
names
[
i
],-
1
));
#
elif
defined
(
ECL_WINDOWS_BACKTRACE
)
DWORD64
displacement
;
if
(
SymFromAddr
(
process
,
(
DWORD64
)
pointers
[
i
],
&
displacement
,
pSymbol
))
{
cl_format
(
5
,
ECL_T
,
ecl_make_constant_base_string
(
" > (~a+0x~x) [0x~x]~%"
,
-
1
),
cl_format
(
5
,
ECL_T
,
@
" > (~a+0x~x) [0x~x]~%"
,
ecl_make_constant_base_string
(
pSymbol
->
Name
,-
1
),
ecl_make_unsigned_integer
(
displacement
),
ecl_make_unsigned_integer
((
cl_index
)
pointers
[
i
]));
}
else
{
cl_format
(
3
,
ECL_T
,
ecl_make_constant_base_string
(
" > (unknown) [0x~x]~%"
,
-
1
),
cl_format
(
3
,
ECL_T
,
@
" > (unknown) [0x~x]~%"
,
ecl_make_unsigned_integer
((
cl_index
)
pointers
[
i
]));
}
#
endif
...
...
src/c/ffi/libraries.d
View file @
36a9c95c
...
...
@@ -99,7 +99,7 @@ static cl_object
copy_object_file
(
cl_object
original
)
{
int
err
;
cl_object
copy
=
ecl_make_constant_base_string
(
"TMP:ECL"
,-
1
)
;
cl_object
copy
=
@
"TMP:ECL"
;
copy
=
si_coerce_to_filename
(
si_mkstemp
(
copy
));
/*
* We either have to make a full copy to convince the loader to load this object
...
...
@@ -124,7 +124,7 @@ copy_object_file(cl_object original)
#
endif
#
ifdef
cygwin
{
cl_object
new_copy
=
ecl_make_constant_base_string
(
".dll"
,-
1
)
;
cl_object
new_copy
=
@
".dll"
;
new_copy
=
si_base_string_concatenate
(
2
,
copy
,
new_copy
);
cl_rename_file
(
2
,
copy
,
new_copy
);
copy
=
new_copy
;
...
...
src/c/file.d
View file @
36a9c95c
...
...
@@ -5654,7 +5654,7 @@ static cl_object
not_a_file_stream
(
cl_object
strm
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~A is not an file stream"
,
-
1
),
@
"~A is not an file stream"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
strm
),
@
'
:
expected
-
type
'
,
@
'
file
-
stream
'
,
@
'
:
datum
'
,
strm
);
...
...
@@ -5664,7 +5664,7 @@ static void
not_an_input_stream
(
cl_object
strm
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~A is not an input stream"
,
-
1
),
@
"~A is not an input stream"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
strm
),
@
'
:
expected
-
type
'
,
cl_list
(
2
,
@
'
satisfies
'
,
@
'
input
-
stream
-
p
'
),
...
...
@@ -5675,7 +5675,7 @@ static void
not_an_output_stream
(
cl_object
strm
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~A is not an output stream"
,
-
1
),
@
"~A is not an output stream"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
strm
),
@
'
:
expected
-
type
'
,
cl_list
(
2
,
@
'
satisfies
'
,
@
'
output
-
stream
-
p
'
),
@
'
:
datum
'
,
strm
);
...
...
@@ -5685,7 +5685,7 @@ static void
not_a_character_stream
(
cl_object
s
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~A is not a character stream"
,
-
1
),
@
"~A is not a character stream"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
s
),
@
'
:
expected
-
type
'
,
@
'
character
'
,
@
'
:
datum
'
,
cl_stream_element_type
(
s
));
...
...
@@ -5695,7 +5695,7 @@ static void
not_a_binary_stream
(
cl_object
s
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~A is not a binary stream"
,
-
1
),
@
"~A is not a binary stream"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
s
),
@
'
:
expected
-
type
'
,
@
'
integer
'
,
@
'
:
datum
'
,
cl_stream_element_type
(
s
));
...
...
@@ -5719,7 +5719,7 @@ file_libc_error(cl_object error_type, cl_object stream,
ecl_va_end
(
args
);
si_signal_simple_error
(
4
,
(
cl_object
)(
cl_symbols
+
ecl_fixnum
(
error_type
)),
ECL_NIL
,
ecl_make_constant_base_string
(
"~?~%C library explanation: ~A."
,
-
1
),
@
"~?~%C library explanation: ~A."
,
cl_list
(
3
,
ecl_make_constant_base_string
(
msg
,-
1
),
rest
,
error
));
_ecl_unexpected_return
();
...
...
@@ -5862,7 +5862,7 @@ init_file(void)
flags
=
ECL_STREAM_DEFAULT_FORMAT
;
#
endif
null_stream
=
ecl_make_stream_from_FILE
(
ecl_make_constant_base_string
(
"/dev/null"
,
-
1
),
null_stream
=
ecl_make_stream_from_FILE
(
@
"/dev/null"
,
NULL
,
ecl_smm_io
,
8
,
flags
,
external_format
);
generic_close
(
null_stream
);
null_stream
=
cl_make_two_way_stream
(
null_stream
,
cl_make_broadcast_stream
(
0
));
...
...
@@ -5871,20 +5871,20 @@ init_file(void)
/* We choose C streams by default only when _not_ using threads.
* The reason is that C streams block on I/O operations. */
#
if
!
defined
(
ECL_THREADS
)
standard_input
=
maybe_make_windows_console_FILE
(
ecl_make_constant_base_string
(
"stdin"
,
-
1
),
standard_input
=
maybe_make_windows_console_FILE
(
@
"stdin"
,
stdin
,
ecl_smm_input
,
8
,
flags
,
external_format
);
standard_output
=
maybe_make_windows_console_FILE
(
ecl_make_constant_base_string
(
"stdout"
,
-
1
),
standard_output
=
maybe_make_windows_console_FILE
(
@
"stdout"
,
stdout
,
ecl_smm_output
,
8
,
flags
,
external_format
);
error_output
=
maybe_make_windows_console_FILE
(
ecl_make_constant_base_string
(
"stderr"
,
-
1
),
error_output
=
maybe_make_windows_console_FILE
(
@
"stderr"
,
stderr
,
ecl_smm_output
,
8
,
flags
,
external_format
);
#
else
standard_input
=
maybe_make_windows_console_fd
(
ecl_make_constant_base_string
(
"stdin"
,
-
1
),
standard_input
=
maybe_make_windows_console_fd
(
@
"stdin"
,
STDIN_FILENO
,
ecl_smm_input_file
,
8
,
flags
,
external_format
);
standard_output
=
maybe_make_windows_console_fd
(
ecl_make_constant_base_string
(
"stdout"
,
-
1
),
standard_output
=
maybe_make_windows_console_fd
(
@
"stdout"
,
STDOUT_FILENO
,
ecl_smm_output_file
,
8
,
flags
,
external_format
);
error_output
=
maybe_make_windows_console_fd
(
ecl_make_constant_base_string
(
"stderr"
,
-
1
),
error_output
=
maybe_make_windows_console_fd
(
@
"stderr"
,
STDERR_FILENO
,
ecl_smm_output_file
,
8
,
flags
,
external_format
);
#
endif
...
...
src/c/format.d
View file @
36a9c95c
...
...
@@ -2201,7 +2201,7 @@ format(format_stack fmt, cl_index start, cl_index end)
if
(!
ECL_ARRAY_HAS_FILL_POINTER_P
(
output
))
{
cl_error
(
7
,
@
'
si
::
format
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Cannot output to a non adjustable string."
,
-
1
),
@
"Cannot output to a non adjustable string."
,
@
'
:
control
-
string
'
,
string
,
@
'
:
offset
'
,
ecl_make_fixnum
(
0
));
}
...
...
src/c/load.d
View file @
36a9c95c
...
...
@@ -52,7 +52,7 @@ si_load_binary(cl_object filename, cl_object verbose,
prefix
=
@si
::
base
-
string
-
concatenate
(
3
,
init_prefix
,
prefix
,
ecl_make_constant_base_string
(
"_"
,-
1
)
);
@
"_"
);
}
basename
=
cl_pathname_name
(
1
,
filename
);
basename
=
@si
::
base
-
string
-
concatenate
(
2
,
prefix
,
@string
-
upcase
(
1
,
funcall
(
4
,
@
'
nsubstitute
'
,
ECL_CODE_CHAR
(
'_'
),
ECL_CODE_CHAR
(
'-'
),
basename
)));
...
...
@@ -263,7 +263,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
}
NOT_A_FILENAME
:
if
(
verbose
!=
ECL_NIL
)
{
cl_format
(
3
,
ECL_T
,
ecl_make_constant_base_string
(
"~&;;; Loading ~s~%"
,
-
1
),
cl_format
(
3
,
ECL_T
,
@
"~&;;; Loading ~s~%"
,
filename
);
}
ecl_bds_bind
(
the_env
,
@
'
*
package
*
'
,
ecl_symbol_value
(
@
'
*
package
*
'
));
...
...
@@ -297,7 +297,7 @@ si_load_bytecodes(cl_object source, cl_object verbose, cl_object print, cl_objec
FEerror
(
"LOAD: Could not load file ~S (Error: ~S)"
,
2
,
filename
,
ok
);
if
(
print
!=
ECL_NIL
)
{
cl_format
(
3
,
ECL_T
,
ecl_make_constant_base_string
(
"~&;;; Loading ~s~%"
,
-
1
),
cl_format
(
3
,
ECL_T
,
@
"~&;;; Loading ~s~%"
,
filename
);
}
@
(
return
filename
);
...
...
src/c/main.d
View file @
36a9c95c
...
...
@@ -887,7 +887,7 @@ si_setenv(cl_object var, cl_object value)
ret_val
=
setenv
((
char
*)
var
->
base_string
.
self
,
(
char
*)
value
->
base_string
.
self
,
1
);
#
else
value
=
cl_format
(
4
,
ECL_NIL
,
ecl_make_constant_base_string
(
"~A=~A"
,
-
1
),
var
,
value
=
cl_format
(
4
,
ECL_NIL
,
@
"~A=~A"
,
var
,
value
);
value
=
si_copy_to_simple_base_string
(
value
);
putenv
((
char
*)
value
->
base_string
.
self
);
...
...
src/c/pathname.d
View file @
36a9c95c
...
...
@@ -777,7 +777,7 @@ cl_logical_pathname(cl_object x)
x
=
cl_pathname
(
x
);
if
(!
x
->
pathname
.
logical
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~S cannot be coerced to a logical pathname."
,
-
1
),
@
"~S cannot be coerced to a logical pathname."
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
x
),
@
'
:
expected
-
type
'
,
@
'
logical
-
pathname
'
,
@
'
:
datum
'
,
x
);
...
...
src/c/read.d
View file @
36a9c95c
...
...
@@ -1791,7 +1791,7 @@ static void
error_locked_readtable
(
cl_object
r
)
{
cl_error
(
2
,
ecl_make_constant_base_string
(
"Cannot modify locked readtable ~A."
,
-
1
),
@
"Cannot modify locked readtable ~A."
,
r
);
}
...
...
src/c/stacks.d
View file @
36a9c95c
...
...
@@ -98,7 +98,7 @@ ecl_cs_overflow(void)
ecl_unrecoverable_error
(
env
,
stack_overflow_msg
);
if
(
env
->
cs_max_size
==
(
cl_index
)
0
||
env
->
cs_size
<
env
->
cs_max_size
)
si_serror
(
6
,
ecl_make_constant_base_string
(
"Extend stack size"
,
-
1
),
si_serror
(
6
,
@
"Extend stack size"
,
@
'
ext
::
stack
-
overflow
'
,
@
'
:
size
'
,
ecl_make_fixnum
(
size
),
@
'
:
type
'
,
@
'
ext
::
c
-
stack
'
);
...
...
@@ -184,7 +184,7 @@ ecl_bds_overflow(void)
ecl_unrecoverable_error
(
env
,
stack_overflow_msg
);
}
env
->
bds_limit
+=
margin
;
si_serror
(
6
,
ecl_make_constant_base_string
(
"Extend stack size"
,
-
1
),
si_serror
(
6
,
@
"Extend stack size"
,
@
'
ext
::
stack
-
overflow
'
,
@
'
:
size
'
,
ecl_make_fixnum
(
size
),
@
'
:
type
'
,
@
'
ext
::
binding
-
stack
'
);
ecl_bds_set_size
(
env
,
size
+
(
size
/
2
));
...
...
@@ -528,7 +528,7 @@ frs_overflow(void) /* used as condition in list.d */
ecl_unrecoverable_error
(
env
,
stack_overflow_msg
);
}
env
->
frs_limit
+=
margin
;
si_serror
(
6
,
ecl_make_constant_base_string
(
"Extend stack size"
,
-
1
),
si_serror
(
6
,
@
"Extend stack size"
,
@
'
ext
::
stack
-
overflow
'
,
@
'
:
size
'
,
ecl_make_fixnum
(
size
),
@
'
:
type
'
,
@
'
ext
::
frame
-
stack
'
);
frs_set_size
(
env
,
size
+
size
/
2
);
...
...
src/c/symbol.d
View file @
36a9c95c
...
...
@@ -160,7 +160,7 @@ static void
FEtype_error_plist
(
cl_object
x
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Not a valid property list ~D"
,
-
1
),
@
"Not a valid property list ~D"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
x
),
@
'
:
expected
-
type
'
,
@
'
si
::
property
-
list
'
,
@
'
:
datum
'
,
x
);
...
...
src/c/time.d
View file @
36a9c95c
...
...
@@ -181,7 +181,7 @@ cl_sleep(cl_object z)
/* INV: ecl_minusp() makes sure `z' is real */
if
(
ecl_minusp
(
z
))
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Not a non-negative number ~S"
,
-
1
),
@
"Not a non-negative number ~S"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
z
),
@
'
:
expected
-
type
'
,
@
'
real
'
,
@
'
:
datum
'
,
z
);
/* Compute time without overflows */
...
...
src/c/typespec.d
View file @
36a9c95c
...
...
@@ -39,7 +39,7 @@ FEtype_error_list(cl_object x) {
void
FEtype_error_proper_list
(
cl_object
x
)
{
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Not a proper list ~D"
,
-
1
),
@
"Not a proper list ~D"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
x
),
@
'
:
expected
-
type
'
,
ecl_read_from_cstring
(
"si::proper-list"
),
@
'
:
datum
'
,
x
);
...
...
@@ -51,7 +51,7 @@ FEcircular_list(cl_object x)
/* FIXME: Is this the right way to rebind it? */
ecl_bds_bind
(
ecl_process_env
(),
@
'
*
print
-
circle
*
'
,
ECL_T
);
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"Circular list ~D"
,
-
1
),
@
"Circular list ~D"
,
@
'
:
format
-
arguments
'
,
cl_list
(
1
,
x
),
@
'
:
expected
-
type
'
,
@
'
list
'
,
@
'
:
datum
'
,
x
);
...
...
@@ -63,7 +63,7 @@ FEtype_error_index(cl_object seq, cl_fixnum ndx)
cl_object
n
=
ecl_make_fixnum
(
ndx
);
cl_index
l
=
ECL_INSTANCEP
(
seq
)?
seq
->
instance
.
length
:
ecl_length
(
seq
);
cl_error
(
9
,
@
'
simple
-
type
-
error
'
,
@
'
:
format
-
control
'
,
ecl_make_constant_base_string
(
"~S is not a valid index into the object ~S"
,
-
1
),
@
"~S is not a valid index into the object ~S"
,
@
'
:
format
-
arguments
'
,
cl_list
(
2
,
n
,
seq
),
@
'
:
expected
-
type
'
,
cl_list
(
3
,
@
'
integer
'
,
ecl_make_fixnum
(
0
),
ecl_make_fixnum
(
l
-
1
)),
@
'
:
datum
'
,
n
);
...
...
src/c/unixfsys.d
View file @
36a9c95c
...
...
@@ -253,7 +253,7 @@ enter_directory(cl_object base_dir, cl_object subdir, bool ignore_if_failure)
/* Nothing to do */
return
base_dir
;
}
else
if
(
subdir
==
@
'
:
up
'
)
{
aux
=
ecl_make_constant_base_string
(
".."
,-
1
)
;
aux
=
@
".."
;
}
else
if
(!
ECL_BASE_STRING_P
(
subdir
))
{
unlikely_if
(!
ecl_fits_in_base_string
(
subdir
))
FEerror
(
"Directory component ~S found in pathname~& ~S"
...
...
@@ -369,8 +369,7 @@ file_truename(cl_object pathname, cl_object filename, int flags)
if
(
pathname
->
pathname
.
name
!=
ECL_NIL
||
pathname
->
pathname
.
type
!=
ECL_NIL
)
{
pathname
=
si_base_string_concatenate
(
2
,
filename
,
ecl_make_constant_base_string
(
"/"
,-
1
));
(
2
,
filename
,
@
"/"
);
pathname
=
cl_truename
(
pathname
);
}
}
...
...
@@ -664,7 +663,7 @@ cl_file_author(cl_object file)
output
=
ecl_make_simple_base_string
(
pwent
->
pw_name
,-
1
);
}
#
else
output
=
ecl_make_constant_base_string
(
"UNKNOWN"
,-
1
)
;
output
=
@
"UNKNOWN"
;
#
endif
@
(
return
output
);
}
...
...
@@ -711,7 +710,7 @@ ecl_homedir_pathname(cl_object user)
ecl_make_constant_base_string
(
h
,-
1
));
#
endif
}
else
{
namestring
=
ecl_make_constant_base_string
(
"/"
,-
1
)
;
namestring
=
@
"/"
;
}
if
(
namestring
->
base_string
.
self
[
0
]
==
'~'
)
{
FEerror
(
"Not a valid home pathname ~S"
,
1
,
namestring
);
...
...
@@ -804,7 +803,7 @@ list_directory(cl_object base_dir, cl_object text_mask, cl_object pathname_mask,
ecl_disable_interrupts
();
for
(;;)
{
if
(
hFind
==
NULL
)
{
cl_object
aux
=
ecl_make_constant_base_string
(
".\\*"
,-
1
)
;
cl_object
aux
=
@
".\\*"
;
cl_object
mask
=
si_base_string_concatenate
(
2
,
prefix
,
aux
);
hFind
=
FindFirstFile
((
char
*)
mask
->
base_string
.
self
,
&
fd
);
if
(
hFind
==
INVALID_HANDLE_VALUE
)
{
...
...
src/c/unixsys.d
View file @
36a9c95c
...
...
@@ -304,7 +304,7 @@ create_descriptor(cl_object stream, cl_object direction,
HANDLE
stream_handle
=
ecl_stream_to_HANDLE
(
stream
,
direction
!=
@
'
:
input
'
);
if
(
stream_handle
==
INVALID_HANDLE_VALUE
)
{
CEerror
(
ecl_make_constant_base_string
(
"Create a new stream."
,
-
1
),
CEerror
(
@
"Create a new stream."
,
"~S argument to RUN-PROGRAM does not have a file handle:~%~S"
,
2
,
direction
,
stream
);
create_descriptor
(
@
'
:
stream
'
,
direction
,
child
,
parent
);
...
...
@@ -342,7 +342,7 @@ create_descriptor(cl_object stream, cl_object direction,
if
(*
child
>=
0
)
{
*
child
=
dup
(*
child
);
}
else
{
CEerror
(
ecl_make_constant_base_string
(
"Create a new stream."
,
-
1
),
CEerror
(
@
"Create a new stream."
,
"~S argument to RUN-PROGRAM does not have a file handle:~%~S"
,
2
,
direction
,
stream
);
create_descriptor
(
@
'
:
stream
'
,
direction
,
child
,
parent
);
...
...
@@ -367,7 +367,7 @@ si_run_program_inner(cl_object command, cl_object argv, cl_object environ, cl_ob
#
if
defined
(
ECL_MS_WINDOWS_HOST
)
argv
=
cl_format
(
4
,
ECL_NIL
,
ecl_make_constant_base_string
(
"~A~{ ~A~}"
,
-
1
),
@
"~A~{ ~A~}"
,
command
,
argv
);
argv
=
si_copy_to_simple_base_string
(
argv
);
#
else
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment