added Integer>>priorTo:do:by:

changed the index of Integer>>bitAt: and stix_bitatint() to be 0 based.
added Error>>asCharacter
allowed underscores in integer literals
This commit is contained in:
hyunghwan.chung 2016-12-28 13:42:12 +00:00
parent d03b97f19d
commit eea13c0bd2
13 changed files with 216 additions and 113 deletions

View File

@ -151,8 +151,8 @@
#method == anObject
{
"check if the receiver is identical to anObject.
this doesn't compare the contents"
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
}
@ -164,8 +164,8 @@
#method(#class) == anObject
{
"check if the receiver is identical to anObject.
this doesn't compare the contents"
(* check if the receiver is identical to anObject.
* this doesn't compare the contents *)
<primitive: #_identical>
}
@ -234,10 +234,10 @@
#method(#class) isMemberOf: aClass
{
## a class object is an instance of Class
## but Class inherits from Apex. On the other hand,
## most of ordinary classes are under Object again under Apex.
## special consideration is required here.
(* a class object is an instance of Class
* but Class inherits from Apex. On the other hand,
* most of ordinary classes are under Object again under Apex.
* special consideration is required here. *)
^aClass == Class
}
@ -362,6 +362,11 @@
{
<primitive: #_error_as_integer>
}
#method asCharacter
{
<primitive: #_error_as_character>
}
#method asString
{

View File

@ -3,8 +3,6 @@
#include 'Boolean.st'.
#########################################################################################
#class Magnitude(Object)
{
}
@ -70,7 +68,6 @@
self primitiveFailed.
}
#method // aNumber
{
<primitive: #_integer_quo2>
@ -127,9 +124,8 @@
#method bitAt: index
{
"## index is 1-based"
<primitive: #_integer_bitat>
^(self bitShift: (index - 1) negated) bitAnd: 1.
^(self bitShift: index negated) bitAnd: 1.
}
#method bitAnd: aNumber
@ -176,7 +172,6 @@
#method to: end by: step do: aBlock
{
| i |
i := self.
(step > 0)
ifTrue: [
@ -197,6 +192,30 @@
{
^self to: end by: 1 do: aBlock.
}
#method priorTo: end by: step do: aBlock
{
| i |
i := self.
(step > 0)
ifTrue: [
[ i < end ] whileTrue: [
aBlock value: i.
i := i + step.
].
]
ifFalse: [
[ i > end ] whileTrue: [
aBlock value: i.
i := i - step.
].
].
}
#method priorTo: end do: aBlock
{
^self priorTo: end by: 1 do: aBlock.
}
#method abs
{
@ -210,10 +229,8 @@
self > 0 ifTrue: [^1].
^0.
}
}
#class Integer(Number)
{
#method timesRepeat: aBlock
@ -260,6 +277,7 @@
}
}
#########################################################################################
#include 'Collect.st'.
@ -293,10 +311,6 @@
#include 'Except.st'.
#include 'Process.st'.
#class Resource(Object)
{
}
#class FFI(Object)
{
#dcl name handle funcs.
@ -314,9 +328,9 @@
self.handle := self privateOpen: self.name.
"[ self.handle := self privateOpen: self.name ]
on: Error do: [
on: Exception do: [
]
on: XError do: [
on: XException do: [
]."
^self.
@ -372,4 +386,4 @@ f isNil ifTrue: [ self error: 'No such function' ].
#########################################################################################
#include 'Stdio.st'.
#include 'Console.st'.
#include 'Console.st'.

View File

@ -2,7 +2,6 @@
#class MyObject(Object)
{
#method(#class) main
{
| s c f |
@ -56,7 +55,7 @@
f puts: S'e'.
f puts: (i asString).
(i = c) ifFalse: [f puts: S',' ].
(((i + 1) rem: 8) = 0) ifTrue: [ f putc: C'\n' ] ifFalse: [ f putc: C' ' ].
(((i + 1) rem: 8) = 0) ifTrue: [ f putc: C'\n' ] ifFalse: [ f putc: C' ' ].
].
(((c + 1) rem: 8) = 0) ifFalse: [ f putc: C'\n' ].
f puts: S'};\n'.

View File

@ -125,14 +125,14 @@
##v1 := Stdio2 open: '/tmp/1.txt' for: 'w+'.
v1 := Stdio2 new open: '/tmp/x/1.txt' for: 'w+'.
v1 := Stdio2 new open: '/tmp/1.txt' for: 'w+'.
(v1 isError)
ifTrue: [
System logNl: ('Error in opening a file....' & v1 asString).
]
ifFalse: [
## v1 puts: 'hello'.
v1 puts ('hello', 'world', 'good', C'\n', C'\t', 'under my umbrella.', C'\n').
v1 puts ('hello', 'world', 'good', C'\n', C'\t', 'under my umbrella 123.', C'\n').
v1 close.
(*v1 format(10, 20) isNil ifFalse: [
@ -147,6 +147,43 @@
self varg_test3 (10, 20, 30, 40, 50) dump.
thisContext vargCount dump.
thisContext vargCount dump.
((2305843009213693951 bitAt: 61) = 0) ifFalse: [
System logNl: 'Test 1 failed'.
thisProcess terminate
].
((-2305843009213693951 bitAt: 62) = 1) ifFalse: [
System logNl: 'Test 2 failed'.
thisProcess terminate
].
((2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 120) = 0) ifFalse: [
System logNl: 'Test 3 failed'.
thisProcess terminate
].
((-2r1000000000000000000000000000100000000000000000000000000000000000000000000000 bitAt: 16rFFFFFFFFFFFFFFFF0) = 1) ifFalse: [
System logNl: 'Test 4 failed'.
thisProcess terminate
].
0 priorTo: 200 do: [:i |
| k |
k := 1 bitShift: i.
## (k printStringRadix: 2) dump.
((k bitAt: i) = 1) ifFalse: [
System logNl: 'Test 5 failed'.
thisProcess terminate.
].
((k bitAt: i - 1) = 0) ifFalse: [
System logNl: 'Test 6 failed'.
thisProcess terminate.
].
].
2r100000000_10001111_01010000 dump.
16rFFFFFFFF_12345678 dump.
}
#method(#class) varg_test()
@ -171,6 +208,17 @@
## ^b * 100
^f
}
#method t001(a)
{
a isNil ifTrue: [^E'1'].
(a = 20) ifTrue: [^error].
(a = 10) ifTrue: [^10].
^a.
a := error(10).
[ a = error(10) ] ifTrue: [....].
}
}
#extend MyObject

View File

@ -2144,7 +2144,7 @@ oops_einval:
stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
{
/* y is 1-based */
/* y is 0-based */
if (STIX_OOP_IS_SMOOI(x) && STIX_OOP_IS_SMOOI(y))
{
@ -2153,16 +2153,18 @@ stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
v1 = STIX_OOP_TO_SMOOI(x);
v2 = STIX_OOP_TO_SMOOI(y);
if (v2 <= 0) return STIX_SMOOI_TO_OOP(0);
if (v2 < 0) return STIX_SMOOI_TO_OOP(0);
if (v1 >= 0)
{
if (v2 >= STIX_SMOOI_BITS) return STIX_SMOOI_TO_OOP(0);
v3 = ((stix_oow_t)v1 >> (v2 - 1)) & 1;
/* the absolute value may be composed of up to
* STIX_SMOOI_BITS - 1 bits as there is a sign bit.*/
if (v2 >= STIX_SMOOI_BITS - 1) return STIX_SMOOI_TO_OOP(0);
v3 = ((stix_oow_t)v1 >> v2) & 1;
}
else
{
if (v2 >= STIX_SMOOI_BITS) return STIX_SMOOI_TO_OOP(1);
v3 = ((~(stix_oow_t)-v1 + 1) >> (v2 - 1)) & 1;
if (v2 >= STIX_SMOOI_BITS - 1) return STIX_SMOOI_TO_OOP(1);
v3 = ((~(stix_oow_t)-v1 + 1) >> v2) & 1;
}
return STIX_SMOOI_TO_OOP(v3);
}
@ -2171,6 +2173,7 @@ stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
if (!is_bigint(stix, y)) goto oops_einval;
if (STIX_OBJ_GET_CLASS(y) == stix->_large_negative_integer) return STIX_SMOOI_TO_OOP(0);
/* y is definitely >= STIX_SMOOI_BITS */
if (STIX_OOP_TO_SMOOI(x) >= 0)
return STIX_SMOOI_TO_OOP(0);
@ -2185,9 +2188,9 @@ stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
if (!is_bigint(stix, x)) goto oops_einval;
v = STIX_OOP_TO_SMOOI(y);
if (v <= 0) return STIX_SMOOI_TO_OOP(0);
wp = (v - 1) / STIX_LIW_BITS;
bp = (v - 1) - (wp * STIX_LIW_BITS);
if (v < 0) return STIX_SMOOI_TO_OOP(0);
wp = v / STIX_LIW_BITS;
bp = v - (wp * STIX_LIW_BITS);
xs = STIX_OBJ_GET_SIZE(x);
if (STIX_OBJ_GET_CLASS(x) == stix->_large_positive_integer)
@ -2246,8 +2249,8 @@ stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
STIX_ASSERT (stix, sign >= 0);
if (sign >= 1)
{
wp = (w - 1) / STIX_LIW_BITS;
bp = (w - 1) - (wp * STIX_LIW_BITS);
wp = w / STIX_LIW_BITS;
bp = w - (wp * STIX_LIW_BITS);
}
else
{
@ -2255,11 +2258,6 @@ stix_oop_t stix_bitatint (stix_t* stix, stix_oop_t x, stix_oop_t y)
STIX_ASSERT (stix, sign == 0);
stix_pushtmp (stix, &x);
y = stix_subints (stix, y, STIX_SMOOI_TO_OOP(1));
stix_poptmp (stix);
if (!y) return STIX_NULL;
stix_pushtmp (stix, &x);
quo = stix_divints (stix, y, STIX_SMOOI_TO_OOP(STIX_LIW_BITS), 0, &rem);
stix_poptmp (stix);

View File

@ -195,18 +195,18 @@ static STIX_INLINE int is_binselchar (stix_ooci_t c)
{
/*
* binary-selector-character :=
* '!' | '%' | '&' | '*' | '+' |
* '/' | '<' | '>' | '=' | '?' | '@' |
* '\' | '~' | '|' | '-'
* '%' | '&' | '*' | '+' | '-' |
* '/' | '<' | '>' | '=' | '?' |
* '@' | '\' | '~' | '|'
*/
switch (c)
{
case '!':
case '%':
case '&':
case '*':
case '+':
case '-':
case '/':
case '<':
case '>':
@ -216,7 +216,6 @@ static STIX_INLINE int is_binselchar (stix_ooci_t c)
case '\\':
case '|':
case '~':
case '-':
return 1;
default:
@ -894,6 +893,10 @@ static int get_ident (stix_t* stix, stix_ooci_t char_read_ahead)
{
SET_TOKEN_TYPE (stix, STIX_IOTOK_FALSE);
}
else if (is_token_word(stix, VOCA_ERROR))
{
SET_TOKEN_TYPE (stix, STIX_IOTOK_ERRLIT);
}
else if (is_token_word(stix, VOCA_THIS_CONTEXT))
{
SET_TOKEN_TYPE (stix, STIX_IOTOK_THIS_CONTEXT);
@ -929,6 +932,7 @@ static int get_numlit (stix_t* stix, int negated)
stix_ooci_t c;
int radix = 0, r;
c = stix->c->lxc.c;
SET_TOKEN_TYPE (stix, STIX_IOTOK_NUMLIT);
@ -946,6 +950,19 @@ static int get_numlit (stix_t* stix, int negated)
ADD_TOKEN_CHAR(stix, c);
GET_CHAR_TO (stix, c);
if (c == '_')
{
stix_iolxc_t underscore;
underscore = stix->c->lxc;
GET_CHAR_TO(stix, c);
if (!is_digitchar(c))
{
unget_char (stix, &stix->c->lxc);
unget_char (stix, &underscore);
break;
}
else continue;
}
}
while (is_digitchar(c));
@ -974,6 +991,19 @@ static int get_numlit (stix_t* stix, int negated)
{
ADD_TOKEN_CHAR(stix, c);
GET_CHAR_TO (stix, c);
if (c == '_')
{
stix_iolxc_t underscore;
underscore = stix->c->lxc;
GET_CHAR_TO(stix, c);
if (CHAR_TO_NUM(c, radix) >= radix)
{
unget_char (stix, &stix->c->lxc);
unget_char (stix, &underscore);
break;
}
else continue;
}
}
while (CHAR_TO_NUM(c, radix) < radix);
@ -3492,6 +3522,11 @@ static int __read_array_literal (stix_t* stix, stix_oop_t* xlit)
lit = stix->_false;
break;
case STIX_IOTOK_ERRLIT:
/* AAAAAAAAA */
lit = string_to_num (stix, TOKEN_NAME(stix), TOKEN_TYPE(stix) == STIX_IOTOK_RADNUMLIT);
break;
case STIX_IOTOK_ARPAREN: /* #( */
case STIX_IOTOK_LPAREN: /* ( */
saved_arlit_count = stix->c->mth.arlit_count;
@ -3707,6 +3742,10 @@ static int compile_expression_primary (stix_t* stix, const stix_oocs_t* ident, c
GET_TOKEN (stix);
break;
case STIX_IOTOK_ERRLIT:
/* AAAAAA */
break;
case STIX_IOTOK_THIS_CONTEXT:
if (emit_byte_instruction(stix, BCODE_PUSH_CONTEXT) <= -1) return -1;
GET_TOKEN (stix);
@ -5248,6 +5287,10 @@ static int __compile_pooldic_definition (stix_t* stix)
lit = stix->_false;
goto add_literal;
case STIX_IOTOK_ERRLIT:
/* AAAAAAAAAAAA */
goto add_literal;
case STIX_IOTOK_CHARLIT:
STIX_ASSERT (stix, TOKEN_NAME_LEN(stix) == 1);
lit = STIX_CHAR_TO_OOP(TOKEN_NAME_PTR(stix)[0]);

View File

@ -2409,6 +2409,22 @@ static int pf_integer_inttostr (stix_t* stix, stix_ooi_t nargs)
return 1;
}
static int pf_error_as_character (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv;
stix_ooi_t ec;
STIX_ASSERT (stix, nargs == 0);
rcv = STIX_STACK_GETRCV(stix, nargs);
if (!STIX_OOP_IS_ERROR(rcv)) return 0;
ec = STIX_OOP_TO_ERROR(rcv);
STIX_ASSERT (stix, STIX_IN_SMOOI_RANGE(ec));
STIX_STACK_SETRET (stix, nargs, STIX_CHAR_TO_OOP(ec));
return 1;
}
static int pf_error_as_integer (stix_t* stix, stix_ooi_t nargs)
{
stix_oop_t rcv;
@ -2800,6 +2816,7 @@ static pf_t pftab[] =
{ 1, 1, pf_integer_ge, "_integer_ge" },
{ 1, 1, pf_integer_inttostr, "_integer_inttostr" },
{ 0, 0, pf_error_as_character, "_error_as_character" },
{ 0, 0, pf_error_as_integer, "_error_as_integer" },
{ 0, 0, pf_error_as_string, "_error_as_string" },

View File

@ -318,7 +318,7 @@ static void print_object (stix_t* stix, stix_oow_t mask, stix_oop_t oop)
}
else if (STIX_OOP_IS_ERROR(oop))
{
stix_logbfmt (stix, mask, "E%08zd", STIX_OOP_TO_ERROR(oop));
stix_logbfmt (stix, mask, "error(%zd)", STIX_OOP_TO_ERROR(oop));
}
else
{

View File

@ -131,6 +131,25 @@ static stix_mmgr_t sys_mmgr =
/* ========================================================================= */
#if defined(_WIN32) || defined(__OS2__) || defined(__DOS__)
# define IS_PATH_SEP(c) ((c) == '/' || (c) == '\\')
#else
# define IS_PATH_SEP(c) ((c) == '/')
#endif
static const stix_bch_t* get_base_name (const stix_bch_t* path)
{
const stix_bch_t* p, * last = STIX_NULL;
for (p = path; *p != '\0'; p++)
{
if (IS_PATH_SEP(*p)) last = p;
}
return (last == STIX_NULL)? path: (last + 1);
}
static STIX_INLINE stix_ooi_t open_input (stix_t* stix, stix_ioarg_t* arg)
{
xtn_t* xtn = stix_getxtn(stix);
@ -140,18 +159,19 @@ static STIX_INLINE stix_ooi_t open_input (stix_t* stix, stix_ioarg_t* arg)
if (arg->includer)
{
/* includee */
stix_bch_t bcs[1024]; /* TODO: right buffer size */
stix_oow_t bcslen = STIX_COUNTOF(bcs);
stix_oow_t ucslen;
if (stix_convootobcstr (stix, arg->name, &ucslen, bcs, &bcslen) <= -1)
{
{
stix_seterrnum (stix, STIX_EECERR);
return -1;
}
/* TODO: make bcs relative to the includer */
#if defined(__MSDOS__) || defined(_WIN32) || defined(__OS2__)
fp = fopen (bcs, "rb");
#else

View File

@ -316,6 +316,7 @@ struct stix_iotok_t
enum
{
STIX_IOTOK_EOF,
STIX_IOTOK_ERRLIT,
STIX_IOTOK_CHARLIT,
STIX_IOTOK_STRLIT,
STIX_IOTOK_SYMLIT,

View File

@ -195,37 +195,6 @@ void stix_fini (stix_t* stix)
}
}
stix_mmgr_t* stix_getmmgr (stix_t* stix)
{
return stix->mmgr;
}
stix_cmgr_t* stix_getcmgr (stix_t* stix)
{
return stix->cmgr;
}
void stix_setcmgr (stix_t* stix, stix_cmgr_t* cmgr)
{
stix->cmgr = cmgr;
}
void* stix_getxtn (stix_t* stix)
{
return (void*)(stix + 1);
}
stix_errnum_t stix_geterrnum (stix_t* stix)
{
return stix->errnum;
}
void stix_seterrnum (stix_t* stix, stix_errnum_t errnum)
{
stix->errnum = errnum;
}
const stix_ooch_t* stix_geterrstr (stix_t* stix)
{
return stix_errnumtoerrstr (stix->errnum);

View File

@ -217,7 +217,7 @@ typedef enum stix_method_type_t stix_method_type_t;
/* SMOOI takes up 62 bits on a 64-bit architecture and 30 bits
* on a 32-bit architecture. The absolute value takes up 61 bits and 29 bits
* respectively for the 1 sign bit. */
* respectively for the sign bit. */
#define STIX_SMOOI_BITS (STIX_OOI_BITS - STIX_OOP_TAG_BITS)
#define STIX_SMOOI_ABS_BITS (STIX_SMOOI_BITS - 1)
#define STIX_SMOOI_MAX ((stix_ooi_t)(~((stix_oow_t)0) >> (STIX_OOP_TAG_BITS + 1)))
@ -476,7 +476,6 @@ struct stix_method_t
/* primitive number */
stix_oop_t preamble; /* SmallInteger */
stix_oop_t preamble_data[2]; /* SmallInteger */
/* number of temporaries including arguments */
@ -968,7 +967,6 @@ struct stix_t
#define STIX_STACK_SETRETTOERROR(stix,nargs) STIX_STACK_SETRET(stix, nargs, STIX_ERROR_TO_OOP(stix->errnum))
/*#define STIX_STACK_SETRETTOERROR(stix,nargs,ec) STIX_STACK_SETRET(stix, nargs, STIX_ERROR_TO_OOP(ec))*/
/* =========================================================================
* STIX VM LOGGING
* ========================================================================= */
@ -1056,33 +1054,25 @@ STIX_EXPORT void stix_fini (
stix_t* stix
);
#if defined(STIX_HAVE_INLINE)
static STIX_INLINE stix_mmgr_t* stix_getmmgr (stix_t* stix) { return stix->mmgr; }
static STIX_INLINE void* stix_getxtn (stix_t* stix) { return (void*)(stix + 1); }
STIX_EXPORT stix_mmgr_t* stix_getmmgr (
stix_t* stix
);
static STIX_INLINE stix_cmgr_t* stix_getcmgr (stix_t* stix) { return stix->cmgr; }
static STIX_INLINE void stix_setcmgr (stix_t* stix, stix_cmgr_t* cmgr) { stix->cmgr = cmgr; }
STIX_EXPORT stix_cmgr_t* stix_getcmgr (
stix_t* stix
);
static STIX_INLINE stix_errnum_t stix_geterrnum (stix_t* stix) { return stix->errnum; }
static STIX_INLINE void stix_seterrnum (stix_t* stix, stix_errnum_t errnum) { stix->errnum = errnum; }
#else
# define stix_getmmgr(stix) ((stix)->mmgr)
# define stix_getxtn(stix) ((void*)((stix) + 1))
STIX_EXPORT void stix_setcmgr (
stix_t* stix,
stix_cmgr_t* cmgr
);
# define stix_getcmgr(stix) ((stix)->cmgr)
# define stix_setcmgr(stix,mgr) ((stix)->cmgr = (mgr))
STIX_EXPORT void* stix_getxtn (
stix_t* stix
);
STIX_EXPORT stix_errnum_t stix_geterrnum (
stix_t* stix
);
STIX_EXPORT void stix_seterrnum (
stix_t* stix,
stix_errnum_t errnum
);
# define stix_geterrnum(stix) ((stix)->errnum)
# define stix_seterrnum(stix,num) ((stix)->errnum = (num))
#endif
STIX_EXPORT const stix_ooch_t* stix_geterrstr (
stix_t* stix
@ -1240,7 +1230,6 @@ STIX_EXPORT int stix_genpfmethod (
# define stix_convootobcstr(stix,oocs,oocslen,bcs,bcslen) stix_convutobcstr(stix,oocs,oocslen,bcs,bcslen)
# define stix_convbtooocstr(stix,bcs,bcslen,oocs,oocslen) stix_convbtoucstr(stix,bcs,bcslen,oocs,oocslen)
#else
#error TODO
# define stix_convootobchars(stix,oocs,oocslen,bcs,bcslen) stix_convutobchars(stix,oocs,oocslen,bcs,bcslen)
# define stix_convbtooochars(stix,bcs,bcslen,oocs,oocslen) stix_convbtouchars(stix,bcs,bcslen,oocs,oocslen)
# define stix_convootobcstr(stix,oocs,oocslen,bcs,bcslen) stix_convutobcstr(stix,oocs,oocslen,bcs,bcslen)

View File

@ -79,12 +79,10 @@ static int pf_open (stix_t* stix, stix_ooi_t nargs)
#endif
if (!rcv->fp)
{
STIX_DEBUG2 (stix, "cannot open %s for %s\n", namebuf, modebuf);
stix_seterrnum (stix, stix_syserrtoerrnum(errno));
goto reterr;
}
STIX_DEBUG3 (stix, "opened %s for %s - %p\n", namebuf, modebuf, rcv->fp);
STIX_STACK_SETRETTORCV (stix, nargs);
return 1;
@ -100,7 +98,6 @@ static int pf_close (stix_t* stix, stix_ooi_t nargs)
rcv = (stdio_t*)STIX_STACK_GETRCV(stix, nargs);
if (rcv->fp)
{
STIX_DEBUG1 (stix, "closing %p\n", rcv->fp);
fclose (rcv->fp);
rcv->fp = NULL;
}
@ -191,7 +188,6 @@ reterr:
return 1;
}
static int pf_putc (stix_t* stix, stix_ooi_t nargs)
{
return __pf_puts (stix, nargs, 1);
@ -202,6 +198,10 @@ static int pf_puts (stix_t* stix, stix_ooi_t nargs)
return __pf_puts (stix, nargs, STIX_TYPE_MAX(stix_oow_t));
}
/*TODO: add print function that can accept ByteArray
* add format function for formatted output */
/* ------------------------------------------------------------------------ */
typedef struct fnctab_t fnctab_t;