Thanks to everyone who replied. I used John McKown's example.
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of Jousma, David
Sent: Friday, June 30, 2017 3:00 PM
To: [email protected]
Subject: Re: Assembler program
Here is a program I wrote last millennium. Not saying it's the best, but it
worked at the time.
WHEREAMI CSECT
WHEREAMI RMODE 24
WHEREAMI AMODE 31
***********************************************************************
* *
* WHEREAMI - *
* COMMON INTERFACE FOR BATCH, CICS, COM-PLETE, AND TSO. *
* DETERMINES ENVIRONMENT BASE ON PGM NAME IN JFCB. *
* IF IN CICS, OR COM-PLETE, DETERMINES WHETHER IT IS PROD, QA,*
* OR TEST, BASED ON JOBNAME. *
* *
* DATA FORMAT BEING PASSED: *
* 01 WHEREAMI-INTERFACE *
* 05 WHEREAMI-INTERFACE-LENGTH PIC S9(4) VALUE +10. *
* 05 WHEREAMI-ENVIRONMENT PIC X(4) VALUE SPACES. *
* 88 ENVIRONMENT-UNDETERMINED VALUE '****'. *
* 88 EXECUTING-IN-BATCH VALUE 'BTCH'. *
* 88 EXECUTING-IN-CICS VALUE 'CICS'. *
* 88 EXECUTING-IN-COMPLETE VALUE 'CMPL'. *
* 88 EXECUTING-IN-TSO VALUE 'TSO '. *
* 05 WHEREAMI-CICS-REGION PIC X(4) VALUE SPACES. *
* 88 ENVIRONMENT-UNDETERMINED VALUE '****'. *
* 88 EXECUTING-IN-PROD VALUE 'PROD'. *
* 88 EXECUTING-IN-QUAL VALUE 'QUAL'. *
* 88 EXECUTING-IN-TEST VALUE 'TEST'. *
* *
***********************************************************************
* *
* INPUTS - *
* REG 1 - ADDRESS OF PARAMETER LIST *
* REG13 - ADDRESS OF REGISTER SAVE AREA *
* REG14 - RETURN ADDRESS *
* REG15 - ENTRY POINT ADDRESS. *
* *
***********************************************************************
* *
* ATTRIBUTES - *
* REENTRANT AND REUSABLE *
* *
***********************************************************************
* *
* DEFINE REGISTER EQUATES, SAVE CALLERS REGISTERS, GETMAIN STORAGE, *
* AND ESTABLISH ADDRESSABILITY. *
* *
***********************************************************************
R0 EQU 0
R1 EQU 1 ADDR OF PARM LIST
R2 EQU 2 ADDR OF PSA
R3 EQU 3 ADDR OF TCB
R4 EQU 4 ADDR OF TIOT
R5 EQU 5 ADDR OF JSCB
R6 EQU 6 ADDR OF CVT
R7 EQU 7 ADDR OF SMCA
R8 EQU 8
R9 EQU 9
R10 EQU 10 WORK REG
R11 EQU 11
R12 EQU 12 1ST BASE REGISTER
R13 EQU 13
R14 EQU 14
R15 EQU 15
*
WHEREAMI CSECT
BAKR R14,R0 SAVE CALLERS STATUS ON STACK
LR R12,R15 LOAD BASE REGISTER
USING WHEREAMI,R12 -AND EST ADDR TO IT
LA R13,0 INDICATE NO SAVE AREA
L R10,0(,R1) GET ADDR OF PARMLIST
USING PARMLIST,R10
*
LA R2,0 LOAD ADDR OF PSA
USING PSA,R2
L R3,PSATOLD GET ADDR OF CURRENT TCB
USING TCB,R3
L R4,TCBTIO GET ADDR OF TIOT
USING TIOT1,R4
L R5,TCBJSCB GET ADDR OF JSCB
USING IEZJSCB,R5
L R6,FLCCVT GET ADDR OF CVT
USING CVT,R6
L R7,CVTSMCA GET ADDR OF SMCA
USING SMCABASE,R7
*
CKCICS CLC JSCBPGMN(3),=C'DFH' IS THIS A CICS REGION?
BNE CKCMPL -NO, CHECK COMPLETE REGION
MVC PARMENV,=C'CICS ' -YES, SET PARM TO CICS
CKPRDFOR CLC TIOCNJOB(6),=C'PRDFOR' IS CICS REGION PRODUCTION?
BNE CKSYSFOR -NO, CHECK NEXT REGION.
MVC PARMREG,=C'PROD' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKSYSFOR CLC TIOCNJOB(6),=C'SYSFOR' IS CICS REGION Q/A?
BNE CKDEVFOR -NO, CHECK NEXT REGION.
MVC PARMREG,=C'QUAL' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKDEVFOR CLC TIOCNJOB(6),=C'DEVFOR' IS CICS REGION TEST?
BNE CKINTFOR -NO, CHECK NEXT REGION
MVC PARMREG,=C'TEST' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKINTFOR CLC TIOCNJOB(6),=C'INTFOR' IS CICS REGION TEST?
BNE CKSUPFOR -NO, CHECK NEXT REGION.
MVC PARMREG,=C'TEST' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKSUPFOR CLC TIOCNJOB(6),=C'SUPFOR' IS CICS REGION TEST?
BNE CKCICSUN -NO, SET UNDETERMINED REGION
MVC PARMREG,=C'TEST' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKCICSUN MVC PARMREG,=X'5C5C5C5C' SET REGION TO ****
B CKPARM10 -AND CHECK PARM LENGTH
*
CKCMPL CLC JSCBPGMN(7),=C'COMPLET' IS THIS A COM-PLETE REGION?
BNE CKTSO -NO, CHECK IF TSO
MVC PARMENV,=C'CMPL ' -YES, SET PARM TO COM-PLETE
CKCOMPPR CLC TIOCNJOB(6),=C'COMPPR' IS COM-PLETE REGION PRODUCTION?
BNE CKCOMPTS -NO, CHECK FOR Q/A
MVC PARMREG,=C'PROD' -YES, SET PARM TO PROD
B CKPARM10 -AND CHECK PARM LENGTH
CKCOMPTS CLC TIOCNJOB(6),=C'COMPTS' IS COM-PLETE REGION TEST?
BNE CKCMPLUN -NO, SET UNDETERMINED REGION
MVC PARMREG,=C'TEST' -YES, SET PARM TO TEST
B CKPARM10 -AND CHECK PARM LENGTH
CKCMPLUN MVC PARMREG,=X'5C5C5C5C' SET REGION TO ****
B CKPARM10 -AND CHECK PARM LENGTH
*
CKTSO CLC JSCBPGMN(3),=C'IKJ' IS THIS A TSO SESSION?
BNE CKBATCH -NO, CHECK IF BATCH
MVC PARMENV,=C'TSO ' -NO SET PARM TO TSO
MVC PARMREG,=X'5C5C5C5C' SET REGION TO ****
B CKPARM10 -AND CHECK PARM LENGTH
*
CKBATCH MVC PARMENV,=C'BTCH' -NO SET PARM TO BATCH
MVC PARMREG,=X'5C5C5C5C' SET REGION TO ****
*
CKPARM10 CLC PARMLEN,=X'000A' IS PARM LENGTH = 10?
BE RETURN YES, RETURN
*
*
* ADD NEW CODE FOR ADDITIONAL FUNCTIONALITY HERE
*
* DC F'0'
RETURN PR RETURN TO CALLING PROGRAM
LTORG
PARMLIST DSECT
PARMLEN DS CL2 LENGTH OF PARMLIST
* A(10)- VER 1.0 OF WHEREAMI
PARMENV DS CL4
* CICS - CICS ENVIRONMENT
* CMPL - COM-PLETE ENVIRONMENT
* BTCH - BATCH ENVIRONMENT
PARMREG DS CL4
* PROD - PRODUCTION REGIONS
* QUAL - QUALITY ASSURANCE REGIONS
* TEST - TESTING REGIONS
IKJTCB
IHAPSA
IEZJSCB
IEFTIOT1
CVT DSECT=YES
IEESMCA
END
_________________________________________________________________
Dave Jousma
Manager Mainframe Engineering, Assistant Vice President [email protected]
1830 East Paris, Grand Rapids, MI 49546 MD RSCB2H p 616.653.8429 f 616.653.2717
-----Original Message-----
From: IBM Mainframe Discussion List [mailto:[email protected]] On Behalf
Of PINION, RICHARD W.
Sent: Friday, June 30, 2017 12:52 PM
To: [email protected]
Subject: Assembler program
I need a program or snippet of code that determines if the program is being
executed from a TSO user or a batch job.
FIRST TENNESSEE
Confidentiality notice:
This e-mail message, including any attachments, may contain legally privileged
and/or confidential information. If you are not the intended recipient(s), or
the employee or agent responsible for delivery of this message to the intended
recipient(s), you are hereby notified that any dissemination, distribution, or
copying of this e-mail message is strictly prohibited. If you have received
this message in error, please immediately notify the sender and delete this
e-mail message from your computer.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected] with the message: INFO IBM-MAIN
This e-mail transmission contains information that is confidential and may be
privileged. It is intended only for the addressee(s) named above. If you
receive this e-mail in error, please do not read, copy or disseminate it in any
manner. If you are not the intended recipient, any disclosure, copying,
distribution or use of the contents of this information is prohibited. Please
reply to the message immediately by informing the sender that the message was
misdirected. After replying, please erase it from your computer system. Your
assistance in correcting this error is appreciated.
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions, send email to
[email protected] with the message: INFO IBM-MAIN
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
