*DECK FMERROR 
      PROC  FM$ERR  (DISPLAY, DLOC, ERRORS, TYPE, FATAL); 
      ITEM
        DISPLAY  U,          # POINTER TO DISPLAY STRING               #
        DLOC     I,          # CHARACTER-1 TO POINT TO                 #
        TYPE     I,          # ERROR ORDINAL                           #
        FATAL    B;          # FATAL ERROR FLAG                        #
        ARRAY  ERRORS  S(1);
          ITEM  ERRTXT  C(0,0,136); 
      BEGIN 
#CALL FMCOM                                                            #
CONTROL NOLIST; 
*CALL FMCOM 
CONTROL LIST; 
  
        ARRAY  LINE  S(25);  # LINE IMAGE                              #
          ITEM
            CC    C(0,0,1), 
            LINETEXT  C(0,6,136); 
        DEF  DBLSPACE  # "0" #; 
        DEF  SNGLSPACE # " " #; 
  
        DEF  POINTER  # "'" #;
  
        XREF PROC  FM$ABRT; 
        XREF PROC  FM$CALL; 
        XREF PROC  FM$DAYF; 
        XREF FUNC  IFETCH I;
        XREF PROC  PUT; 
CONTROL EJECT;
 #
* *   FMERROR - PRINT ERROR MESSAGES FOR FORM 
* *   M.T. KAUFMAN
* 1DC FMCONV
* 
* DC  FUNCTION
* 
*     PRINTS AN ERROR MESSAGE.  IF DESIRED, WILL PRINT A TEXT STRING
*     WITH A POINTER UNDER SOME CHARACTER.
*     IF THE OUTPUT FILE IS NOT OPEN, OR THE OUTPUT FILE NAME IS
*     BINARY ZERO, THE FIRST 79 CHARACTERS OF THE MESSAGE ARE 
*     OUTPUT TO THE DAYFILE, AND THE CARD IMAGE AND CARD POINTER
*     ARE NOT DISPLAYED.  THIS INSURES SOME INDICATION OF WHAT IS 
*     WRONG WILL BE DISPLAYED, EVEN IN THE EVENT OF A CONTROL 
*     CARD ERROR OR FORM INTERNAL ERROR.
* 
* DC  ENTRY CONDITIONS
* 
*     POINTERS TO THE TEXT FOR DISPLAY AND AN ARRAY OF ERROR
*     MESSAGES, DISPLAY POINTER LOCATION, AND ERROR ORDINAL.
* 
* DC  EXIT CONDITIONS 
* 
*     IF THE CALLER SETS A FLAG INDICATING THIS IS A FATAL ERROR, 
*     THE FEX EXIT WILL BE CALLED AND THE RUN TERMINATED WITHOUT
*     RETURNING 
* 
* DC  ERROR CONDITIONS
* 
*     NONE
* 
 #
CONTROL EJECT;
    IF L$LFN NQ 0 AND IFETCH(FM$LFDB,RM$OC) EQ OC$OPEN THEN 
      BEGIN 
        CC = DBLSPACE;       # FIRST ERROR LINE IS DOUBLE-SPACED       #
        IF  ADDRESS(DISPLAY) NQ 0  THEN 
          BEGIN              # PRINT TEXT OF LINE IN ERROR             #
            P<TEXT> = ADDRESS(DISPLAY); 
            I = USED(DISPLAY)/6;
            IF  136 LQ RESIDUAL(DISPLAY)/6
              THEN  J = 136;
              ELSE  J = RESIDUAL(DISPLAY)/6;
            LINETEXT = C<I,J>TXT$ITM; 
            PUT (FM$LFDB, LINE, J+1); 
          END 
  
            IF  DLOC GQ 0  THEN 
              BEGIN          # PRINT POINTER TO CHARACTER IN ERROR     #
                CC = SNGLSPACE; 
                LINETEXT = " "; 
                IF  135 LQ DLOC  THEN  J = 135;  ELSE  J = DLOC;
                C<J>LINETEXT = POINTER; 
                PUT (FM$LFDB, LINE, J+2); 
              END 
      END;
  
        K = 0;                            # PRINT ERROR MESSAGE        #
        FOR  I = 1 STEP 1 UNTIL TYPE  DO
          BEGIN 
            FOR J=J  WHILE  C<9>ERRTXT[K] NQ ":"  DO  K = K+1;
            K = K + 1;
          END 
        FOR  J = 0 STEP 1 WHILE C<9>ERRTXT[J+K] NQ ":"  DO; 
        J = 10*J  + 9;
        IF  J GR 136  THEN  J = 136;
        LINETEXT = C<0,J>ERRTXT[K]; 
        IF L$LFN NQ 0 AND IFETCH(FM$LFDB,RM$OC) EQ OC$OPEN THEN 
          PUT(FM$LFDB,LINE,J+1);
        ELSE
          BEGIN 
            IF J GR 79 THEN J = 79; 
            CC = SNGLSPACE; # BLANK COLUMN 1 OF DAYFILE MESSAGE        #
            FOR I = 1 STEP 1 UNTIL 10 DO
              C<J + I>LINETEXT = O"00"; # ADD 60 BIT EOL               #
            FM$DAYF(LINE); # OUTPUT MESSAGE TO DAYFILE                 #
          END;
  
  
        IF  FATAL  THEN 
          BEGIN              # FATAL ERROR PROCESSING                  #
            IF  FEX$$ NQ 0  THEN
              BEGIN 
                P<EXIT> = FEX$$;    # USER EXIT                        #
                FM$CALL (EXIT); 
              END 
  
            FM$ABRT;                  # STOP RUN NOW                   #
          END 
  
      END 
      TERM
