*DECK S$ERR 
          PROC S$ERR(ENUM, STRING$, VAL); 
  
  
  
  
#**       S$ERR - HANDLE ERROR PROCESSING FOR SORT/MERGE               #
#                                                                      #
#         CALLING SEQUENCE -                                           #
#         S$ERROR(ERRORNUMBER[,STRING$,NUM])                           #
#         (SEE S$ERROR FOR DETAILS )- IT LOADS THIS ROUTINE AND        #
#         CALLS IT TO DO THE ACTUAL WORK                               #
  
  
          BEGIN 
  
          DEF BUFLEN    #20#;     #   LENGTH OF BUFFER WITH ERRORS     #
*CALL A 
*CALL E$
*CALL STRING$ 
*CALL JCREG 
  
  
          ITEM  ENUM         I;        # E$<NUMBER>                    #
          ITEM  VAL          I;        # VALUE (OPTIONAL)              #
          ITEM  RECCOUNT  I = 0;       # COUNT OF SAVED RECORDS        #
          ITEM  ERMSG  B = FALSE;      # ERROR TABLE LOADED            #
          ITEM  I  I;                  # MISCELLANEOUS                 #
          ITEM  POINTER  I = 1;        # POINTS TO SAVE BUFFER         #
          ITEM  EFOPENED B = FALSE;    # TRUE IF ERROR FILE IS OPENED  #
          ITEM  DIAGNOSTICS  B;        # TRUE IF DIAGNOSTICS WANTED    #
          ITEM  SAVED  B = FALSE;      # TRUE IF ERRORS ARE SAVED      #
          ITEM GETSEVERITY  I;
          ITEM GETLENGTH    I;
          ITEM ENUM1    I;
          ITEM VAL1     I;
          ITEM C10      C(10);
          ITEM  C60  C(60); 
          ARRAY SAVEBUF [1:BUFLEN] S(27);   # SAVE BUFFER              #
              BEGIN 
              ITEM SAVENUM     I (0,0,60);
              ITEM SAVEVAL     I (1,0,60);
              ITEM SAVSTRL     I (2,0,60);
              ITEM SAVSTRC     C (3,0,240); 
              END 
          ARRAY STRING$1 [0:0] S(25); 
             BEGIN
             ITEM STRLEN1  I (0,0,60);
             ITEM STRINGC1 C (1,0,240); 
             END
          BASED ARRAY BASEDAR;; 
  
  
          XREF
              BEGIN 
              PROC S$ABT; 
              PROC S$ABORT; 
              PROC S$END; 
              PROC S$ERRHD;   # PUT A HEADER IN ERROR FILE             #
              PROC S$OPEF;    # OPEN ERROR FILE                        #
              PROC S$PTEF;    # PUT LINE ON ERROR FILE                 #
              PROC S$PTEFU;   # PUT UNSHIFTED ON ERROR FILE            #
              PROC S$CLEF;             # CLOSE ERROR FILE              #
              PROC S$CLLF;    # CLOSE LIST FILE                        #
              PROC S$PTLF;    # PUT LINE ON LIST FILE                  #
              PROC S$PTLFU;   # PUT UNSHIFTED ON LIST FILE             #
              PROC S$LOAD;    # LOAD MODULE WITH ERR MESS TABLE        #
              PROC S$ULOAD;   # UNLOAD THIS MODULE                     #
              PROC S$PRTCD;   # PRINT ON FILE "CODE"                   #
              PROC S$ERMSG;   # CONTAINS TABLE WITH ERROR MESSAGES     #
              PROC S$SJCR;
              PROC S$SSTAT;   # SETS STATUS VARIABLE                   #
              ITEM S$ELEV;    # ERROR LEVEL SPECIFIED                  #
              ITEM S$EFNAM C(10); # ERROR FILE NAME                    #
              ITEM S$JCRV       S:JCREG;  # CONTROL REGISTER           #
              ITEM S$LFNAM C(10); # LIST FILE NAME                     #
              ITEM S$MXERR;       # HIGHEST SEVERITY OF ERRORS MET     #
              ITEM S$LOGLN;   # LOGICAL LINE NUMBER      #
              ITEM S$STVAR;               # 'SM5ST' VARIABLE USED      #
              END 
  
  
  
