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 ); }