implemented reading and printing of fixed-point decimal number. primitives yet to be written
This commit is contained in:
		| @ -148,6 +148,7 @@ enum hcl_iotok_type_t | ||||
| 	HCL_IOTOK_STRLIT, | ||||
| 	HCL_IOTOK_NUMLIT, | ||||
| 	HCL_IOTOK_RADNUMLIT, | ||||
| 	HCL_IOTOK_FPDECLIT, | ||||
| 	HCL_IOTOK_SMPTRLIT, | ||||
| 	HCL_IOTOK_ERRORLIT, | ||||
| 	HCL_IOTOK_NIL, | ||||
|  | ||||
							
								
								
									
										76
									
								
								lib/hcl.h
									
									
									
									
									
								
							
							
						
						
									
										76
									
								
								lib/hcl.h
									
									
									
									
									
								
							| @ -101,7 +101,7 @@ enum hcl_synerrnum_t | ||||
| 	HCL_SYNERR_HASHLIT,       /* wrong hashed literal */ | ||||
| 	HCL_SYNERR_CHARLIT,       /* wrong character literal */ | ||||
| 	HCL_SYNERR_RADNUMLIT ,    /* invalid numeric literal with radix */ | ||||
| 	HCL_SYNERR_INTRANGE,      /* integer range error */ | ||||
| 	HCL_SYNERR_NUMRANGE,      /* number range error */ | ||||
| 	HCL_SYNERR_ERRORLIT,      /* wrong error literal */ | ||||
| 	HCL_SYNERR_SMPTRLIT,      /* wrong smptr literal */ | ||||
|  | ||||
| @ -551,6 +551,16 @@ struct hcl_dic_t | ||||
| 	hcl_oop_oop_t bucket; /* Array */ | ||||
| }; | ||||
|  | ||||
| #define HCL_FPDEC_NAMED_INSTVARS 2 | ||||
| typedef struct hcl_fpdec_t hcl_fpdec_t; | ||||
| typedef struct hcl_fpdec_t* hcl_oop_fpdec_t; | ||||
| struct hcl_fpdec_t | ||||
| { | ||||
| 	HCL_OBJ_HEADER; | ||||
| 	hcl_oop_t value; /* smooi or bigint */ | ||||
| 	hcl_oop_t scale; /* smooi, positive */ | ||||
| }; | ||||
|  | ||||
| #define HCL_CONTEXT_NAMED_INSTVARS 8 | ||||
| typedef struct hcl_context_t hcl_context_t; | ||||
| typedef struct hcl_context_t* hcl_oop_context_t; | ||||
| @ -693,12 +703,36 @@ struct hcl_heap_t | ||||
|  * VIRTUAL MACHINE PRIMITIVES | ||||
|  * ========================================================================= */ | ||||
|  | ||||
| typedef void* (*hcl_alloc_heap_t) (hcl_t* hcl, hcl_oow_t size); | ||||
| typedef void (*hcl_free_heap_t) (hcl_t* hcl, void* ptr); | ||||
| typedef void* (*hcl_alloc_heap_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	hcl_oow_t          size | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_log_write_t) (hcl_t* hcl, unsigned int mask, const hcl_ooch_t* msg, hcl_oow_t len); | ||||
| typedef void (*hcl_syserrstrb_t) (hcl_t* hcl, int syserr, hcl_bch_t* buf, hcl_oow_t len); | ||||
| typedef void (*hcl_syserrstru_t) (hcl_t* hcl, int syserr, hcl_uch_t* buf, hcl_oow_t len); | ||||
| typedef void (*hcl_free_heap_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	void*              ptr | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_log_write_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	unsigned int       mask, | ||||
| 	const hcl_ooch_t*  msg, | ||||
| 	hcl_oow_t          len | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_syserrstrb_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	int                syserr, | ||||
| 	hcl_bch_t*         buf, | ||||
| 	hcl_oow_t          len | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_syserrstru_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	int                syserr, | ||||
| 	hcl_uch_t*         buf, | ||||
| 	hcl_oow_t          len | ||||
| ); | ||||
|  | ||||
| enum hcl_vmprim_opendl_flag_t | ||||
| { | ||||
| @ -706,12 +740,31 @@ enum hcl_vmprim_opendl_flag_t | ||||
| }; | ||||
| typedef enum hcl_vmprim_opendl_flag_t hcl_vmprim_opendl_flag_t; | ||||
|  | ||||
| typedef void* (*hcl_vmprim_dlopen_t) (hcl_t* hcl, const hcl_ooch_t* name, int flags); | ||||
| typedef void (*hcl_vmprim_dlclose_t) (hcl_t* hcl, void* handle); | ||||
| typedef void* (*hcl_vmprim_dlgetsym_t) (hcl_t* hcl, void* handle, const hcl_ooch_t* name); | ||||
| typedef void* (*hcl_vmprim_dlopen_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	const hcl_ooch_t*  name, | ||||
| 	int                flags | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_vmprim_gettime_t) (hcl_t* hcl, hcl_ntime_t* now); | ||||
| typedef void (*hcl_vmprim_sleep_t) (hcl_t* hcl, const hcl_ntime_t* duration); | ||||
| typedef void (*hcl_vmprim_dlclose_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	void*              handle | ||||
| ); | ||||
|  | ||||
| typedef void* (*hcl_vmprim_dlgetsym_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	void*              handle, | ||||
| 	const hcl_ooch_t*  name | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_vmprim_gettime_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	hcl_ntime_t*       now | ||||
| ); | ||||
|  | ||||
| typedef void (*hcl_vmprim_sleep_t) ( | ||||
| 	hcl_t*             hcl, | ||||
| 	const hcl_ntime_t* duration); | ||||
|  | ||||
| struct hcl_vmprim_t | ||||
| { | ||||
| @ -1324,6 +1377,7 @@ enum hcl_brand_t | ||||
| 	HCL_BRAND_SYMBOL, | ||||
| 	HCL_BRAND_STRING, | ||||
| 	HCL_BRAND_DIC, | ||||
| 	HCL_BRAND_FPDEC, /* fixed-point decimal */ | ||||
|  | ||||
| 	HCL_BRAND_CFRAME,/* compiler frame */ | ||||
| 	HCL_BRAND_PRIM, | ||||
|  | ||||
| @ -268,6 +268,7 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int | ||||
| 	return alloc_numeric_array(hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc); | ||||
| } | ||||
|  | ||||
|  | ||||
| /* ------------------------------------------------------------------------ * | ||||
|  * NGC HANDLING | ||||
|  * ------------------------------------------------------------------------ */ | ||||
|  | ||||
							
								
								
									
										16
									
								
								lib/print.c
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								lib/print.c
									
									
									
									
									
								
							| @ -284,6 +284,22 @@ next: | ||||