CONTROL EJECT;
          FUNC  DEC(VALUE) C(10); 
  
          # CONVERTS A BINARY NUMBER TO DISPLAY CHARACTERS             #
  
              ITEM  VALUE       I;     # VALUE TO BE CONVERTED         #
              ITEM  C10PLUS     C(20);
              ITEM  I            I; 
              ITEM  N            I; 
              BEGIN 
              C10PLUS = "         0          "; 
              N = VALUE;
              IF N LS 0  THEN 
                  N = -N; 
              IF N GR 999999999 THEN
                  BEGIN 
                  C10PLUS = " *********          "; 
                  I = 0;
                  END 
              ELSE
                  BEGIN 
                  FOR I = 9 WHILE N NQ 0  DO
                      BEGIN 
                      C<I,1>C10PLUS = N - (N/10)*10 + 27; 
                      N = N/10; 
                      I = I - 1;
                      END 
                  END 
              IF VALUE LS 0 THEN
                  C<I,1>C10PLUS = "-";
              DEC = C<I,10>C10PLUS; 
              END  # DEC #
  
CONTROL EJECT;
              PROC PRTCD(LINE); 
  
          # THE SOLE USE OF THIS PROCEDURE IS TO DEBUG                 #
  
              ITEM LINE C(60);
              BEGIN 
              $BEGIN
              S$PRTCD(LINE);
              S$PRTCD(0); 
              $END
              END 
  
CONTROL EJECT;
          PROC PUTERROR(ENUM$,STRING$$,VAL$); 
  
#**           PUTERROR -  FORMAT DIAGNOSTIC MESSAGE                    #
#                                                                      #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#             PUTERROR(ENUM$,STRING$$,VAL$)                            #
#                                                                      #
#     GIVEN-                                                           #
#             ENUM$ = E$<NUMBER> INDICATING MESSAGE                    #
#             STRING$$ = ARRAY CONTAINING A STRING AND ITS LENGTH      #
#                                                                      #
#     DOES-                                                            #
#             FORMATS DIAGNOSTIC MESSAGE AND CALLS S$PTEF TO PUT IT    #
#             ON ERROR FILE                                            #
              ITEM ENUM$ I; 
              ITEM VAL$  I; 
              ARRAY STRING$$ [0:24] S(1); 
                 BEGIN
                 ITEM STRL$$  I (0,0,60); 
                 ITEM STRC$$  C (0,0,10); 
                 END
  
              ARRAY ARROW [0:0] S(8); 
                  ITEM ARROWC C (0,0,80) = ["  "];
  
              ARRAY SEVERITY [2:5] S(2);
                 ITEM MESSAGE C (0,0,20) = [
                                           "TRIVIAL ERROR", 
                                           "WARNING", 
                                           "FATAL ERROR", 
                                           "CATASTROPHIC ERROR" 
                                          ];
              ITEM POS     I; # WORD POSITION OF STRING PART           #
              ITEM MISC        C(10);  # USED FOR S$PRTCD CALLS        #
              ITEM I       I; # MISCELLANEOUS                          #
              ITEM REST    I; # REMAINING NB. OF CHARACTERS IN STRING  #
              ITEM CPOS    I; # CHARACTER POSITION IN ARROW            #
              ITEM LN      I; # LENGTH OF PARTIAL STRING               #
              ITEM ERRORHEADER C(70); # ERROR MESS. HEADER             #
              ITEM L       I; # LENGTH OF ERROR MESSAGE IN CHARACTERS  #
              ITEM PREVLN I = -1;    # PREVIOUS LINE NUMBER     # 
  
          BEGIN  # PROCEDURE PUTERROR # 
  
          # CALL S$ERMSG WITH THE ERROR NUMBER.                        #
          # IT WILL SET THE LAST THREE VARIABLES AS FOLLOWS -          #
          #   I - ERROR SEVERITY       #
          #   L - LENGTH OF ERROR MESSAGE TEXT                         #
          #   P<BASEDAR> - ADDRESS OF ERROR MESSAGE TEXT               #
  
          $BEGIN
          C60 = "S$ERR - PROCEDURE PUTERROR ENTERED WITH ENUM$ =";
          C<50,10>C60 = DEC(ENUM$); 
          PRTCD(C60); 
          $END
  
          S$ERMSG(ENUM$,I,L,P<BASEDAR>);
  
          $BEGIN
          C60 = "S$ERR - PROCEDURE S$ERMSG RETURNED WITH ENUM$ =";
          C<50,10>C60 = DEC(ENUM$); 
          PRTCD(C60); 
          $END
  
          ERRORHEADER = MESSAGE[I/10];
          C<20,6>ERRORHEADER = "NUMBER";
          C<27,7>ERRORHEADER = DEC(ENUM$);
  
          S$PTEFU(" ",10);
          S$PTEF(ERRORHEADER,70); 
          S$PTEFU(" ",10);
          S$PTEFU(BASEDAR,L); 
          S$PTEFU(" ",10);
  
          IF S$LFNAM NQ "0" THEN
              BEGIN 
              $BEGIN
              C60 = "S$ERR - IN PTLF - ENUM$ = "; 
              C<50,10>C60 = DEC(ENUM$); 
              PRTCD(C60); 
              $END
              S$PTLFU(" ",10);
              S$PTLF(ERRORHEADER,70); 
              S$PTLFU(" ",10);
              S$PTLFU(BASEDAR,L); 
              S$PTLFU(" ",10);
              END 
          IF ENUM$ LQ 40 THEN   # PRINT STRING$                    #
             BEGIN
             POS = 0;           # WORD POSITION IN STRING          #
             REST = STRL$$[0];  # REST OF STRING TO BE PRINTED     #
             IF S$LOGLN EQ PREVLN THEN
                 BEGIN
                 POS = ((VAL$-1)/80) * 8; 
                 REST = STRL$$[0] - 10 * POS; 
                 IF REST GR 80 THEN REST = 80;
                 END
