! PASCAL OPEH ROUTINES RELEASE 1
! Mike Brown - September 1980
!
%SYSTEMROUTINESPEC DUMP (%INTEGER S, F)
%SYSTEMROUTINESPEC NCODE (%INTEGER S, F, A)
%SYSTEMROUTINESPEC NDIAG (%INTEGER PCOUNT, LNB, FAULT, INF)
%EXTRINSICBYTEINTEGER FLAGABORT
!
%CONSTBYTEINTEGERARRAY HEX (0:15) = %C
   '0', '1', '2', '3', '4', '5', '6', '7', %C
   '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'
!
%ROUTINE PHEX (%INTEGER VALUE, PLACES)
%INTEGER Z
   %CYCLE Z = PLACES << 2 - 4, -4, 0
      PRINTSYMBOL(HEX(VALUE >> Z & 15))
   %REPEAT
%END
!
%ROUTINE ABORT (%INTEGER CODE, PC, LNB)
%INTEGER W
   PRINTSTRING("ABORT")
   WRITE(CODE,1)
   NEWLINE
   PRINTSTRING("PC =")
   PHEX(PC,8)
   PRINTSTRING(" ; LNB =")
   PHEX(LNB,8)
   NEWLINE
   PRINTSTRING("CODE")
   NEWLINE
   NCODE(PC - 64,PC + 64,PC - 64)
   NEWLINE
   PRINTSTRING("GLA")
   NEWLINE
   W = INTEGER(LNB + 16)
   DUMP(W,W + 128)
   NEWLINE
   PRINTSTRING("STACKFRAME")
   NEWLINE
   DUMP(LNB,LNB + 256)
   FLAGABORT = 1
   %MONITOR
   %STOP
%END
!
%EXTERNALINTEGERFN ICL9HEPROLOG (%INTEGER DUMMY)
! DUMMY AS DESIRE ALL CONTINGENCIES BE ROUTED VIA SUBSYSTEM
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HECOMPERR (%INTEGER LANGUAGE, ERRORNO)
%INTEGER LNB, PC, GLA, LANGFLAG
   *STLN_LNB
   %CYCLE
      GLA = INTEGER(LNB + 16)
      LANGFLAG = INTEGER(GLA + 16)
      %IF LANGFLAG = X'070AFFFF' %THEN %EXIT
      PC = INTEGER(LNB + 8)
      LNB = INTEGER(LNB)                                                        ;! RETREAT ONE STACKFRAME
   %REPEAT
   NDIAG(PC,LNB,ERRORNO,0)
   %STOP
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HEFATALCOMPERR (%INTEGER LANGUAGE, ERRORNO)
                                                                                ;! SOFTWARE SIGNALLED ERROR
%INTEGER LNB, PC, GLA, LANGFLAG
   *STLN_LNB
   %CYCLE                                                                       ;! SKIP OVER LIBRARY PROCEDURES
      GLA = INTEGER(LNB + 16)
      LANGFLAG = INTEGER(GLA + 16)
      %IF LANGFLAG = X'070AFFFF' %THEN %EXIT
      PC = INTEGER(LNB + 8)
      LNB = INTEGER(LNB)
   %REPEAT
   %IF LNB & 3 # 0 %THEN LNB = LNB - 1
   NDIAG(PC,LNB,ERRORNO,0)                                                      ;! CALL SUBSYSTEM NDIAG
   %STOP
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HEFILETIDYPROC (%LONGINTEGER DUMMY)
! DUMMY
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HERESET
! DUMMY
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HETIDYUP
! DUMMY
   %RESULT = 0
%END
!
%EXTERNALINTEGERFN ICL9HERROR (%INTEGER GROUP0, GROUP1, PROCNO0, PROCNO1, %C
   ERRNO0, ERRNO1, MESS0, MESS1)
%INTEGER GROUP, PROCNO, ERRNO, LNB, PC, GLA, LANGFLAG
   GROUP = INTEGER(GROUP1)
   PROCNO = INTEGER(PROCNO1)
   ERRNO = INTEGER(ERRNO1)
   %IF GROUP < 0 %OR GROUP > 255 %THEN %RESULT = 11
   %IF PROCNO < 0 %OR PROCNO > 255 %THEN %RESULT = 12
   %IF ERRNO < 0 %OR ERRNO > 65535 %THEN %RESULT = 13
   *STLN_LNB
   %CYCLE
      GLA = INTEGER(LNB + 16)
      LANGFLAG = INTEGER(GLA + 16)
      %IF LANGFLAG = X'070AFFFF' %THEN %EXIT
      PC = INTEGER(LNB + 8)
      LNB = INTEGER(LNB)
   %REPEAT
   %IF GROUP = 0 %AND PROCNO = 0 %THEN %START                                   ;! USER DEFINED ERROR
      SELECT OUTPUT (0)
      NEWLINE
      PRINTSTRING("USER SIGNALLED ERROR : ERROR NO =")
      WRITE(ERRNO,1)
      PRINTSTRING("   GROUP =")
      WRITE(GROUP,1)
      PRINTSTRING("   PROCNO =")
      WRITE(PROCNO,1)
      NEWLINE
      NDIAG(PC,LNB,0,0)
      %STOP
      %RESULT = 0
   %FINISH
   %IF GROUP # 0 %THEN %START                                                   ;! USER LIBRARY ERROR
      SELECT OUTPUT (0)
      PRINTSTRING("USER LIBRARY ERROR : GROUP =")
      WRITE(GROUP,1)
      PRINTSTRING("   PROCNO =")
      WRITE(PROCNO,1)
      PRINTSTRING("   ERRNO =")
      WRITE(ERRNO,1)
      NEWLINE
      ABORT(0,PC,LNB)
      %RESULT = 0
   %FINISH
%END
!
%ENDOFFILE