!* MODIFIED 18/02/78
!* MODIFIED 12/1/77 10:10 - ALAN ADD MESS. 248
!*
SYSTEMROUTINESPEC READ ERROR DATA(STRINGNAME LAST ERRING PROC, C
INTEGERNAME LAST ERROR CODE)
!*
CONSTSTRING (24)ARRAY B ERROR(1:37) = C
'REAL OVERFLOW',
'REAL UNDERFLOW',
'INTEGER OVERFLOW',
'DECIMAL OVERFLOW',
'ZERO DIVIDE',
'ARRAY BOUNDS EXCEEDED',
'CAPACITY EXCEEDED',
'ILLEGAL OPERATION',
'ADDRESS ERROR',
'INTERRUPT OF CLASS',
'UNASSIGNED VARIABLE',
'TIME EXCEEDED',
'OUTPUT EXCEEDED',
'OPERATOR TERMINATION',
'ILLEGAL EXPONENT',
'SWITCH LABEL NOT SET',
'CORRUPT DOPE VECTOR',
'ILLEGAL CYCLE',
'INT PT TOO LARGE',
'ARRAY INSIDE OUT',
'NO RESULT',
'PARAM NOT DESTINATION',
'PROGRAM TOO LARGE',
'STREAM NOT DEFINED',
'INPUT ENDED',
'SYMBOL IN DATA',
'IOCP ERROR',
'SUB CHARACTER IN DATA',
'STREAM IN USE',
'GRAPH FAULT',
'DIAGNOSTICS FAIL',
'RESOLUTION FAULT',
'INVALID MARGINS',
'SYMBOL INSTEAD OF STRING',
'STRING INSIDE OUT',
'WRONG PARAMS PROVIDED',
'UNSATISFIED REFERENCE'
!*
CONSTSTRING (28)ARRAY MERROR(50:75) = C
'SQRT ARG NEGATIVE',
'LOG ARG NEGATIVE',
'LOG ARG ZERO',
'EXP ARG OUT OF RANGE',
'SIN ARG OUT OF RANGE',
'COS ARG OUT OF RANGE',
'TAN ARG OUT OF RANGE',
'TAN ARG INAPPROPRIATE',
'ASIN ARG OUT OF RANGE',
'ACOS ARG OUT OF RANGE',
'ATAN2 ARGS ZERO',
'SINH ARG OUT OF RANGE',
'COSH ARG OUT OF RANGE',
'LGAMMA ARG NOT POSITIVE',
'LGAMMA ARG TOO LARGE',
'GAMMA ARG OUT OF RANGE',
'COT ARG OUT OF RANGE',
'COT ARG INAPPROPRIATE',
'REAL EXPONENTIATION FAULT',
'COMPLEX EXPONENTIATION FAULT',
'RADIUS ARGS TOO LARGE',
'ARCTAN ARGS ZERO',
'ARCSIN ARG OUT OF RANGE',
'ARCCOS ARG OUT OF RANGE',
'HYPSIN ARG OUT OF RANGE',
'HYPCOS ARG OUT OF RANGE'
!*
CONSTSTRING (25)ARRAY F ERROR(101:110) = C
'MISSING LEFT BRACKET',
'MISSING RIGHT BRACKET',
'NEGATIVE SIGN INCORRECT',
'INVALID FORMAT',
'DECIMAL FIELD > WIDTH',
'FORMAT WIDTH 0 INVALID',
'REPETITION FACTOR INVALID',
'NULL LITERAL INVALID',
'INTEGER FIELD TOO LARGE',
'NO WIDTH FIELD ALLOWED'
!*
CONSTSTRING (35)ARRAY IO ERROR (140:185) = C
'INVALID INTEGER',
'INVALID REAL',
'INVALID SUBSCRIPT(S)',
'INVALID COMPLEX CONSTANT',
'VARIABLE IS NOT AN ARRAY',
'NAME IS NOT FOLLOWED BY AN ''=''',
'VARIABLE NOT IN NAMELIST LIST',
'INVALID ITEM',
'INVALID CHARACTER',
'INVALID VARIABLE NAME',
'LITERAL NOT TERMINATED',
'UNIT NOT DEFINED',
'FILE DOES NOT EXIST',
'INPUT FILE ENDED',
'WRONG LENGTH RECORD',
'INCOMPATIBLE FORMAT DESCRIPTOR',
'READ AFTER WRITE',
'WRITE AFTER ENDFILE',
'RECORD NUMBER OUT OF RANGE',
'NO FORMAT DESCRIPTOR FOR DATA ITEM',
'DECODE/ENCODE BUFFER FAULT',
'INVALID RECORD SIZE',
'NO WRITE ACCESS TO FILE',
'PHYSICAL END OF TAPE',
'INVALID UNIT NUMBER',
'TOO MANY FILES DEFINED',
'INVALID RECORD SIZE',
'INVALID FILE NAME',
'FILE ALREADY EXISTS',
'OUTPUT FILE CAPACITY EXCEEDED',
'UNRECOVERABLE SYSTEM I/O ERROR',
'INVALID OPERATION ON FILE',
'WRONG LENGTH RECORD',
'NO ACCESS PERMISSION',
'INVALID FILE DESCRIPTION',
'FILE NOT AVAILABLE',
'FILE ALREADY OPEN',
'ADDRESSES INSIDE OUT',
'FILE NOT OPEN',
'FILE DESCRIPTION INCORRECT FOR D.A.',
'FILE RECORD SIZE INCORRECT FOR D.A.',
'FACILITY NOT AVAILABLE',
'I/O ERROR-UNSPECIFIED',
'ILLEGAL I/O OPERATION',
'FORMAT TEXT TOO LARGE',
'FILE HAS CONFLICTING USE'
!*
CONSTSTRING (33)ARRAY SJ ERROR (201:232) = C
'INVALID USERNAME',
'INVALID PARAMETER &&',
'CPU LIMIT > PERMITTED MAXIMUM',
'OUTPUT LIMIT > PERMITTED MAXIMUM',
'RESOURCE ALLOWANCE EXCEEDED',
'INVALID CONTROL STATEMENT',
'NO FILE ACCESS ALLOWED',
'DATA FILE NOT ON-LINE',
'TAPE ACCESS NOT ALLOWED',
'TAPE NOT AVAILABLE',
'JOB CPU TIME EXCEEDED',
'JOB OUTPUT LIMIT EXCEEDED',
'JOB TERMINATED BY OPERATOR',
'INVALID KEYWORD',
'TOO MANY PARAMETERS',
'USER NOT REGISTERED FOR FILE USE',
'SPOOL DATA AREA FULL',
'FILE DOES NOT EXIST',
'FILE ALREADY EXISTS',
'INVALID FILE NAME',
'SOURCE LIBRARY NOT DEFINED',
'NO ''CURRENT'' OBJECT FILE',
'INVALID UNIT NUMBER',
'FILE NAME TOO LONG',
'FAILED TO CREATE AREA',
'CORRUPT OBJECT FILE',
'TOO MANY EXTERNAL NAMES',
'PROGRAM TOO LARGE',
'FILE NAMES MUST BE DIFFERENT',
'FILE FACILITIES NOT AVAILABLE',
'INVALID FILENAME FOR LEVEL 2 USER',
'FILES IN LIBRARY STILL CONNECTED'
!*
CONSTSTRING (22) ARRAY OMF ERR(241:248)= C
'OMF WORKFILE FAILS',
'OMF FILE TOO SMALL',
'CORRUPT FIXUP',
'TOO MANY CHS',
'DUPLICATE NAME',
'OMF FILE NOT AVAILABLE',
'NO SPACE FOR WRITE',
'OMF WORKFILE FULL'
CONSTSTRING (22)ARRAY JSV ERR(251:253)= C
'JSVAR NOT AVAILABLE',
'JSVAR NOT ASSIGNED',
'JSVAR STRING TRUNCATED'
!*
!*
OWNSTRING (63) NAME
!*
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
!*
STRINGFN ITOS(INTEGER N)
!RETURNS STRING CONTAINING CHARACTER VALUE OF N WITH NO LEADING SPACE
!N SHOULD BE POSITIVE OR NEGATIVE INTEGER
CONSTINTEGERARRAY TENS(0:9)=C
1,10,100,1000,10000,100000,1000000,10000000,100000000,1000000000
STRING (11) RES
INTEGER M,R,I,STARTED
IF N=0 THEN RESULT ="0"; !SPECIAL CASE
IF N<0 THEN N=-N AND RES = "-" ELSE RES=""
STARTED=0; !INDICATES THAT NO CHARS PUT OUT SO FAR
CYCLE I=9,-1,0
R=TENS(I)
IF N>=R OR STARTED#0 START
STARTED=1; !TO INDICATE THAT CHAR ALREADY FOUND
M=N//R
RES=RES.TOSTRING(M+'0')
N=N-M*R
FINISH
REPEAT
RESULT =RES
END ; !OF ITOS
!*
SYSTEMROUTINE SETMESS(INTEGERNAME N,STRINGNAME V,S)
!* PRINT MESSAGE CORRESPONDING TO FAULT N ON THE CURRENT OUTPUT STREAM
STRING (63) T,U
INTEGER ERROR CODE,I
V='PROGRAM ERROR '
IF 1<=N<=37 THEN S=B ERROR(N) AND ->PRINT
IF 50<=N<=75 THEN S=M ERROR(N) AND ->PRINT
V='FORMAT ERROR '
IF 101<=N<=110 THEN S=F ERROR(N) AND ->PRINT
V='INPUT/OUTPUT ERROR '
IF 140<=N<=185 THEN S=IO ERROR(N) AND ->PRINT
V='ERROR '
IF 201<=N<=232 THEN S=SJ ERROR(N) AND ->PRINT
IF 241<=N<=248 THEN S='***'.OMF ERR(N) AND ->PRINT2
IF 251<=N<=253 THEN S='***'.JSV ERR(N) AND ->PRINT2
IF COMREG(25)=0 THEN MONITOR
V=''
S='ERROR CODE '
IF N=1000 THENSTART
READ ERROR DATA(T,ERROR CODE)
IF ERROR CODE>X'10000' THENSTART
I=ERROR CODE&X'FF'
ERROR CODE=ERROR CODE>>8
FINISHELSE I=0
S=S.ITOS(ERROR CODE)
IF I#0 THEN S=S."/".ITOS(I)
S=S.' FROM SYSTEM PROCEDURE '.T
FINISHELSE S=S.ITOS(N)
RETURN
!*
PRINT: V=V.ITOS(N)
!*
PRINT2: IF S->T.('&&').U THEN S=T.NAME.U
RETURN
END ;! SETMESS
!*
SYSTEMROUTINE OPEH MESS(INTEGER N,STRINGNAME V,TEXT)
NAME=''
SETMESS(N,V,TEXT)
END
!*
SYSTEMROUTINE PRINTMESS(INTEGER N)
STRING (63) S,V
SETMESS(N,V,S)
NEWLINES(3)
PRINTSTRING('*** '.V.' '.S.'***')
NEWLINES(3)
END ;! PRINTMESS
!*
SYSTEMROUTINE SSMESS(INTEGER N)
NAME=''
PRINTMESS(N)
END ;! SSMESS
!*
SYSTEMROUTINE SSMESSA(INTEGER N,STRING (63) A)
NAME=A
PRINTMESS(N)
END ;! SSMESSA
ENDOFFILE