PRINT:       IF REST GR 80 THEN 
                 LN = 80; 
             ELSE 
                 LN = REST; 
             S$PTEF(STRING$$[POS+1],LN);
             IF S$LFNAM NQ "0" THEN 
                 S$PTLF(STRING$$[POS+1],LN);
             REST = REST - 80;
             CPOS = 10 * POS; 
             POS = POS + 8; 
  
             IF VAL$ GR CPOS AND VAL$ LQ CPOS+80 THEN 
                 BEGIN
                 I = VAL$ - CPOS; 
                 C<I,1>ARROWC[0] = "^"; 
                 S$PTEF(ARROW,I+1); 
                 S$PTEFU(" ",10); 
                 IF S$LFNAM NQ "0" THEN 
                    BEGIN 
                    S$PTLF(ARROW,I+1);
                    S$PTLFU(" ",10);
                    END 
                 C<I,1>ARROWC[0] = " "; 
                 END
             PREVLN = S$LOGLN;
             IF REST GR 0 THEN GOTO PRINT;
             END
          END  # PROCEDURE PUTERROR # 
  
CONTROL EJECT;
              PROC SAVEREC(ENUM$,STRING$$,VAL$);
#**           SAVEREC -  SAVE MESSAGE IN MEMORY                        #
#                                                                      #
#                                                                      #
#     CALLING SEQUENCE-                                                #
#             SAVEREC(ENUM$,STRING$$,VAL$)                             #
#                                                                      #
#     GIVEN-                                                           #
#             ENUM$,STRING$$,VAL$ - AS IN ROUTINE PUTERROR             #
#                                                                      #
#     DOES-                                                            #
#             STORES PARAMETERS IN TABLE IN CM                         #
  
              ITEM ENUM$ I; 
              ITEM VAL$  I; 
              ARRAY STRING$$ [0:0] S(25); 
                 BEGIN
                 ITEM STRL$$  I (0,0,60); 
                 ITEM STRC$$  C (1,0,240);
                 END
              ITEM BUFFERFULL B = FALSE;   # TRUE IF SAVEBUFFER IS FULL#
                 BEGIN  # PROCEDURE SAVEREC  #
                 $BEGIN 
                 C60 = "S$ERR - PROCEDURE SAVEREC ENTERED - ENUM$ = ";
                 C<50,10>C60 = DEC(ENUM$);
                 PRTCD(C60);
                 $END 
                 IF BUFFERFULL THEN RETURN; 
                  IF POINTER LS BUFLEN  THEN
                    BEGIN 
                    SAVENUM[POINTER] = ENUM$; 
                      IF ENUM$ LQ 40   THEN 
                          BEGIN 
                          SAVEVAL[POINTER] = VAL$;
                          SAVSTRL[POINTER] = STRL$$;
                          SAVSTRC[POINTER] = STRC$$;
                          END 
                      IF ENUM$ GR 40  THEN  # VAL$,STRING$ NOT DEFINED #
                          BEGIN 
                          SAVEVAL[POINTER] = 0; 
                          SAVSTRL[POINTER] = 0; 
                          SAVSTRC[POINTER] = "    ";
                          END 
                    POINTER = POINTER + 1;
                    RECCOUNT = RECCOUNT + 1;
                    END 
                  IF POINTER EQ BUFLEN  THEN
                      BEGIN 
                      BUFFERFULL = TRUE;
                      SAVENUM[POINTER] = E$153;    # BUFFER FULL #
                      SAVEVAL[POINTER] = 0; 
                      SAVSTRL[POINTER] = 0; 
                      SAVSTRC[POINTER] = "      ";
                      POINTER = POINTER + 1;
                      RECCOUNT = RECCOUNT + 1;
                      END 
                 END    # PROCEDURE SAVEREC # 
  
