
<BLOCK (<ROOT>)>

L-ERROR-HANDLER 

<LINK '<ERRET> "">

<LINK '<ERRET T> "">

<DEFINE C-FCN (CHAR CHAN)
	#DECL ((CHAR) CHARACTER (CHAN) CHANNEL)
	<COND (<==? .CHAR <ASCII 3>>
	       <RESET .CHAN>
	       <VALRET ":PROCED
:JOB
">)>>

<SETG ^C-HANDLER <HANDLER <GET ,INCHAN INTERRUPT> ,C-FCN>>

<DEFINE CTRL-C ("OPTIONAL" (FOO 1) "AUX" (OVAL T)
		(HEADER <GET ,INCHAN INTERRUPT>) (CH ,^C-HANDLER))
	#DECL ((FOO) <OR FIX ATOM FALSE> (OVAL) <OR ATOM FALSE> (HEADER) IHEADER
	       (CH) HANDLER)
	<COND (<EMPTY? <2 .CH>> <SET OVAL <>>)>
	<COND (<TYPE? .FOO FIX> .OVAL)
	      (.FOO <OR .OVAL <HANDLER .HEADER .CH>> .OVAL)
	      (<OR <NOT .OVAL> <OFF .CH>> .OVAL)>>

\ 

<DEFINE GRAB (TARG "TUPLE" FOO "AUX" (CK <>) GSW FNAME TEMP (TSNAME <SNAME>) CH)
 
	#DECL ((TARG) ATOM (FOO) TUPLE (CK GSW) <OR ATOM FALSE>
	       (TSNAME FNAME) STRING (TEMP) <OR STRING FALSE>
	       (CH) <OR CHANNEL FALSE>)
	<COND (<EMPTY? .FOO> <SET GSW <>> <SET FNAME <SPNAME .TARG>>)
	      (<LENGTH? .FOO 1>
	       <COND (<TYPE? <1 .FOO> STRING>
		      <SET FNAME <1 .FOO>>
		      <SET CK T>
		      <SET GSW <>>)
		     (T <SET GSW <1 .FOO>> <SET FNAME <SPNAME .TARG>>)>)
	      (T <SET GSW <1 .FOO>> <SET FNAME <2 .FOO>> <SET CK T>)>
	<COND (<AND .CK <SET TEMP <MEMQ !\; .FNAME>>>
	       <SET TSNAME
		    <SUBSTRUC .FNAME 0 <- <LENGTH .FNAME> <LENGTH .TEMP>>>>
	       <SET FNAME <REST .TEMP>>)>
	<COND (<SET CH <OPEN "READB" <STRING .TSNAME ";" .FNAME>>>
	       
	       <COND (.GSW <SETG .TARG <GC-READ .CH>>)
		     (T <SET .TARG <GC-READ .CH>>)>
	       <CLOSE .CH>
	       .TARG)
	      (T .CH)>>

<DEFINE DUMP (TARG "OPTIONAL" (FNAME <SPNAME .TARG>) "AUX" CH) 
	#DECL ((TARG) ATOM (FNAME) STRING (CH) <OR CHANNEL FALSE>)
	<COND (<SET CH <OPEN "PRINTB" .FNAME>>
	       <GC-DUMP <VALUE .TARG> .CH>
	       <CLOSE .CH>
	       .TARG)
	      (T .CH)>>

<SETG SCRIPT-CHANNEL <>>

<DEFINE SCRIPT ("OPTIONAL" (FNAME "_SCRIP >") (OUT-ONLY <>)
		"AUX" (CHAN <OPEN "PRINT" .FNAME>))
	#DECL ((FNAME) STRING (OUT-ONLY) <OR ATOM FALSE>
	       (CHAN) <OR CHANNEL FALSE>)
	<COND (.CHAN
	       <PUT <TOP .OUTCHAN> 1 (.CHAN)>
	       <COND (<NOT .OUT-ONLY> <PUT <TOP .INCHAN> 1 (.CHAN)>)>
	       <SETG SCRIPT-CHANNEL .CHAN>
	       T)>>

<DEFINE UNSCRIPT ("AUX" (OC <TOP .OUTCHAN>) CHAN) 
	#DECL ((OC) VECTOR (CHAN) CHANNEL)
	<COND (<NOT <EMPTY? <1 .OC>>>
	       <SET CHAN <1 <1 .OC>>>
	       <PUT .OC 1 ()>
	       <COND (<NOT <EMPTY? <1 <SET OC <TOP .INCHAN>>>>> <PUT .OC 1 ()>)>
	       <CLOSE .CHAN>
	       <SETG SCRIPT-CHANNEL <>>
	       T)>>

<DEFINE ERROR-H ("OPTIONAL" (WHICH T)
		 "AUX" (HEADER <GET ERROR!-INTERRUPTS INTERRUPT>) CHANDLE
		       (L-HANDLER <AND <GASSIGNED? L-HANDLER> ,L-HANDLER>) L-E)
	#DECL ((HEADER) <OR FALSE IHEADER> (CHANDLE L-E) HANDLER
	       (L-HANDLER) <OR FALSE RSUBR> (WHICH) <OR ATOM FALSE>)
	<COND
	 (<AND .HEADER .L-HANDLER>
	  <COND
	   (<NOT <GASSIGNED? L-ERROR-HANDLER>>
	    <SET CHANDLE <3 .HEADER>>
	    <REPEAT ()
		  <COND (<==? <3 .CHANDLE> .L-HANDLER>
			 <SET L-E <SETG L-ERROR-HANDLER .CHANDLE>>
			 <RETURN>)
			(<EMPTY? <SET CHANDLE <1 .CHANDLE>>>
			 <SET L-E
			      <SETG L-ERROR-HANDLER
				    <OFF <HANDLER .HEADER .L-HANDLER>>>>
			 <RETURN>)>>)
	   (<SET L-E ,L-ERROR-HANDLER>)>
	  <COND (.WHICH
		 <SETG L-NOISY T>
		 <SETG L-NO-DEFER <>>
		 <COND (<EMPTY? <2 .L-E>> <HANDLER .HEADER .L-E> <>) (T)>)
		(T
		 <SETG L-NOISY <>>
		 <SETG L-NO-DEFER T>
		 <COND (<EMPTY? <2 .L-E>> <>) (T <OFF .L-E> T)>)>)>>

<ERROR-H <>>

<ENDBLOCK>
