{------------------------------------------------------------------------------
#
#	Apple Macintosh Developer Technical Support
#
#	Exception handling for MPW Pascal, MacApp and MPW C
#
#	UFailure (aka Signals) - ÒExceptional code, with a few exceptions.Ó
#
#	UFailure.inc1.p	-	Pascal source - the IMPLEMENTATION
#
#	Copyright © 1985-1988 Apple Computer, Inc.
#	All rights reserved.
#
#	Versions:	1.0					11/88
#
#	Components:	UFailure.p			November 1, 1988
#				UFailure.h			November 1, 1988
#				UFailure.inc1.p		November 1, 1988
#				UFailure.a			November 1, 1988
#
#	UFailure (or Signals) is a set of exception handling routines suitable for
#	use with MacApp, MPW C, and MPW Pascal. It is a jazzed-up version of the MacApp
#	UFailure unit. There is a set of C interfaces to it as well.
#
------------------------------------------------------------------------------}


VAR
	{$PUSH}
	{$Z+}	{make gTopHandler accessable to assembly code}
	gTopHandler:		PFailInfo;	{linked list of failure handlers}
 	gInitHandler:		ProcPtr;
	{$POP}


PROCEDURE InitUFailure; EXTERNAL;
	{ Allocates the heap block for CatchSignals and initializes the global
		variables used by the unit. }

PROCEDURE InitSignals; EXTERNAL;
	{ Calls InitUFailure. It also sets up the A6 for the main level of Pascal,
		so it must be called from the outermost level of Pascal. }


FUNCTION CatchSignal: INTEGER; EXTERNAL;
	{ Until the procedure which encloses this call returns, this will catch
		subsequent Signal calls, returning the code passed to Signal.  When
		CatchSignal is encountered initially, it returns a code of zero.  These
		calls may "nest"; i.e. you may have multiple CatchSignals in one procedure.
		Each nested CatchSignal call uses 72 bytes of heap space.
		If you signal with SignalMessage and pass in a non-zero message you should use
		CatchHandler instead so you have a way of getting at the message. }


PROCEDURE FreeSignal; EXTERNAL;
	{ This undoes the effect of the last CatchSignal.  A Signal will then invoke
		the CatchSignal prior to the last one. }


PROCEDURE Signal(code: INTEGER); EXTERNAL;
	{ Returns control to the point of the last CatchSignal.  The program will
		then behave as though that CatchSignal had returned with the code parameter
		supplied to Signal. If CatchHandler is catching, the message parameter will be 0. }


PROCEDURE SignalMessage(code: INTEGER; message: LONGINT); EXTERNAL;
	{ Returns control to the point of the last CatchSignal/CatchFailures.
		If CatchFailures is catching, the message parameter will be returned. }
		
		
{-----------------------------------+
|	MacApp stuff					|
+-----------------------------------}


{-----------------------------------+ 
|	External Declarations			|
+-----------------------------------}
PROCEDURE CatchFailures (VAR fi: FailInfo;
						PROCEDURE Handler(e: INTEGER; m: LONGINT)); EXTERNAL;

PROCEDURE DoFailure(pf: PFailInfo); EXTERNAL;

{-----------------------------------+ 
|	CallInitHandler					|
+-----------------------------------}
PROCEDURE CallInitHandler (error: INTEGER; message: LONGINT; p: ProcPtr);
		INLINE	$205F,		{MOVE.L		(A7)+,A0	}
				$4E90;		{JMP		(A0)		}

{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	FailMemError					|
+-----------------------------------}
PROCEDURE FailMemError;
VAR
	e:	OSErr;
{$IFC qDebug}
	s:		Str255;
{$ENDC}
BEGIN
	e := MemError;

{$IFC UsingMacApp}
{$IFC qDebug}
	IF gAskFailure AND (e = noErr) AND CanReadLn THEN
		BEGIN
{$%+}
		GetMethodName(%_GetA6+4, s);
{$%-}
		e := ReadInteger(CONCAT('FailMemError called by ', s, '.  Enter return error: '));
		END;
{$ENDC qDebug}
{$ENDC UsingMacApp}

	IF e <> noErr THEN
		Failure(e, 0);
END {FailMemError};


{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	FailNIL							|
+-----------------------------------}
PROCEDURE FailNIL (p: UNIV Ptr);
BEGIN
	{ no check for gAskFailure here, since we do this when objects are created. }
	IF p = NIL THEN
		Failure(memFullErr, 0);
END {FailNIL};


{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	FailNewMessage					|
+-----------------------------------}
PROCEDURE FailNewMessage (error: INTEGER; oldMessage, newMessage: LONGINT);
BEGIN
	IF oldMessage = 0 THEN
		oldMessage := newMessage;
	Failure(error, oldMessage);
END {FailNewMessage};


{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	FailOSErr						|
+-----------------------------------}
PROCEDURE FailOSErr (error: INTEGER);

{$IFC qDebug}
VAR
	s:		Str255;
{$ENDC}

BEGIN
{$IFC UsingMacApp}
{$IFC qDebug}
	IF gAskFailure AND (error = noErr) AND CanReadLn THEN
		BEGIN
{$%+}
		GetMethodName(%_GetA6+4, s);
{$%-}
		error := ReadInteger(CONCAT('FailOSErr called by ', s, '.  Enter return error: '));
		END;
{$ENDC qDebug}
{$ENDC UsingMacApp}

	IF error <> noErr THEN
		Failure(error, 0);
END {FailOSErr};


{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	FailResError					|
+-----------------------------------}
PROCEDURE FailResError;
VAR
	e:	OSErr;
{$IFC qDebug}
	s:		Str255;
{$ENDC}
BEGIN
	e := ResError;

