コード例 #1
0
ファイル: s-mold.c プロジェクト: draegtun/ren-c
*/	REBSER *Form_Reduce(REBSER *block, REBCNT index)
/*
**		Reduce a block and then form each value into a string. Return the
**		string or NULL if an unwind triggered while reducing.
**
***********************************************************************/
{
	REBINT start = DSP + 1;
	REBINT n;

	REB_MOLD mo;

	while (index < BLK_LEN(block)) {
		index = Do_Next(block, index, 0);
		if (THROWN(DS_TOP)) {
			*DS_VALUE(start) = *DS_TOP;
			DSP = start;
			return NULL;
		}
	}

	CLEARS(&mo);
	Reset_Mold(&mo);

	for (n = start; n <= DSP; n++)
		Mold_Value(&mo, &DS_Base[n], 0);

	DSP = start;

	return Copy_String(mo.series, 0, -1);
}
コード例 #2
0
ファイル: dev-net.c プロジェクト: earl/r3-hostkit
*/	 DEVICE_CMD Accept_Socket(REBREQ *sock)
/*
**		Accept an inbound connection on a TCP listen socket.
**
**		The function will return:
**			=0: succeeded
**			>0: in-progress, still trying
**		    <0: error occurred, no longer trying
**
**		Before usage:
**			Open_Socket();
**			Set local_port to desired port number.
**			Listen_Socket();
**
***********************************************************************/
{
	SOCKAI sa;
	REBREQ *news;
	int len = sizeof(sa);
	int result;
	extern void Attach_Request(REBREQ **prior, REBREQ *req);

	// Accept a new socket, if there is one:
	result = accept(sock->socket, (struct sockaddr *)&sa, &len);

	if (result == BAD_SOCKET) {
		result = GET_ERROR;
		if (result == NE_WOULDBLOCK) return DR_PEND;
		sock->error = result;
		//Signal_Device(sock, EVT_ERROR);
		return DR_ERROR;
	}

	// To report the new socket, the code here creates a temporary
	// request and copies the listen request to it. Then, it stores
	// the new values for IP and ports and links this request to the
	// original via the sock->data.
	news = MAKE_NEW(*news);	// Be sure to deallocate it
	CLEARS(news);
//	*news = *sock;
	news->device = sock->device;

	SET_OPEN(news);
	SET_FLAG(news->state, RSM_OPEN);
	SET_FLAG(news->state, RSM_CONNECT);

	news->socket = result;
	news->net.remote_ip   = sa.sin_addr.s_addr; //htonl(ip); NOTE: REBOL stays in network byte order
	news->net.remote_port = ntohs(sa.sin_port);
	Get_Local_IP(news);

	//Nonblocking_Mode(news->socket);  ???Needed?

	Attach_Request((REBREQ**)&sock->data, news);
	Signal_Device(sock, EVT_ACCEPT);

	// Even though we signalled, we keep the listen pending to
	// accept additional connections.
	return DR_PEND;
}
コード例 #3
0
ファイル: p-file.c プロジェクト: mbk/ren-c
*/	static void Write_File_Port(REBREQ *file, REBVAL *data, REBCNT len, REBCNT args)
/*
***********************************************************************/
{
	REBSER *ser;

	if (IS_BLOCK(data)) {
		// Form the values of the block
		// !! Could be made more efficient if we broke the FORM
		// into 32K chunks for writing.
		REB_MOLD mo;
		CLEARS(&mo);
		Reset_Mold(&mo);
		if (args & AM_WRITE_LINES) {
			mo.opts = 1 << MOPT_LINES;
		}
		Mold_Value(&mo, data, 0);
		Set_String(data, mo.series); // fall into next section
		len = SERIES_TAIL(mo.series);
	}

	// Auto convert string to UTF-8
	if (IS_STRING(data)) {
		ser = Encode_UTF8_Value(data, len, ENCF_OS_CRLF);
		file->common.data = ser? BIN_HEAD(ser) : VAL_BIN_DATA(data); // No encoding may be needed
		len = SERIES_TAIL(ser);
	}
	else {
		file->common.data = VAL_BIN_DATA(data);
	}
	file->length = len;
	OS_DO_DEVICE(file, RDC_WRITE);
}
コード例 #4
0
ファイル: c-frame.c プロジェクト: kealist/ren-c
*/  void Init_Obj_Value(REBVAL *value, REBSER *frame)
/*
***********************************************************************/
{
	assert(frame);
	CLEARS(value);
	Val_Init_Object(value, frame);
}
コード例 #5
0
ファイル: c-frame.c プロジェクト: dailybarid/rebol
*/  void Init_Obj_Value(REBVAL *value, REBSER *frame)
/*
***********************************************************************/
{
	ASSERT(frame, RP_BAD_SET_CONTEXT);
	CLEARS(value);
	SET_OBJECT(value, frame);
}
コード例 #6
0
ファイル: u-dialect.c プロジェクト: 51weekend/r3
*/	REBINT Do_Dialect(REBSER *dialect, REBSER *block, REBCNT *index, REBSER **out)
/*
**		Format for dialect is:
**			CMD arg1 arg2 arg3 CMD arg1 arg2 ...
**
**		Returns:
**			cmd value or error as result (or zero for end)
**			index is updated
**			if *out is zero, then we create a new output block
**
**		The arg sequence is terminated by:
**			1. Maximum # of args for command
**			2. An arg that is not of a specified datatype for CMD
**			3. Encountering a new CMD
**			4. End of the dialect block
**
***********************************************************************/
{
	REBDIA dia;
	REBINT n;
	REBINT dsp = DSP; // Save stack position

	CLEARS(&dia);

	if (*index >= SERIES_TAIL(block)) return 0; // end of block

	DISABLE_GC; // Avoid GC during Dialect (prevents unknown crash problem)

	if (!*out) *out = Make_Block(25);

	dia.dialect = dialect;
	dia.args = block;
	dia.argi = *index;
	dia.out  = *out;	
	SET_FLAG(dia.flags, RDIA_NO_CMD);

	//Print("DSP: %d Dinp: %r - %m", DSP, BLK_SKIP(block, *index), block);
	n = Do_Dia(&dia);
	//Print("DSP: %d Dout: CMD: %d %m", DSP, dia.cmd, *out);
	DSP = dsp; // pop any temp values used above

	if (Delect_Debug > 0) {
		Total_Missed += dia.missed;
		// !!!! debug
		if (dia.missed) Debug_Fmt(Dia_Fmt, Get_Field_Name(dia.dialect, dia.cmd), dia.out->tail, dia.missed, Total_Missed);
	}

	if (n < 0) return n; //error
	*index = dia.argi;

	ENABLE_GC;

	return dia.cmd;
}
コード例 #7
0
ファイル: t-date.c プロジェクト: mbk/ren-c
*/	REBCNT Week_Day(REBDAT date)
/*
**		Return the day of the week for a specific date.
**
***********************************************************************/
{
	REBDAT year1;
	CLEARS(&year1);
	year1.date.day = 1;
	year1.date.month = 1;

	return ((Diff_Date(date, year1) + 5) % 7) + 1;
}
コード例 #8
0
ファイル: s-mold.c プロジェクト: draegtun/ren-c
*/  REBSER *Form_Tight_Block(REBVAL *blk)
/*
***********************************************************************/
{
	REBVAL *val;

	REB_MOLD mo;
	CLEARS(&mo);
	Reset_Mold(&mo);

	for (val = VAL_BLK_DATA(blk); NOT_END(val); val++)
		Mold_Value(&mo, val, 0);
	return Copy_String(mo.series, 0, -1);
}
コード例 #9
0
ファイル: s-mold.c プロジェクト: draegtun/ren-c
*/  REBSER *Copy_Mold_Value(const REBVAL *value, REBCNT opts)
/*
**		Form a value based on the mold opts provided.
**
***********************************************************************/
{
	REB_MOLD mo;
	CLEARS(&mo);
	mo.opts = opts;
	Reset_Mold(&mo);

	Mold_Value(&mo, value, TRUE);
	return Copy_String(mo.series, 0, -1);
}
コード例 #10
0
ファイル: s-ops.c プロジェクト: rhencke/rebol
//
//  Entab_Unicode: C
// 
// Entab a string and return a new series.
//
REBSER *Entab_Unicode(REBUNI *bp, REBCNT index, REBCNT len, REBINT tabsize)
{
    REBINT n = 0;
    REBUNI *dp;
    REBUNI c;

    REB_MOLD mo;
    CLEARS(&mo);
    mo.opts = MOPT_RESERVE;
    mo.reserve = len;

    Push_Mold(&mo);
    dp = UNI_AT(mo.series, mo.start);

    for (; index < len; index++) {

        c = bp[index];

        // Count leading spaces, insert TAB for each tabsize:
        if (c == ' ') {
            if (++n >= tabsize) {
                *dp++ = '\t';
                n = 0;
            }
            continue;
        }

        // Hitting a leading TAB resets space counter:
        if (c == '\t') {
            *dp++ = (REBYTE)c;
            n = 0;
        }
        else {
            // Incomplete tab space, pad with spaces:
            for (; n > 0; n--) *dp++ = ' ';

            // Copy chars thru end-of-line (or end of buffer):
            while (index < len) {
                if ((*dp++ = bp[index++]) == '\n') break;
            }
        }
    }

    SET_SERIES_LEN(mo.series, mo.start + cast(REBCNT, dp - UNI_AT(mo.series, mo.start)));
    UNI_TERM(mo.series);

    return Pop_Molded_String(&mo);
}
コード例 #11
0
ファイル: host-device.c プロジェクト: 51weekend/r3
*/	void Signal_Device(REBREQ *req, REBINT type)
/*
**		Generate a device event to awake a port on REBOL.
**
***********************************************************************/
{
	REBEVT evt;

	CLEARS(&evt);

	evt.type = (REBYTE)type;
	evt.model = EVM_DEVICE;
	evt.req  = req;
	if (type == EVT_ERROR) evt.data = req->error;

	RL_Event(&evt);	// (returns 0 if queue is full, ignored)
}
コード例 #12
0
ファイル: p-dir.c プロジェクト: kealist/ren-c
*/	static int Read_Dir(REBREQ *dir, REBSER *files)
/*
**		Provide option to get file info too.
**		Provide option to prepend dir path.
**		Provide option to use wildcards.
**
***********************************************************************/
{
	REBINT result;
	REBCNT len;
	REBSER *fname;
	REBSER *name;
	REBREQ file;

	RESET_TAIL(files);
	CLEARS(&file);

	// Temporary filename storage:
	fname = BUF_OS_STR;
	file.special.file.path = cast(REBCHR*, Reset_Buffer(fname, MAX_FILE_NAME));

	SET_FLAG(dir->modes, RFM_DIR);

	dir->common.data = cast(REBYTE*, &file);

	while ((result = OS_DO_DEVICE(dir, RDC_READ)) == 0 && !GET_FLAG(dir->flags, RRF_DONE)) {
		len = OS_STRLEN(file.special.file.path);
		if (GET_FLAG(file.modes, RFM_DIR)) len++;
		name = Copy_OS_Str(file.special.file.path, len);
		if (GET_FLAG(file.modes, RFM_DIR))
			SET_ANY_CHAR(name, name->tail-1, '/');
		Val_Init_File(Alloc_Tail_Array(files), name);
	}

	if (result < 0 && dir->error != -RFE_OPEN_FAIL
		&& (
			OS_STRCHR(dir->special.file.path, '*')
			|| OS_STRCHR(dir->special.file.path, '?')
		)
	) {
		result = 0;  // no matches found, but not an error
	}

	return result;
}
コード例 #13
0
ファイル: host-device.c プロジェクト: 51weekend/r3
*/	REBINT OS_Wait(REBCNT millisec, REBCNT res)
/*
**		Check if devices need attention, and if not, then wait.
**		The wait can be interrupted by a GUI event, otherwise
**		the timeout will wake it.
**
**		Res specifies resolution. (No wait if less than this.)
**
**		Returns:
**			-1: Devices have changed state.
**		     0: past given millsecs
**			 1: wait in timer
**
**		The time it takes for the devices to be scanned is
**		subtracted from the timer value.
**
***********************************************************************/
{
	REBREQ req;		// OK: QUERY below does not store it
	REBCNT delta;
	i64 base;

	// printf("OS_Wait %d\n", millisec);

	base = OS_Delta_Time(0, 0); // start timing

	// Setup for timing:
	CLEARS(&req);
	req.device = RDI_EVENT;

	// Let any pending device I/O have a chance to run:
	if (OS_Poll_Devices()) return -1;

	// Nothing, so wait for period of time
	delta = (REBCNT)OS_Delta_Time(base, 0)/1000 + res;
	if (delta >= millisec) return 0;
	millisec -= delta;  // account for time lost above
	req.length = millisec;

	// printf("Wait: %d ms\n", millisec);
	OS_Do_Device(&req, RDC_QUERY); // wait for timer or other event

	return 1;  // layer above should check delta again
}
コード例 #14
0
ファイル: main.c プロジェクト: lidongliangfly/cinclude
static bool check_allocs(void)
{
    DCHECK;

    bool ret = false;
    struct __a *p = NULL;
    int const n = 4;

    TALLOCS(p, n, goto error);

    ASSERT(p != NULL, goto error);

    int i,j;

    for(i = 0; i < n; ++i) {
        for(j = 0; j < 100; ++j) {
            p[i].dummy[j] = -1;
        }
    }

    CLEARS(p, n);

    DUMPZ(sizeof(*p) * n);

    for(i = 0; i < n; ++i) {
        for(j = 0; j < 100; ++j) {
            MASSERT(p[i].dummy[j] == 0, goto error,
                    "(%d,%d) = %d\n", i, j, p[i].dummy[j]);
        }
    }

    REALLOC(p,1, goto error);
    REALLOC(p,2, goto error);

    ret = true;
error:

    FREE(p);
    ASSERT(p == NULL, return false);

    return ret;
}
コード例 #15
0
ファイル: s-ops.c プロジェクト: rhencke/rebol
//
//  Detab_Unicode: C
// 
// Detab a unicode string and return a new series.
//
REBSER *Detab_Unicode(REBUNI *bp, REBCNT index, REBCNT len, REBINT tabsize)
{
    REBCNT cnt = 0;
    REBCNT n;
    REBUNI *dp;
    REBUNI c;

    REB_MOLD mo;
    CLEARS(&mo);

    // Estimate new length based on tab expansion:
    for (n = index; n < len; n++)
        if (bp[n] == TAB) cnt++;

    mo.opts = MOPT_RESERVE;
    mo.reserve = len + (cnt * (tabsize - 1));

    Push_Mold(&mo);
    dp = UNI_AT(mo.series, mo.start);
    n = 0;
    while (index < len) {

        c = bp[index++];

        if (c == '\t') {
            *dp++ = ' ';
            n++;
            for (; n % tabsize != 0; n++) *dp++ = ' ';
            continue;
        }

        if (c == '\n') n = 0;
        else n++;

        *dp++ = c;
    }

    SET_SERIES_LEN(mo.series, mo.start + cast(REBCNT, dp - UNI_AT(mo.series, mo.start)));
    UNI_TERM(mo.series);

    return Pop_Molded_String(&mo);
}
コード例 #16
0
ファイル: host-device.c プロジェクト: 51weekend/r3
*/	REBREQ *OS_Make_Devreq(int device)
/*
***********************************************************************/
{
	REBDEV *dev;
	REBREQ *req;
	int size;

	// Validate device:
	if (device >= RDI_MAX || !(dev = Devices[device]))
		return 0;

	size = dev->req_size ? dev->req_size : sizeof(REBREQ);
	req = OS_Make(size);
	CLEARS(req);
	SET_FLAG(req->flags, RRF_ALLOC);
	req->clen = size;
	req->device = device;

	return req;
}
コード例 #17
0
ファイル: a-lib.c プロジェクト: asampal/ren-c
*/ RL_API int RL_Set_Field(REBSER *obj, u32 word, RXIARG val, int type)
/*
**	Set a field (context variable) of an object.
**
**	Returns:
**		The type arg, or zero if word not found in object or if field is protected.
**	Arguments:
**		obj  - object pointer (e.g. from RXA_OBJECT)
**		word - global word identifier (integer)
**		val  - new value for field
**		type - datatype of value
**
***********************************************************************/
{
	REBVAL value;
	CLEARS(&value);
	if (!(word = Find_Word_Index(obj, word, FALSE))) return 0;
	if (VAL_GET_EXT(FRM_KEYS(obj) + word, EXT_WORD_LOCK)) return 0;
	RXI_To_Value(FRM_VALUES(obj)+word, val, type);
	return type;
}
コード例 #18
0
ファイル: s-mold.c プロジェクト: draegtun/ren-c
*/	REBSER *Mold_Print_Value(const REBVAL *value, REBCNT limit, REBFLG mold)
/*
**		Basis function for print.  Can do a form or a mold based
**		on the mold flag setting.  Can limit string output to a
**		specified size to prevent long console garbage output.
**
***********************************************************************/
{
	REB_MOLD mo;
	CLEARS(&mo);
	Reset_Mold(&mo);

	Mold_Value(&mo, value, mold);

	if (limit != 0 && STR_LEN(mo.series) > limit) {
		SERIES_TAIL(mo.series) = limit;
		Append_Unencoded(mo.series, "..."); // adds a null at the tail
	}

	return mo.series;
}
コード例 #19
0
ファイル: host-stdio.c プロジェクト: mbk/ren-c
*/	void Open_StdIO(void)
/*
**		Open REBOL's standard IO device. This same device is used
**		by both the host code and the R3 DLL itself.
**
**		This must be done before any other initialization is done
**		in order to output banners or errors.
**
***********************************************************************/
{
	CLEARS(&Std_IO_Req);
	Std_IO_Req.clen = sizeof(Std_IO_Req);
	Std_IO_Req.device = RDI_STDIO;

	OS_Do_Device(&Std_IO_Req, RDC_OPEN);

	if (Std_IO_Req.error) Host_Crash("stdio open");

	inbuf = OS_ALLOC_ARRAY(REBYTE, inbuf_len);
	inbuf[0] = 0;
}
コード例 #20
0
ファイル: a-lib.c プロジェクト: asampal/ren-c
*/ RL_API int RL_Callback(RXICBI *cbi)
/*
**	Evaluate a REBOL callback function, either synchronous or asynchronous.
**
**	Returns:
**		Sync callback: type of the result; async callback: true if queued
**	Arguments:
**		cbi - callback information including special option flags,
**			object pointer (where function is located), function name
**			as global word identifier (within above object), argument list
**			passed to callback (see notes below), and result value.
**	Notes:
**		The flag value will determine the type of callback. It can be either
**		synchronous, where the code will re-enter the interpreter environment
**		and call the specified function, or asynchronous where an EVT_CALLBACK
**		event is queued, and the callback will be evaluated later when events
**		are processed within the interpreter's environment.
**		For asynchronous callbacks, the cbi and the args array must be managed
**		because the data isn't processed until the callback event is
**		handled. Therefore, these cannot be allocated locally on
**		the C stack; they should be dynamic (or global if so desired.)
**		See c:extensions-callbacks
**
***********************************************************************/
{
	REBEVT evt;

	// Synchronous callback?
	if (!GET_FLAG(cbi->flags, RXC_ASYNC)) {
		return Do_Callback(cbi->obj, cbi->word, cbi->args, &(cbi->result));
	}

	CLEARS(&evt);
	evt.type = EVT_CALLBACK;
	evt.model = EVM_CALLBACK;
	evt.eventee.ser = cbi;
	SET_FLAG(cbi->flags, RXC_QUEUED);

	return RL_Event(&evt);	// (returns 0 if queue is full, ignored)
}
コード例 #21
0
ファイル: p-dir.c プロジェクト: 51weekend/r3
*/	static int Read_Dir(REBREQ *dir, REBSER *files)
/*
**		Provide option to get file info too.
**		Provide option to prepend dir path.
**		Provide option to use wildcards.
**
***********************************************************************/
{
	REBINT result;
	REBCNT len;
	REBSER *fname;
	REBSER *name;
	REBREQ file;

	RESET_TAIL(files);
	CLEARS(&file);

	// Temporary filename storage:
	fname = BUF_OS_STR;
	file.file.path = (REBCHR*)Reset_Buffer(fname, MAX_FILE_NAME);

	SET_FLAG(dir->modes, RFM_DIR);

	dir->data = (REBYTE*)(&file);

	while ((result = OS_DO_DEVICE(dir, RDC_READ)) == 0 && !GET_FLAG(dir->flags, RRF_DONE)) {
		len = LEN_STR(file.file.path);
		if (GET_FLAG(file.modes, RFM_DIR)) len++;
		name = Copy_OS_Str(file.file.path, len);
		if (GET_FLAG(file.modes, RFM_DIR))
			SET_ANY_CHAR(name, name->tail-1, '/');
		Set_Series(REB_FILE, Append_Value(files), name);
	}

	if (result < 0 && dir->error != -RFE_OPEN_FAIL
		&& (FIND_CHR(dir->file.path, '*') || FIND_CHR(dir->file.path, '?')))
		result = 0;  // no matches found, but not an error

	return result;
}
コード例 #22
0
ファイル: a-lib.c プロジェクト: asampal/ren-c
*/ RL_API int RL_Set_Value(REBSER *series, u32 index, RXIARG val, int type)
/*
**	Set a value in a block.
**
**	Returns:
**		TRUE if index past end and value was appended to tail of block.
**	Arguments:
**		series - block series pointer
**		index - index of the value in the block (zero based)
**		val  - new value for field
**		type - datatype of value
**
***********************************************************************/
{
	REBVAL value;
	CLEARS(&value);
	RXI_To_Value(&value, val, type);
	if (index >= series->tail) {
		Append_Value(series, &value);
		return TRUE;
	}
	*BLK_SKIP(series, index) = value;
	return FALSE;
}
コード例 #23
0
ファイル: p-dir.c プロジェクト: kealist/ren-c
*/	static REB_R Dir_Actor(struct Reb_Call *call_, REBSER *port, REBCNT action)
/*
**		Internal port handler for file directories.
**
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *path;
	REBVAL *state;
	REBREQ dir;
	REBCNT args = 0;
	REBINT result;
	REBCNT len;
	//REBYTE *flags;

	Validate_Port(port, action);

	*D_OUT = *D_ARG(1);
	CLEARS(&dir);

	// Validate and fetch relevant PORT fields:
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) raise Error_1(RE_INVALID_SPEC, spec);
	path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
	if (!path) raise Error_1(RE_INVALID_SPEC, spec);

	if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
	else if (!IS_FILE(path)) raise Error_1(RE_INVALID_SPEC, path);

	state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.

	//flags = Security_Policy(SYM_FILE, path);

	// Get or setup internal state data:
	dir.port = port;
	dir.device = RDI_FILE;

	switch (action) {

	case A_READ:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(call_, ALL_READ_REFS);
		if (!IS_BLOCK(state)) {		// !!! ignores /SKIP and /PART, for now
			Init_Dir_Path(&dir, path, 1, POL_READ);
			Val_Init_Block(state, Make_Array(7)); // initial guess
			result = Read_Dir(&dir, VAL_SERIES(state));
			///OS_FREE(dir.file.path);
			if (result < 0)
				raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error);
			*D_OUT = *state;
			SET_NONE(state);
		}
		else {
			// !!! This copies the strings in the block, shallowly.  What is
			// the purpose of doing this?  Why copy at all?
			Val_Init_Block(
				D_OUT,
				Copy_Array_Core_Managed(
					VAL_SERIES(state),
					0,
					VAL_BLK_LEN(state),
					FALSE, // !deep
					TS_STRING
				)
			);
		}
		break;

	case A_CREATE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
create:
		Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
		result = OS_DO_DEVICE(&dir, RDC_CREATE);
		///OS_FREE(dir.file.path);
		if (result < 0) raise Error_1(RE_NO_CREATE, path);
		if (action == A_CREATE) {
			// !!! Used to return R_ARG2, but create is single arity.  :-/
			return R_ARG1;
		}
		SET_NONE(state);
		break;

	case A_RENAME:
		if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
		else {
			REBSER *target;

			Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
			// Convert file name to OS format:
			if (!(target = Value_To_OS_Path(D_ARG(2), TRUE)))
				raise Error_1(RE_BAD_FILE_PATH, D_ARG(2));
			dir.common.data = BIN_DATA(target);
			OS_DO_DEVICE(&dir, RDC_RENAME);
			Free_Series(target);
			if (dir.error) raise Error_1(RE_NO_RENAME, path);
		}
		break;

	case A_DELETE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, 0, POL_WRITE);
		// !!! add *.r deletion
		// !!! add recursive delete (?)
		result = OS_DO_DEVICE(&dir, RDC_DELETE);
		///OS_FREE(dir.file.path);
		if (result < 0) raise Error_1(RE_NO_DELETE, path);
		// !!! Returned R_ARG2 before, but there is no second argument :-/
		return R_ARG1;

	case A_OPEN:
		// !! If open fails, what if user does a READ w/o checking for error?
		if (IS_BLOCK(state)) raise Error_1(RE_ALREADY_OPEN, path);
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(call_, ALL_OPEN_REFS);
		if (args & AM_OPEN_NEW) goto create;
		//if (args & ~AM_OPEN_READ) raise Error_1(RE_INVALID_SPEC, path);
		Val_Init_Block(state, Make_Array(7));
		Init_Dir_Path(&dir, path, 1, POL_READ);
		result = Read_Dir(&dir, VAL_SERIES(state));
		///OS_FREE(dir.file.path);
		if (result < 0) raise Error_On_Port(RE_CANNOT_OPEN, port, dir.error);
		break;

	case A_OPENQ:
		if (IS_BLOCK(state)) return R_TRUE;
		return R_FALSE;

	case A_CLOSE:
		SET_NONE(state);
		break;

	case A_QUERY:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
		if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
		Ret_Query_File(port, &dir, D_OUT);
		///OS_FREE(dir.file.path);
		break;

	//-- Port Series Actions (only called if opened as a port)

	case A_LENGTH:
		len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
		SET_INTEGER(D_OUT, len);
		break;

	default:
		raise Error_Illegal_Action(REB_PORT, action);
	}

	return R_OUT;
}
コード例 #24
0
ファイル: s-mold.c プロジェクト: draegtun/ren-c
static void Mold_String_Series(const REBVAL *value, REB_MOLD *mold)
{
	REBCNT len = VAL_LEN(value);
	REBSER *ser = VAL_SERIES(value);
	REBCNT idx = VAL_INDEX(value);
	REBYTE *bp;
	REBUNI *up;
	REBUNI *dp;
	REBOOL uni = !BYTE_SIZE(ser);
	REBCNT n;
	REBUNI c;

	REB_STRF sf;
	CLEARS(&sf);

	// Empty string:
	if (idx >= VAL_TAIL(value)) {
		Append_Unencoded(mold->series, "\"\"");  //Trap_DEAD_END(RE_PAST_END);
		return;
	}

	Sniff_String(ser, idx, &sf);
	if (!GET_MOPT(mold, MOPT_ANSI_ONLY)) sf.paren = 0;

	// Source can be 8 or 16 bits:
	if (uni) up = UNI_HEAD(ser);
	else bp = STR_HEAD(ser);

	// If it is a short quoted string, emit it as "string":
	if (len <= MAX_QUOTED_STR && sf.quote == 0 && sf.newline < 3) {

		dp = Prep_Uni_Series(mold, len + sf.newline + sf.escape + sf.paren + sf.chr1e + 2);

		*dp++ = '"';

		for (n = idx; n < VAL_TAIL(value); n++) {
			c = uni ? up[n] : cast(REBUNI, bp[n]);
			dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
		}

		*dp++ = '"';
		*dp = 0;
		return;
	}

	// It is a braced string, emit it as {string}:
	if (!sf.malign) sf.brace_in = sf.brace_out = 0;

	dp = Prep_Uni_Series(mold, len + sf.brace_in + sf.brace_out + sf.escape + sf.paren + sf.chr1e + 2);

	*dp++ = '{';

	for (n = idx; n < VAL_TAIL(value); n++) {

		c = uni ? up[n] : cast(REBUNI, bp[n]);
		switch (c) {
		case '{':
		case '}':
			if (sf.malign) {
				*dp++ = '^';
				*dp++ = c;
				break;
			}
		case '\n':
		case '"':
			*dp++ = c;
			break;
		default:
			dp = Emit_Uni_Char(dp, c, (REBOOL)GET_MOPT(mold, MOPT_ANSI_ONLY)); // parened
		}
	}

	*dp++ = '}';
	*dp = 0;
}
コード例 #25
0
ファイル: host-args.c プロジェクト: RamchandraApte/rebol
*/	void Parse_Args(int argc, REBCHR **argv, REBARGS *rargs)
/*
**		Parse REBOL's command line arguments, setting options
**		and values in the provided args structure.
**
***********************************************************************/
{
	REBCHR *arg;
	REBCHR *args = 0; // holds trailing args
	int flag;
	int i;

	CLEARS(rargs);

	// First arg is path to execuable (on most systems):
	if (argc > 0) rargs->exe_path = *argv;

	OS_Get_Current_Dir(&rargs->home_dir);

	// Parse each argument:
	for (i = 1; i < argc ; i++) {
		arg = argv[i];
		if (arg == 0) continue; // shell bug
		if (*arg == '-') {
			if (arg[1] == '-') {
				// --option words
				flag = find_option_word(arg+2);
				if (flag & RO_EXT) {
					flag = Get_Ext_Arg(flag, rargs, (i+1 >= argc) ? 0 : argv[i+1]);
					if ((flag & RO_EXT) == 0) i++; // used it
					else flag &= ~RO_EXT;
				}
				if (!flag) flag = RO_HELP;
				rargs->options |= flag;
			}
			else {
				// -x option chars
				while (*++arg) {
					flag = find_option_char(*arg, arg_chars);
					if (flag & RO_EXT) {
						flag = Get_Ext_Arg(flag, rargs, (i+1 >= argc) ? 0 : argv[i+1]);
						if ((flag & RO_EXT) == 0) i++; // used it
						else flag &= ~RO_EXT;
					}
					if (!flag) flag = RO_HELP;
					rargs->options |= flag;
				}
			}
		}
		else if (*arg == '+') {
			// +x option chars
			while (*++arg) {
				flag = find_option_char(*arg, arg_chars2);
				if (flag & RO_EXT) {
					flag = Get_Ext_Arg(flag, rargs, (i+1 >= argc) ? 0 : argv[i+1]);
					if ((flag & RO_EXT) == 0) i++; // used it
					else flag &= ~RO_EXT;
				}
				if (!flag) flag = RO_HELP;
				rargs->options |= flag;
			}
		}
		else {
			// script filename
			if (!rargs->script)
				rargs->script = arg;
			else {
				int len;
				if (!args) {
					args = MAKE_STR(ARG_BUF_SIZE);
					args[0] = 0;
				}
				len = ARG_BUF_SIZE - LEN_STR(args) - 2; // space remaining
				JOIN_STR(args, arg, len);
				JOIN_STR(args, TXT(" "), 1);
			}
		}
	}

	if (args) {
		args[LEN_STR(args)-1] = 0; // remove trailing space
		Get_Ext_Arg(RO_ARGS, rargs, args);
	}
}
コード例 #26
0
ファイル: p-dir.c プロジェクト: 51weekend/r3
*/	static int Dir_Actor(REBVAL *ds, REBSER *port, REBCNT action)
/*
**		Internal port handler for file directories.
**
***********************************************************************/
{
	REBVAL *spec;
	REBVAL *path;
	REBVAL *state;
	REBREQ dir;
	REBCNT args = 0;
	REBINT result;
	REBCNT len;
	//REBYTE *flags;

	Validate_Port(port, action);

	*D_RET = *D_ARG(1);
	CLEARS(&dir);

	// Validate and fetch relevant PORT fields:
	spec  = BLK_SKIP(port, STD_PORT_SPEC);
	if (!IS_OBJECT(spec)) Trap1(RE_INVALID_SPEC, spec);
	path = Obj_Value(spec, STD_PORT_SPEC_HEAD_REF);
	if (!path) Trap1(RE_INVALID_SPEC, spec);

	if (IS_URL(path)) path = Obj_Value(spec, STD_PORT_SPEC_HEAD_PATH);
	else if (!IS_FILE(path)) Trap1(RE_INVALID_SPEC, path);
	
	state = BLK_SKIP(port, STD_PORT_STATE); // if block, then port is open.

	//flags = Security_Policy(SYM_FILE, path);

	// Get or setup internal state data:
	dir.port = port;
	dir.device = RDI_FILE;

	switch (action) {

	case A_READ:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(ds, ALL_READ_REFS);
		if (!IS_BLOCK(state)) {		// !!! ignores /SKIP and /PART, for now
			Init_Dir_Path(&dir, path, 1, POL_READ);
			Set_Block(state, Make_Block(7)); // initial guess
			result = Read_Dir(&dir, VAL_SERIES(state));
			///OS_FREE(dir.file.path);
			if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
			*D_RET = *state;
			SET_NONE(state);
		} else {
			len = VAL_BLK_LEN(state);
			// !!? Why does this need to copy the block??
			Set_Block(D_RET, Copy_Block_Values(VAL_SERIES(state), 0, len, TS_STRING));
		}
		break;

	case A_CREATE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
create:
		Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
		result = OS_DO_DEVICE(&dir, RDC_CREATE);
		///OS_FREE(dir.file.path);
		if (result < 0) Trap1(RE_NO_CREATE, path);
		if (action == A_CREATE) return R_ARG2;
		SET_NONE(state);
		break;

	case A_RENAME:
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
		else {
			REBSER *target;

			Init_Dir_Path(&dir, path, 0, POL_WRITE | REMOVE_TAIL_SLASH); // Sets RFM_DIR too
			// Convert file name to OS format:
			if (!(target = Value_To_OS_Path(D_ARG(2)))) Trap1(RE_BAD_FILE_PATH, D_ARG(2));
			dir.data = BIN_DATA(target);
			OS_DO_DEVICE(&dir, RDC_RENAME);
			Free_Series(target);
			if (dir.error) Trap1(RE_NO_RENAME, path);
		}
		break;

	case A_DELETE:
		//Trap_Security(flags[POL_WRITE], POL_WRITE, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, 0, POL_WRITE);
		// !!! add *.r deletion
		// !!! add recursive delete (?)
		result = OS_DO_DEVICE(&dir, RDC_DELETE);
		///OS_FREE(dir.file.path);
		if (result < 0) Trap1(RE_NO_DELETE, path);
		return R_ARG2;

	case A_OPEN:
		// !! If open fails, what if user does a READ w/o checking for error?
		if (IS_BLOCK(state)) Trap1(RE_ALREADY_OPEN, path); // already open
		//Trap_Security(flags[POL_READ], POL_READ, path);
		args = Find_Refines(ds, ALL_OPEN_REFS);
		if (args & AM_OPEN_NEW) goto create;
		//if (args & ~AM_OPEN_READ) Trap1(RE_INVALID_SPEC, path);
		Set_Block(state, Make_Block(7));
		Init_Dir_Path(&dir, path, 1, POL_READ);
		result = Read_Dir(&dir, VAL_SERIES(state));
		///OS_FREE(dir.file.path);
		if (result < 0) Trap_Port(RE_CANNOT_OPEN, port, dir.error);
		break;

	case A_OPENQ:
		if (IS_BLOCK(state)) return R_TRUE;
		return R_FALSE;

	case A_CLOSE:
		SET_NONE(state);
		break;

	case A_QUERY:
		//Trap_Security(flags[POL_READ], POL_READ, path);
		SET_NONE(state);
		Init_Dir_Path(&dir, path, -1, REMOVE_TAIL_SLASH | POL_READ);
		if (OS_DO_DEVICE(&dir, RDC_QUERY) < 0) return R_NONE;
		Ret_Query_File(port, &dir, D_RET);
		///OS_FREE(dir.file.path);
		break;

	//-- Port Series Actions (only called if opened as a port)

	case A_LENGTHQ:
		len = IS_BLOCK(state) ? VAL_BLK_LEN(state) : 0;
		SET_INTEGER(D_RET, len);
		break;

	default:
		Trap_Action(REB_PORT, action);
	}

	return R_RET;
}
コード例 #27
0
ファイル: n-sets.c プロジェクト: rgchris/ren-c
//
//  Make_Set_Operation_Series: C
// 
// Do set operations on a series.  Case-sensitive if `cased` is TRUE.
// `skip` is the record size.
//
static REBSER *Make_Set_Operation_Series(
    const REBVAL *val1,
    const REBVAL *val2,
    REBFLGS flags,
    REBOOL cased,
    REBCNT skip
) {
    REBCNT i;
    REBINT h = 1; // used for both logic true/false and hash check
    REBOOL first_pass = TRUE; // are we in the first pass over the series?
    REBSER *out_ser;

    assert(ANY_SERIES(val1));

    if (val2) {
        assert(ANY_SERIES(val2));

        if (ANY_ARRAY(val1)) {
            if (!ANY_ARRAY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));

            // As long as they're both arrays, we're willing to do:
            //
            //     >> union quote (a b c) 'b/d/e
            //     (a b c d e)
            //
            // The type of the result will match the first value.
        }
        else if (!IS_BINARY(val1)) {

            // We will similarly do any two ANY-STRING! types:
            //
            //      >> union <abc> "bde"
            //      <abcde>

            if (IS_BINARY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));
        }
        else {
            // Binaries only operate with other binaries

            if (!IS_BINARY(val2))
                fail (Error_Unexpected_Type(VAL_TYPE(val1), VAL_TYPE(val2)));
        }
    }

    // Calculate `i` as maximum length of result block.  The temporary buffer
    // will be allocated at this size, but copied out at the exact size of
    // the actual result.
    //
    i = VAL_LEN_AT(val1);
    if (flags & SOP_FLAG_BOTH) i += VAL_LEN_AT(val2);

    if (ANY_ARRAY(val1)) {
        REBSER *hser = 0;   // hash table for series
        REBSER *hret;       // hash table for return series

        // The buffer used for building the return series.  Currently it
        // reuses BUF_EMIT, because that buffer is not likely to be in
        // use (emit doesn't call set operations, nor vice versa).  However,
        // other routines may get the same idea and start recursing so it
        // may be better to use something more similar to the mold stack
        // approach of marking off successive ranges in the array.
        //
        REBSER *buffer = ARR_SERIES(BUF_EMIT);
        Resize_Series(buffer, i);
        hret = Make_Hash_Sequence(i);   // allocated

        // Optimization note: !!
        // This code could be optimized for small blocks by not hashing them
        // and extending Find_Key to FIND on the value itself w/o the hash.

        do {
            REBARR *array1 = VAL_ARRAY(val1); // val1 and val2 swapped 2nd pass!

            // Check what is in series1 but not in series2
            //
            if (flags & SOP_FLAG_CHECK)
                hser = Hash_Block(val2, skip, cased);

            // Iterate over first series
            //
            i = VAL_INDEX(val1);
            for (; i < ARR_LEN(array1); i += skip) {
                RELVAL *item = ARR_AT(array1, i);
                if (flags & SOP_FLAG_CHECK) {
                    h = Find_Key_Hashed(
                        VAL_ARRAY(val2),
                        hser,
                        item,
                        VAL_SPECIFIER(val1),
                        skip,
                        cased,
                        1
                    );
                    h = (h >= 0);
                    if (flags & SOP_FLAG_INVERT) h = !h;
                }
                if (h) {
                    Find_Key_Hashed(
                        AS_ARRAY(buffer),
                        hret,
                        item,
                        VAL_SPECIFIER(val1),
                        skip,
                        cased,
                        2
                    );
                }
            }

            if (i != ARR_LEN(array1)) {
                //
                // In the current philosophy, the semantics of what to do
                // with things like `intersect/skip [1 2 3] [7] 2` is too
                // shaky to deal with, so an error is reported if it does
                // not work out evenly to the skip size.
                //
                fail (Error(RE_BLOCK_SKIP_WRONG));
            }

            if (flags & SOP_FLAG_CHECK)
                Free_Series(hser);

            if (!first_pass) break;
            first_pass = FALSE;

            // Iterate over second series?
            //
            if ((i = ((flags & SOP_FLAG_BOTH) != 0))) {
                const REBVAL *temp = val1;
                val1 = val2;
                val2 = temp;
            }
        } while (i);

        if (hret)
            Free_Series(hret);

        out_ser = ARR_SERIES(Copy_Array_Shallow(AS_ARRAY(buffer), SPECIFIED));
        SET_SERIES_LEN(buffer, 0); // required - allow reuse
    }
    else {
        REB_MOLD mo;
        CLEARS(&mo);

        if (IS_BINARY(val1)) {
            //
            // All binaries use "case-sensitive" comparison (e.g. each byte
            // is treated distinctly)
            //
            cased = TRUE;
        }

        // ask mo.series to have at least `i` capacity beyond mo.start
        //
        mo.opts = MOPT_RESERVE;
        mo.reserve = i;
        Push_Mold(&mo);

        do {
            REBSER *ser = VAL_SERIES(val1); // val1 and val2 swapped 2nd pass!
            REBUNI uc;

            // Iterate over first series
            //
            i = VAL_INDEX(val1);
            for (; i < SER_LEN(ser); i += skip) {
                uc = GET_ANY_CHAR(ser, i);
                if (flags & SOP_FLAG_CHECK) {
                    h = (NOT_FOUND != Find_Str_Char(
                        uc,
                        VAL_SERIES(val2),
                        0,
                        VAL_INDEX(val2),
                        VAL_LEN_HEAD(val2),
                        skip,
                        cased ? AM_FIND_CASE : 0
                    ));

                    if (flags & SOP_FLAG_INVERT) h = !h;
                }

                if (!h) continue;

                if (
                    NOT_FOUND == Find_Str_Char(
                        uc, // c2 (the character to find)
                        mo.series, // ser
                        mo.start, // head
                        mo.start, // index
                        SER_LEN(mo.series), // tail
                        skip, // skip
                        cased ? AM_FIND_CASE : 0 // flags
        )
                ) {
                    Append_String(mo.series, ser, i, skip);
                }
            }

            if (!first_pass) break;
            first_pass = FALSE;

            // Iterate over second series?
            //
            if ((i = ((flags & SOP_FLAG_BOTH) != 0))) {
                const REBVAL *temp = val1;
                val1 = val2;
                val2 = temp;
            }
        } while (i);

        out_ser = Pop_Molded_String(&mo);
    }

    return out_ser;
}