// // Int32s: C // // Get integer as positive, negative 32 bit value. // Sign field can be // 0: >= 0 // 1: > 0 // -1: < 0 // REBINT Int32s(const REBVAL *val, REBINT sign) { REBINT n = 0; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) fail (Error_Out_Of_Range(val)); n = (REBINT)VAL_DECIMAL(val); } else { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) fail (Error_Out_Of_Range(val)); n = VAL_INT32(val); } // More efficient to use positive sense: if ( (sign == 0 && n >= 0) || (sign > 0 && n > 0) || (sign < 0 && n < 0) ) return n; fail (Error_Out_Of_Range(val)); }
// // Int8u: C // REBINT Int8u(const REBVAL *val) { if (VAL_INT64(val) > cast(i64, 255) || VAL_INT64(val) < cast(i64, 0)) fail (Error_Out_Of_Range(val)); return VAL_INT32(val); }
// // Int32: C // REBINT Int32(const REBVAL *val) { REBINT n = 0; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) fail (Error_Out_Of_Range(val)); n = (REBINT)VAL_DECIMAL(val); } else { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) fail (Error_Out_Of_Range(val)); n = VAL_INT32(val); } return n; }
// // Error_Bad_Path_Range: C // REBCTX *Error_Bad_Path_Range(REBPVS *pvs) { REBVAL item; COPY_VALUE(&item, pvs->item, pvs->item_specifier); return Error_Out_Of_Range(&item); }
// // Float_Int16: C // REBINT Float_Int16(REBD32 f) { if (fabs(f) > (REBD32)(0x7FFF)) { DS_PUSH_DECIMAL(f); fail (Error_Out_Of_Range(DS_TOP)); } return (REBINT)f; }
// // Get_Num_From_Arg: C // // Get the amount to skip or pick. // Allow multiple types. Throw error if not valid. // Note that the result is one-based. // REBINT Get_Num_From_Arg(const REBVAL *val) { REBINT n; if (IS_INTEGER(val)) { if (VAL_INT64(val) > (i64)MAX_I32 || VAL_INT64(val) < (i64)MIN_I32) fail (Error_Out_Of_Range(val)); n = VAL_INT32(val); } else if (IS_DECIMAL(val) || IS_PERCENT(val)) { if (VAL_DECIMAL(val) > MAX_I32 || VAL_DECIMAL(val) < MIN_I32) fail (Error_Out_Of_Range(val)); n = (REBINT)VAL_DECIMAL(val); } else if (IS_LOGIC(val)) n = (VAL_LOGIC(val) ? 1 : 2); else fail (Error_Invalid_Arg(val)); return n; }
// // Int64s: C // // Get integer as positive, negative 64 bit value. // Sign field can be // 0: >= 0 // 1: > 0 // -1: < 0 // REBI64 Int64s(const REBVAL *val, REBINT sign) { REBI64 n; if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) > MAX_I64 || VAL_DECIMAL(val) < MIN_I64) fail (Error_Out_Of_Range(val)); n = (REBI64)VAL_DECIMAL(val); } else { n = VAL_INT64(val); } // More efficient to use positive sense: if ( (sign == 0 && n >= 0) || (sign > 0 && n > 0) || (sign < 0 && n < 0) ) return n; fail (Error_Out_Of_Range(val)); }
// // Poke_Vector_Fail_If_Locked: C // void Poke_Vector_Fail_If_Locked( REBVAL *value, const REBVAL *picker, const REBVAL *poke ) { REBSER *vect = VAL_SERIES(value); FAIL_IF_LOCKED_SERIES(vect); REBINT n; if (IS_INTEGER(picker) || IS_DECIMAL(picker)) n = Int32(picker); else fail (Error_Invalid_Arg(picker)); n += VAL_INDEX(value); if (n <= 0 || cast(REBCNT, n) > SER_LEN(vect)) fail (Error_Out_Of_Range(picker)); REBYTE *vp = SER_DATA_RAW(vect); REBINT bits = VECT_TYPE(vect); REBI64 i; REBDEC f; if (IS_INTEGER(poke)) { i = VAL_INT64(poke); if (bits > VTUI64) f = cast(REBDEC, i); else { // !!! REVIEW: f was not set in this case; compiler caught the // unused parameter. So fill with distinctive garbage to make it // easier to search for if it ever is. f = -646.699; } } else if (IS_DECIMAL(poke)) { f = VAL_DECIMAL(poke); if (bits <= VTUI64) i = cast(REBINT, f); } else fail (Error_Invalid_Arg(poke)); set_vect(bits, vp, n - 1, i, f); }
// // Poke_Tuple_Immediate: C // // !!! Note: In the current implementation, tuples are immediate values. // So a POKE only changes the `value` in your hand. // void Poke_Tuple_Immediate( REBVAL *value, const REBVAL *picker, const REBVAL *poke ) { REBYTE *dat = VAL_TUPLE(value); REBINT len = VAL_TUPLE_LEN(value); if (len < 3) len = 3; REBINT n = Get_Num_From_Arg(picker); if (n <= 0 || n > cast(REBINT, MAX_TUPLE)) fail (Error_Out_Of_Range(picker)); REBINT i; if (IS_INTEGER(poke) || IS_DECIMAL(poke)) i = Int32(poke); else if (IS_BLANK(poke)) { n--; CLEAR(dat + n, MAX_TUPLE - n); VAL_TUPLE_LEN(value) = n; return; } else fail (poke); if (i < 0) i = 0; else if (i > 255) i = 255; dat[n - 1] = i; if (n > len) VAL_TUPLE_LEN(value) = n; }
// // Transport_Actor: C // static REB_R Transport_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action, enum Transport_Types proto) { REBREQ *sock; // IO request REBVAL *spec; // port spec REBVAL *arg; // action argument value REBVAL *val; // e.g. port number value REBINT result; // IO result REBCNT refs; // refinement argument flags REBCNT len; // generic length REBSER *ser; // simplifier Validate_Port(port, action); *D_OUT = *D_ARG(1); arg = DS_ARGC > 1 ? D_ARG(2) : NULL; sock = cast(REBREQ*, Use_Port_State(port, RDI_NET, sizeof(*sock))); if (proto == TRANSPORT_UDP) { SET_FLAG(sock->modes, RST_UDP); } //Debug_Fmt("Sock: %x", sock); spec = OFV(port, STD_PORT_SPEC); if (!IS_OBJECT(spec)) fail (Error(RE_INVALID_PORT)); // sock->timeout = 4000; // where does this go? !!! // HOW TO PREVENT OVERWRITE DURING BUSY OPERATION!!! // Should it just ignore it or cause an error? // Actions for an unopened socket: if (!IS_OPEN(sock)) { switch (action) { // Ordered by frequency case A_OPEN: arg = Obj_Value(spec, STD_PORT_SPEC_NET_HOST); val = Obj_Value(spec, STD_PORT_SPEC_NET_PORT_ID); if (OS_DO_DEVICE(sock, RDC_OPEN)) fail (Error_On_Port(RE_CANNOT_OPEN, port, -12)); SET_OPEN(sock); // Lookup host name (an extra TCP device step): if (IS_STRING(arg)) { sock->common.data = VAL_BIN(arg); sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80; result = OS_DO_DEVICE(sock, RDC_LOOKUP); // sets remote_ip field if (result < 0) fail (Error_On_Port(RE_NO_CONNECT, port, sock->error)); return R_OUT; } // Host IP specified: else if (IS_TUPLE(arg)) { sock->special.net.remote_port = IS_INTEGER(val) ? VAL_INT32(val) : 80; memcpy(&sock->special.net.remote_ip, VAL_TUPLE(arg), 4); break; } // No host, must be a LISTEN socket: else if (IS_NONE(arg)) { SET_FLAG(sock->modes, RST_LISTEN); sock->common.data = 0; // where ACCEPT requests are queued sock->special.net.local_port = IS_INTEGER(val) ? VAL_INT32(val) : 8000; break; } else fail (Error_On_Port(RE_INVALID_SPEC, port, -10)); case A_CLOSE: return R_OUT; case A_OPENQ: return R_FALSE; case A_UPDATE: // allowed after a close break; default: fail (Error_On_Port(RE_NOT_OPEN, port, -12)); } } // Actions for an open socket: switch (action) { // Ordered by frequency case A_UPDATE: // Update the port object after a READ or WRITE operation. // This is normally called by the WAKE-UP function. arg = OFV(port, STD_PORT_DATA); if (sock->command == RDC_READ) { if (ANY_BINSTR(arg)) VAL_TAIL(arg) += sock->actual; } else if (sock->command == RDC_WRITE) { SET_NONE(arg); // Write is done. } return R_NONE; case A_READ: // Read data into a buffer, expanding the buffer if needed. // If no length is given, program must stop it at some point. refs = Find_Refines(call_, ALL_READ_REFS); if ( !GET_FLAG(sock->modes, RST_UDP) && !GET_FLAG(sock->state, RSM_CONNECT) ) { fail (Error_On_Port(RE_NOT_CONNECTED, port, -15)); } // Setup the read buffer (allocate a buffer if needed): arg = OFV(port, STD_PORT_DATA); if (!IS_STRING(arg) && !IS_BINARY(arg)) { Val_Init_Binary(arg, Make_Binary(NET_BUF_SIZE)); } ser = VAL_SERIES(arg); sock->length = SERIES_AVAIL(ser); // space available if (sock->length < NET_BUF_SIZE/2) Extend_Series(ser, NET_BUF_SIZE); sock->length = SERIES_AVAIL(ser); sock->common.data = STR_TAIL(ser); // write at tail //if (SERIES_TAIL(ser) == 0) sock->actual = 0; // Actual for THIS read, not for total. //Print("(max read length %d)", sock->length); result = OS_DO_DEVICE(sock, RDC_READ); // recv can happen immediately if (result < 0) fail (Error_On_Port(RE_READ_ERROR, port, sock->error)); break; case A_WRITE: // Write the entire argument string to the network. // The lower level write code continues until done. refs = Find_Refines(call_, ALL_WRITE_REFS); if (!GET_FLAG(sock->modes, RST_UDP) && !GET_FLAG(sock->state, RSM_CONNECT)) fail (Error_On_Port(RE_NOT_CONNECTED, port, -15)); // Determine length. Clip /PART to size of string if needed. spec = D_ARG(2); len = VAL_LEN(spec); if (refs & AM_WRITE_PART) { REBCNT n = Int32s(D_ARG(ARG_WRITE_LIMIT), 0); if (n <= len) len = n; } // Setup the write: *OFV(port, STD_PORT_DATA) = *spec; // keep it GC safe sock->length = len; sock->common.data = VAL_BIN_DATA(spec); sock->actual = 0; //Print("(write length %d)", len); result = OS_DO_DEVICE(sock, RDC_WRITE); // send can happen immediately if (result < 0) fail (Error_On_Port(RE_WRITE_ERROR, port, sock->error)); if (result == DR_DONE) SET_NONE(OFV(port, STD_PORT_DATA)); break; case A_PICK: // FIRST server-port returns new port connection. len = Get_Num_Arg(arg); // Position if (len == 1 && GET_FLAG(sock->modes, RST_LISTEN) && sock->common.data) Accept_New_Port(D_OUT, port, sock); // sets D_OUT else fail (Error_Out_Of_Range(arg)); break; case A_QUERY: // Get specific information - the scheme's info object. // Special notation allows just getting part of the info. Ret_Query_Net(port, sock, D_OUT); break; case A_OPENQ: // Connect for clients, bind for servers: if (sock->state & ((1<<RSM_CONNECT) | (1<<RSM_BIND))) return R_TRUE; return R_FALSE; case A_CLOSE: if (IS_OPEN(sock)) { OS_DO_DEVICE(sock, RDC_CLOSE); SET_CLOSED(sock); } break; case A_LENGTH: arg = OFV(port, STD_PORT_DATA); len = ANY_SERIES(arg) ? VAL_TAIL(arg) : 0; SET_INTEGER(D_OUT, len); break; case A_OPEN: result = OS_DO_DEVICE(sock, RDC_CONNECT); if (result < 0) fail (Error_On_Port(RE_NO_CONNECT, port, sock->error)); break; case A_DELETE: // Temporary to TEST error handler! { REBVAL *event = Append_Event(); // sets signal VAL_SET(event, REB_EVENT); // (has more space, if we need it) VAL_EVENT_TYPE(event) = EVT_ERROR; VAL_EVENT_DATA(event) = 101; VAL_EVENT_REQ(event) = sock; } break; default: fail (Error_Illegal_Action(REB_PORT, action)); } return R_OUT; }
// // Error_Bad_Path_Range: C // REBCTX *Error_Bad_Path_Range(REBPVS *pvs) { return Error_Out_Of_Range(pvs->item); }
// // PD_Time: C // REBINT PD_Time(REBPVS *pvs) { REBVAL *val; REBINT i; REBINT n; REBDEC f; REB_TIMEF tf; if (IS_WORD(pvs->select)) { switch (VAL_WORD_CANON(pvs->select)) { case SYM_HOUR: i = 0; break; case SYM_MINUTE: i = 1; break; case SYM_SECOND: i = 2; break; default: return PE_BAD_SELECT; } } else if (IS_INTEGER(pvs->select)) i = VAL_INT32(pvs->select) - 1; else return PE_BAD_SELECT; Split_Time(VAL_TIME(pvs->value), &tf); // loses sign if (!(val = pvs->setval)) { val = pvs->store; switch(i) { case 0: // hours SET_INTEGER(val, tf.h); break; case 1: SET_INTEGER(val, tf.m); break; case 2: if (tf.n == 0) SET_INTEGER(val, tf.s); else SET_DECIMAL(val, (REBDEC)tf.s + (tf.n * NANO)); break; default: return PE_NONE; } return PE_USE; } else { if (IS_INTEGER(val) || IS_DECIMAL(val)) n = Int32s(val, 0); else if (IS_NONE(val)) n = 0; else return PE_BAD_SET; switch(i) { case 0: tf.h = n; break; case 1: tf.m = n; break; case 2: if (IS_DECIMAL(val)) { f = VAL_DECIMAL(val); if (f < 0.0) fail (Error_Out_Of_Range(val)); tf.s = (REBINT)f; tf.n = (REBINT)((f - tf.s) * SEC_SEC); } else { tf.s = n; tf.n = 0; } break; default: return PE_BAD_SELECT; } VAL_TIME(pvs->value) = Join_Time(&tf, FALSE); return PE_OK; } }
// // Make_Time: C // // Returns NO_TIME if error. // REBI64 Make_Time(REBVAL *val) { REBI64 secs = 0; if (IS_TIME(val)) { secs = VAL_TIME(val); } else if (IS_STRING(val)) { REBYTE *bp; REBCNT len; bp = Temp_Byte_Chars_May_Fail(val, MAX_SCAN_TIME, &len, FALSE); if (!Scan_Time(bp, len, val)) goto no_time; secs = VAL_TIME(val); } else if (IS_INTEGER(val)) { if (VAL_INT64(val) < -MAX_SECONDS || VAL_INT64(val) > MAX_SECONDS) fail (Error_Out_Of_Range(val)); secs = VAL_INT64(val) * SEC_SEC; } else if (IS_DECIMAL(val)) { if (VAL_DECIMAL(val) < (REBDEC)(-MAX_SECONDS) || VAL_DECIMAL(val) > (REBDEC)MAX_SECONDS) fail (Error_Out_Of_Range(val)); secs = DEC_TO_SECS(VAL_DECIMAL(val)); } else if (ANY_ARRAY(val) && VAL_BLK_LEN(val) <= 3) { REBFLG neg = FALSE; REBI64 i; val = VAL_BLK_DATA(val); if (!IS_INTEGER(val)) goto no_time; i = Int32(val); if (i < 0) i = -i, neg = TRUE; secs = i * 3600; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (!IS_INTEGER(val)) goto no_time; if ((i = Int32(val)) < 0) goto no_time; secs += i * 60; if (secs > MAX_SECONDS) goto no_time; if (NOT_END(++val)) { if (IS_INTEGER(val)) { if ((i = Int32(val)) < 0) goto no_time; secs += i; if (secs > MAX_SECONDS) goto no_time; } else if (IS_DECIMAL(val)) { if (secs + (REBI64)VAL_DECIMAL(val) + 1 > MAX_SECONDS) goto no_time; // added in below } else goto no_time; } } secs *= SEC_SEC; if (IS_DECIMAL(val)) secs += DEC_TO_SECS(VAL_DECIMAL(val)); if (neg) secs = -secs; } else no_time: return NO_TIME; return secs; }