CONTROL EJECT;
              PROC GETREC(ENUM$,STRING$$,VAL$); 
#**           GETREC -  RETRIEVE PARAMETERS FROM SAVE BUFFER           #
#                                                                      #
#     CALLING SEQUENCE                                                 #
#             GETREC(ENUM$,STRING$$,VAL$)                              #
#                                                                      #
#     GIVEN-                                                           #
#             ENUM$, STRING$$, VAL$ - AS IN ROUTINE PUTERROR           #
#     DOES-                                                            #
#             RETRIEVES PARAMETERS FROM SAVEBUFFER                     #
              ITEM ENUM$ I; 
              ITEM VAL$  I; 
              ARRAY STRING$$ [0:0] S(25); 
                 BEGIN
                 ITEM STRL$$  I (0,0,60); 
                 ITEM STRC$$  C (1,0,240);
                 END
                 BEGIN  # PROCEDURE GETREC  # 
  
                 $BEGIN 
                 C60 = "S$ERR - PROCEDURE GETREC ENTERED WITH ENUM$ = ";
                 C<50,10>C60 = DEC(ENUM$);
                 PRTCD(C60);
                 $END 
  
                 ENUM$ = SAVENUM[POINTER];
                 VAL$  = SAVEVAL[POINTER];
                 STRL$$ = SAVSTRL[POINTER]; 
                 STRC$$ = SAVSTRC[POINTER]; 
                 POINTER = POINTER + 1; 
                 END    # PROCEDURE GETREC #
  
  
CONTROL DISJOINT; 
  
CONTROL INERT;
  
CONTROL EJECT;
#   S $ E R R     M A I N    P R O C E D U R E                         #
  
          # PUT OUT A MESSAGE TO TELL THE WORLD THERE WAS AN           #
          # ERROR - IF WE ARE IN DEBUGGING MODE                        #
  
          $BEGIN
          C60 = "PROC S$ERR ENTERED WITH ERROR NO - ";
          C<53,7>C60 = DEC(ENUM); 
          PRTCD(C60); 
          $END
  
  
          # IN GENERAL, S$ERR IS CALLED WITH A VALID ERROR             #
          # NUMBER, OR WITH THE SPECIAL TRIGGER NUMBER '0'.            #
          # THE TRIGGER NUMBER IS A REQUEST TO FINISH UP THE           #
          # PROCESSING AND PRINT ALL THE ERRORS. THIS IS A             #
          # SPECIAL CASE AND IS HANDLED WITH SPECIAL CODE.             #
          # THEREFORE, WHY NOT USE A GO TO (SHUDDER)                   #
  
          IF ENUM EQ 0 THEN GOTO FINALREPORT; 
  
          # IF WE GET HERE, THE ERROR NUMBER WAS NONZERO               #
  
          # SINCE WE HAVE AN ERROR,   WHY NOT UPDATE                   #
          # S$MXERR SO THAT IT IS CORRECT AT THIS TIME                 #
  
          IF NOT ERMSG THEN 
              BEGIN 
              S$LOAD("S$ERMSG");
              ERMSG = TRUE; 
              END 
          S$ERMSG(ENUM,GETSEVERITY,GETLENGTH,P<BASEDAR>); 
          IF GETSEVERITY GR S$MXERR THEN
              S$MXERR = GETSEVERITY;
  
          S$SSTAT;                     # UPDATE STATUS VARIABLES       #
  
  
          IF S$EFNAM EQ "0" THEN       # E=$NULL WAS SPECIFIED         #
              BEGIN 
              DIAGNOSTICS = FALSE;
#***#         RETURN; 
              END 
          # IF WE GET HERE, WE HAVE AN ERROR AND WE                    #
          # SHOULD PROBABLY DO SOMETHING ABOUT IT.                     #
          # FIRST, CHECK THE DESIRED ERROR REPORTING LEVEL             #
  
          IF S$ELEV EQ 100 THEN        # USER HASN'T SAID ANYTHING     #
              S$ELEV = 30;             # DEFAULT TO WARNING            #
  
          IF GETSEVERITY LS S$ELEV THEN 
