static int
p_text_to_string(value v, type t, value vs, type ts)
{
pword *pw, *list;
char *s;
int len;
pword *old_tg = Gbl_Tg;
if (IsRef(t))
{
Bip_Error(PDELAY_1);
}
if (IsString(t))
{
Kill_DE;
Return_Unify_Pw(v, t, vs, ts);
}
if (IsAtom(t)) /* not including [] ! */
{
Kill_DE;
Return_Unify_String(vs, ts, DidString(v.did));
}
if (IsNil(t))
{
Kill_DE;
Return_Unify_String(vs, ts, empty_string);
}
if (IsList(t)) /* make a string from a list */
{
int element_type = 0;
list = v.ptr; /* space for the string header */
Push_Buffer(1); /* make minimum buffer */
s = (char *) BufferStart(old_tg); /* start of the new string */
for(;;) /* loop through the list */
{
int c;
pw = list++;
Dereference_(pw); /* get the list element */
if (IsRef(pw->tag)) /* check it */
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(pw, pw->tag.all);
Bip_Error(PDELAY);
}
else if (IsInteger(pw->tag)) /* char code */
{
element_type |= 1;
c = pw->val.nint;
if (c < 0 || 255 < c)
{
Gbl_Tg = old_tg;
Bip_Error(RANGE_ERROR);
}
}
else if (IsAtom(pw->tag)) /* char atom */
{
element_type |= 2;
if (DidLength(pw->val.did) != 1)
{
Gbl_Tg = old_tg;
Bip_Error(RANGE_ERROR);
}
c = DidName(pw->val.did)[0];
}
else
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
*s++ = c;
if (s == (char *) Gbl_Tg) /* we need another pword */
{
Gbl_Tg += 1;
Check_Gc;
}
Dereference_(list); /* get the list tail */
if (IsRef(list->tag))
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(list, list->tag.all);
Bip_Error(PDELAY);
}
else if (IsList(list->tag))
list = list->val.ptr;
else if (IsNil(list->tag))
break; /* end of the list */
else
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
}
if (element_type != 1 && element_type != 2) /* mixed type list? */
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
*s = '\0'; /* terminate the string */
Set_Buffer_Size(old_tg, s - (char *)(old_tg + 1) + 1);
Kill_DE;
Return_Unify_String(vs, ts, old_tg);
}
Bip_Error(TYPE_ERROR);
}
pword *
term_to_dbformat(pword *parg, dident mod)
{
pword **save_tt = TT;
register word arity = 1, len;
register word curr_offset = 0, top_offset = 2; /* in 'word's */
register pword *queue_tail = (pword *) 0;
pword *queue_head = (pword *) 0;
register pword *pw;
register char *dest, *stop;
pword *header;
temp_area meta_attr;
int flag = 0;
Temp_Create(meta_attr, 4 * ATTR_IO_TERM_SIZE * sizeof(pword));
header = TG;
dest = (char *) (header + 1) + 4; /* space for the TBUFFER pword and for
* the external format header */
for(;;) /* handle <arity> consecutive pwords, starting at <parg> */
{
do /* handle the pword pointed to by parg */
{
pw = parg;
/* I need here a slightly modified version of Dereference_(pw)
* that stops also at MARKed words. Not very nice, I know.
*/
while (IsRef(pw->tag) && !(pw->tag.kernel & MARK) && !IsSelfRef(pw))
pw = pw->val.ptr;
Reserve_Space(6);
if (pw->tag.kernel & MARK)
{
if (SameTypeC(pw->tag,TDE)) /* a suspension */
{
Store_Byte(Tag(pw->tag.kernel));
Store_Int32((pw[SUSP_FLAGS].tag.kernel & ~MARK));
if (SuspDead(pw)) {
curr_offset += Words(SUSP_HEADER_SIZE-1);
parg += SUSP_HEADER_SIZE-1;
arity -= SUSP_HEADER_SIZE-1;
} else {
Store_Byte(SuspPrio(pw) + (SuspRunPrio(pw) << 4));
curr_offset += Words(SUSP_GOAL-1);
parg += SUSP_GOAL-1;
arity -= SUSP_GOAL-1;
}
}
else if (pw->val.nint == curr_offset) /* a nonstd variable */
{
Store_Byte(Tag(pw->tag.kernel));
Store_Int(pw->val.nint);
if (!IsNamed(pw->tag.kernel))
{
Store_Byte(0);
}
else /* store its name */
{
dident vdid = TagDid(pw->tag.kernel);
len = DidLength(vdid);
Store_Int(len);
Reserve_Space(len);
Store_String(len, DidName(vdid));
}
}
else /* just a reference to an already encountered variable */
{
Store_Byte(Tag(TVAR_TAG));
Store_Int(pw->val.nint);
}
}
else switch (TagType(pw->tag))
{
case TINT:
#if SIZEOF_CHAR_P > 4
if (pw->val.nint < WSUF(-2147483648) || WSUF(2147483648) <= pw->val.nint)
{
/* store as a bignum (to be readable on 32bit machines) */
len = tag_desc[pw->tag.kernel].string_size(pw->val, pw->tag, 1);
Store_Byte(TBIG);
Store_Int(len);
Reserve_Space(len+1);
stop = dest+len;
dest += tag_desc[pw->tag.kernel].to_string(pw->val, pw->tag,
dest, 1);
while (dest <= stop) /* pad and terminate */
*dest++ = 0;
break;
}
#endif
Store_Byte(TINT);
#ifdef OLD_FORMAT
Store_Int32(pw->val.nint);
#else
Store_Int(pw->val.nint);
#endif
break;
case TNIL:
Store_Byte(Tag(pw->tag.kernel));
break;
case TDICT:
len = DidLength(pw->val.did);
Store_Byte(TDICT);
Store_Int(DidArity(pw->val.did));
Store_Int(len);
Reserve_Space(len);
Store_String(len, DidName(pw->val.did));
break;
case TDBL:
{
ieee_double d;
d.as_dbl = Dbl(pw->val);
Store_Byte(TDBL);
Store_Byte(sizeof(double)-1); /* backward compat */
Reserve_Space(sizeof(double));
Store_Int32(d.as_struct.mant1);
Store_Int32(d.as_struct.mant0);
break;
}
case TIVL:
{
ieee_double dlwb, dupb;
dlwb.as_dbl = IvlLwb(pw->val.ptr);
dupb.as_dbl = IvlUpb(pw->val.ptr);
Store_Byte(TIVL);
Reserve_Space(2*sizeof(double));
Store_Int32(dlwb.as_struct.mant1);
Store_Int32(dlwb.as_struct.mant0);
Store_Int32(dupb.as_struct.mant1);
Store_Int32(dupb.as_struct.mant0);
break;
}
case TSTRG:
len = StringLength(pw->val);
Store_Byte(TSTRG);
Store_Int(len);
Reserve_Space(len);
Store_String(len, StringStart(pw->val));
break;
case TVAR_TAG: /* standard variable */
Store_Byte(Tag(TVAR_TAG));
Store_Int(curr_offset);
Trail_(pw);
pw->val.nint = curr_offset;
pw->tag.kernel |= MARK;
break;
case TNAME:
case TUNIV:
Store_Byte(Tag(TVAR_TAG));
Store_Int(top_offset);
Trail_Tag(pw);
pw->val.nint = top_offset;
pw->tag.kernel |= MARK;
top_offset += 2;
EnQueue_(pw, 1, 0);
break;
case TMETA:
Store_Byte(Tag(TVAR_TAG));
Store_Int(top_offset);
Trail_Tag(pw);
pw->val.nint = top_offset;
pw->tag.kernel |= MARK;
top_offset += 4;
EnQueue_(pw, 2, QUEUE_MASK_META);
break;
case TSUSP:
Store_Byte(Tag(TSUSP));
pw = pw->val.ptr;
if (pw->tag.kernel & MARK) /* not the first encounter */
{
Store_Int(pw->val.nint);
}
else
{
Store_Int(top_offset);
Trail_Pword(pw);
pw->tag.kernel |= MARK;
pw->val.nint = top_offset;
if (SuspDead(pw))
{
top_offset += Words(SUSP_HEADER_SIZE); /* for TDE */
EnQueue_(pw, SUSP_HEADER_SIZE, 0);
}
else
{
top_offset += Words(SUSP_SIZE); /* for TDE */
EnQueue_(pw, SUSP_SIZE, 0);
}
}
break;
case TLIST:
Store_Byte(Tag(TLIST));
Store_Int(top_offset);
top_offset += 4;
EnQueue_(pw->val.ptr, 2, 0);
break;
case TCOMP:
Store_Byte(Tag(TCOMP));
Store_Int(top_offset);
if (flag) {
pword pw_out;
(void) transf_meta_out(pw->val, pw->tag,
(pword *) TempAlloc(meta_attr, ATTR_IO_TERM_SIZE * sizeof(pword)),
D_UNKNOWN, &pw_out);
pw = pw_out.val.ptr;
len = 1 + DidArity(pw->val.did);
EnQueue_(pw, len, 0);
} else {
len = 1 + DidArity(pw->val.ptr->val.did);
EnQueue_(pw->val.ptr, len, 0);
}
top_offset += 2*len;
break;
default:
if (TagType(pw->tag) >= 0 && TagType(pw->tag) <= NTYPES)
{
len = tag_desc[TagType(pw->tag)].string_size(pw->val, pw->tag, 1);
Store_Byte(Tag(pw->tag.kernel));
Store_Int(len);
Reserve_Space(len+1);
stop = dest+len;
dest += tag_desc[TagType(pw->tag)].to_string(pw->val, pw->tag,
dest, 1);
while (dest <= stop) /* pad and terminate */
*dest++ = 0;
}
else
{
p_fprintf(current_err_,
"bad type in term_to_dbformat: 0x%x\n",
pw->tag.kernel);
}
break;
}
curr_offset += Words(1);
++parg;
} while (--arity);
if (EmptyQueue())
break;
DeQueue_(parg, arity, flag);
}
/* # bytes of external representation */
Store_Byte(0); /* add a terminating 0 */
Set_Buffer_Size(header, dest - (char*) header - sizeof(pword));
header->tag.kernel = TBUFFER;
Align(); /* align the global stack pointer */
TG = (pword *) dest;
dest = (char *) (header + 1); /* fill in the external format header */
Store_Int32(top_offset); /* (size of term after restoring) */
Untrail_Variables(save_tt);
Temp_Destroy(meta_attr);
return header;
}
static int
p_string_list(value vs, type ts, value vl, type tl)
{
register pword *pw, *list;
register char *s;
register int len;
pword *old_tg = Gbl_Tg;
if (IsRef(ts)) /* no string given */
{
if (IsRef(tl)) /* we need at least one */
{
Bip_Error(PDELAY_1_2);
}
else if (IsList(tl)) /* make a string from a list */
{
list = vl.ptr; /* space for the string header */
Push_Buffer(1); /* make minimum buffer */
s = (char *) BufferStart(old_tg); /* start of the new string */
for(;;) /* loop through the list */
{
pw = list++;
Dereference_(pw); /* get the list element */
if (IsRef(pw->tag)) /* check it */
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(pw, pw->tag.all);
Bip_Error(PDELAY);
}
else if (!IsInteger(pw->tag))
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
else if (pw->val.nint < 0 || pw->val.nint > 255)
{
Gbl_Tg = old_tg;
Bip_Error(RANGE_ERROR);
}
*s++ = pw->val.nint;
if (s == (char *) Gbl_Tg) /* we need another pword */
{
Gbl_Tg += 1;
Check_Gc;
}
Dereference_(list); /* get the list tail */
if (IsRef(list->tag))
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(list, list->tag.all);
Bip_Error(PDELAY);
}
else if (IsList(list->tag))
list = list->val.ptr;
else if (IsNil(list->tag))
break; /* end of the list */
else
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
}
*s = '\0'; /* terminate the string */
Set_Buffer_Size(old_tg, s - (char *)(old_tg + 1) + 1);
Kill_DE;
Return_Unify_String(vs, ts, old_tg);
}
else if (IsNil(tl))
{
Kill_DE;
Return_Unify_String(vs, ts, empty_string);
}
else
{
Bip_Error(TYPE_ERROR);
}
}
else if (IsString(ts))
{
Kill_DE;
Check_Output_List(tl);
s = StringStart(vs); /* get a pointer to the string */
len = StringLength(vs);
if (len == 0)
{
Return_Unify_Nil(vl, tl);
}
/* Additional a-priori overflow check because adding to TG may
* may wrap around the address space and break Check_Gc below
*/
Check_Available_Pwords(2*len);
pw = Gbl_Tg; /* reserve space for the list */
Gbl_Tg += 2*len;
Check_Gc;
pw->val.nint = *s++ & 0xFFL; /* construct the list */
pw++->tag.kernel = TINT;
while (--len > 0)
{
pw->val.ptr = pw + 1;
pw++->tag.kernel = TLIST;
pw->val.nint = *s++ & 0xFFL;
pw++->tag.kernel = TINT;
}
pw->tag.kernel = TNIL;
Return_Unify_List(vl, tl, old_tg);
}
else
{
Bip_Error(TYPE_ERROR);
}
}
//---------------------------------------------------------
bool CSG_Grid::_Load_Native(const CSG_String &File_Name, TSG_Grid_Memory_Type Memory_Type)
{
bool bResult, hdr_bFlip, hdr_bSwapBytes;
int iType, hdr_Offset, NX, NY;
double Cellsize, xMin, yMin;
CSG_File Stream;
TSG_Data_Type hdr_Type;
CSG_Grid_System System;
CSG_String File_Data, Value;
//-----------------------------------------------------
bResult = false;
if( Stream.Open(File_Name, SG_FILE_R, false) )
{
//-------------------------------------------------
// Load Header...
hdr_Type = SG_DATATYPE_Undefined;
hdr_Offset = 0;
hdr_bFlip = false;
hdr_bSwapBytes = false;
NX = NY = 0;
Cellsize = 0.0;
xMin = 0.0;
yMin = 0.0;
//-------------------------------------------------
do
{
switch( _Load_Native_Get_Key(Stream, Value) )
{
case GRID_FILE_KEY_NAME: Set_Name (Value); break;
case GRID_FILE_KEY_DESCRIPTION: Set_Description (Value); break;
case GRID_FILE_KEY_UNITNAME: Set_Unit (Value); break;
case GRID_FILE_KEY_CELLCOUNT_X: NX = Value.asInt(); break;
case GRID_FILE_KEY_CELLCOUNT_Y: NY = Value.asInt(); break;
case GRID_FILE_KEY_POSITION_XMIN: xMin = Value.asDouble(); break;
case GRID_FILE_KEY_POSITION_YMIN: yMin = Value.asDouble(); break;
case GRID_FILE_KEY_CELLSIZE: Cellsize = Value.asDouble(); break;
case GRID_FILE_KEY_Z_FACTOR: m_zFactor = Value.asDouble(); break;
case GRID_FILE_KEY_NODATA_VALUE: Set_NoData_Value(Value.asDouble()); break;
case GRID_FILE_KEY_DATAFILE_OFFSET: hdr_Offset = Value.asInt(); break;
case GRID_FILE_KEY_BYTEORDER_BIG: hdr_bSwapBytes = Value.Find(GRID_FILE_KEY_TRUE) >= 0; break;
case GRID_FILE_KEY_TOPTOBOTTOM: hdr_bFlip = Value.Find(GRID_FILE_KEY_TRUE) >= 0; break;
case GRID_FILE_KEY_DATAFILE_NAME:
if( SG_File_Get_Path(Value).Length() > 0 )
{
File_Data = Value;
}
else
{
File_Data = SG_File_Make_Path(SG_File_Get_Path(File_Name), Value);
}
break;
case GRID_FILE_KEY_DATAFORMAT:
for(iType=0; iType<SG_DATATYPE_Undefined && hdr_Type == SG_DATATYPE_Undefined; iType++)
{
if( Value.Find(gSG_Data_Type_Identifier[iType]) >= 0 )
{
hdr_Type = (TSG_Data_Type)iType;
}
}
break;
}
}
while( !Stream.is_EOF() );
//-------------------------------------------------
// Load Data...
if( m_System.Assign(Cellsize, xMin, yMin, NX, NY) )
{
//---------------------------------------------
// ASCII...
if( !SG_Data_Type_is_Numeric(hdr_Type) )
{
if( m_Type >= SG_DATATYPE_Undefined )
{
m_Type = SG_DATATYPE_Float;
}
if( Stream.Open(File_Data , SG_FILE_R, false)
|| Stream.Open(SG_File_Make_Path(NULL, File_Name, SG_T( "dat")) , SG_FILE_R, false)
|| Stream.Open(SG_File_Make_Path(NULL, File_Name, SG_T("sdat")) , SG_FILE_R, false) )
{
Stream.Seek(hdr_Offset);
bResult = _Load_ASCII(Stream, Memory_Type, hdr_bFlip);
}
}
//---------------------------------------------
// Binary...
else
{
if( m_Type >= SG_DATATYPE_Undefined )
{
m_Type = hdr_Type;
}
if( (NX = SG_Grid_Cache_Check(m_System, Get_nValueBytes())) > 0 )
{
Set_Buffer_Size(NX);
if( _Cache_Create(File_Data , hdr_Type, hdr_Offset, hdr_bSwapBytes, hdr_bFlip)
|| _Cache_Create(SG_File_Make_Path(NULL, File_Name, SG_T( "dat")) , hdr_Type, hdr_Offset, hdr_bSwapBytes, hdr_bFlip)
|| _Cache_Create(SG_File_Make_Path(NULL, File_Name, SG_T("sdat")) , hdr_Type, hdr_Offset, hdr_bSwapBytes, hdr_bFlip) )
{
return( true );
}
Memory_Type = GRID_MEMORY_Cache;
}
if( _Memory_Create(Memory_Type) )
{
if( Stream.Open(File_Data , SG_FILE_R, true)
|| Stream.Open(SG_File_Make_Path(NULL, File_Name, SG_T( "dat")) , SG_FILE_R, true)
|| Stream.Open(SG_File_Make_Path(NULL, File_Name, SG_T("sdat")) , SG_FILE_R, true) )
{
Stream.Seek(hdr_Offset);
bResult = _Load_Binary(Stream, hdr_Type, hdr_bFlip, hdr_bSwapBytes);
}
}
}
}
}
return( bResult );
}
