Obj FuncCREATE_PTY_IOSTREAM( Obj self, Obj dir, Obj prog, Obj args ) { Obj allargs[MAX_ARGS+1]; Char *argv[MAX_ARGS+2]; UInt i,len; Int pty; len = LEN_LIST(args); if (len > MAX_ARGS) ErrorQuit("Too many arguments",0,0); ConvString(dir); ConvString(prog); for (i = 1; i <=len; i++) { allargs[i] = ELM_LIST(args,i); ConvString(allargs[i]); } /* From here we cannot afford to have a garbage collection */ argv[0] = CSTR_STRING(prog); for (i = 1; i <=len; i++) { argv[i] = CSTR_STRING(allargs[i]); } argv[i] = (Char *)0; pty = StartChildProcess( CSTR_STRING(dir) , CSTR_STRING(prog), argv ); if (pty < 0) return Fail; else return INTOBJ_INT(pty); }
Obj UNIX_Chdir( Obj self, Obj string ) { int result; ConvString( string ); result = chdir( (char*)CSTR_STRING(string) ); if (result == -1) { fprintf( stderr, "UNIX_Chdir: %s\n", (char*)CSTR_STRING(string) ); perror("UNIX_Chdir"); } return ( 0 == result ? True : False ) ; }
Obj MPIerror_string( Obj self, Obj errorcode ) { int resultlen; Obj str; str = NEW_STRING( 72 ); MPI_Error_string( INT_INTOBJ(errorcode), (char*)CSTR_STRING(str), &resultlen); ((char*)CSTR_STRING(str))[resultlen] = '\0'; SET_LEN_STRING(str, resultlen); ResizeBag( str, SIZEBAG_STRINGLEN( GET_LEN_STRING(str) ) ); return str; }
Obj MPIsend( Obj self, Obj args ) { Obj buf, dest, tag; MPIARGCHK(2, 3, MPI_Send( <string buf>, <int dest>[, <opt int tag = 0> ] )); buf = ELM_LIST( args, 1 ); dest = ELM_LIST( args, 2 ); tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) : 0 ); ConvString( buf ); MPI_Send( ((char*)CSTR_STRING(buf)), strlen((const Char*)CSTR_STRING(buf)), /* don't incl. \0 */ MPIdatatype_infer(buf), INT_INTOBJ(dest), INT_INTOBJ(tag), MPI_COMM_WORLD); return 0; }
Obj MPIget_processor_name( Obj self ) { int resultlen; Obj str; /* It was reported by Frank Celler that a value of 72 instead of 1024 below caused overwriting of the free block list on PC in GAP-3 */ str = NEW_STRING( 1024 ); MPI_Get_processor_name( (char*)CSTR_STRING(str), &resultlen); ((char*)CSTR_STRING(str))[resultlen] = '\0'; #ifndef PRE_GAP_4_3 SET_LEN_STRING(str, resultlen); ResizeBag( str, SIZEBAG_STRINGLEN( GET_LEN_STRING(str) ) ); #endif return str; }
Obj FuncINTFLOOR_MACFLOAT( Obj self, Obj obj ) { #if HAVE_TRUNC Double f = trunc(VAL_MACFLOAT(obj)); #else Double f = VAL_MACFLOAT(obj); if (f >= 0.0) f = floor(f); else f = -floor(-f); #endif if (fabs(f) < (Double) (1L<<NR_SMALL_INT_BITS)) return INTOBJ_INT((Int)f); int str_len = (int) (log(fabs(f)) / log(16.0)) + 3; Obj str = NEW_STRING(str_len); char *s = CSTR_STRING(str), *p = s+str_len-1; if (f < 0.0) f = -f, s[0] = '-'; while (p > s || (p == s && s[0] != '-')) { int d = (int) fmod(f,16.0); *p-- = d < 10 ? '0'+d : 'a'+d-10; f /= 16.0; } return FuncIntHexString(self,str); }
Obj MPIrecv( Obj self, Obj args ) { volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */ MPIARGCHK( 1, 3, MPI_Recv( <string buf>, <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) ); buf = ELM_LIST( args, 1 ); source = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) : INTOBJ_INT(MPI_ANY_SOURCE) ); tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) : INTOBJ_INT(MPI_ANY_TAG) ); if ( ! IS_STRING( buf ) ) ErrorQuit("MPI_Recv(): received a buffer that is not a string", 0L, 0L); ConvString( buf ); /* Note GET_LEN_STRING() returns GAP string length and strlen(CSTR_STRING()) returns C string length (up to '\0') */ if ( ! MPI_READ_ERROR() ) MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf), last_datatype=MPIdatatype_infer(buf), INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_READ_DONE(); if ( ! IS_STRING( buf ) ) { /* CLEAN THIS UP LATER */ ErrorQuit("ParGAP: panic: MPI_Recv(): result buffer is not a string", 0L, 0L); exit(1); } /* if (last_datatype != MPI_CHAR) { MPI_Get_count(&last_status, last_datatype, &count); etc. } */ return buf; }
static void WriteBytesNativeString(void *addr, UInt count) { Obj target = TLS(SerializationObj); UInt size = GET_LEN_STRING(target); GROW_STRING(target, size + count + 1); memcpy(CSTR_STRING(target) + size, addr, count); SET_LEN_STRING(target, size + count); }
static Obj VIEWSTRING_MPD(Obj self, Obj f, Obj digits) { mp_prec_t prec = mpd_get_prec(GET_MPD(f)); Obj str = NEW_STRING(2*(prec*302/1000+10)+3); int slen = 0, n; TEST_IS_INTOBJ("STRING_MPD",digits); n = INT_INTOBJ(digits); if (n == 1) n = 2; char *c = CSTR_STRING(str); slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN); Obj im = NEW_MPFR(prec); mpfr_add(MPFR_OBJ(im), GET_MPD(f)->re, GET_MPD(f)->im, GMP_RNDN); mpfr_sub(MPFR_OBJ(im), MPFR_OBJ(im), MPD_OBJ(f)->re, GMP_RNDN); /* round off small im */ if (!mpfr_zero_p(MPFR_OBJ(im))) { if (mpfr_sgn(MPFR_OBJ(im)) < 0) c[slen++] = '-'; else c[slen++] = '+'; mpfr_abs (MPFR_OBJ(im), MPD_OBJ(f)->im, GMP_RNDN); c[slen++] = 'I'; c[slen++] = '*'; slen += PRINT_MPFR(c+slen, 0, n, MPFR_OBJ(im), GMP_RNDN); } SET_LEN_STRING(str, slen); SHRINK_STRING(str); return str; }
static void WriteBytesNativeString(void * addr, UInt count) { Obj target = MODULE_STATE(Serialize).obj; UInt size = GET_LEN_STRING(target); GROW_STRING(target, size + count + 1); memcpy(CSTR_STRING(target) + size, addr, count); SET_LEN_STRING(target, size + count); }
/**************************************************************************** ** *F AppendBufToString() ** ** Append 'bufsize' bytes from the string buffer 'buf' to the string object ** 'string'. If 'string' is 0, then a new string object is allocated first. ** ** The string object is returned at the end, regardless of whether it was ** given as an argument, or created from scratch. ** */ static Obj AppendBufToString(Obj string, const char * buf, UInt bufsize) { char *s; if (string == 0) { string = NEW_STRING(bufsize); s = CSTR_STRING(string); } else { const UInt len = GET_LEN_STRING(string); GROW_STRING(string, len + bufsize); SET_LEN_STRING(string, len + bufsize); s = CSTR_STRING(string) + len; } memcpy(s, buf, bufsize); s[bufsize] = '\0'; return string; }
static void ReadBytesNativeString(void *addr, UInt size) { Obj str = TLS(SerializationObj); UInt max = GET_LEN_STRING(str); UInt off = TLS(SerializationIndex); if (off + size > max) DeserializationError(); memcpy(addr, CSTR_STRING(str)+off, size); TLS(SerializationIndex) += size; }
Obj FuncWRITE_IOSTREAM( Obj self, Obj stream, Obj string, Obj len ) { UInt pty = INT_INTOBJ(stream); ConvString(string); while (!PtyIOStreams[pty].inuse) pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L, "you can replace stream number <num> via 'return <num>;'")); HandleChildStatusChanges(pty); return INTOBJ_INT(WriteToPty(pty, CSTR_STRING(string), INT_INTOBJ(len))); }
Obj UNIX_Hostname( Obj self ) { char buf[100]; Obj host; int res; res = gethostname( buf, 100 ); if (res == -1) { perror("UNIX_Hostname: "); sprintf( buf, "<unknown name>"); } host = NEW_STRING( strlen(buf) ); /* NEW_STRING() allows for extra '\0' */ strncat( CSTR_STRING(host), buf, strlen(buf) ); return host; }
Obj MPIbinsend( Obj self, Obj args ) { Obj buf, dest, tag, size; int s,i; MPIARGCHK(3, 4, MPI_Binsend( <string buf>, <int dest>, <int size>, [, <opt int tag = 0> ] )); buf = ELM_LIST( args, 1 ); dest = ELM_LIST( args, 2 ); size = ELM_LIST (args, 3); tag = ( LEN_LIST(args) > 3 ? ELM_LIST( args, 4 ) : 0 ); s = MPI_Send( ((char*)CSTR_STRING(buf)), INT_INTOBJ(size), /* don't incl. \0 */ MPI_CHAR, INT_INTOBJ(dest), INT_INTOBJ(tag), MPI_COMM_WORLD); return 0; }
Obj FuncREAD_IOSTREAM_NOWAIT(Obj self, Obj stream, Obj len) { Obj string; UInt pty = INT_INTOBJ(stream); Int ret; string = NEW_STRING(INT_INTOBJ(len)); while (!PtyIOStreams[pty].inuse) pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L, "you can replace stream number <num> via 'return <num>;'")); /* HandleChildStatusChanges(pty); Omit this to allow picking up "trailing" bytes*/ ret = ReadFromPty2(pty, CSTR_STRING(string), INT_INTOBJ(len), 0); if (ret == -1) return Fail; SET_LEN_STRING(string, ret); ResizeBag(string, SIZEBAG_STRINGLEN(ret)); return string; }
static Obj STRING_MPD(Obj self, Obj f, Obj digits) { mp_prec_t prec = mpd_get_prec(GET_MPD(f)); Obj str = NEW_STRING(2*(prec*302/1000+10)+3); int slen = 0, n; TEST_IS_INTOBJ("STRING_MPD",digits); n = INT_INTOBJ(digits); if (n == 1) n = 2; char *c = CSTR_STRING(str); slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN); c[slen++] = '+'; c[slen++] = 'I'; c[slen++] = '*'; slen += PRINT_MPFR(c+slen, 0, n, MPD_OBJ(f)->im, GMP_RNDN); SET_LEN_STRING(str, slen); SHRINK_STRING(str); return str; }
/**************************************************************************** ** *F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name ** ** 'RNamObj' returns the record name corresponding to the object <obj>, ** which currently must be a string or an integer. */ UInt RNamObj ( Obj obj ) { /* convert integer object */ if ( IS_INTOBJ(obj) ) { return RNamIntg( INT_INTOBJ(obj) ); } /* convert string object (empty string may have type T_PLIST) */ else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) { return RNamName( CSTR_STRING(obj) ); } /* otherwise fail */ else { obj = ErrorReturnObj( "Record: '<rec>.(<obj>)' <obj> must be a string or an integer", 0L, 0L, "you can replace <obj> via 'return <obj>;'" ); return RNamObj( obj ); } }
Obj MPIrecv2( Obj self, Obj args ) { volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */ int count, sranje; MPI_Comm_rank(MPI_COMM_WORLD, &sranje); MPIARGCHK( 0, 2, MPI_Recv( <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) ); source = ( LEN_LIST(args) > 0 ? ELM_LIST( args, 1 ) : INTOBJ_INT(MPI_ANY_SOURCE) ); tag = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) : INTOBJ_INT(MPI_ANY_TAG) ); MPI_Probe(INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_Get_count(&last_status, MPI_CHAR, &count); buf = NEW_STRING( count); ConvString( buf ); /* Note GET_LEN_STRING() returns GAP string length and strlen(CSTR_STRING()) returns C string length (up to '\0') */ MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf), MPI_CHAR, INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_READ_DONE(); /* if (last_datatype != MPI_CHAR) { MPI_Get_count(&last_status, last_datatype, &count); etc. } */ return buf; }
// // Returns a pointer to the // contents of the GAP string object <string> char * GAP_CSTR_STRING(Obj string) { return CSTR_STRING(string); }
char * GAP_CSTR_STRING(Obj string) { if (!IS_STRING_REP(string)) return 0; return CSTR_STRING(string); }