MACRO EXN &OFFSET,&VALUE,&NAME GBLA &EXNCNT,&EXNOFF(200) GBLC &EXNAME(200) LCLA &I ACTR 400 &I SETA 1 .LOOP ANOP AIF (&I LE &EXNCNT).NOTDONE MNOTE 8,'Exception &NAME is not defined' MEXIT .NOTDONE ANOP AIF ('&NAME' EQ '&EXNAME(&I)').FOUND &I SETA &I+1 AGO .LOOP .FOUND ANOP DC AL1(&OFFSET),X'&VALUE',AL2(&EXNOFF(&I)) MEND * * $Source: /commtar/monoBANK/RTS/tKexncvt.a,v $ * $Revision: 1.11 $ $Date: 88/07/01 19:04:41 $ $Author: stt $ * PUNCH ' ALIAS #EXNCVT' #EXNCVT ADASTART 'Convert CICS conditions to Ada exceptions', X CICS=NO *********************************************************************** * * * This code converts CICS "conditions" to Ada exceptions. * * Supermain issues a HANDLE CONDITION ERROR and specifies * * this routine as the handler. This routine looks at the * * EIB and decides what exception to raise, sets up the * * registers, and raises the exception. * * * * The registers at entry to this routine are the same as * * when the CICS call was made. For the RTS CICS interface * * routines, this means: * * * * R3 -> current stack frame * * R8 -> EIB * * R9 -> DFHEISTG * * R14 -> CICS call (use as exception address) * * * * Since we are raising an exception anyway we don't need * * to worry about saving registers. Once we have figured * * out what exception to raise, we load the address of its * * exception descriptor into R4 and branch to GHLERRH. * * * * This code works with version 1.6.1 of CICS. It would be * * nice to have another version for use with 1.7 that uses * * the EIBRESP field instead... * * * *********************************************************************** COPY CICSEX USING DFHEISTG,R9 USING DFHEIBLK,R8 USING GBL,RGLBL not really, but soon DFHEIPLR EQU R9 DFHEIBR EQU R8 USING PSTACK,R3 BALR R2,0 get a base register USING *,R2 tell assembler PUSH USING ADACICS TYPE=RESTORE,SAVE89=NO reset global stack/tcb values POP USING * * Look up the CICS component code to get the * address of the right conversion table. * LA PR2,COMPCNT get the component count LA PR3,COMPTBL-1 point to component table COMPLOOP DS 0H LA PR1,0(PR2,PR3) point to component code CLC EIBFN(1),0(PR1) match? BE COMPFND if so, we found it BCT PR2,COMPLOOP if not, try again * * If we get here, we don't know this component code, so * just raise ERROR. * UNKERROR DS 0H SR PR1,PR1 clear R4 ICM PR1,B'0011',EXNERROR+2 generic ERROR condition * * The offset of the exception descriptor must be in PR1 * before coming to this point. * DORAISE DS 0H L PR2,=V(#CICSEXR) point to read-only data area LA PR1,0(PR2,PR1) point to exception descriptor B GBLERRH raise the exception * * We found the component. Now look up the specific response * code in the table for that component. The number of the * component table is in PR2. * COMPFND DS 0H BCTR PR2,0 decrement by 1 (for 0 origin) SLL PR2,2 multiply by 4 (via shift) L PR3,RESPTAB(PR2) get address of response table SR R7,R7 will get offset USING RESPSECT,PR3 symbolic map for table entries EXLOOP DS 0H CLI RESPOFF,X'FF' end of table? BE UNKERROR if so, don't know this error ICM R7,B'0001',RESPOFF get the offset LA R11,EIBRCODE(R7) point to appropriate byte CLC RESPCODE,0(R11) check the response byte BE EXFOUND if equal, we found it LA PR3,RESPLEN(,PR3) if not, bump to next entry B EXLOOP and try it * * We found a matching response code - get the exception * descriptor offset and raise the exception. * EXFOUND DS 0H ICM R7,B'0011',RESPEXN get descriptor offset LR PR1,R7 copy to PR1 B DORAISE raise the exception LTORG EJECT * * Component table * COMPTBL EQU * DC X'02' 1 DC X'04' 2 - Terminal control DC X'06' 3 - File control DC X'08' 4 - Transient Data control DC X'0A' 5 - Temporary Storage control DC X'0C' 6 - Storage control DC X'0E' 7 - Program control DC X'10' 8 - Interval control DC X'12' 9 - Task control DC X'14' 10 - Journal control DC X'16' 11 - Sync Point control DC X'18' 12 - BMS DC X'1A' 13 - Trace control DC X'1E' 14 - Batch Data Interchange DC X'4A' COMPCNT EQU *-COMPTBL number of components * * exception tables * RESPTAB DS 0F DC A(EXN1) DC A(EXN2) DC A(EXN3) DC A(EXN4) DC A(EXN5) DC A(EXN6) DC A(EXN7) DC A(EXN8) DC A(EXN9) DC A(EXN10) DC A(EXN11) DC A(EXN12) DC A(EXN13) DC A(EXN14) DC A(EXN15) * EXN1 DS 0F EXN 0,E0,INVREQ DC X'FF' EXN2 DS 0F EXN 0,04,EOF EXN 0,10,EODS EXN 0,C1,EOF EXN 0,C2,ENDINPT EXN 0,D0,SYSIDERR EXN 0,D2,SESSIONERR EXN 0,D3,SYSBUSY EXN 0,D4,SESSBUSY EXN 0,D5,NOTALLOC EXN 0,E0,INVREQ EXN 0,E1,LENGERR EXN 0,E3,WRBRK EXN 0,E4,RDATT EXN 0,E5,SIGNAL EXN 0,E6,TERMIDERR EXN 0,E7,NOPASSBKRD EXN 0,E8,NOPASSBKWR EXN 0,EA,IGREQCD EXN 0,EB,CBIDERR EXN 0,F1,TERMERR EXN 1,20,EOC EXN 1,40,INBFMH EXN 3,F6,NOSTART EXN 3,F7,NONVAL DC X'FF' EXN3 DS 0F EXN 0,01,DSIDERR EXN 0,02,ILLOGIC EXN 0,08,INVREQ EXN 0,0C,NOTOPEN EXN 0,0D,DISABLED EXN 0,0F,ENDFILE EXN 0,80,IOERR EXN 0,81,NOTFND EXN 0,82,DUPREC EXN 0,83,NOSPACE EXN 0,84,DUPKEY EXN 0,D0,SYSIDERR EXN 0,D1,ISCINVREQ EXN 0,D6,NOTAUTH EXN 0,E1,LENGERR DC X'FF' EXN4 DS 0F EXN 0,01,QZERO EXN 0,02,QIDERR EXN 0,04,IOERR EXN 0,08,NOTOPEN EXN 0,10,NOSPACE EXN 0,C0,QBUSY EXN 0,D0,SYSIDERR EXN 0,D1,ISCINVREQ EXN 0,D6,NOTAUTH EXN 0,E1,LENGERR DC X'FF' EXN5 DS 0F EXN 0,01,ITEMERR EXN 0,02,QIDERR EXN 0,04,IOERR EXN 0,08,NOSPACE EXN 0,20,INVREQ EXN 0,D0,SYSIDERR EXN 0,D1,ISCINVREQ EXN 0,D6,NOTAUTH EXN 0,E1,LENGERR DC X'FF' EXN6 DS 0F EXN 0,E1,LENGERR EXN 0,E2,NOSTG DC X'FF' EXN7 DS 0F EXN 0,01,PGMIDERR EXN 0,D6,NOTAUTH EXN 0,E0,INVREQ DC X'FF' EXN8 DS 0F EXN 0,01,ENDDATA EXN 0,04,IOERR EXN 0,11,TRANSIDERR EXN 0,12,TERMIDERR EXN 0,14,INVTSREQ EXN 0,20,EXPIRED EXN 0,81,NOTFND EXN 0,D0,SYSIDERR EXN 0,D1,ISCINVREQ EXN 0,D6,NOTAUTH EXN 0,E1,LENGERR EXN 0,E9,ENVDEFERR EXN 0,FF,INVREQ DC X'FF' EXN9 DS 0F EXN 0,32,ENQBUSY EXN 0,E0,INVREQ DC X'FF' EXN10 DS 0F EXN 0,01,JIDERR EXN 0,02,INVREQ EXN 0,05,NOTOPEN EXN 0,06,LENGERR EXN 0,07,IOERR EXN 0,09,NOJBUFSP EXN 0,D6,NOTAUTH DC X'FF' EXN11 DS 0F EXN 0,01,ROLLEDBACK DC X'FF' EXN12 DS 0F EXN 0,01,INVREQ EXN 0,02,RETPAGE EXN 0,04,MAPFAIL EXN 0,08,INVMPSZ EXN 0,20,INVERRTERM EXN 0,40,RTESOME EXN 0,80,RTEFAIL EXN 0,E1,LENGERR EXN 0,E3,WRBRK EXN 0,E4,RDATT EXN 1,02,PARTNFAIL EXN 1,04,INVPARTN EXN 1,08,INVPARTNSET EXN 1,10,INVLDC EXN 1,20,UNEXPIN EXN 1,40,IGREQCD EXN 1,80,TSIOERR EXN 2,01,OVERFLOW EXN 0,04,EODS EXN 0,08,EOC EXN 0,10,IGREQID DC X'FF' EXN13 DS 0F EXN 0,E0,INVREQ DC X'FF' EXN14 DS 0F EXN 0,04,DSSTAT EXN 0,08,FUNCERR EXN 0,0C,SELNERR EXN 0,10,UNEXPIN EXN 0,E1,LENGERR EXN 1,11,EODS EXN 1,2B,IGREQCD EXN 1,20,EOC DC X'FF' EXN15 DS 0F EXN 3,01,ERROR DC X'FF' * * This entry is for unknown codes * EXNERROR DS 0F EXN 0,00,ERROR EJECT DFHEISTG DSECT DFHEISTG ADACICSD DFHEIEND ADAEIBLK ADAGLOBL ADAUDA ADAPSTAK STKLOCAL EQU * ADAPSTKE ADAEND RESPSECT DSECT RESPOFF DS X offset in EIBRCODE RESPCODE DS X value to compare RESPEXN DS AL2 exception descriptor offset RESPLEN EQU *-RESPOFF length of the entry END * $Cprt start$ * * Copyright (C) 1988 by Intermetrics, Inc. * * This material may be used duplicated or disclosed by or for the * U.S. Government pursuant to the copyright license under DAR clause * 7-104.9(a) (May 1981). * * This project was spnsored by the STARS Foundation * Naval Research Laboratory, Washington DC * * $Cprt end$