{$IFC UsingMacApp}
{$IFC qDebug}
	IF gAskFailure AND (e = noErr) AND CanReadLn THEN
		BEGIN
{$%+}
		GetMethodName(%_GetA6+4, s);
{$%-}
		e := ReadInteger(CONCAT('FailResError called by ', s, '.  Enter return error: '));
		END;
{$ENDC qDebug}
{$ENDC UsingMacApp}

	IF e <> noErr THEN
		Failure(e, 0);
END {FailResError};


{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	Failure							|
+-----------------------------------}
PROCEDURE Failure (error: INTEGER; message: LONGINT);
VAR
	pf: 	PFailInfo;
	ih: 	ProcPtr;
	pc:		LONGINT;
{$IFC UsingMacApp}
{$IFC qDebug}
	cl: 	String8;
	me: 	String8;
	seg:	INTEGER;
	who:	STRING[17];
{$ENDC qDebug}
{$ENDC UsingMacApp}
BEGIN
	pf := gTopHandler;

	IF pf <> NIL THEN
		BEGIN
{$IFC UsingMacApp}
{$IFC qDebug}
		pc := pf^.whoPC;
		GetProcname(LONGINT(@pc), cl, me);
		who := CONCAT(cl, '.', me);
		IF cl = kSpace8 THEN
			who[9] := ' ';
		
		Writeln('Failure caught by ', who);
		Writeln('        error = ', error:1, ' message = ', message:1,
				' (', BSR(message, 16):1, '/', BAND(message, $0000FFFF):1, ')');
{$ENDC qDebug}
{$ENDC UsingMacApp}

	{* RBB removed the line 
		gTopHandler := pf^.nextInfo;
	  on 9/26/88 since DoFailure calls FreeSignal first thing *}
		pf^.error := error;
		pf^.message := message;
		DoFailure(pf);			{Go execute the failure handler}
		END
	ELSE IF gInitHandler <> NIL THEN
		BEGIN
		ih := gInitHandler;
		gInitHandler := NIL;
		CallInitHandler(error, message, ih);

		ExitToShell;
		END
	ELSE
		BEGIN
{$IFC UsingMacApp}
{$IFC qDebug}
		ProgramBreak('Failure called, but no handler!');
{$ENDC qDebug}
{$ELSEC}
	Debugger;
{$ENDC UsingMacApp}
		END;
END {Failure};


{$IFC UsingMacApp}
{$IFC qDebug}
{$IFC qTrace}{$D+}{$ENDC}
{$S MADebug}
{-----------------------------------+ 
|	ProgramBreak					|
+-----------------------------------}
PROCEDURE ProgramBreak (grievance: Str255);
	{ ProgramBreak: Your app can call this when it comes to a situation that you do not expect
		and cannot handle gracefully.  It beeps and displays a message.  If called before
		there is a WriteLn window, it calls OBJFail, which goes into an infinite loop.
		Otherwise, it enters our debugger. }
VAR
	synthRec:	RECORD
				mode:		INTEGER;
				triplet:	Tone;
				endTriplet: Tone;
				END;

BEGIN
{$IFC FALSE}
	WITH synthRec, triplet DO
		BEGIN
		mode := swMode;

		count := 445;
		amplitude := 100;
		duration := 25;

		endTriplet.count := 0;
		endTriplet.amplitude := 0;
		endTriplet.duration := 0;
		END;

	StartSound(@synthRec, SIZEOF(synthRec), Pointer(-1));
{$ENDC}
	SysBeep(2);

	WWForceOutput(forceOn, forceUnchanged);
	WriteLn('ProgramBreak: ', grievance);
	WWEndForce;

{$IFC qTrace}
	TRCBreak;
{$ELSEC}
	OBJFail(kFailNone);
{$ENDC}
END {ProgramBreak};
{$IFC qTrace}{$D++}{$ENDC}


{$IFC qTrace}{$D+}{$ENDC}
{$S MADebug}
{-----------------------------------+ 
|	ProgramReport					|
+-----------------------------------}
PROCEDURE ProgramReport (grievance: Str255; break: BOOLEAN);

BEGIN
	Writeln(grievance);
	IF break THEN
		TRCBreak;
END {ProgramReport};
{$IFC qTrace}{$D++}{$ENDC}
{$ENDC qDebug}
{$ENDC UsingMacApp}


{$IFC UsingMacApp}
{$S MAInit}
{$IFC qTrace}{$D+}{$ENDC}
{-----------------------------------+ 
|	SetInitHandler					|
+-----------------------------------}
PROCEDURE SetInitHandler (handler: ProcPtr);
BEGIN
	gInitHandler := handler;
END {SetInitHandler};
{$IFC qTrace}{$D++}{$ENDC}
{$ENDC UsingMacApp}


{We assume that the programmer passes in the correct FailInfo record; ie. the one that is the
	top of the stack.}
{$IFC UsingMacApp}
{$S MAMain}
{$ENDC}
{-----------------------------------+ 
|	Success							|
+-----------------------------------}
PROCEDURE Success (VAR fi: FailInfo);
BEGIN
{$IFC qDebug}
	IF gTopHandler <> @fi THEN
	{$IFC UsingMacApp}
		BEGIN
		Write('gTopHandler = ');
		WritePtr(gTopHandler);
		Write('parameter = ');
		WritePtr(@fi);
		WRITELN;
		ProgramBreak('Problem with Success: too many or too few calls to Success');
		END;
	{$ELSEC UsingMacApp}
		Debugger;
	{$ENDC UsingMacApp}
{$ENDC qDebug}

	gTopHandler := fi.nextInfo;
END {Success};