| 			break; | ||||
| 		} | ||||
|  | ||||
| 		case HCL_BRAND_FPDEC: | ||||
| 		{ | ||||
| 			hcl_oop_t tmp; | ||||
| 			hcl_oop_fpdec_t f = (hcl_oop_fpdec_t)obj; | ||||
| 			hcl_ooi_t scale; | ||||
|  | ||||
| 			scale = HCL_OOP_TO_SMOOI(f->scale); | ||||
|  | ||||
| 			tmp = hcl_inttostr(hcl, f->value, 10, -1); | ||||
| 			if (!tmp) return -1; | ||||
|  | ||||
| 			HCL_ASSERT (hcl, (hcl_oop_t)tmp == hcl->_nil);  | ||||
| 			if (outbfmt(hcl, mask, "%.*js.%.*js", hcl->inttostr.xbuf.len - scale, hcl->inttostr.xbuf.ptr, scale, &hcl->inttostr.xbuf.ptr[hcl->inttostr.xbuf.len - scale]) <= -1) return -1; | ||||
| 			break; | ||||
| 		} | ||||
|  | ||||
| #if 0 | ||||
| 		case HCL_BRAND_REAL: | ||||
| 		{ | ||||
|  | ||||
							
								
								
									
										73
									
								
								lib/read.c
									
									
									
									
									
								
							
							
						
						
									
										73
									
								
								lib/read.c
									
									
									
									
									
								
							| @ -126,7 +126,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n | ||||
|  | ||||
| 		if (*ptr != '#')  | ||||
| 		{ | ||||
| 			hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 			hcl_seterrbfmt (hcl, HCL_EINVAL, "radixed number not starting with # - %*.js", str->len, str->ptr); | ||||
| 			return -1; | ||||
| 		} | ||||
| 		ptr++; /* skip '#' */ | ||||
| @ -136,7 +136,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n | ||||
| 		else if (*ptr == 'b') base = 2; | ||||
| 		else | ||||
| 		{ | ||||
| 			hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 			hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); | ||||
| 			return -1; | ||||
| 		} | ||||
| 		ptr++; | ||||
| @ -152,7 +152,7 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n | ||||
| 		if (value < old_value)  | ||||
| 		{ | ||||
| 			/* overflow must have occurred */ | ||||
| 			hcl_seterrnum (hcl, HCL_ERANGE); | ||||
| 			hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); | ||||
| 			return -1; | ||||
| 		} | ||||
| 		old_value = value; | ||||
| @ -162,13 +162,13 @@ static int string_to_ooi (hcl_t* hcl, hcl_oocs_t* str, int radixed, hcl_ooi_t* n | ||||
| 	if (ptr < end) | ||||
| 	{ | ||||
| 		/* trailing garbage? */ | ||||
| 		hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 		hcl_seterrbfmt (hcl, HCL_EINVAL, "trailing garbage after numeric literal - %.*js", str->len, str->ptr); | ||||
| 		return -1; | ||||
| 	} | ||||
|  | ||||
| 	if (value > HCL_TYPE_MAX(hcl_ooi_t) + (negsign? 1: 0)) /* assume 2's complement */ | ||||
| 	{ | ||||
| 		hcl_seterrnum (hcl, HCL_ERANGE); | ||||
| 		hcl_seterrbfmt (hcl, HCL_ERANGE, "number too big - %.*js", str->len, str->ptr); | ||||
| 		return -1; | ||||
| 	} | ||||
|  | ||||
| @ -218,7 +218,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) | ||||
|  | ||||
| 		if (*ptr != '#')  | ||||
| 		{ | ||||
| 			hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 			hcl_seterrbfmt(hcl, HCL_EINVAL, "radixed number not starting with # - %.*js", str->len, str->ptr); | ||||
| 			return HCL_NULL; | ||||
| 		} | ||||
| 		ptr++; /* skip '#' */ | ||||
| @ -228,7 +228,7 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) | ||||
| 		else if (*ptr == 'b') base = 2; | ||||
| 		else | ||||
| 		{ | ||||
| 			hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 			hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid radix specifier - %c", *ptr); | ||||
| 			return HCL_NULL; | ||||
| 		} | ||||
| 		ptr++; | ||||
| @ -241,6 +241,47 @@ static hcl_oop_t string_to_num (hcl_t* hcl, hcl_oocs_t* str, int radixed) | ||||
| 	return hcl_strtoint(hcl, ptr, end - ptr, base); | ||||
| } | ||||
|  | ||||
| static hcl_oop_t string_to_fpdec (hcl_t* hcl, hcl_oocs_t* str, const hcl_ioloc_t* loc) | ||||
| { | ||||
| 	hcl_oow_t pos; | ||||
| 	hcl_oow_t scale = 0; | ||||
| 	hcl_oop_t v; | ||||
| 	hcl_oop_fpdec_t f; | ||||
|  | ||||
| 	pos = str->len; | ||||
| 	while (pos > 0) | ||||
| 	{ | ||||
| 		pos--; | ||||
| 		if (str->ptr[pos] == '.') | ||||
| 		{ | ||||
| 			scale = str->len - pos - 1; | ||||
| 			if (scale > HCL_SMOOI_MAX) | ||||
| 			{ | ||||
| 				hcl_setsynerrbfmt (hcl, HCL_SYNERR_NUMRANGE, loc, str, "too many digits after decimal point"); | ||||
| 				return HCL_NULL; | ||||
| 			} | ||||
|  | ||||
| 			if (scale > 0) HCL_MEMMOVE (&str->ptr[pos], &str->ptr[pos + 1], scale * HCL_SIZEOF(str->ptr[0])); | ||||
| 		} | ||||
| 	} | ||||
|  | ||||
| 	v = hcl_strtoint(hcl, str->ptr, str->len - 1, 10); | ||||
| 	if (scale > 0) HCL_MEMMOVE (&str->ptr[pos + 1], &str->ptr[pos], scale * HCL_SIZEOF(str->ptr[0])); | ||||
| 	if (!v) return HCL_NULL; | ||||
|  | ||||
| 	hcl_pushtmp (hcl, &v); | ||||
| 	f = (hcl_oop_fpdec_t)hcl_makearray (hcl, HCL_FPDEC_NAMED_INSTVARS, 0); | ||||
| 	hcl_poptmp (hcl); | ||||
|  | ||||
| 	if (!f) return HCL_NULL; | ||||
|  | ||||
| 	HCL_OBJ_SET_FLAGS_BRAND(f, HCL_BRAND_FPDEC); | ||||
| 	f->value = v; | ||||
| 	f->scale = HCL_SMOOI_TO_OOP(scale); | ||||
|  | ||||
| 	return f; | ||||
| } | ||||
|  | ||||
| static HCL_INLINE int is_spacechar (hcl_ooci_t c) | ||||
| { | ||||
| 	/* TODO: handle other space unicode characters */ | ||||
| @ -352,7 +393,7 @@ static int copy_string_to (hcl_t* hcl, const hcl_oocs_t* src, hcl_oocs_t* dst, h | ||||
| #define CLEAR_TOKEN_NAME(hcl) ((hcl)->c->tok.name.len = 0) | ||||
| #define SET_TOKEN_TYPE(hcl,tv) ((hcl)->c->tok.type = (tv)) | ||||
|  | ||||
| #define TOKEN_TYPE(hc) ((hcl)->c->tok.type) | ||||
| #define TOKEN_TYPE(hcl) ((hcl)->c->tok.type) | ||||
| #define TOKEN_NAME(hcl) (&(hcl)->c->tok.name) | ||||
| #define TOKEN_NAME_CAPA(hcl) ((hcl)->c->tok.name_capa) | ||||
| #define TOKEN_NAME_LEN(hcl) ((hcl)->c->tok.name.len) | ||||
| @ -1114,18 +1155,25 @@ retry: | ||||
| 		case '0': case '1': case '2': case '3': case '4': | ||||
| 		case '5': case '6': case '7': case '8': case '9': | ||||
| 		numlit: | ||||
| 			/* TODO: floating-pointer number */ | ||||
| 			SET_TOKEN_TYPE (hcl, HCL_IOTOK_NUMLIT); | ||||
| 			while (1) | ||||
| 			{ | ||||
| 				ADD_TOKEN_CHAR (hcl, c); | ||||
| 				GET_CHAR_TO (hcl, c); | ||||
| 				if (TOKEN_TYPE(hcl) == HCL_IOTOK_NUMLIT && c == '.') | ||||
| 				{ | ||||
| 					SET_TOKEN_TYPE (hcl, HCL_IOTOK_FPDECLIT); | ||||
| 					ADD_TOKEN_CHAR (hcl, c); | ||||
| 					GET_CHAR_TO (hcl, c); | ||||
| 				} | ||||
|  | ||||
| 				if (!is_digitchar(c)) | ||||
| 				{ | ||||
| 					unget_char (hcl, &hcl->c->lxc); | ||||
| 					break; | ||||
| 				} | ||||
| 			} | ||||
|  | ||||
| 			break; | ||||
|  | ||||
| 		default: | ||||
| @ -1999,7 +2047,6 @@ static int read_object (hcl_t* hcl) | ||||
|  | ||||
| 			case HCL_IOTOK_VBAR: | ||||
| /* TODO: think wheter to allow | | inside a quoted list... */ | ||||
|  | ||||
| /* TODO: revise this part ... */ | ||||
| 				if (array_level > 0) | ||||
| 				{ | ||||
| @ -2074,6 +2121,10 @@ static int read_object (hcl_t* hcl) | ||||
| 				obj = string_to_num(hcl, TOKEN_NAME(hcl), TOKEN_TYPE(hcl) == HCL_IOTOK_RADNUMLIT); | ||||
| 				break; | ||||
|  | ||||
| 			case HCL_IOTOK_FPDECLIT: | ||||
| 				obj = string_to_fpdec(hcl, TOKEN_NAME(hcl), TOKEN_LOC(hcl)); | ||||
| 				break; | ||||
|  | ||||
| 			/* | ||||
| 			case HCL_IOTOK_REAL: | ||||
| 				obj = hcl_makerealnum(hcl, HCL_IOTOK_RVAL(hcl)); | ||||
| @ -2299,7 +2350,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer) | ||||
|  | ||||
| 	if (!reader || !printer) | ||||
| 	{ | ||||
| 		hcl_seterrnum (hcl, HCL_EINVAL); | ||||
| 		hcl_seterrbfmt (hcl, HCL_EINVAL, "reader and/or printer not supplied"); | ||||
| 		return -1; | ||||
| 	} | ||||
|  | ||||
|  | ||||
		Reference in New Issue
	
	Block a user