(**************************************************************************** (* (* Copyright (C) 1979,1980 (* Oregon Minicomputer Software, Inc. (* ALL RIGHTS RESERVED (* (* This software is the proprietary information of (* Oregon Minicomputer Software, Inc., and is distributed (* under license from Oregon Minicomputer Software, Inc.. (* Ownership of this software is held by Oregon Minicomputer (* Software, Inc. (* (* All copies, modifications, enhancements, and derivative (* versions must bear this statement of copyright and (* ownership. (* (***************************************************************************) PROGRAM ERROR; /* ERROR PROCESSING */ /*$T-,A- TURN OFF STACK OVERFLOW CHECKING IN CASE THAT WAS THE ERROR! */ /* PASCAL ERROR PROCESSING WRITTEN BY STEVE POULSEN OREGON MINICOMPUTER SOFTWARE 2340 SW CANYON ROAD PORTLAND, OR 97201 503 226-7760 THIS PROCEDURE IS CALLED BY THE $ERROR ROUTINE IN THE PASCAL SUPPORT LIBRARY TO PROCESS ERROR CONDITIONS. THE PARAMETERS DESCRIBE THE TYPE OF ERROR. CLASS IS A SCALAR TYPE DESCRIBING THE CLASS OF THE ERROR. ERRORNUMBER IS A UNIQUE NUMBER DESCRIBING THE ERROR. ERRORMSGLENGTH IS THE NUMBER OF CHARACTERS IN THE ERROR MESSAGE (MSG). NOTE THAT ONLY THAT NUMBER OF CHARACTERS ARE AVAILABLE IN THE MSG ARRAY! ALSO, THE ARRAY MUST BE READ ONLY. IF THE CLASS OF THE ERROR IS IOERROR THEN THE PARAMETER XFILE IS THE FILE VARIABLE FOR THE FILE THAT CAUSED THE ERROR. IOSTATUS IS THE ERROR STATUS FOR THAT FILE. IF THE FILE IS THE TERMINAL THEN IOSTATUS IS THE FIRST WORD OF THE I/O STATUS BLOCK FOR THE QIO CALL WHICH DIED. OTHERWISE, IOSTATUS IS THE VALUE OF F.ERR IN THE FDB ASSOCIATED WITH THE FILE. USERPC IS (USUALLY) THE PC ADDRESS OF THE CALLER OF THE ORIGINAL I/O OPERATION FROM THE USER'S CODE. THIS ADDRESS CAN SOMETIMES BE USED TO LOCATE THE PASCAL STATEMENT WHICH CAUSED THE ERROR. FILENAMELENGTH IS (NATURALLY) THE LENGTH OF THE FILENAME STRING. IF THE LENGTH IS ZERO, THERE IS NO STRING. FILENAME IS THE ASCII STRING FOR THE FILE NAME. */ /*$E+ MAKE THIS AN EXTERNAL PROCEDURE DEFINITION */ TYPE ERRORTYPE = (FATAL, IOERROR, WARNING); MESSAGE = ARRAY [1..100] OF CHAR; PROCEDURE ERROR(CLASS:ERRORTYPE; ERRORNUMBER,ERRORMSGLENGTH:INTEGER; VAR MSG:MESSAGE; VAR XFILE:TEXT; IOSTATUS,USERPC:INTEGER; FILENAMELENGTH: INTEGER; VAR FILENAME: MESSAGE); VAR I:INTEGER; BEGIN WRITELN; CASE CLASS OF WARNING: WRITE('Warning: '); IOERROR: WRITE('?I/O error: '); ELSE WRITE('?Fatal error: '); END; writeln(msg:errormsglength); IF CLASS=IOERROR THEN BEGIN IF FILENAMELENGTH > 0 THEN WRITELN(' Filename: "',filename:filenamelength,'"'); writeln(' I/O status: ',IOSTATUS:1); END; WRITELN(' Program counter: ',USERPC:-1); END;