home *** CD-ROM | disk | FTP | other *** search
Text File | 1992-10-16 | 3.7 KB | 190 lines | [TEXT/MPS ] |
- {$P}
- {[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
- {UFailure.inc1.p}
- {Copyright © 1985-1990 Apple Computer, Inc. All rights reserved.}
-
- {$W+}
- {$R-}
- {$Init-}
- {$OV-}
-
- PROCEDURE ApplicationBeep;
- EXTERNAL;
-
- PROCEDURE CatchFailures(VAR fi: FailInfo;
- PROCEDURE Handler(e: INTEGER;
- m: LONGINT));
- EXTERNAL;
-
- PROCEDURE DoFailure(pf: FailInfoPtr);
- EXTERNAL;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE Assertion(condition: Boolean;
- description: StringPtr);
-
- BEGIN
- IF NOT condition THEN
- BEGIN
- Failure(minErr, 0); { ??? silent failure, but someday 0
- messages need to be non-silent }
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE EachFailureHandlerDo(PROCEDURE DoToHandler(fiPtr: FailInfoPtr));
-
- VAR
- pf: FailInfoPtr;
-
- BEGIN
- pf := gTopHandler;
-
- WHILE (pf <> NIL) DO
- BEGIN
- DoToHandler(pf);
- pf := pf^.nextInfo;
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE FailMemError;
-
- VAR
- e: OSErr;
-
- BEGIN
- e := MemError;
-
- IF e <> noErr THEN
- Failure(e, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE FailNewMessage(error: INTEGER;
- oldMessage, newMessage: LONGINT);
-
- BEGIN
- IF oldMessage = 0 THEN
- oldMessage := newMessage;
- Failure(error, oldMessage);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- 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;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE FailNILResource(r: UNIV Handle);
-
- VAR
- e: OSErr;
-
- BEGIN
- IF r = NIL THEN
- BEGIN
- e := ResError;
- IF e = noErr THEN
- e := resNotFound;
- Failure(e, 0);
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE FailOSErr(error: INTEGER);
-
- BEGIN
- IF error <> noErr THEN
- Failure(error, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE FailResError;
-
- VAR
- e: OSErr;
-
- BEGIN
- e := ResError;
-
- IF e <> noErr THEN
- Failure(e, 0);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE Failure(error: INTEGER;
- message: LONGINT);
-
- VAR
- pf: FailInfoPtr;
- pc: LONGINT;
-
- BEGIN
- pf := gTopHandler;
-
- IF pf <> NIL THEN
- BEGIN
- {pop the stack first, because calling the handler is likely to
- result in a call to Failure}
- gTopHandler := pf^.nextInfo;
-
-
- pf^.error := error;
- pf^.message := message;
- DoFailure(pf); {Go execute the failure handler}
- END
- ELSE
- BEGIN
- DebugStr('Failure called, but no handler!');
- END;
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- FUNCTION HandlerExists(testFailInfoPtr: FailInfoPtr): Boolean;
-
- PROCEDURE DoToHandler(pf: FailInfoPtr);
-
- BEGIN
- IF pf = testFailInfoPtr THEN
- HandlerExists := true;
- END;
-
- BEGIN
- HandlerExists := false;
- EachFailureHandlerDo(DoToHandler);
- END;
-
- {--------------------------------------------------------------------------------------------------}
- {$S MAFailureRes}
-
- PROCEDURE Success(VAR fi: FailInfo);
-
- BEGIN
- gTopHandler := fi.nextInfo;
- END;
-