FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00001 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00001 00000 C;+ 00002 00000 C.ENTRY MESAGE 00003 00000 C - M E S A G E 00004 00000 C IDENT: /840614/ 00005 00000 C FILE: MESAGE.FLX 00006 00000 C SYSTEM: VMS V3.2 00007 00000 C LANGUAGE: FLECS/F77 00008 00000 C AUTHOR: M. Oothoudt, J. F. Harrison 00009 00000 C DATE: 16-Mar-83 00010 00000 C;- 00011 00000 C REFERENCES: 00012 00000 C 00013 00000 C REVISIONS: 00014 00000 C 01-APR-83 (MAO) In OUTPUT-OTHER-MESAGE, do I*2-->I*4 right. 00015 00000 C 14-JUN-83 (MAO) Fix fix of 01-APR-83. 00016 00000 C 26-JUL-83 (MAO) Prefix messages with image file name, not process name 00017 00000 C 11-AUG-83 (TK) Add support for RSX '%A' format directive. 00018 00000 C 09-FEB-84 (MAO) $WAITFR after $GETJPI for V4.0 compatibility. 00019 00000 C 14-JUN-84 (MAO) Use IMAGE_NAME instead of $GETJPI to get image name. 00020 00000 C;+ 00021 00000 C 00022 00000 C****PURPOSE: Output formatted message to SYS$OUTPUT: and optionally 00023 00000 C to the operator's console and/or a file. The format 00024 00000 C of the message is given in Note 1. 00025 00000 C 00026 00000 C****RESTRICTIONS: Output to operator's console and/or file NOT 00027 00000 C implemented. 00028 00000 C 00029 00000 C****CALLING SEQUENCE: 00030 00000 C 00031 00000 C CALL MESAGE(MSGTYP,MSGNUM,OUTFLG,[TEXT,[P1,[P2,...,Pn]]]) 00032 00000 C 00033 00000 C INPUT: 00034 00000 C 00035 00000 C MSGTYP= (I*2) Message type/facility (see note 2): 00036 00000 C "4001 - Q message 00037 00000 C "4002 - DS system service error 00038 00000 C "4003 - IO RMS error 00039 00000 C "4004 - USER message 00040 00000 C OTHER - Any other code may be given, and if 00041 00000 C known, output will be produced. 00042 00000 C 00043 00000 C MSGNUM= (I*2) The message number for the given type. 00044 00000 C For IO message type, this number is ignored and the 00045 00000 C last RMS error that occurred is used. 00046 00000 C 00047 00000 C OUTFLG= (I*2) Output control flag: 00048 00000 C Bit 0=1, For OTHER message type, messages for 00049 00000 C MSGTYP/MSGNUM are put out if either or both of 00050 00000 C MSGTYP/MSGNUM are nonzero. For Q, DS, IO and 00051 00000 C USER message types, this bit has no effect. 00052 00000 C Bit 1=1, For Q, USER or OTHER message types, generate 00053 00000 C a traceback on SYS$OUTPUT:. For DS or IO 00054 00000 C message types, this is always done. 00055 00000 C Bit 2=1, Do not put date & time in messages. FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00002 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00056 00000 C 00057 00000 C TEXT = (Character string, null terminated byte array or quoted string 00058 00000 C A message to put out in addition to that given by 00059 00000 C MSGTYP/MSGNUM. The message may contain embedded formatti 00060 00000 C %VA ASCII byte array 00061 00000 C %A ASCII byte 00062 00000 C %D Signed decimal 00063 00000 C %M Unsigned decimal 00064 00000 C %U Unsigned decimal with no zero suppression 00065 00000 C %O Signed octal 00066 00000 C %P Unsigned octal 00067 00000 C %N New line 00068 00000 C P1-Pn = (I*2 variable, byte array or quoted string) variables for to 00069 00000 C embedded formatting in TEXT. At most 13 parameters 00070 00000 C will be used. Byte arrays for %VA must be null 00071 00000 C terminated or a quoted string. 00072 00000 C 00073 00000 C MODIFIED: None 00074 00000 C 00075 00000 C OUTPUT: None 00076 00000 C 00077 00000 C CMN BLOCKS USED: None 00078 00000 C 00079 00000 C****RESOURCES: 00080 00000 C LIBRARIES: QLIB:ARGS:IMAGE_NAME 00081 00000 C FOR$ERRSNS:LIB$MOVC3:LIB$PUT_OUTPUT:LIB$SIGNAL 00082 00000 C OTHER SUBR: NONE 00083 00000 C DISK FILES: NONE 00084 00000 C DEVICES: SYS$OUTPUT: 00085 00000 C SGAS: NONE 00086 00000 C EVENT FLAGS: NONE 00087 00000 C SYSTEM DIR: SYS$FAOL:SYS$GETMSG 00088 00000 C 00089 00000 C****NOTES: 00090 00000 C 1. The format of the output message is: 00091 00000 C 00092 00000 C dd-mm-yy hh:mm:ss.ss -- image name -- text 00093 00000 C message 00094 00000 C System traceback 00095 00000 C 00096 00000 C The first line is always put out. The date and time may be suppressed 00097 00000 C by setting bit 2 of OUTFLG. "text" is constructed from TEXT and 00098 00000 C variables P1-Pn. 00099 00000 C The second line is always put out except for MSGTYP=OTHER, where it 00100 00000 C is put out only if bit 0 of OUTFLG is set and if either MSGTYP or 00101 00000 C MSGNUM are nonzero. It contains an appropriate descriptive text 00102 00000 C for the MSGTYP/MSGNUM. 00103 00000 C The traceback is always put out for MSGTYP=DS or IO; for others it is 00104 00000 C put out only if bit 1 of OUTFLG is set. Note that unlike the 11M 00105 00000 C version of this routine, the traceback includes MESAGE and all 00106 00000 C MACRO routines in the calling sequence. 00107 00000 C 00108 00000 C 2. Note that the MSGTYP and MSGNUM arguments are 16 bit 00109 00000 C variables and thus can contain a general VMS status only by putting 00110 00000 C the high 16 bits in MSGTYP and the low 16 bits in MSGNUM (ie. the FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00003 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00111 00000 C OTHER catagory of MSGTYP). 00112 00000 C Q and USER MSGTYP's from 11M will still work as in 11M. 00113 00000 C For DS errors, VMS system service statuses may be obtained by setting 00114 00000 C MSGTYP=DS and MSGNUM=low 16 bits of status. 00115 00000 C For IO errors, set MSGTYP=IO and the subroutine will automatically 00116 00000 C determine what the last RMS error was. 00117 00000 C 00118 00000 C 3. Output to the operator's console or a file is not implemente 00119 00000 C Output only goes to SYS$OUTPUT. 00120 00000 C;- 00121 00001 SUBROUTINE MESAGE(MESSAGE_TYPE,MESSAGE_NUMBER,OUTPUT_FLAG, 00122 00002 1 TEXT,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13) 00123 00002 00124 00002 C Special note on variable types: Variables TEXT and P1-P13 00125 00002 C are typed as byte arrays so that this subroutine can be 00126 00002 C called with either CHARACTER or byte array data. If the 00127 00002 C MESAGE variables were typed CHARACTER and the user called 00128 00002 C the subroutine with byte arrays, an ACCESS VIOLATION occurs. 00129 00002 C 00130 00002 C DATA DICTIONARY 00131 00002 C 00132 00003 IMPLICIT COMPLEX (A-H,J-Z) !Force explicit variable typing 00133 00003 00134 00003 C Constants 00135 00003 00136 00004 INTEGER*2 BIT_DATE !LOCAL, "Suppress date/time bit" 00137 00005 INTEGER*2 BIT_OPER !LOCAL, "CO: output desired bit" 00138 00006 INTEGER*2 BIT_TRACE !LOCAL, "Traceback desired bit" 00139 00007 INTEGER*2 DS !LOCAL, Code for system service msg 00140 00008 INTEGER*2 IO !LOCAL, Code for IO message 00141 00009 INTEGER*2 MAX_CHAR !LOCAL, Max # char in raw message 00142 00010 INTEGER*2 MAX_PAR !LOCAL, Max # parameters Pn in subr call 00143 00011 INTEGER*2 Q !LOCAL, Code for user message 00144 00012 INTEGER*2 USER !LOCAL, Code for user message 00145 00012 00146 00013 PARAMETER (BIT_DATE='4'O) !bit 2 00147 00014 PARAMETER (BIT_OPER='1'O) !bit 0 00148 00015 PARAMETER (BIT_TRACE='2'O) !bit 1 00149 00016 PARAMETER (DS='4002'O) 00150 00017 PARAMETER (IO='4003'O) 00151 00018 PARAMETER (MAX_CHAR=128) !At least 4 smaller than TEXT_MSG 00152 00019 PARAMETER (MAX_PAR=13) !Must agree with subr arg list!! 00153 00020 PARAMETER (Q='4001'O) 00154 00021 PARAMETER (USER='4004'O) 00155 00021 00156 00022 INCLUDE '($SSDEF)/NOLIST' 00157 00022 00158 00022 C Variables: 00159 00022 00160 00023 INTEGER*4 ARG_MAP !LOCAL, Bit map for subr call arguments 00161 00024 LOGICAL*2 CONT !LOCAL, .FALSE. if formatting error 00162 00025 INTEGER*4 FAOLLST(2*MAX_PAR+1)!LOCAL, Item list for $FAOL 00163 00026 INTEGER*2 FAOLLST_PNT !LOCAL, Pointer into FAOLLST 00164 00027 INTEGER*4 I !LOCAL, scratch 00165 00028 CHARACTER*9 IMAGE !LOCAL, image name FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00004 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00166 00029 INTEGER*2 J !LOCAL, scratch 00167 00030 INTEGER*2 ISTAT(2) !LOCAL, EQUIV (STATUS,ISTAT) 00168 00031 BYTE LETTER !LOCAL, scratch 00169 00032 INTEGER*2 MESSAGE_TYPE !EXT, Type of message to put out 00170 00033 INTEGER*2 MESSAGE_NUMBER!EXT, Message number 00171 00034 INTEGER*2 NARGS !LOCAL, # of arguments in subr call 00172 00035 INTEGER*2 NP !LOCAL, # of next P to use 00173 00036 INTEGER*2 NPARM !LOCAL, # of P's actually given in call 00174 00037 INTEGER*2 OUTPUT_FLAG !EXT, Control bits for message 00175 00038 BYTE P1(1) !EXT, Parameter 1 00176 00039 BYTE P2(1) !EXT, Parameter 2 00177 00040 BYTE P3(1) !EXT, Parameter 3 00178 00041 BYTE P4(1) !EXT, Parameter 4 00179 00042 BYTE P5(1) !EXT, Parameter 5 00180 00043 BYTE P6(1) !EXT, Parameter 6 00181 00044 BYTE P7(1) !EXT, Parameter 7 00182 00045 BYTE P8(1) !EXT, Parameter 8 00183 00046 BYTE P9(1) !EXT, Parameter 9 00184 00047 BYTE P10(1) !EXT, Parameter 10 00185 00048 BYTE P11(1) !EXT, Parameter 11 00186 00049 BYTE P12(1) !EXT, Parameter 12 00187 00050 BYTE P13(1) !EXT, Parameter 13 00188 00051 INTEGER*4 P_ADDR(MAX_PAR)!LOCAL, Addresses of P1-Pn 00189 00052 INTEGER*2 POINT_IN !LOCAL, Pointer in TEXT 00190 00053 INTEGER*2 POINT_OUT !LOCAL, Pointer in TEXT_MSG 00191 00054 INTEGER*4 STATUS !LOCAL, a VMS return status 00192 00055 INTEGER*4 STATUS_LEN !LOCAL, length of STATUS_MSG 00193 00056 CHARACTER*132 STATUS_MSG!LOCAL, text for status message 00194 00057 INTEGER*4 SYS$FAOL !FCT, Format input text 00195 00058 BYTE TEXT(1) !EXT, Text to output 00196 00059 CHARACTER*132 TEXT_MSG !LOCAL, Unformatted TEXT to output 00197 00060 CHARACTER*132 TEXT_OUT !LOCAL, Formatted TEXT to output 00198 00061 INTEGER*4 TEXT_OUT_LEN !LOCAL, # char in TEXT_OUT 00199 00061 00200 00062 EQUIVALENCE (STATUS,ISTAT(1)) FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00005 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00201 00062 .PAGE 00202 00062 C 00203 00064 INITIALIZE-VARIABLES 00204 00064 C 00205 00066 FORMAT-GIVEN-TEXT-AND-OUTPUT-TO-SYSOUTPUT 00206 00066 C 00207 00066 SELECT (MESSAGE_TYPE) 00208 00069 . (Q) OUTPUT-Q-MESSAGE 00209 00073 . (DS) OUTPUT-SYSTEM-SERVICE-MESSAGE 00210 00077 . (IO) OUTPUT-RMS-MESSAGE 00211 00081 . (USER) OUTPUT-USER-MESSAGE 00212 00085 . (OTHERWISE) OUTPUT-OTHER-MESSAGE 00213 00087 ...FIN!select 00214 00087 00215 00088 RETURN ---------------------------------------- 00216 00089 TO FORMAT-GIVEN-TEXT-AND-OUTPUT-TO-SYSOUTPUT 00217 00089 . 00218 00090 . CONT=.TRUE. !No formatting errors yet 00219 00091 . FAOLLST_PNT=1 !Use 1st item 00220 00092 . NP=1 !Use first P 00221 00093 . POINT_IN=1 !Begin at the beginning 00222 00094 . POINT_OUT=1 ! " 00223 00094 . 00224 00095 . IF ( IAND(OUTPUT_FLAG,BIT_DATE) .EQ. 0 ) 00225 00095 . . 00226 00095 C . . Get $FAOL to insert date & time 00227 00095 . . 00228 00096 . . TEXT_MSG(POINT_OUT:POINT_OUT+6) = '!%D -- ' 00229 00097 . . POINT_OUT=POINT_OUT+7 00230 00098 . . FAOLLST(FAOLLST_PNT)=0 !==>use current time 00231 00099 . . FAOLLST_PNT=FAOLLST_PNT+1 00232 00099 . ...FIN!if 00233 00100 . 00234 00100 C . Insert Image name 00235 00100 . 00236 00101 . DO (I=1,9) 00237 00102 . . TEXT_MSG(POINT_OUT:POINT_OUT)=IMAGE(I:I) 00238 00103 . . POINT_OUT=POINT_OUT+1 00239 00103 . ...FIN!do 00240 00105 . TEXT_MSG(POINT_OUT:POINT_OUT+3) = ' -- ' 00241 00106 . POINT_OUT=POINT_OUT+4 00242 00106 . 00243 00106 C . Now put in user's text, converting to $FAOL syntax 00244 00106 . 00245 00111 . IF (NARGS.GT.3 .AND. (IAND(ARG_MAP,8).NE.0) ) INSERT-USER-TEXT 00246 00111 . 00247 00112 D . TYPE*,'MESAGE: Length of unformatted text=',POINT_OUT-1 00248 00113 D . TYPE*,'MESAGE: Unformatted text=',TEXT_MSG 00249 00113 . 00250 00114 . IF (CONT) 00251 00114 . . 00252 00114 C . . Format the output string FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00006 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00253 00114 . . 00254 00115 . . STATUS=SYS$FAOL(TEXT_MSG(1:POINT_OUT-1),TEXT_OUT_LEN,TEXT_OUT, 00255 00116 1. . FAOLLST) 00256 00117 D . . TYPE*,'MESAGE: Formatted text length=',TEXT_OUT_LEN 00257 00118 . . IF (STATUS.NE.SS$_NORMAL) 00258 00119 . . . CALL LIB$PUT_OUTPUT ('MESAGE: $FAOL ERROR') 00259 00121 . . . OUTPUT-STATUS-MESSAGE 00260 00123 . . . PERFORM-TRACEBACK 00261 00123 . . ...FIN!if 00262 00125 . ...FIN!if 00263 00126 . 00264 00126 C . Use LIB$PUT_OUTPUT to avoid using caller's LUNs/Channels 00265 00126 . 00266 00127 . CALL LIB$PUT_OUTPUT( TEXT_OUT(1:TEXT_OUT_LEN) ) 00267 00127 ...FIN!to format-given-text-and-output-to-sysoutput ---------------------------------------- 00268 00129 TO INITIALIZE-VARIABLES 00269 00129 . 00270 00129 C . Find out which arguments were given in call to MESAGE 00271 00129 . 00272 00130 . CALL ARGS (NARGS,ARG_MAP) 00273 00130 . 00274 00131 . NPARM = NARGS-4 !# of P's given 00275 00131 . 00276 00132 D . TYPE*,'MESAGE: NARGS=',NARGS,' NPARM=',NPARM 00277 00132 . 00278 00133 . P_ADDR(1) = %LOC(P1) !Get addresses of all parameters 00279 00134 . P_ADDR(2) = %LOC(P2) 00280 00135 . P_ADDR(3) = %LOC(P3) 00281 00136 . P_ADDR(4) = %LOC(P4) 00282 00137 . P_ADDR(5) = %LOC(P5) 00283 00138 . P_ADDR(6) = %LOC(P6) 00284 00139 . P_ADDR(7) = %LOC(P7) 00285 00140 . P_ADDR(8) = %LOC(P8) 00286 00141 . P_ADDR(9) = %LOC(P9) 00287 00142 . P_ADDR(10) = %LOC(P10) 00288 00143 . P_ADDR(11) = %LOC(P11) 00289 00144 . P_ADDR(12) = %LOC(P12) 00290 00145 . P_ADDR(13) = %LOC(P13) 00291 00145 . 00292 00145 C . Get image name: Get image file name and extract image name. 00293 00145 C . Eg. for DRA1:[MP.B.C]ABC.EXE.37, use ABC. 00294 00145 . 00295 00146 . CALL IMAGE_NAME(IMAGE) 00296 00146 ...FIN!to initialize-variables ---------------------------------------- 00297 00148 TO INSERT-USER-TEXT 00298 00148 . 00299 00149 . WHILE (TEXT(POINT_IN).NE.0 .AND. CONT) 00300 00149 . . 00301 00150 . . WHEN (TEXT(POINT_IN) .EQ.'%') FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00007 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00302 00150 . . . 00303 00150 C . . . Formatting directive 00304 00150 . . . 00305 00151 . . . WHEN (NP.LE.MAX_PAR .AND. NP.LE.NPARM) 00306 00153 . . . . PROCESS-FORMATTING-DESCRIPTOR 00307 00153 . . . ...FIN!when 00308 00155 . . . ELSE 00309 00156 . . . . CONT=.FALSE. 00310 00157 . . . . CALL LIB$PUT_OUTPUT('MESAGE: Too many formatted items') 00311 00159 . . . . PERFORM-TRACEBACK 00312 00159 . . . ...FIN!else 00313 00161 . . ...FIN!when 00314 00162 . . ELSE 00315 00162 . . . 00316 00162 C . . . Normal text 00317 00162 . . . 00318 00163 . . . TEXT_MSG(POINT_OUT:POINT_OUT)=CHAR(TEXT(POINT_IN)) 00319 00164 . . . POINT_OUT=POINT_OUT+1 00320 00165 . . . IF (TEXT(POINT_IN).EQ.'!') 00321 00166 . . . . TEXT_MSG(POINT_OUT:POINT_OUT)='!' !FAOL directive to force ! 00322 00167 . . . . POINT_OUT=POINT_OUT+1 00323 00167 . . . ...FIN!if 00324 00168 . . ...FIN!else 00325 00169 . . 00326 00170 . . POINT_IN=POINT_IN+1 !Next position 00327 00171 . . IF (POINT_OUT.GT.MAX_CHAR) 00328 00172 . . . CONT=.FALSE. 00329 00173 . . . CALL LIB$PUT_OUTPUT('MESAGE--Input text string too long') 00330 00175 . . . PERFORM-TRACEBACK 00331 00175 . . ...FIN!if 00332 00177 . ...FIN!while 00333 00178 ...FIN!to insert-user-text ---------------------------------------- 00334 00180 TO OUTPUT-OTHER-MESSAGE 00335 00180 . 00336 00180 C . Assume this is meant to be some sort of 32 bit system code. 00337 00180 . 00338 00181 . IF (IAND(OUTPUT_FLAG,BIT_OPER) .NE. 0) 00339 00181 . . 00340 00181 C . . Note EQUIV (ISTAT(1),STATUS) 00341 00181 . . 00342 00182 . . ISTAT(1)=MESSAGE_NUMBER !830614MAO 00343 00183 . . ISTAT(2)=MESSAGE_TYPE !830614MAO 00344 00188 . . IF (STATUS.NE.0) OUTPUT-STATUS-MESSAGE 00345 00188 . . 00346 00188 C . . See TO OUTPUT-RMS-MESSAGE for a way to implement "CO:" output. 00347 00188 . ...FIN!if 00348 00189 . 00349 00194 . IF ( IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0) PERFORM-TRACEBACK 00350 00194 ...FIN!to output-other-message ---------------------------------------- FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00008 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00351 00196 TO OUTPUT-Q-MESSAGE 00352 00196 . 00353 00196 C . Do this right when have Q message file 00354 00196 . 00355 00197 . TYPE*,MESSAGE_TYPE,' - ',MESSAGE_NUMBER,' - ', 00356 00198 1. ' Q message file not yet implemented' 00357 00198 . 00358 00198 C . See TO OUTPUT-RMS-MESSAGE for a way to implement "CO:" output. 00359 00198 . 00360 00203 . IF (IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0) PERFORM-TRACEBACK 00361 00203 ...FIN!to output-q-message ---------------------------------------- 00362 00205 TO OUTPUT-RMS-MESSAGE 00363 00205 . 00364 00206 . CALL ERRSNS (,STATUS,,,) !Get RMS error 00365 00211 . IF (.NOT.STATUS) OUTPUT-STATUS-MESSAGE 00366 00213 . PERFORM-TRACEBACK 00367 00213 C . 00368 00213 C . To emulate CO: output of 11M, could do following: 00369 00213 C . SYS$GETMSG to get the message text for the error # 00370 00213 C . When (disk output) open, write & close file 00371 00213 C . ELSE SYS$SNDOPR to op terminal (& to op log file?) 00372 00213 C . 00373 00213 ...FIN!to output-rms-message ---------------------------------------- 00374 00215 TO OUTPUT-STATUS-MESSAGE 00375 00215 . 00376 00215 C . Put out message for given status value. See PERFORM-TRACEBACK 00377 00215 C . for reason that this cannot be done there. 00378 00215 . 00379 00216 . CALL SYS$GETMSG(%VAL(STATUS),STATUS_LEN,STATUS_MSG,%VAL(15),) 00380 00217 . CALL LIB$PUT_OUTPUT(STATUS_MSG(1:STATUS_LEN)) 00381 00217 ...FIN!to output-status-message ---------------------------------------- 00382 00219 TO OUTPUT-SYSTEM-SERVICE-MESSAGE 00383 00219 . 00384 00219 C . Potential problem here! MSGNUM is 16 bits while actual status 00385 00219 C . codes are 32 bits. However, top 16 bits are facility so we 00386 00219 C . will assume this is a SS$_ error which happens to be facility=0. 00387 00219 . 00388 00220 . STATUS = MESSAGE_NUMBER 00389 00222 . OUTPUT-STATUS-MESSAGE 00390 00224 . PERFORM-TRACEBACK 00391 00224 . 00392 00224 C . See TO OUTPUT-RMS-MESSAGE for a way to implement "CO:" output. 00393 00224 . 00394 00224 ...FIN!to output-system-service-message ---------------------------------------- FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00009 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00395 00226 TO OUTPUT-USER-MESSAGE 00396 00226 . 00397 00226 C . Do this right when have USER message file 00398 00226 . 00399 00227 . TYPE*,MESSAGE_TYPE,' - ',MESSAGE_NUMBER,' - ', 00400 00228 1. ' USER message file not yet implemented' 00401 00228 . 00402 00228 C . See TO OUTPUT-RMS-MESSAGE for a way to implement "CO:" output. 00403 00228 . 00404 00233 . IF (IAND(OUTPUT_FLAG,BIT_TRACE) .NE.0) PERFORM-TRACEBACK 00405 00233 ...FIN!to output-user-message ---------------------------------------- 00406 00235 TO PERFORM-TRACEBACK 00407 00235 . 00408 00235 C . Force a traceback printout; unlike 11M, MESAGE is included 00409 00235 C . in the traceback listing. 00410 00235 . 00411 00235 C . Unfortunately if we call LIB$SIGNAL with a signal value, we 00412 00235 C . often get ACCESS VIOLATIONS, aborting the program. The reason 00413 00235 C . is that many of the signal messages require parameters, and 00414 00235 C . we do not have any available. Thus we put out the message 00415 00235 C . with OUTPUT-STATUS-MESSAGE and then force traceback here. 00416 00235 . 00417 00236 . CALL LIB$SIGNAL ( %VAL(0), ) 00418 00236 ...FIN!to perform-traceback ---------------------------------------- 00419 00238 TO PROCESS-FORMATTING-DESCRIPTOR 00420 00238 . 00421 00239 . POINT_IN = POINT_IN+1 !point to char after % 00422 00239 . 00423 00239 . SELECT ( TEXT(POINT_IN) ) 00424 00240 . . (0) 00425 00240 . . . 00426 00240 C . . . Oops, % at end of line--just output it like 11M 00427 00240 . . . 00428 00241 . . . TEXT_MSG(POINT_OUT:POINT_OUT)='%' 00429 00242 . . . POINT_OUT=POINT_OUT+1 00430 00243 . . . POINT_IN=POINT_IN-1 !point back to null 00431 00243 . . ...FIN!%eol 00432 00244 . . ('V') 00433 00245 . . . POINT_IN=POINT_IN+1 !Check if is %VA 00434 00246 . . . WHEN (TEXT(POINT_IN).NE.'A') 00435 00247 . . . . CONT=.FALSE. !Give up 00436 00248 . . . . CALL LIB$PUT_OUTPUT('MESAGE: %Vx, x is not A') 00437 00250 . . . . PERFORM-TRACEBACK !Give user line # of error 00438 00250 . . . ...FIN!when 00439 00252 . . . ELSE 00440 00252 . . . . 00441 00252 C . . . . Find length of user's string 00442 00252 . . . . FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00010 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00443 00253 . . . . I=-1 00444 00256 . . . . REPEAT WHILE (LETTER.NE.0) 00445 00257 . . . . . I=I+1 00446 00258 . . . . . CALL LIB$MOVC3(1,%VAL(P_ADDR(NP)+I),LETTER) 00447 00259 D . . . . . TYPE*,'CHAR ',I,' IN %VA STRING =',LETTER 00448 00259 . . . . ...FIN!repeat while 00449 00260 . . . . 00450 00260 C . . . . Put length of string and address into $FAOL list 00451 00260 . . . . 00452 00261 . . . . FAOLLST(FAOLLST_PNT)=I 00453 00262 . . . . FAOLLST(FAOLLST_PNT+1) = P_ADDR(NP) 00454 00263 . . . . NP=NP+1 00455 00264 . . . . FAOLLST_PNT=FAOLLST_PNT+2 00456 00264 . . . . 00457 00264 C . . . . Put $FAOL directive into output string 00458 00264 . . . . 00459 00265 . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!AD' 00460 00266 . . . . POINT_OUT=POINT_OUT+3 00461 00266 . . . ...FIN!else 00462 00267 . . ...FIN!%va 00463 00268 . . ('A') 00464 00268 . . . 00465 00268 C . . . Put length of string and address into $FAOL list 00466 00268 . . . 00467 00269 . . . FAOLLST(FAOLLST_PNT)=1 00468 00270 . . . FAOLLST(FAOLLST_PNT+1) = P_ADDR(NP) 00469 00271 . . . NP=NP+1 00470 00272 . . . FAOLLST_PNT=FAOLLST_PNT+2 00471 00272 . . . 00472 00272 C . . . Put $FAOL directive into output string 00473 00272 . . . 00474 00273 . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!AD' 00475 00274 . . . POINT_OUT=POINT_OUT+3 00476 00274 . . ...FIN!%a 00477 00275 . . ('N') 00478 00275 . . . 00479 00275 C . . . New line request; needs no parameters for list 00480 00275 . . . 00481 00276 . . . TEXT_MSG(POINT_OUT:POINT_OUT+1)='!/' 00482 00277 . . . POINT_OUT=POINT_OUT+2 00483 00277 . . ...FIN!%n 00484 00278 . . (OTHERWISE) 00485 00278 . . . 00486 00278 C . . . Numeric values: Put value into $FAOL list 00487 00278 . . . 00488 00279 . . . CALL LIB$MOVC3(2,%VAL(P_ADDR(NP)),FAOLLST(FAOLLST_PNT)) 00489 00280 . . . NP=NP+1 00490 00281 . . . FAOLLST_PNT=FAOLLST_PNT+1 00491 00281 . . . 00492 00281 C . . . Put $FAOL directive into output string 00493 00281 . . . 00494 00281 . . . SELECT(TEXT(POINT_IN)) 00495 00282 . . . . ('D') 00496 00282 . . . . . 00497 00282 C . . . . . Signed Decimal FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00011 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT 00498 00282 . . . . . 00499 00283 . . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!SW' 00500 00284 . . . . . POINT_OUT=POINT_OUT+3 00501 00284 . . . . ...FIN!%d 00502 00285 . . . . ('M') 00503 00285 . . . . . 00504 00285 C . . . . . Unsigned Decimal 00505 00285 . . . . . 00506 00286 . . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!UW' 00507 00287 . . . . . POINT_OUT=POINT_OUT+3 00508 00287 . . . . ...FIN!%m 00509 00288 . . . . ('U') 00510 00288 . . . . . 00511 00288 C . . . . . Unsigned Decimal with no zero suppression 00512 00288 C . . . . . However, zeros are suppressed. FAOL bug?? MAO 00513 00288 . . . . . 00514 00289 . . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!ZW' 00515 00290 . . . . . POINT_OUT=POINT_OUT+3 00516 00290 . . . . ...FIN!%u 00517 00291 . . . . ('O') 00518 00291 . . . . . 00519 00291 C . . . . . Signed Octal--$FAO doesn't support this, so we fake it 00520 00291 . . . . . 00521 00292 . . . . . IF (FAOLLST(FAOLLST_PNT-1) .GT. 32767) 00522 00293 . . . . . . FAOLLST(FAOLLST_PNT-1) = 65536-FAOLLST(FAOLLST_PNT-1) 00523 00294 . . . . . . TEXT_MSG(POINT_OUT:POINT_OUT) = '-' 00524 00295 . . . . . . POINT_OUT=POINT_OUT+1 00525 00295 . . . . . ...FIN!if negative 00526 00296 . . . . . 00527 00297 . . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!OW' 00528 00298 . . . . . POINT_OUT=POINT_OUT+3 00529 00298 . . . . ...FIN!%o 00530 00299 . . . . ('P') 00531 00299 . . . . . 00532 00299 C . . . . . Unsigned Octal 00533 00299 . . . . . 00534 00300 . . . . . TEXT_MSG(POINT_OUT:POINT_OUT+2) = '!OW' 00535 00301 . . . . . POINT_OUT=POINT_OUT+3 00536 00301 . . . . ...FIN!%p 00537 00302 . . . . (OTHERWISE) 00538 00302 . . . . . 00539 00302 C . . . . . Unknown format 00540 00302 . . . . . 00541 00303 . . . . . CONT=.FALSE. !Give up 00542 00304 . . . . . CALL LIB$PUT_OUTPUT('MESAGE: %x, x unknown format') 00543 00306 . . . . . PERFORM-TRACEBACK 00544 00306 . . . . ...FIN!otherwise 00545 00308 . . . ...FIN!select 00546 00308 . . . 00547 00308 . . ...FIN!otherwise 00548 00309 . ...FIN!select 00549 00309 ...FIN!to process-formatting-descriptor 00550 00311 END ---------------------------------------- FLECS VERSION 860214 15-JUN-87 09:33:49 PAGE 00012 MESAGE.FOR,MESAGE.FLL/-SP=MESAGE.FLX/CO:GLBOPT PROCEDURE CROSS-REFERENCE TABLE 00216 FORMAT-GIVEN-TEXT-AND-OUTPUT-TO-SYSOUTPUT 00205 00268 INITIALIZE-VARIABLES 00203 00297 INSERT-USER-TEXT 00245 00334 OUTPUT-OTHER-MESSAGE 00212 00351 OUTPUT-Q-MESSAGE 00208 00362 OUTPUT-RMS-MESSAGE 00210 00374 OUTPUT-STATUS-MESSAGE 00259 00344 00365 00389 00382 OUTPUT-SYSTEM-SERVICE-MESSAGE 00209 00395 OUTPUT-USER-MESSAGE 00211 00406 PERFORM-TRACEBACK 00260 00311 00330 00349 00360 00366 00390 00404 00437 00543 00419 PROCESS-FORMATTING-DESCRIPTOR 00306 (FLECS VERSION 22.38) MESAGE 15-Jun-1987 09:33:51 VAX FORTRAN V4.5-219 Page 6 15-Jun-1987 09:33:49 $1$DUA11:[MP1Q.FLEALECOM.QLIB]MESAGE.FOR;1 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1809 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 254 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 1172 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 3235 ENTRY POINTS Address Type Name 0-00000000 MESAGE VARIABLES Address Type Name Address Type Name 2-0000025C I*4 ARG_MAP 2-0000023A L*2 CONT 2-0000023C I*2 FAOLLST_PNT ** I*4 I ** I*2 I32725 2-0000025A I*2 I32738 2-00000258 I*2 I32740 2-00000256 I*2 I32742 2-00000254 I*2 I32744 2-00000252 I*2 I32746 MESAGE 15-Jun-1987 09:33:51 VAX FORTRAN V4.5-219 Page 7 15-Jun-1987 09:33:49 $1$DUA11:[MP1Q.FLEALECOM.QLIB]MESAGE.FOR;1 2-00000250 I*2 I32748 2-0000024E I*2 I32750 2-0000024C I*2 I32752 2-0000024A I*2 I32754 2-00000248 I*2 I32756 ** I*2 I32758 2-000000A4 CHAR IMAGE ** I*2 J 2-000000AD L*1 LETTER AP-00000008@ I*2 MESSAGE_NUMBER AP-00000004@ I*2 MESSAGE_TYPE 2-0000023E I*2 NARGS 2-00000240 I*2 NP 2-00000242 I*2 NPARM AP-0000000C@ I*2 OUTPUT_FLAG 2-00000244 I*2 POINT_IN 2-00000246 I*2 POINT_OUT 2-00000000 I*4 STATUS 2-00000260 I*4 STATUS_LEN 2-000000AE CHAR STATUS_MSG 2-00000132 CHAR TEXT_MSG 2-000001B6 CHAR TEXT_OUT 2-00000264 I*4 TEXT_OUT_LEN ARRAYS Address Type Name Bytes Dimensions 2-00000004 I*4 FAOLLST 108 (27) 2-00000000 I*2 ISTAT 4 (2) AP-00000014@ L*1 P1 1 (1) AP-00000038@ L*1 P10 1 (1) AP-0000003C@ L*1 P11 1 (1) AP-00000040@ L*1 P12 1 (1) AP-00000044@ L*1 P13 1 (1) AP-00000018@ L*1 P2 1 (1) AP-0000001C@ L*1 P3 1 (1) AP-00000020@ L*1 P4 1 (1) AP-00000024@ L*1 P5 1 (1) AP-00000028@ L*1 P6 1 (1) AP-0000002C@ L*1 P7 1 (1) AP-00000030@ L*1 P8 1 (1) AP-00000034@ L*1 P9 1 (1) 2-00000070 I*4 P_ADDR 52 (13) AP-00000010@ L*1 TEXT 1 (1) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 0-00000135 32724 0-00000138 32726 0-0000013C 32727 0-00000140 32728 0-0000014C 32729 0-00000158 32730 0-00000164 32731 0-00000168 32732 0-0000016C 32733 0-00000170 32734 0-00000174 32735 0-00000178 32736 0-0000017C 32737 ** 32738 0-00000180 32739 0-0000065A 32740 0-00000184 32741 0-000006BC 32742 0-00000190 32743 ** 32744 0-00000194 32745 ** 32746 0-00000198 32747 ** 32748 0-0000019C 32749 ** 32750 0-000001A0 32751 ** 32752 0-000001A4 32753 ** 32754 0-000001B4 32755 ** 32756 0-00000334 32757 ** 32758 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name ARGS FOR$ERRSNS IMAGE_NAME LIB$MOVC3 LIB$PUT_OUTPUT LIB$SIGNAL I*4 SYS$FAOL SYS$GETMSG MESAGE 15-Jun-1987 09:33:51 VAX FORTRAN V4.5-219 Page 8 15-Jun-1987 09:33:49 $1$DUA11:[MP1Q.FLEALECOM.QLIB]MESAGE.FOR;1 COMMAND QUALIFIERS FORTRAN/F77/LIST=MESAGE.LST/NOI4/F77 MESAGE /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW) /DEBUG=(NOSYMBOLS,TRACEBACK) /STANDARD=(NOSYNTAX,NOSOURCE_FORM) /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP,NODICTIONARY,SINGLE) /WARNINGS=(GENERAL,NODECLARATIONS,NOULTRIX) /CONTINUATIONS=19 /NOCROSS_REFERENCE /NOD_LINES /NOEXTEND_SOURCE /F77 /NOG_FLOATING /NOI4 /NOMACHINE_CODE /OPTIMIZE COMPILATION STATISTICS Run Time: 2.04 seconds Elapsed Time: 4.40 seconds Page Faults: 1054 Dynamic Memory: 930 pages