PageRenderTime 180ms CodeModel.GetById 61ms app.highlight 78ms RepoModel.GetById 32ms app.codeStats 1ms

/src/core/c-error.c

https://github.com/WoodyLin/r3
C | 835 lines | 358 code | 124 blank | 353 comment | 73 complexity | a4ec293259c8dc776b38153d3279b2be MD5 | raw file
  1/***********************************************************************
  2**
  3**  REBOL [R3] Language Interpreter and Run-time Environment
  4**
  5**  Copyright 2012 REBOL Technologies
  6**  REBOL is a trademark of REBOL Technologies
  7**
  8**  Licensed under the Apache License, Version 2.0 (the "License");
  9**  you may not use this file except in compliance with the License.
 10**  You may obtain a copy of the License at
 11**
 12**  http://www.apache.org/licenses/LICENSE-2.0
 13**
 14**  Unless required by applicable law or agreed to in writing, software
 15**  distributed under the License is distributed on an "AS IS" BASIS,
 16**  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 17**  See the License for the specific language governing permissions and
 18**  limitations under the License.
 19**
 20************************************************************************
 21**
 22**  Module:  c-error.c
 23**  Summary: error handling
 24**  Section: core
 25**  Author:  Carl Sassenrath
 26**  Notes:
 27**
 28***********************************************************************/
 29/*
 30		The Trap() functions are used for errors within the C code.
 31
 32		TrapN() provides simple trampoline to the var-arg Make_Error()
 33		that constructs a new error object.
 34
 35		The Make_Error function uses the error category objects to
 36		convert from an error code (integer) to error words and strings.
 37		Other important state information such as location of error
 38		and function context are also saved at this point.
 39
 40		Throw_Error is called to throw the error back to a prior catch.
 41		A catch is defined using a set of C-macros. During the throw
 42		the error object is stored in a global: This_Error (because we
 43		cannot be sure that the longjmp value is able to hold a pointer
 44		on 64bit CPUs.)
 45
 46		On the catch side, the Catch_Error function takes the error
 47		object and stores it into the value provided (normally on the
 48		DStack).
 49
 50		Catch_Error can be extended to provide a debugging breakpoint
 51		for examining the call trace and context frames on the stack.
 52*/
 53/*
 54
 55	Error Handling
 56
 57	Errors occur in two places:
 58
 59		1. evaluation of natives and actions
 60		2. evaluation of a block
 61
 62	When an error occurs, an error object is built and thrown back to
 63	the nearest prior catch function. The catch is a longjmp that was
 64	set by a TRY or similar native.  At that point the interpreter stack
 65	can be either examined (for debugging) or restored to the current
 66	catch state.
 67
 68	The error is returned from the catch as a disarmed error object. At
 69	that point, the error can be passed around and accessed as a normal
 70	object (although its datatype is ERROR!). The DISARM function
 71	becomes unnecessary and will simply copy the fields to a normal
 72	OBJECT! type.
 73
 74	Using the new CAUSE native with the error object will re-activate
 75	the error and throw the error back further to the prior catch.
 76
 77	The error object will include a new TRACE field that provides a back
 78	trace of the interpreter stack. This is a block of block pointers
 79	and may be clipped at some reasonable size (perhaps 10).
 80
 81	When C code hits an error condition, it calls Trap(id, arg1, arg2, ...).
 82	This function takes a variable number of arguments.
 83
 84	BREAK and RETURN
 85
 86	TRY/RECOVER/EXCEPT.
 87
 88		try [block]
 89		try/recover [block] [block]
 90
 91	TRACE f1, :path/f1, or [f1 f2 f3]
 92	foo: func [[trace] ...]
 93
 94*/
 95
 96
 97#include "sys-core.h"
 98
 99#include "sys-state.h"