#***#         RETURN; # KEEP QUIET     #
  
          # NOW DECIDE WHETHER TO PRINT IT OR SAVE IT                  #
  
          IF S$EFNAM EQ " " OR S$LFNAM EQ " " THEN
              BEGIN 
              $BEGIN
              C60 = "S$ERR IS SAVING THIS ERROR"; 
              PRTCD(C60); 
              $END
              SAVEREC(ENUM,STRING$,VAL);
              SAVED = TRUE; 
#***#         RETURN; 
              END 
  
          # IF WE GET HERE, WE HAVE TO PRINT IT ON                     #
          # A FILE. SO WE CHECK IF THE FILE IS OPENED, ETC.            #
  
          IF S$EFNAM EQ " " THEN
              S$EFNAM = "OUTPUT"; 
          IF S$LFNAM EQ " " THEN
              S$LFNAM = "OUTPUT"; 
  
          IF NOT EFOPENED THEN
              BEGIN 
              S$OPEF(S$EFNAM);
              S$ERRHD;
              EFOPENED = TRUE;
              END 
  
          # PRINT ANY SAVED ERRORS FIRST                               #
  
          IF SAVED THEN 
              BEGIN 
              $BEGIN
              C60 = "S$ERR IS NOW PRINTING SAVED ERRORS"; 
              PRTCD(C60); 
              $END
              POINTER = 1;
              FOR I = 1 STEP 1 UNTIL RECCOUNT DO
                  BEGIN 
                  GETREC(ENUM1,STRING$1,VAL1);
                  PUTERROR(ENUM1,STRING$1,VAL1);
                  $BEGIN
                  C60 = "SAVED ERROR HAS BEEN PRINTED"; 
                  PRTCD(C60); 
                  $END
                  END 
              SAVED = FALSE;
              END 
  
          # NOW WE CAN PRINT OUR NEW ERROR                             #
  
          PUTERROR(ENUM,STRING$,VAL); 
          $BEGIN
          C60 = "S$ERR WROTE THIS ERROR TO LFN - "; 
          C<50,10>C60 = S$EFNAM;
          PRTCD(C60); 
          $END
  
          # ALL DONE                   #
  
#***#     RETURN; 
  
FINALREPORT:    # WHAT TO DO WITH S$ERROR(0)                           #
  
  
          $BEGIN
          C60 = "S$ERR - FINAL REPORT ACTIVATED (ERROR 0)"; 
          PRTCD(C60); 
          $END
  
          S$SSTAT;                     # UPDATE STATUS VARIABLES       #
  
          IF EFOPENED THEN             # WE HAVE AN OPEN FILE          #
              BEGIN 
              S$CLEF; # CLOSE ERROR FILE                               #
              EFOPENED = FALSE; 
              S$ULOAD("S$ERMSG"); 
              ERMSG = FALSE;  # RESET FLAG, STUPID #
#***#         RETURN; 
              END;
  
          IF NOT SAVED THEN 
              BEGIN 
              $BEGIN
              C60 = "THERE WERE NO SAVED ERROR MESSAGES"; 
              PRTCD(C60); 
              $END
#***#         RETURN; 
              END 
  
          # WE MUST HAVE SAVED MESSAGES AND A CLOSED FILE              #
          IF S$EFNAM EQ " " THEN S$EFNAM = "OUTPUT";
          IF S$LFNAM EQ " " THEN S$LFNAM = "OUTPUT";
  
          S$OPEF(S$EFNAM);
          S$ERRHD;
          POINTER = 1;
          FOR I = 1 STEP 1 UNTIL RECCOUNT DO
              BEGIN 
              GETREC(ENUM1,STRING$1,VAL1);
              PUTERROR(ENUM1,STRING$1,VAL1);
              END 
          SAVED = FALSE;
          S$CLEF; 
          S$ULOAD("S$ERMSG"); 
          ERMSG = FALSE;  # RESET FLAG, STUPID #
#***#     RETURN;                      # AVOID FOLLOWING CODE          #
  
          IF S$ELEV EQ 200 #IMPOSSIBLE# THEN S$CLLF; # FOR LOADER ONLY #
  
          END  # S$ERR MAIN PROCEDURE # 
  
  
  
          TERM