100
101// Globals or Threaded???
102static REBOL_STATE Top_State; // Boot var: holds error state during boot
103
104
105/***********************************************************************
106**
107*/	void Check_Stack(void)
108/*
109***********************************************************************/
110{
111	if ((DSP + 100) > (REBINT)SERIES_REST(DS_Series))
112		Trap0(RE_STACK_OVERFLOW);
113}
114
115
116/***********************************************************************
117**
118*/	void Catch_Error(REBVAL *value)
119/*
120**		Gets the current error and stores it as a value.
121**		Normally the value is on the stack and is returned.
122**
123***********************************************************************/
124{
125	if (IS_NONE(TASK_THIS_ERROR)) Crash(RP_ERROR_CATCH);
126	*value = *TASK_THIS_ERROR;
127//	Print("CE: %r", value);
128	SET_NONE(TASK_THIS_ERROR);
129	//!!! Reset or ENABLE_GC;
130}
131
132
133/***********************************************************************
134**
135*/	void Throw_Error(REBSER *err)
136/*
137**		Throw the C stack.
138**
139***********************************************************************/
140{
141	if (!Saved_State) Crash(RP_NO_SAVED_STATE);
142	SET_ERROR(TASK_THIS_ERROR, ERR_NUM(err), err);
143	if (Trace_Level) Trace_Error(TASK_THIS_ERROR);
144	longjmp(*Saved_State, 1);
145}
146
147
148/***********************************************************************
149**
150*/	void Throw_Break(REBVAL *val)
151/*
152**		Throw a break or return style error (for special cases
153**		where we do not want to unwind the stack).
154**
155***********************************************************************/
156{
157	if (!Saved_State) Crash(RP_NO_SAVED_STATE);
158	*TASK_THIS_ERROR = *val;
159	longjmp(*Saved_State, 1);
160}
161
162
163/***********************************************************************
164**
165*/	void Throw_Return_Series(REBCNT type, REBSER *series)
166/*
167**		Throws a series value using error temp values.
168**
169***********************************************************************/
170{
171	REBVAL *val;
172	REBVAL *err;
173	REBSER *blk = VAL_SERIES(TASK_ERR_TEMPS);
174
175	RESET_SERIES(blk);
176	val = Append_Value(blk);
177	Set_Series(type, val, series);
178	err = Append_Value(blk);
179	SET_THROW(err, RE_RETURN, val);
180	VAL_ERR_SYM(err) = SYM_RETURN; // indicates it is "virtual" (parse return)
181	Throw_Break(err);
182}
183
184
185/***********************************************************************
186**
187*/	void Throw_Return_Value(REBVAL *value)
188/*
189**		Throws a series value using error temp values.
190**
191***********************************************************************/
192{
193	REBVAL *val;
194	REBVAL *err;
195	REBSER *blk = VAL_SERIES(TASK_ERR_TEMPS);
196
197	RESET_SERIES(blk);
198	val = Append_Value(blk);
199	*val = *value;
200	err = Append_Value(blk);
201	SET_THROW(err, RE_RETURN, val);
202	VAL_ERR_SYM(err) = SYM_RETURN; // indicates it is "virtual" (parse return)
203	Throw_Break(err);
204}
205
206
207/***********************************************************************
208**
209*/	void Trap_Stack()
210/*
211***********************************************************************/
212{
213	if (IS_INTEGER(TASK_THIS_ERROR)) return; // composing prior error.
214
215	if (!Saved_State) Crash(RP_NO_SAVED_STATE);
216
217	*TASK_THIS_ERROR = *TASK_STACK_ERROR; // pre-allocated
218
219	longjmp(*Saved_State, 1);
220}
221
222
223/***********************************************************************
224**
225*/	REBCNT Stack_Depth()
226/*
227***********************************************************************/
228{
229	REBCNT dsf = DSF;
230	REBCNT count = 0;
231
232	for (dsf = DSF; dsf > 0; dsf = PRIOR_DSF(dsf)) {
233		count++;
234	}
235
236	return count;
237}
238
239
240/***********************************************************************
241**
242*/	REBSER *Make_Backtrace(REBINT start)
243/*
244**		Return a block of backtrace words.
245**
246***********************************************************************/
247{
248	REBCNT depth = Stack_Depth();
249	REBSER *blk = Make_Block(depth-start);
250	REBINT dsf;
251	REBVAL *val;
252
253	for (dsf = DSF; dsf > 0; dsf = PRIOR_DSF(dsf)) {
254		if (start-- <= 0) {
255			val = Append_Value(blk);
256			Init_Word(val, VAL_WORD_SYM(DSF_WORD(dsf)));
257		}
258	}
259
260	return blk;
261}
262
263
264/***********************************************************************
265**
266*/	void Set_Error_Type(ERROR_OBJ *error)
267/*
268**		Sets error type and id fields based on code number.
269**
270***********************************************************************/
271{
272	REBSER *cats;		// Error catalog object
273	REBSER *cat;		// Error category object
274	REBCNT n;		// Word symbol number
275	REBCNT code;
276
277	code = VAL_INT32(&error->code);
278
279	// Set error category:
280	n = code / 100 + 1;
281	cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
282
283	if (code >= 0 && n < SERIES_TAIL(cats) &&
284		NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
285	) {
286		Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);
287
288		// Find word related to the error itself:
289		
290		n = code % 100 + 3;
291		if (n < SERIES_TAIL(cat))
292			Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
293	}
294}
295
296
297/***********************************************************************
298**
299*/	REBVAL *Find_Error_Info(ERROR_OBJ *error, REBINT *num)
300/*
301**		Return the error message needed to print an error.
302**		Must scan the error catalog and its error lists.
303**		Note that the error type and id words no longer need
304**		to be bound to the error catalog context.
305**		If the message is not found, return null.
306**
307***********************************************************************/
308{
309	REBSER *frame;
310	REBVAL *obj1;
311	REBVAL *obj2;
312
313	if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;
314
315	// Find the correct error type object in the catalog:
316	frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
317	obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
318	if (!obj1) return 0;
319
320	// Now find the correct error message for that type:
321	frame = VAL_OBJ_FRAME(obj1);
322	obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
323	if (!obj2) return 0;
324
325	if (num) {
326		obj1 = Find_Word_Value(frame, SYM_CODE);
327		*num = VAL_INT32(obj1)
328			+ Find_Word_Index(frame, VAL_WORD_SYM(&error->id), FALSE)
329			- Find_Word_Index(frame, SYM_TYPE, FALSE) - 1;
330	}
331
332	return obj2;
333}
334
335
336/***********************************************************************
337**
338*/	void Make_Error_Object(REBVAL *arg, REBVAL *value)
339/*
340**		Creates an error object from arg and puts it in value.
341**		The arg can be a string or an object body block.
342**		This function is called by MAKE ERROR!.
343**
344***********************************************************************/
345{
346	REBSER *err;		// Error object
347	ERROR_OBJ *error;	// Error object values
348	REBINT code = 0;
349
350	// Create a new error object from another object, including any non-standard fields:
351	if (IS_ERROR(arg) || IS_OBJECT(arg)) {
352		err = Merge_Frames(VAL_OBJ_FRAME(ROOT_ERROBJ),
353			IS_ERROR(arg) ? VAL_OBJ_FRAME(arg) : VAL_ERR_OBJECT(arg));
354		error = ERR_VALUES(err);
355//		if (!IS_INTEGER(&error->code)) {
356			if (!Find_Error_Info(error, &code)) code = RE_INVALID_ERROR;
357			SET_INTEGER(&error->code, code);
358//		}
359		SET_ERROR(value, VAL_INT32(&error->code), err);
360		return;
361	}
362
363	// Make a copy of the error object template:
364	err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
365	error = ERR_VALUES(err);
366	SET_NONE(&error->id);
367	SET_ERROR(value, 0, err);
368
369	// If block arg, evaluate object values (checking done later):
370	// If user set error code, use it to setup type and id fields.
371	if (IS_BLOCK(arg)) {
372		DISABLE_GC;
373		Do_Bind_Block(err, arg); // GC-OK (disabled)
374		ENABLE_GC;
375		if (IS_INTEGER(&error->code) && VAL_INT64(&error->code)) {
376			Set_Error_Type(error);
377		} else {
378			if (Find_Error_Info(error, &code)) {
379				SET_INTEGER(&error->code, code);
380			}
381		}
382		// The error code is not valid:
383		if (IS_NONE(&error->id)) {
384			SET_INTEGER(&error->code, RE_INVALID_ERROR);
385			Set_Error_Type(error);
386		}
387		if (VAL_INT64(&error->code) < 100 || VAL_INT64(&error->code) > 1000)
388			Trap_Arg(arg);
389	}
390
391	// If string arg, setup other fields
392	else if (IS_STRING(arg)) {
393		SET_INTEGER(&error->code, RE_USER); // user error
394		Set_String(&error->arg1, Copy_Series_Value(arg));
395		Set_Error_Type(error);
396	}
397
398// No longer allowed:
399//	else if (IS_INTEGER(arg)) {
400//		error->code = *arg;
401//		Set_Error_Type(error);
402//	}
403	else
404		Trap_Arg(arg);
405
406	if (!(VAL_ERR_NUM(value) = VAL_INT32(&error->code))) {
407		Trap_Arg(arg);
408	}
409}
410
411
412/***********************************************************************
413**
414*/	REBSER *Make_Error(REBINT code, REBVAL *arg1, REBVAL *arg2, REBVAL *arg3)
415/*
416**		Create and init a new error object.
417**
418***********************************************************************/
419{
420	REBSER *err;		// Error object
421	ERROR_OBJ *error;	// Error object values
422
423	if (PG_Boot_Phase < BOOT_ERRORS) Crash(RP_EARLY_ERROR, code); // Not far enough!
424
425	// Make a copy of the error object template:
426	err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
427	error = ERR_VALUES(err);
428
429	// Set error number:
430	SET_INTEGER(&error->code, (REBINT)code);
431	Set_Error_Type(error);
432
433	// Set error argument values:
434	if (arg1) error->arg1 = *arg1;
435	if (arg2) error->arg2 = *arg2;
436	if (arg3) error->arg3 = *arg3;
437
438	// Set backtrace and location information:
439	if (DSF > 0) {
440		// Where (what function) is the error:
441		Set_Block(&error->where, Make_Backtrace(0));
442		// Nearby location of the error (in block being evaluated):
443		error->nearest = *DSF_BACK(DSF);
444	}
445
446	return err;
447}
448
449
450/***********************************************************************
451**
452*/	void Trap0(REBCNT num)
453/*
454***********************************************************************/
455{
456	Throw_Error(Make_Error(num, 0, 0, 0));
457}
458
459
460/***********************************************************************
461**
462*/	void Trap1(REBCNT num, REBVAL *arg1)
463/*
464***********************************************************************/
465{
466	Throw_Error(Make_Error(num, arg1, 0, 0));
467}
468
469
470/***********************************************************************
471**
472*/	void Trap2(REBCNT num, REBVAL *arg1, REBVAL *arg2)
473/*
474***********************************************************************/
475{
476	Throw_Error(Make_Error(num, arg1, arg2, 0));
477}
478
479
480/***********************************************************************
481**
482*/	void Trap3(REBCNT num, REBVAL *arg1, REBVAL *arg2, REBVAL *arg3)
483/*
484***********************************************************************/
485{
486	Throw_Error(Make_Error(num, arg1, arg2, arg3));
487}
488
489
490/***********************************************************************
491**
492*/	void Trap_Arg(REBVAL *arg)
493/*
494***********************************************************************/
495{
496	Trap1(RE_INVALID_ARG, arg);
497}
498
499
500/***********************************************************************
501**
502*/	void Trap_Type(REBVAL *arg)
503/*
504**		<type> type is not allowed here
505**
506***********************************************************************/
507{
508	Trap1(RE_INVALID_TYPE, Of_Type(arg));
509}
510
511
512/***********************************************************************
513**
514*/	void Trap_Range(REBVAL *arg)
515/*
516**		value out of range: <value>
517**
518***********************************************************************/
519{
520	Trap1(RE_OUT_OF_RANGE, arg);
521}
522
523
524/***********************************************************************
525**
526*/	void Trap_Word(REBCNT num, REBCNT sym, REBVAL *arg)
527/*
528***********************************************************************/
529{
530	Init_Word(DS_TOP, sym);
531	if (arg) Trap2(num, DS_TOP, arg);
532	else Trap1(num, DS_TOP);
533}
534
535
536/***********************************************************************
537**
538*/	void Trap_Action(REBCNT type, REBCNT action)
539/*
540***********************************************************************/
541{
542	Trap2(RE_CANNOT_USE, Get_Action_Word(action), Get_Type(type));
543}
544
545
546/***********************************************************************
547**
548*/	void Trap_Math_Args(REBCNT type, REBCNT action)
549/*
550***********************************************************************/
551{
552	Trap2(RE_NOT_RELATED, Get_Action_Word(action), Get_Type(type));
553}
554
555
556/***********************************************************************
557**
558*/	void Trap_Types(REBCNT errnum, REBCNT type1, REBCNT type2)
559/*
560***********************************************************************/
561{
562	if (type2 != 0) Trap2(errnum, Get_Type(type1), Get_Type(type2));
563	Trap1(errnum, Get_Type(type1));
564}
565
566
567/***********************************************************************
568**
569*/	void Trap_Expect(REBVAL *object, REBCNT index, REBCNT type)
570/*
571**		Object field is not of expected type.
572**		PORT expected SCHEME of OBJECT type
573**
574***********************************************************************/
575{
576	Trap3(RE_EXPECT_TYPE, Of_Type(object), Obj_Word(object, index), Get_Type(type));
577}
578
579
580/***********************************************************************
581**
582*/	void Trap_Make(REBCNT type, REBVAL *spec)
583/*
584***********************************************************************/
585{
586	Trap2(RE_BAD_MAKE_ARG, Get_Type(type), spec);
587}
588
589
590/***********************************************************************
591**
592*/	void Trap_Num(REBCNT err, REBCNT num)
593/*
594***********************************************************************/
595{
596	DS_PUSH_INTEGER(num);
597	Trap1(err, DS_TOP);
598}
599
600
601/***********************************************************************
602**
603*/	void Trap_Reflect(REBCNT type, REBVAL *arg)
604/*
605***********************************************************************/
606{
607	Trap_Arg(arg);
608}
609
610
611/***********************************************************************
612**
613*/	void Trap_Port(REBCNT errnum, REBSER *port, REBINT err_code)
614/*
615***********************************************************************/
616{
617	REBVAL *spec = OFV(port, STD_PORT_SPEC);
618	REBVAL *val;
619
620	if (!IS_OBJECT(spec)) Trap0(RE_INVALID_PORT);
621
622	val = Get_Object(spec, STD_PORT_SPEC_HEAD_REF); // most informative
623	if (IS_NONE(val)) val = Get_Object(spec, STD_PORT_SPEC_HEAD_TITLE);
624
625	DS_PUSH_INTEGER(err_code);
626	Trap2(errnum, val, DS_TOP);
627}
628
629
630/***********************************************************************
631**
632*/	REBINT Check_Error(REBVAL *val)
633/*
634**		Process a loop exceptions. Pass in the TOS value, returns:
635**
636**			 2 - if break/return, change val to that set by break
637**			 1 - if break
638**			-1 - if continue, change val to unset
639**			 0 - if not break or continue
640**			else: error if not an ERROR value
641**
642***********************************************************************/
643{
644	// It's UNSET, not an error:
645	if (!IS_ERROR(val))
646		Trap0(RE_NO_RETURN); //!!! change to special msg
647
648	// If it's a BREAK, check for /return value:
649	if (IS_BREAK(val)) {
650		if (VAL_ERR_VALUE(val)) {
651			*val = *VAL_ERR_VALUE(val);
652			return 2;
653		} else {
654			SET_UNSET(val);
655			return 1;
656		}
657	}
658
659	if (IS_CONTINUE(val)) {
660		SET_UNSET(val);
661		return -1;
662	}
663
664	return 0;
665	// Else: Let all other errors return as values.
666}
667
668
669/***********************************************************************
670**
671*/	void Init_Errors(REBVAL *errors)
672/*
673***********************************************************************/
674{
675	REBSER *errs;
676	REBVAL *val;
677
678	// Create error objects and error type objects:
679	*ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
680	errs = Construct_Object(0, VAL_BLK(errors), 0);
681	Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);
682
683	Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));
684
685	// Create objects for all error types:
686	for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
687		errs = Construct_Object(0, VAL_BLK(val), 0);
688		SET_OBJECT(val, errs);
689	}
690
691	// Catch top level errors, to provide decent output:
692	PUSH_STATE(Top_State, Saved_State);
693	if (SET_JUMP(Top_State)) {
694		POP_STATE(Top_State, Saved_State);
695		DSP++; // Room for return value
696		Catch_Error(DS_TOP); // Stores error value here
697		Print_Value(DS_TOP, 0, FALSE);
698		Crash(RP_NO_CATCH);
699	}
700	SET_STATE(Top_State, Saved_State);
701}
702
703
704/***********************************************************************
705**
706*/	REBYTE *Security_Policy(REBCNT sym, REBVAL *name)
707/*
708**	Given a security symbol (like FILE) and a value (like the file
709**	path) returns the security policy (RWX) allowed for it.
710**
711**	Args:
712**
713**		sym:  word that represents the type ['file 'net]
714**		name: file or path value
715**
716**	Returns BTYE array of flags for the policy class:
717**
718**		flags: [rrrr wwww xxxx ----]
719**
720**		Where each byte is:
721**			0: SEC_ALLOW
722**			1: SEC_ASK
723**			2: SEC_THROW
724**			3: SEC_QUIT
725**
726**	The secuity is defined by the system/state/policies object, that
727**	is of the form:
728**
729**		[
730**			file:  [%file1 tuple-flags %file2 ... default tuple-flags]
731**			net:   [...]
732**			call:  tuple-flags
733**			stack: tuple-flags
734**			eval:  integer (limit)
735**		]
736**
737***********************************************************************/
738{
739	REBVAL *policy = Get_System(SYS_STATE, STATE_POLICIES);
740	REBYTE *flags;
741	REBCNT len;
742	REBCNT errcode = RE_SECURITY_ERROR;
743
744	if (!IS_OBJECT(policy)) goto error;
745
746	// Find the security class in the block: (file net call...)
747	policy = Find_Word_Value(VAL_OBJ_FRAME(policy), sym);
748	if (!policy) goto error;
749
750	// Obtain the policies for it:
751	// Check for a master tuple: [file rrrr.wwww.xxxx]
752	if (IS_TUPLE(policy)) return VAL_TUPLE(policy); // non-aligned
753	// removed A90: if (IS_INTEGER(policy)) return (REBYTE*)VAL_INT64(policy); // probably not used
754
755	// Only other form is detailed block:
756	if (!IS_BLOCK(policy)) goto error;
757
758	// Scan block of policies for the class: [file [allow read quit write]]
759	len = 0;	// file or url length
760	flags = 0;	// policy flags
761	for (policy = VAL_BLK(policy); NOT_END(policy); policy += 2) {
762
763		// Must be a policy tuple:
764		if (!IS_TUPLE(policy+1)) goto error;
765
766		// Is it a policy word:
767		if (IS_WORD(policy)) { // any word works here
768			// If no strings found, use the default:
769			if (len == 0) flags = VAL_TUPLE(policy+1); // non-aligned
770		}
771
772		// Is it a string (file or URL):
773		else if (ANY_BINSTR(policy) && name) {
774			//Debug_Fmt("sec: %r %r", policy, name);
775			if (Match_Sub_Path(VAL_SERIES(policy), VAL_SERIES(name))) {
776				// Is the match adequate?
777				if (VAL_TAIL(name) >= len) {
778					len = VAL_TAIL(name);
779					flags = VAL_TUPLE(policy+1); // non-aligned
780				}
781			}
782		}
783		else goto error;
784	}
785
786	if (!flags) {
787		errcode = RE_SECURITY;
788		policy = name ? name : 0;
789error:
790		if (!policy) {
791			Init_Word(DS_TOP, sym);
792			policy = DS_TOP;
793		}
794		Trap1(errcode, policy);
795	}
796
797	return flags;
798}
799
800
801/***********************************************************************
802**
803*/	void Trap_Security(REBCNT flag, REBCNT sym, REBVAL *value)
804/*
805**		Take action on the policy flags provided. The sym and value
806**		are provided for error message purposes only.
807**
808***********************************************************************/
809{
810	if (flag == SEC_THROW) {
811		if (!value) {
812			Init_Word(DS_TOP, sym);
813			value = DS_TOP;
814		}
815		Trap1(RE_SECURITY, value);
816	}
817	else if (flag == SEC_QUIT) OS_EXIT(101);
818}
819
820
821/***********************************************************************
822**
823*/	void Check_Security(REBCNT sym, REBCNT policy, REBVAL *value)
824/*
825**		A helper function that fetches the security flags for
826**		a given symbol (FILE) and value (path), and then tests
827**		that they are allowed.
828**
829***********************************************************************/
830{
831	REBYTE *flags;
832	
833	flags = Security_Policy(sym, value);
834	Trap_Security(flags[policy], sym, value);
835}