Created
February 1, 2023 05:13
-
-
Save mainframed/63966886037bc5157efad83031d83c3a to your computer and use it in GitHub Desktop.
NJE38 TRANSMIT & RECIEVE
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| //NJE38 JOB (TSO), | |
| // 'Install NJE38', | |
| // CLASS=A, | |
| // MSGCLASS=H, | |
| // MSGLEVEL=(1,1), | |
| // USER=IBMUSER, | |
| // PASSWORD=SYS1 | |
| /*JOBPARM LINES=1000 | |
| //* | |
| //* This JCL does 4 things: | |
| //* 1) Creates SYSGEN.NJE38.MACLIB and adds the NJE38 maclibs to it | |
| //* 2) Creates SYSGEN.NJE38.ASMSRC and adds the needed source files | |
| //* 3) Assembles the required and adds them to SYS2.CMDLIB | |
| //* 4) Updates and adds TRANSMIT/RECEIVE to SYS1.UMODSRC(IKJEFTE2) | |
| //* 5) Installs the IKJEFTE2 changes with SMP | |
| //* | |
| //* ******** | |
| //* ** | |
| //* ** You must Re-IPL with CLPA or you will get a TSO error | |
| //* ** | |
| //* ** This JCL is for MVS/CE ONLY | |
| //* ** | |
| //* ******** | |
| //* | |
| //* Type HELP TRANSMIT or HELP RECEIVE for information how to use | |
| //* these commands. | |
| //* | |
| //* ******************************************************************* | |
| //* | |
| //* Installs SYSGEN.NJE38.MACLIB | |
| //* | |
| //NJE38MAC EXEC PGM=PDSLOAD | |
| //STEPLIB DD DSN=SYSC.LINKLIB,DISP=SHR | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT2 DD DSN=SYSGEN.NJE38.MACLIB,DISP=(NEW,CATLG), | |
| // VOL=SER=PUB001, | |
| // UNIT=3390,SPACE=(CYL,(1,1,5)), | |
| // DCB=(BLKSIZE=3120,RECFM=FB,LRECL=80) | |
| //SYSUT1 DD DATA,DLM=@@ | |
| ./ ADD NAME=AUTHLIST | |
| AUTHLIST DSECT | |
| AUTHPTR DS A -> next AUTHLIST entry or 0 | |
| DS A Reserved | |
| AUTHUSER DS CL8 Authorized userid | |
| AUTHNODE DS CL8 Authorized node of above userid | |
| AUTHSIZE EQU *-AUTHLIST Length of an authlist entry | |
| ./ ADD NAME=LINKTABL | |
| LINKTABL DSECT | |
| * | |
| *** LINKTABL - LINK TABLE ENTRY | |
| * | |
| * 0 +-----------------------------------------------+ | |
| * | LINKID | | |
| * 8 +-----------------------+-----------------------+ | |
| * | LDEFTNME | LACTTNME | | |
| * 10 +-----------------------+-----------------------+ | |
| * | LDEFDRVR | | |
| * 18 +-----------------------------------------------+ | |
| * | LACTDRVR | | |
| * 20 +-----------+-----------+-----------------------+ | |
| * | LDEFLINE | LACTLINE | LDRVRVAR | | |
| * 28 +-----+-----+-----+-----+-----+-----+-----+-----+ | |
| * | L*1 | L*2 | L*3 | L*4 | L*5 | L*6 | L*7 | L*8 | | |
| * 30 +-----+-----+-----+-----+-----+-----+-----+-----+ | |
| * | L*9 |LFLAG| LBUFF | LPENDING | LTAKEN | | |
| * 38 +-----+-----+-----------+-----------+-----------+ | |
| * | LPOINTER | LMSGQ | | |
| * 40 +-----------+-----------+-----------+-----------+ | |
| * | LTRNSCNT | LERRCNT | LTOCNT | | |
| * 48 +-----------+-----------+-----------+-----------+ | |
| * | LNKCLOCK | | |
| * 50 +-----------------------------------------------+ | |
| * | |
| * | |
| *** LINKTABL - LINK TABLE ENTRY | |
| * | |
| LINKID DS CL8 EBCDIC LINK ID | |
| LDEFTNME DS CL4 DEFAULT TASK NAME | |
| LACTTNME DS CL4 ACTIVE TASK NAME | |
| LDEFUSER DS 0CL8 DEFAULT USERID IF NO SECURITY v130 | |
| LDEFDRVR DS CL8 DEFAULT DRIVER ID | |
| LACTDRVR DS CL8 ACTIVE DRIVER ID | |
| LDEFLINE DS XL2 DEFAULT VIRTUAL LINE ADDRESS *XJE | |
| LACTLINE DS XL2 ACTIVE VIRTUAL LINE ADDRESS *XJE | |
| LDRVRVAR DS 1F LINE DRIVER VARIABLE INFO | |
| LDEFCLS1 DS CL1 L*1 DEFAULT SPOOL FILE CLS 1 | |
| LDEFCLS2 DS CL1 L*2 DEFAULT SPOOL FILE CLS 2 | |
| LDEFCLS3 DS CL1 L*3 DEFAULT SPOOL FILE CLS 3 | |
| LDEFCLS4 DS CL1 L*4 DEFAULT SPOOL FILE CLS 4 | |
| LACTCLS1 DS CL1 L*5 ACTIVE SPOOL FILE CLS 1 | |
| LACTCLS2 DS CL1 L*6 ACTIVE SPOOL FILE CLS 2 | |
| LACTCLS3 DS CL1 L*7 ACTIVE SPOOL FILE CLS 3 | |
| LACTCLS4 DS CL1 L*8 ACTIVE SPOOL FILE CLS 4 | |
| LTIMEZON DS 1X L*9 2 COMP TIME ZONE DISP FROM GMT | |
| LFLAG DS 1X LINK FLAG BYTE | |
| LACTIVE EQU X'80' LINK ACTIVE | |
| *LALERT EQU X'40' ************AXS ALERT EXIT SET-not used in XJE | |
| LAUTO EQU X'40' LINK TO BE AUTOSTARTED *XJE | |
| LHOLD EQU X'20' LINK HOLD SET | |
| LDRAIN EQU X'10' LINK DRAIN IN PROGRESS | |
| LTRALL EQU X'08' LINK TRANSACTION TRACING (ALL) | |
| LTRERR EQU X'04' LINK TRANSACTION TRACING (ERROR) | |
| LCONNECT EQU X'02' Link successfully signed onHRC031DT | |
| LHALT EQU X'01' LINK TO BE FORCED INACTIVE | |
| LBUFF DS 1H Max buffer size for line *XJE | |
| LNEGO DS 1H Negotiated actual buffer size *XJE | |
| LTAKEN DS 1H COUNT OF TAG SLOTS IN USE | |
| LPOINTER DS 1F LINK QUEUE ADDR | |
| LMSGQ DS 1F MSG QUEUE POINTER | |
| LTRNSCNT DS 1H LINK TRANSACTION COUNT | |
| LERRCNT DS 1H ERROR COUNT | |
| LTOCNT DS 1H TIMEOUT COUNT | |
| LSPARE DS 1H SPARE HALF WORD | |
| LNKCLOCK DS 8X CLOCK COMP VALUE FOR THIS LINK @VA03349 | |
| * | |
| *- New fields for NJE/MVS use; below *XJE | |
| * | |
| LNEXT DS A -> next LINKTABL entry or 0 | |
| LTCBA DS A -> TCB for this link | |
| LTRMECB DS F Link subtask termination ECB | |
| LECB DS F ECB for main task notific'n to link | |
| LNJEW DS A -> local work area for this link | |
| DS F Available | |
| LWRESWAP DS 0D CDS swap doubleword | |
| LWREQIN DS A Incoming WREs Q chain anchor | |
| LWREQCT DS F Incoming synchronization count | |
| LINKLEN EQU *-LINKTABL LENGTH OF LINK TABLE ENTRY | |
| SPACE | |
| ./ ADD NAME=MSGX | |
| MACRO | |
| &LABEL MSGX &NUM,&VAR | |
| .* REENTERABLE FORM OF MSG MACRO | |
| LCLA &TOFF,&TVARS | |
| LCLC &COFF | |
| &LABEL MVC MSGXNUM,=AL2(&NUM) | |
| AIF (N'&SYSLIST(2) EQ 0).NOVAR | |
| &TOFF SETA N'&SYSLIST(2) | |
| &COFF SETC '&TOFF' | |
| .NOVAR ANOP | |
| AIF (N'&SYSLIST(2) EQ 0).NOVAR1 | |
| &TOFF SETA 0 | |
| &TVARS SETA 1 | |
| .MLOP ANOP | |
| &COFF SETC '&TOFF' | |
| MVC MSGXVAL+&COFF.(8),&SYSLIST(2,&TVARS) | |
| &TOFF SETA &TOFF+8 | |
| &TVARS SETA &TVARS+1 | |
| AIF (&TVARS LE N'&SYSLIST(2)).MLOP | |
| .NOVAR1 ANOP | |
| LA 1,MSGXNUM | |
| LA 0,&TOFF+4 | |
| BAL 14,MSG | |
| SPACE 1 | |
| MEND | |
| ./ ADD NAME=NETSPOOL | |
| * | |
| * Change log: | |
| * | |
| * 23 Jul 20 - Add NCBPCT to return spool file percentage v200 | |
| * 02 Jul 20 - Default userid to CSA in support of TRANSMIT/RECEOVE v200 | |
| * 21 May 20 - Add update directory entry funcation v120 | |
| * 04 May 20 - Show CONFIG assembly date and time on start up. v102 | |
| * | |
| * | |
| NCB DSECT NETSPOOL CONTROL BLOCK | |
| NCBEYE DS CL4'NCB' NCB id | |
| NCBTKN DS F Token identifier (caller unique) | |
| NCBFL1 DS X Flag bits | |
| NCBPRT EQU X'40' PRT type data | |
| NCBPUN EQU X'80' PUN type data | |
| NCBREQ DS X Request type | |
| NCBOPEN EQU X'01' Open NETSPOOL dataset | |
| NCBCLOSE EQU X'02' Close NETSPOOL dataset | |
| NCBPUT EQU X'03' Write a logical record | |
| NCBGET EQU X'04' Read a logical record | |
| NCBPURGE EQU X'05' Delete a file | |
| NCBLOC EQU X'06' Locate a file | |
| NCBCON EQU X'07' Get directory contents | |
| NCBUDIR EQU X'08' Update directory entry v120 | |
| NCBRTNCD DS X RC from VSAM macro (same as R15) | |
| NCBERRCD DS X Error code from VSAM macro | |
| NCBMACAD DS A Addr of failing VSAM macro | |
| NCBTAG DS A Addr of associated TAG block | |
| NCBEODAD DS A Addr of End of Data routine | |
| NCBAREAL DS F Length of record area | |
| NCBAREA DS A Addr of record area | |
| NCBRECLN DS AL2 Length of record | |
| NCBRECCT DS AL2 Record count | |
| NCBPCT DS 0AL2 Spool percentage full (NCBCON) v200 | |
| NCBFID DS AL2 File id # (avail on new file CLOSE) | |
| NCBRESV1 DS AL2 Available bytes | |
| NCBRESV2 DS A Available bytes | |
| DS 0D Force doubleword boundary | |
| NCBSZ EQU *-NCB Size of NCB | |
| * | |
| * | |
| NSDIR DSECT NETSPOOL directory entry | |
| NSLEN DS AL2(NSDIRLN) Length of this record incl len | |
| NSRESV1 DS AL2 Resv | |
| NSBLK DS AL4 Block number of file's ptr block | |
| NSINLOC DS CL8 Originating location | |
| NSLINK DS CL8 Next location for transmission | |
| NSINTOD DS CL8 Time of file origin | |
| NSINVM DS CL8 Originating virtual machine | |
| NSRECNM DS 1F Number of records in file | |
| NSRECLN DS 1H Maximum file data record length | |
| NSINDEV DS 1X Device code of originating dev | |
| NSCLASS DS CL1 File output class | |
| NSID DS 1H File number at origin location | |
| NSCOPY DS 1H Number of copies requested | |
| NSFLAG DS 1X VM/370 SFBLOK control flags | |
| NSFLAG2 DS 1X VM/370 SFBLOK control flags | |
| NSSPARE DS 1H Spare | |
| NSNAME DS CL12 File name | |
| NSTYPE DS CL12 File type | |
| NSDIST DS CL8 File distribution code | |
| NSTOLOC DS CL8 Destination location id | |
| NSTOVM DS CL8 Destination virtual machine id | |
| NSPRIOR DS 1H Transmission priority | |
| NSDEV DS 2X Active file's virt dev addr | |
| NSRESV2 DS AL4 Resv | |
| NSDIRLN EQU *-NSDIR | |
| * | |
| NJ38CSA DSECT NJE38 CSA STORAGE BLOCK | |
| NJ38NODE DS CL8 Node name of this NJE38 | |
| NJ38ASCB DS A ASCB address of NJE38 addr space | |
| NJ38ECB DS F NJE38 ECB for cross memory post | |
| NJ38SWAP DS 0D CDS swap doubleword | |
| NJ38WRIN DS A Incoming WREs Q chain anchor | |
| NJ38WRCT DS F Incoming synchronization count v200 | |
| NJ38DUSR DS CL8 Default 'no security' userid v200 | |
| NJ38CSAZ EQU *-NJ38CSA Size of CSA area | |
| * | |
| CMDBLOK DSECT Map cmd area used by DMTXJE | |
| CMDBLEN DS AL1 CMDBLOK length | |
| CMDBTYP DS AL1(0) Type 0 = CMDBLOK request | |
| DS AL1 | |
| DS AL1 | |
| CMDLINK DS CL8 LINKID | |
| CMDVMID DS CL8 VIRTUAL MACHINE ID | |
| CMDTEXT DS CL120' ' text of command | |
| CMDBLOKL EQU *-CMDBLOK Size of dsect | |
| * | |
| STACKMSG DSECT Stacked message format | |
| STKOWN DS A RQE owner | |
| STKNEXT DS A -> next STACKMSG or zero | |
| STKLEN DS AL1 Stacked msg length | |
| STKZERO DS AL1(0) Must be 0 | |
| STKNODE DS CL8 Node of receiver of this msg | |
| STKID DS CL8 userid of receiver of this msg | |
| STKMSG DS CL238 Area for msg text | |
| STKSZ EQU *-STACKMSG Total size should be 264=RQESZ | |
| * | |
| * | |
| * | |
| RQE DSECT | |
| RQEOWN DS A ->LINKTABL entry of owner (0=free) | |
| RQEDATA DS XL260 TANK or MSG data as used by DMTXJE | |
| RQESZ EQU *-RQE Size of RQE area | |
| * | |
| * | |
| ./ ADD NAME=NJE | |
| * | |
| * DSECTs defining NJE headers | |
| * | |
| * Prefix section common to all headers | |
| * | |
| NJEPDSEC DSECT NJE header prefix | |
| NJEPLEN DS AL2 NJE header segment length | |
| NJEPFLGS DS XL1 NJE header segment flags | |
| NJEPSEQ DS XL1 NJE header segment sequence | |
| NJEPSIZE EQU *-NJEPDSEC NJE header prefix size | |
| * | |
| * NJE job header general section | |
| * | |
| NJHGDSEC DSECT NJE job hdr general section | |
| NJHGLEN DS AL2 NJE job gen. sect. length | |
| NJHGTYPE DS XL1 NJE job gen. sect. type | |
| NJHGMOD DS XL1 NJE job gen. sect. modifier | |
| NJHGJID DS AL2 NJE job gen. sect. identif. | |
| NJHGJCLS DS CL1 NJE job gen. sect. class | |
| NJHGMCLS DS CL1 NJE job gen. sect. msg cls | |
| NJHGFLG1 DS XL1 NJE job gen. sect. flags | |
| NJHGPRIO DS XL1 NJE job gen. sect. priority | |
| NJHGORGQ DS XL1 NJE job gen. sect. qualifier | |
| NJHGJCPY DS XL1 NJE job gen. sect. copy | |
| NJHGLNCT DS XL1 NJE job gen. sect. lpp | |
| DS XL1 NJE job gen. sect. reserved | |
| NJHGHOPS DS AL2 NJE job gen. sect. hop count | |
| NJHGACCT DS CL8 NJE job gen. sect. acct | |
| NJHGJNAM DS CL8 NJE job gen. sect. name | |
| NJHGUSID DS CL8 NJE job gen. sect. userid | |
| NJHGPASS DS XL8 NJE job gen. sect. password | |
| NJHGNPAS DS XL8 NJE job gen. sect. new pass | |
| NJHGETS DS XL8 NJE job gen. sect. TOD time | |
| NJHGORGN DS CL8 NJE job gen. sect. org node | |
| NJHGORGR DS CL8 NJE job gen. sect. org user | |
| NJHGXEQN DS CL8 NJE job gen. sect. exe node | |
| NJHGXEQU DS CL8 NJE job gen. sect. exe user | |
| NJHGPRTN DS CL8 NJE job gen. sect. prt dest | |
| NJHGPRTR DS CL8 NJE job gen. sect. prt user | |
| NJHGPUNN DS CL8 NJE job gen. sect. pun dest | |
| NJHGPUNR DS CL8 NJE job gen. sect. pun user | |
| NJHGFORM DS CL8 NJE job gen. sect. form | |
| NJHGICRD DS XL4 NJE job gen. sect. inp cards | |
| NJHGETIM DS XL4 NJE job gen. sect. job time | |
| NJHGELIN DS XL4 NJE job gen. sect. prt lines | |
| NJHGECRD DS XL4 NJE job gen. sect. pun cards | |
| NJHGPRGN DS CL20 NJE job gen. sect. programmr | |
| NJHGROOM DS CL8 NJE job gen. sect. room no | |
| NJHGDEPT DS CL8 NJE job gen. sect. dept | |
| NJHGBLDG DS CL8 NJE job gen. sect. building | |
| NJHGNREC DS XL4 NJE job gen. sect. rec. cnt | |
| NJHGSIZE EQU *-NJHGDSEC NJE job gen. sect. size | |
| NJHSIZE EQU NJEPSIZE+NJHGSIZE NJE job header total size | |
| * | |
| * NJE data set header general section | |
| * | |
| NDHGDSEC DSECT NJE data set general sect. | |
| NDHGLEN DS AL2 NJE ds gen sect. length | |
| NDHGTYPE DS XL1 NJE ds gen sect. type | |
| NDHGMOD DS XL1 NJE ds gen sect. type modif | |
| NDHGNODE DS CL8 NJE ds gen sect. dest node | |
| NDHGRMT DS CL8 NJE ds gen sect. dest user | |
| NDHGPROC DS CL8 NJE ds gen sect. proc name | |
| NDHGSTEP DS CL8 NJE ds gen sect. step type | |
| NDHGDD DS CL8 NJE ds gen sect. ddname | |
| NDHGDSNO DS AL2 NJE ds gen sect. count | |
| DS XL1 Reserved | |
| NDHGCLAS DS CL1 NJE ds gen sect. class | |
| NDHGNREC DS XL4 NJE ds gen sect. Record cnt | |
| NDHGFLG1 DS XL1 NJE ds gen sect. flags | |
| NDHGRCFM DS XL1 NJE ds gen sect. record fmt | |
| NDHGLREC DS AL2 NJE ds gen sect. record len | |
| NDHGDSCT DS XL1 NJE ds gen sect. copy count | |
| NDHGFCBI DS XL1 NJE ds gen sect. print index | |
| NDHGLNCT DS XL1 NJE ds gen sect. lpp | |
| DS XL1 Reserved | |
| NDHGFORM DS CL8 NJE ds gen sect. form | |
| NDHGFCB DS CL8 NJE ds gen sect. FCB | |
| NDHGUCS DS CL8 Universal char set name | |
| NDHGXWTR DS CL8 Data set external writer | |
| NDHGNAME DS CL8 Data set name qualifier | |
| NDHGFLG2 DS XL1 Second flag byte | |
| NDHGUCSO DS XL1 NJE ds gen sect. UCS options | |
| DS XL2 Reserved | |
| NDHGPMDE DS CL8 NJE ds gen sect. proc mode | |
| NDHGSIZE EQU *-NDHGDSEC Ds hdr general section size | |
| * | |
| * NJE data set header RSCS section | |
| * | |
| NDHVDSEC DSECT Data set header RSCS sect. | |
| NDHVLEN DS AL2 Ds header RSCS sect. length | |
| NDHVTYPE DS AL1 Ds header RSCS sect. type | |
| NDHVMOD DS AL1 Ds header RSCS sec modifier | |
| NDHVFLG1 DS AL1 Ds header RSCS sect flags | |
| NDHVCLAS DS CL1 Ds header RSCS sect class | |
| NDHVIDEV DS AL1 Ds header RSCS sect dev typ | |
| NDHVPGLE DS AL1 Ds header RSCS 3800 page ln | |
| NDHVDIST DS CL8 Ds header RSCS dist code | |
| NDHVFNAM DS CL12 Ds header RSCS filename | |
| NDHVFTYP DS CL12 Ds header RSCS filetype | |
| NDHVPRIO DS AL2 Ds header RSCS trn priority | |
| NDHVVRSN DS AL1 Ds header RSCS version no | |
| NDHVRELN DS AL1 Ds header RSCS release no | |
| NDHVSIZE EQU *-NDHVDSEC Ds header RSCS section size | |
| NDHSIZE EQU NJEPSIZE+NDHGSIZE+NDHVSIZE Total ds header size | |
| * | |
| * NJE job trailer general section | |
| * | |
| NJTGDSEC DSECT Job trailer general section | |
| NJTGLEN DS AL2 Job trailer gen sect length | |
| NJTGTYPE DS AL1 Job trailer gen sect type | |
| NJTGMOD DS AL1 Job trailer gen sc modifier | |
| NJTGFLG1 DS AL1 Job trailer gen sect flags | |
| NJTGXCLS DS CL1 Job trailer execution class | |
| DS XL2 Reserved | |
| NJTGSTRT DS XL8 Job trailer job start TOD | |
| NJTGSTOP DS XL8 Job trailer job stop TOD | |
| DS XL4 Reserved | |
| NJTGALIN DS XL4 Job trailer print lines | |
| NJTGACRD DS XL4 Job trailer card images | |
| DS XL4 Reserved | |
| NJTGIXPR DS XL1 Job trailer init exec prior | |
| NJTGAXPR DS XL1 Job trailer actul exe prior | |
| NJTGIOPR DS XL1 Job trailer init job prior | |
| NJTGAOPR DS XL1 Job trailer actual job prio | |
| NJTGSIZE EQU *-NJTGDSEC Job trailer gen. sect. size | |
| NJTSIZE EQU NJEPSIZE+NJTGSIZE Job trailer total size | |
| * | |
| * NMR record | |
| * | |
| NMRDSECT DSECT | |
| NMRFLAG DS XL1 NMR flags | |
| NMRLVPR DS XL1 NMR level / priority | |
| NMRTYPE DS XL1 NMR type | |
| NMRML DS XL1 Length of contents of NMRMSG | |
| NMRTO DS 0XL9 Destination system | |
| NMRTONOD DS CL8 NMR destination node | |
| NMRTOQUL DS XL1 Destination node system identifier | |
| NMROUT DS CL8 Userid / remote id / console id | |
| NMRFM DS 0XL9 NMR originating system | |
| NMRFMNOD DS CL8 NMR originating node | |
| NMRFMQUL DS XL1 Originating node system identifier | |
| NMRHSIZE EQU *-NMRDSECT Size of NMR header only | |
| NMRECSID DS 0CL8 Message origination node | |
| NMRMSG DS CL148 NMR message / command | |
| NMRSIZE EQU *-NMRDSECT NMR size including message / command | |
| * | |
| * Fields in NMRFLAG | |
| * | |
| NMRFLAGC EQU X'80' NMR is a command | |
| NMRFLAGW EQU X'40' NMROUT has remote workstation id | |
| NMRFLAGT EQU X'20' NMROUT contains a userid | |
| NMRFLAGU EQU X'10' NMROUT contains console identifier | |
| NMRFLAGR EQU X'08' Console is remote-authorized only | |
| NMRFLAGJ EQU X'04' Console is not job-authorized | |
| NMRFLAGD EQU X'02' Console is not device-authorized | |
| NMRFLAGS EQU X'01' Console is not system-authorized | |
| * | |
| * Fields in NMRTYPE | |
| * | |
| NMRTYPE4 EQU X'08' Source userid embedded in NMRMSG | |
| NMRTYPET EQU X'04' Timestamp is not embedded in NMRMSG | |
| NMRTYPEF EQU X'02' NMR comtains a formatted command | |
| NMRTYPED EQU X'02' Contains a delete operator message | |
| * | |
| * SYSIN RCBs | |
| * | |
| RRCB1 EQU X'98' Stream 1 sysin records | |
| RRCB2 EQU X'A8' Stream 2 sysin records | |
| RRCB3 EQU X'B8' Stream 3 sysin records | |
| RRCB4 EQU X'C8' Stream 4 sysin records | |
| RRCB5 EQU X'D8' Stream 5 sysin records | |
| RRCB6 EQU X'E8' Stream 6 sysin records | |
| RRCB7 EQU X'F8' Stream 7 sysin records | |
| * | |
| * SYSOUT RCBs | |
| * | |
| PRCB1 EQU X'99' Stream 1 sysout records | |
| PRCB2 EQU X'A9' Stream 2 sysout records | |
| PRCB3 EQU X'B9' Stream 3 sysout records | |
| PRCB4 EQU X'C9' Stream 4 sysout records | |
| PRCB5 EQU X'D9' Stream 5 sysout records | |
| PRCB6 EQU X'E9' Stream 6 sysout records | |
| PRCB7 EQU X'F9' Stream 7 sysout records | |
| ./ ADD NAME=NJEPARMS | |
| MACRO | |
| &X NJEPARMS | |
| .* | |
| .* Change log: | |
| .* | |
| .* | |
| .* 04 Dec 20 - Expanded internal trace table support v212 | |
| .* 29 Nov 20 - Use text-based configuration; alternate routes v211 | |
| .* 29 Nov 20 - Initial creation. v211 | |
| .* | |
| *--this area mapped as INITPARM; passed to NJEDRV/NJECMX/NJESCN v211 | |
| DS 0D v211 | |
| INITPARM DS 0XL72 v220 | |
| * Offset Owner Area to be passed v211 | |
| * ------ ------- --------------------------------v211 | |
| LCLNODE DS CL8 0 NJEINIT Local node name v211 | |
| CPUID DS D 8 NJEINIT CPUID of this system v211 | |
| ANJECMX DS A 10 NJEINIT -> entry of NJECMX cmd processorv211 | |
| ANJESPL DS A 14 NJEINIT -> NJESPOOL interface v211 | |
| RQENUM DS F 18 NJEINIT # RQEs in stg area v211 | |
| ARQESTG DS A 1C NJEINIT -> RQE stg area v211 | |
| CSABLK DS A 20 NJEINIT -> CSA communication area v211 | |
| ALINKS DS A 24 NJEINIT -> LINKS (LINKTABL anchor) v211 | |
| AROUTES DS A 28 NJEINIT -> ROUTES (RTE list anchor) v211 | |
| AAUTHS DS A 2C NJEINIT -> AUTHS (AUTHLIST anchor) v211 | |
| ACMDBLOK DS A 30 NJEINIT -> CMDBLOK dsect (CMNDBLOK) v211 | |
| MSGQ DS A 34 NJEDRV Stacked msg Q anchor v211 | |
| XJELINK DS A 38 NJEDRV -> task's LINKTABL v211 | |
| ATRACE DS A 3C NJEINIT -> Trace table control v212 | |
| AREGUSER DS A 40 NJEINIT -> REGUSER (REGUSER anchor) v220 | |
| RESV1 DS F 44 Available word v220 | |
| * 48 Total length v220 | |
| INITPRML EQU *-INITPARM Length of this parm list v211 | |
| *--end of passed area v211 | |
| MEND | |
| ./ ADD NAME=NJEQUMSG | |
| MACRO | |
| &X NJEQUMSG | |
| .* | |
| .* Change log: | |
| .* | |
| .* 11 Dec 20 - Initial creation. v220 | |
| .* | |
| QUMSG DSECT Queued user message | |
| QUMNEXT DS A -> next QUMSG or 0 | |
| QUMOWNER DS A -> REGUSER that owns this msg | |
| QUMSGTXT DS CL120 Message text | |
| QUMSIZE EQU *-QUMSG Size of dsect | |
| MEND | |
| ./ ADD NAME=NJERUSER | |
| MACRO | |
| &X NJERUSER | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Initial creation. v220 | |
| .* | |
| * | |
| REGUSERB DSECT Registered userid block | |
| REGNEXT DS A -> next REGUSER or 0 | |
| REGEYE DS CL4'REGU' Eyecatcher | |
| REGWRE DS A -> user's registration WRE in CSA | |
| REGMSGQ DS A -> user's queued msgs WRE chain | |
| REGUSRID DS CL8 Userid | |
| REGSIZE EQU *-REGUSERB Size of dsect | |
| MEND | |
| ./ ADD NAME=NJETRACE | |
| MACRO | |
| &X NJETRACE &TYPE= | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Support for registered users and message queuing v220 | |
| .* 10 Dec 20 - Create NJETRACE macro from old in-line TRACE macro v220 | |
| .* | |
| AIF ('&TYPE' EQ 'DSECT').DSECT | |
| .* | |
| &X STM R15,R2,16(R13) R0-R2 restored by trace rtn | |
| L R2,ATRACE -> trace table | |
| L R15,TRCRTN-TRCCTL(,R2) -> trace routine | |
| BALR R14,R15 Go get a new trace entry | |
| L R15,16(,R13) Restore R15 | |
| MVI 0(R14),&TYPE Move in trace type code | |
| MEXIT | |
| .* | |
| .DSECT ANOP | |
| TRCCTL DSECT | |
| TRCEYE DS CL8'TRACETAB' Eyecatcher | |
| TRCRTN DS A -> Trace routine | |
| DS A Reserved | |
| TRCSTRT DS A -> Start of trace table | |
| TRCCURR DS A -> Current trace entry | |
| TRCEND DS A -> End of trace table | |
| DS A Reserved | |
| TRCSZ EQU 32 Size of each trace entry | |
| * | |
| *-- TRACE TABLE TYPES | |
| * | |
| TRCEXCP EQU X'01' EXCP operation | |
| TRCWAIT EQU X'02' Wait completed | |
| TRCDYNA EQU X'03' Dynamic Allocation | |
| TRCMSG EQU X'04' Message | |
| TRCRCMD EQU X'05' remote command | |
| TRCGET EQU X'06' Getmain | |
| TRCFREE EQU X'07' Freemain | |
| TRCOPNO EQU X'08' Open output request | |
| TRCCLSO EQU X'09' Close output request | |
| TRCOPNI EQU X'0A' Open input request | |
| TRCCONT EQU X'0B' Spool contents request | |
| TRCCLSI EQU X'0C' Close input request | |
| TRCPURG EQU X'0D' File Purge request | |
| TRC0E EQU X'0E' Available | |
| TRCGLQ EQU X'0F' GLINKREQ | |
| TRCGRQ EQU X'10' GROUTREQ | |
| TRCALQ EQU X'11' ALERTREQ | |
| TRCGMQM EQU X'12' GMSGREQ from MSGQ | |
| TRCGMQR EQU X'13' GMSGREQ from RQE | |
| TRCIWRE EQU X'14' Incoming WRE | |
| TRCOWRE EQU X'15' Outgoing WRE | |
| TRCGWRE EQU X'16' Getmain WRE | |
| TRCFWRE EQU X'17' Freemain WRE | |
| * | |
| MEND | |
| ./ ADD NAME=NJEVER | |
| MACRO | |
| NJEVER | |
| GBLC &VERS | |
| &VERS SETC 'v2.3.0' -> Current version | |
| B 34(,R15) | |
| DC AL1(29) | |
| DC CL9'&SYSECT' | |
| DC CL6'&VERS' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| MEND | |
| ./ ADD NAME=NJEWRE | |
| MACRO | |
| &X NJEWRE | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Support for registered users and message queuing v220 | |
| .* | |
| WRE DSECT | |
| WRENEXT DS A -> next WRE or 0 | |
| WRETYPE DS X WRE type | |
| WRENEW EQU X'04' New file added to NETSPOOL | |
| WRECMD EQU X'08' CMD type | |
| WREMSG EQU X'0C' MSG type | |
| WRESTAR EQU X'10' START type | |
| WREREG EQU X'14' Registration request v220 | |
| WREDREG EQU X'18' Deregistration request v220 | |
| WREQRM EQU X'1C' Queue registered user msg v220 | |
| WREDRM EQU X'20' Dequeue registered user msg v220 | |
| WRECODE DS X Command code for link driver | |
| WRETXTLN DS X CMD or MSG text length | |
| WRESP DS X Getmained subpool number v220 | |
| WRELINK DS CL8 Target link name for this WRE | |
| WREUSER DS CL8 Target user name for this WRE | |
| WREORIG DS 0CL8 Originating userid of MSG v220 | |
| WREASCB DS A Originating ASCB addr v220 | |
| WREECB DS F Originator ECB for CM POST v220 | |
| WRETXT DS CL120 Command or message text | |
| WRESIZE EQU *-WRE Size of WRE v220 | |
| * | |
| *- Error codes for registered user services (POST code in WREECB) v220 | |
| ERNOERR EQU 0 No errors v220 | |
| ERNOMSG EQU 4 No more messages v220 | |
| ERSTOP EQU 8 STOP command issued v220 | |
| ERINVREQ EQU 12 Invalid request v220 | |
| ERINACT EQU 16 NJE38 is not active v220 | |
| ERPOST EQU 20 CM POST to NJE38 failure v220 | |
| ERDUPUSR EQU 24 User already registered v220 | |
| ERUSERNF EQU 28 Userid is not registered v220 | |
| ERECBPST EQU 32 User ECB was posted v220 | |
| MEND | |
| ./ ADD NAME=NSIO | |
| MACRO MAC00010 | |
| &L NSIO &TYPE=, XMAC00020 | |
| &NCB=NCB, XMAC00030 | |
| &TAG=, XMAC00040 | |
| &EODAD=, XMAC00050 | |
| &AREALEN=, XMAC00060 | |
| &AREA=, XMAC00070 | |
| &RECLEN=, v210XMAC00080 | |
| &ENTRY= v210 MAC00080 | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 AUG 20 - Add alternate entry point via ENTRY= v210 | |
| .* 21 May 20 - Add update directory entry functionality v120 | |
| .* | |
| .* MAC00100 | |
| LCLA &OFFREQ MAC00110 | |
| LCLA &OFFTAG MAC00120 | |
| LCLA &OFFEOD MAC00130 | |
| LCLA &OFFARL MAC00140 | |
| LCLA &OFFARA MAC00150 | |
| LCLA &OFFRCL MAC00160 | |
| LCLA &NSIZE MAC00180 | |
| LCLA &REQ MAC00190 | |
| LCLC &W MAC00200 | |
| .* MAC00210 | |
| .* Offsets within NCB block MAC00220 | |
| &OFFREQ SETA 9 Offset of NCBREQ MAC00230 | |
| &OFFTAG SETA 16 Offset of NCBTAG MAC00240 | |
| &OFFEOD SETA 20 Offset of NCBEODAD MAC00250 | |
| &OFFARL SETA 24 Offset of NCBAREAL MAC00260 | |
| &OFFARA SETA 28 Offset of NCBAREA MAC00270 | |
| &OFFRCL SETA 32 Offset of NCBRECLN MAC00280 | |
| * MAC00300 | |
| .* Assembled size of NCB DSECT MAC00310 | |
| &NSIZE SETA 48 Size of an NCB MAC00320 | |
| .* MAC00330 | |
| AIF (T'&NCB NE 'O').NCB1 MAC00340 | |
| MNOTE 8,'NCB= PARAMETER REQUIRED' MAC00350 | |
| AGO .TYPE MAC00360 | |
| .* MAC00370 | |
| .NCB1 ANOP MAC00380 | |
| AIF ('&NCB'(1,1) EQ '(').NCB1R MAC00390 | |
| &L LA 1,&NCB -> NCB MAC00400 | |
| AGO .TYPE MAC00410 | |
| .NCB1R ANOP MAC00420 | |
| &W SETC '&NCB'(2,K'&NCB-2) MAC00430 | |
| &L LR 1,&W -> NCB MAC00440 | |
| .* MAC00450 | |
| .ISTYPE ANOP MAC00460 | |
| AIF (T'&TYPE NE 'O').TYPE MAC00470 | |
| MNOTE 8,'TYPE= PARAMETER REQUIRED' MAC00480 | |
| MEXIT MAC00490 | |
| .* MAC00500 | |
| .TYPE ANOP MAC00510 | |
| AIF ('&TYPE' EQ 'OPEN').OPEN MAC00520 | |
| AIF ('&TYPE' EQ 'CLOSE').CLOSE MAC00530 | |
| AIF ('&TYPE' EQ 'PUT').PUT MAC00540 | |
| AIF ('&TYPE' EQ 'GET').GET MAC00550 | |
| AIF ('&TYPE' EQ 'PURGE').PURGE MAC00560 | |
| AIF ('&TYPE' EQ 'FIND').FIND MAC00570 | |
| AIF ('&TYPE' EQ 'CONTENTS').CONTENT MAC00580 | |
| AIF ('&TYPE' EQ 'UDIR').UDIR v120 MAC00570 | |
| MNOTE 8,'TYPE=&TYPE IS NOT A VALID FUNCTION TYPE' MAC00590 | |
| MEXIT MAC00600 | |
| .* MAC00610 | |
| .OPEN ANOP MAC00620 | |
| &REQ SETA 1 MAC00630 | |
| XC 0(&NSIZE,1),0(1) Initialize NCB MAC00640 | |
| MVC 0(4,1),=CL4'NCB' Set NCB identifier MAC00650 | |
| AGO .SETREQ MAC00660 | |
| .* MAC00670 | |
| .CLOSE ANOP MAC00680 | |
| &REQ SETA 2 MAC00690 | |
| AGO .SETREQ MAC00700 | |
| .* MAC00710 | |
| .PUT ANOP MAC00720 | |
| &REQ SETA 3 MAC00730 | |
| AGO .SETREQ MAC00740 | |
| .* MAC00750 | |
| .GET ANOP MAC00760 | |
| &REQ SETA 4 MAC00770 | |
| AGO .SETREQ MAC00780 | |
| .* MAC00790 | |
| .PURGE ANOP MAC00800 | |
| &REQ SETA 5 MAC00810 | |
| AGO .SETREQ MAC00820 | |
| .* MAC00830 | |
| .FIND ANOP MAC00840 | |
| &REQ SETA 6 MAC00850 | |
| AGO .SETREQ MAC00860 | |
| .* MAC00870 | |
| .CONTENT ANOP MAC00880 | |
| &REQ SETA 7 MAC00890 | |
| AGO .SETREQ v120 MAC00860 | |
| .* MAC00830 | |
| .UDIR ANOP v120 MAC00840 | |
| &REQ SETA 8 v120 MAC00850 | |
| .* MAC00900 | |
| .SETREQ ANOP MAC00910 | |
| MVI &OFFREQ.(1),&REQ Set NCBREQ type MAC00920 | |
| .* MAC00930 | |
| .TAG ANOP MAC00940 | |
| AIF (T'&TAG EQ 'O').EODAD MAC00950 | |
| AIF ('&TAG'(1,1) EQ '(').TAG1R MAC00960 | |
| LA 0,&TAG -> TAG data MAC00970 | |
| ST 0,&OFFTAG.(,1) Store in NCB MAC00980 | |
| AGO .EODAD MAC00990 | |
| .TAG1R ANOP MAC01000 | |
| &W SETC '&TAG'(2,K'&TAG-2) MAC01010 | |
| ST &W,&OFFTAG.(,1) Store tag ptr in NCB MAC01020 | |
| .* MAC01030 | |
| .EODAD ANOP MAC01040 | |
| AIF (T'&EODAD EQ 'O').AREALEN MAC01050 | |
| AIF ('&EODAD'(1,1) EQ '(').EODAD1R MAC01060 | |
| LA 0,&EODAD -> End of data routine MAC01070 | |
| ST 0,&OFFEOD.(,1) Store in NCB MAC01080 | |
| AGO .AREALEN MAC01090 | |
| .EODAD1R ANOP MAC01100 | |
| &W SETC '&EODAD'(2,K'&EODAD-2) MAC01110 | |
| ST &W,&OFFEOD.(,1) Set EODAD address in NCB MAC01120 | |
| .* MAC01130 | |
| .AREALEN ANOP MAC01140 | |
| AIF (T'&AREALEN EQ 'O').AREA MAC01150 | |
| AIF ('&AREALEN'(1,1) EQ '(').AREAL1R MAC01160 | |
| MVC &OFFARL.(4,1),=A(&AREALEN) Set area length value in NCB MAC01170 | |
| AGO .AREA MAC01180 | |
| .AREAL1R ANOP MAC01190 | |
| &W SETC '&AREALEN'(2,K'&AREALEN-2) MAC01200 | |
| ST &W,&OFFARL.(,1) Set area length in NCB MAC01210 | |
| .* MAC01220 | |
| .AREA ANOP MAC01230 | |
| AIF (T'&AREA EQ 'O').RECLEN MAC01240 | |
| AIF ('&AREA'(1,1) EQ '(').AREA1R MAC01250 | |
| LA 0,&AREA -> Record buffer area MAC01260 | |
| ST 0,&OFFARA.(,1) Store in NCB MAC01270 | |
| AGO .RECLEN MAC01280 | |
| .AREA1R ANOP MAC01290 | |
| &W SETC '&AREA'(2,K'&AREA-2) MAC01300 | |
| ST &W,&OFFARA.(,1) Set area address in NCB MAC01310 | |
| .* MAC01320 | |
| .RECLEN ANOP MAC01330 | |
| AIF (T'&RECLEN EQ 'O').ENTRY v210 MAC01340 | |
| AIF ('&RECLEN'(1,1) EQ '(').REC1R MAC01350 | |
| MVC &OFFRCL.(2,1),=Y(&RECLEN) Set record length in NCB MAC01360 | |
| AGO .ENTRY v210 MAC01370 | |
| .REC1R ANOP MAC01380 | |
| &W SETC '&RECLEN'(2,K'&RECLEN-2) MAC01390 | |
| STH &W,&OFFRCL.(,1) Set record length in NCB MAC01400 | |
| .* MAC01500 | |
| .ENTRY ANOP MAC01510 | |
| AIF (T'&ENTRY EQ 'O').VCON v210 | |
| AIF ('&ENTRY'(1,1) EQ '(').ENT1R v210 MAC01350 | |
| L 15,&ENTRY Load NJESPOOL entry addr v210 | |
| AGO .LAUNCH v210 | |
| .* MAC01500 | |
| .ENT1R ANOP v210 MAC01510 | |
| &W SETC '&ENTRY'(2,K'&ENTRY-2) v210 MAC01390 | |
| AIF ('&W' EQ '15').LAUNCH v210 MAC01350 | |
| LR 15,&W Entry addr to R15 v210 MAC01400 | |
| AGO .LAUNCH v210 | |
| .* | |
| .VCON ANOP v210 | |
| L 15,=V(NJESPOOL) | |
| .* | |
| .LAUNCH ANOP v210 | |
| BALR 14,15 | |
| .* | |
| .MEND ANOP v210 MAC01510 | |
| MEND MAC01520 | |
| ./ ADD NAME=REGEQU | |
| MACRO REG00010 | |
| &X REGEQU REG00020 | |
| * DEFINES GENERAL REGISTERS REG00030 | |
| R0 EQU 0 REG00040 | |
| R1 EQU 1 REG00050 | |
| R2 EQU 2 REG00060 | |
| R3 EQU 3 REG00070 | |
| R4 EQU 4 REG00080 | |
| R5 EQU 5 REG00090 | |
| R6 EQU 6 REG00100 | |
| R7 EQU 7 REG00110 | |
| R8 EQU 8 REG00120 | |
| R9 EQU 9 REG00130 | |
| R10 EQU 10 REG00140 | |
| R11 EQU 11 REG00150 | |
| R12 EQU 12 REG00160 | |
| R13 EQU 13 REG00170 | |
| R14 EQU 14 REG00180 | |
| R15 EQU 15 REG00190 | |
| * DEFINES CONTROL REGISTERS REG00200 | |
| C0 EQU 0 REG00210 | |
| C1 EQU 1 REG00220 | |
| C2 EQU 2 REG00230 | |
| C3 EQU 3 REG00240 | |
| C4 EQU 4 REG00250 | |
| C5 EQU 5 REG00260 | |
| C6 EQU 6 REG00270 | |
| C7 EQU 7 REG00280 | |
| C8 EQU 8 REG00290 | |
| C9 EQU 9 REG00300 | |
| C10 EQU 10 REG00310 | |
| C11 EQU 11 REG00320 | |
| C12 EQU 12 REG00330 | |
| C13 EQU 13 REG00340 | |
| C14 EQU 14 REG00350 | |
| C15 EQU 15 REG00360 | |
| * DEFINES FLOATING PT REGISTERS REG00370 | |
| F0 EQU 0 REG00380 | |
| F2 EQU 2 REG00390 | |
| F4 EQU 4 REG00400 | |
| F6 EQU 6 REG00410 | |
| MEND REG00420 | |
| ./ ADD NAME=ROUTE | |
| MACRO | |
| &LABEL ROUTE &PARM1,&PARM2, X | |
| &TYPE=ENTRY | |
| GBLA &RTETOT | |
| AIF ('&TYPE' EQ 'FINAL').FINAL | |
| LCLC &DEST,&NEXT | |
| &RTETOT SETA &RTETOT+1 | |
| AIF (&RTETOT NE 1).NOT1 | |
| ROUTES DS 0D | |
| .NOT1 ANOP | |
| &DEST SETC ' ' | |
| &NEXT SETC ' ' | |
| AIF (T'&PARM1 EQ 'O').NOID | |
| &DEST SETC '&PARM1' | |
| AIF (T'&PARM2 EQ 'O').NOID | |
| &NEXT SETC '&PARM2' | |
| .NOID ANOP | |
| &LABEL DC CL8'&DEST',CL8'&NEXT' DESTINATION, NEXT LINK | |
| MEXIT | |
| .FINAL ANOP | |
| NUMRTES EQU &RTETOT | |
| AIF (&RTETOT NE 0).MEND | |
| ROUTES DS 0D | |
| .MEND ANOP | |
| MEND | |
| ./ ADD NAME=RSSEQU | |
| PUSH PRINT | |
| AIF ('&SYSPARM' NE 'SUP').RSS01 | |
| PRINT OFF,NOGEN | |
| .RSS01 ANOP | |
| * | |
| *** RSS EQUATE SYMBOLS - MACHINE USAGE | |
| * | |
| SPACE 1 | |
| * BITS DEFINED IN STANDARD/EXTENDED PSW | |
| EXTMODE EQU X'08' BIT 12 - EXTENDED MODE | |
| MCHEK EQU X'04' BIT 13 - MACHINE CHECK ENABLED | |
| WAIT EQU X'02' BIT 14 - WAIT STATE | |
| PROBMODE EQU X'01' BIT 15 - PROBLEM STATE | |
| SPACE 1 | |
| * BITS DEFINED IN CHANNEL STATUS WORD - CSW | |
| ATTN EQU X'80' BIT 32 - ATTENTION | |
| SM EQU X'40' BIT 33 - STATUS MODIFIER | |
| CUE EQU X'20' BIT 34 - CONTROL UNIT END | |
| BUSY EQU X'10' BIT 35 - BUSY | |
| CE EQU X'08' BIT 36 - CHANNEL END | |
| DE EQU X'04' BIT 37 - DEVICE END | |
| UC EQU X'02' BIT 38 - UNIT CHECK | |
| UE EQU X'01' BIT 39 - UNIT EXCEPTION | |
| * | |
| PCI EQU X'80' BIT 40 - PROGRAM-CONTROL INTERRUPT | |
| IL EQU X'40' BIT 41 - INCORRECT LENGTH | |
| PRGC EQU X'20' BIT 42 - PROGRAM CHECK | |
| PRTC EQU X'10' BIT 43 - PROTECTION CHECK | |
| CDC EQU X'08' BIT 44 - CHANNEL DATA CHECK | |
| CCC EQU X'04' BIT 45 - CHANNEL CONTROL CHECK | |
| IFCC EQU X'02' BIT 46 - INTERFACE CONTROL CHECK | |
| CHC EQU X'01' BIT 47 - CHAINING CHECK | |
| SPACE 1 | |
| * BITS DEFINED IN CHANNEL COMMAND WORD - CCW | |
| CD EQU X'80' BIT 32 - CHAIN DATA | |
| CC EQU X'40' BIT 33 - COMMAND CHAIN | |
| SILI EQU X'20' BIT 34 - SUPPRESS INCORRECT LENGTH IND. | |
| SKIP EQU X'10' BIT 35 - SUPPRESS DATA TRANSFER | |
| PCIF EQU X'08' BIT 36 - PROGRAM-CONTROL INTERRUPT FETCH | |
| IDA EQU X'04' BIT 37 - INDIRECT DATA ADDRESS | |
| SPACE 1 | |
| * BITS DEFINED IN SENSE BYTE 0 -- COMMON TO MOST DEVICES | |
| CMDREJ EQU X'80' BIT 0 - COMMAND REJECT | |
| INTREQ EQU X'40' BIT 1 - INTERVENTION REQUIRED | |
| BUSOUT EQU X'20' BIT 2 - BUS OUT | |
| EQCHK EQU X'10' BIT 3 - EQUIPMENT CHECK | |
| DATACHK EQU X'08' BIT 4 - DATA CHECK | |
| EJECT | |
| * | |
| *** CP370 EQUATE SYMBOLS - CP USAGE | |
| * | |
| * SYMBOLIC REGISTER EQUATES | |
| R0 EQU 0 | |
| R1 EQU 1 | |
| R2 EQU 2 | |
| R3 EQU 3 | |
| R4 EQU 4 | |
| R5 EQU 5 | |
| R6 EQU 6 | |
| R7 EQU 7 GENERAL | |
| R8 EQU 8 REGISTER | |
| R9 EQU 9 DEFINITIONS | |
| R10 EQU 10 | |
| R11 EQU 11 | |
| R12 EQU 12 | |
| R13 EQU 13 | |
| R14 EQU 14 | |
| R15 EQU 15 | |
| * | |
| Y0 EQU 0 FLOATING | |
| Y2 EQU 2 POINT | |
| Y4 EQU 4 REGISTER | |
| Y6 EQU 6 DEFINITIONS | |
| EJECT | |
| POP PRINT | |
| SPACE | |
| ./ ADD NAME=RTE | |
| RTE DSECT | |
| ROUTPTR DS A -> next RTE entry or 0 | |
| DS A Reserved | |
| ROUTNAME DS CL8 Route destination node | |
| ROUTNEXT DS CL8 Link id for indirect routing | |
| ROUTALT1 DS CL8 Alternate link id for indirect rt'g | |
| ROUTALT2 DS CL8 Alternate link id for indirect rt'g | |
| ROUTALT3 DS CL8 Alternate link id for indirect rt'g | |
| ROUTSIZE EQU *-RTE Length of a routing table entry | |
| ./ ADD NAME=TAG | |
| PUSH PRINT | |
| AIF ('&SYSPARM' NE 'SUP').TAG01 | |
| PRINT OFF,NOGEN | |
| .TAG01 ANOP | |
| TAG DSECT | |
| SPACE 1 | |
| *** TAG - FILE TAG | |
| * | |
| * 0 +-----------------------+-----------------------+ | |
| * | TAGNEXT | TAGBLOCK | | |
| * 8 +-----------------------+-----------------------+ | |
| * | TAGINLOC | | |
| * 10 +-----------------------------------------------+ | |
| * | TAGLINK | | |
| * 18 +-----------------------------------------------+ | |
| * | TAGINTOD | | |
| * 20 +-----------------------------------------------+ | |
| * | TAGINVM | | |
| * 28 +-----------------------+-----------+-----+-----+ | |
| * | TAGRECNM | TAGRECLN | T*1 | T*2 | | |
| * 30 +-----------+-----------+-----------+-----+-----+ | |
| * | TAGID | TAGCOPY | T*3 | T*4 | SPARE | | |
| * 38 +-----------+-----------+-----------------------+ | |
| * | TAGNAME | | |
| * 40 | +-----------------------+ | |
| * | | | | |
| * 48 +-----------------------+ | | |
| * | TAGTYPE | | |
| * 50 +-----------------------------------------------+ | |
| * | TAGDIST | | |
| * 58 +-----------------------------------------------+ | |
| * | TAGTOLOC | | |
| * 60 +-----------------------------------------------+ | |
| * | TAGTOVM | | |
| * 68 +-----------------------------------------------+ | |
| * | TAGPRIOR | TAGDEV | | |
| * 70 +-----------+-----------+ | |
| * | |
| *** TAG - FILE TAG | |
| SPACE 1 | |
| TAGNEXT DS 1F ADDR OF NEXT ACTIVE QUEUE ENTRY | |
| TAGBLOCK DS 1F ADDR OF ASSOCIATED I/O AREA | |
| SPACE | |
| TAGINLOC DS CL8 ORIGINATING LOCATION | |
| TAGLINK DS CL8 NEXT LOCATION FOR TRANSMISSION | |
| TAGINTOD DS CL8 TIME OF FILE ORIGIN | |
| TAGINVM DS CL8 ORIGINATING VIRTUAL MACHINE | |
| TAGRECNM DS 1F NUMBER OF RECORDS IN FILE | |
| TAGRECLN DS 1H MAXIMUM FILE DATA RECORD LENGTH | |
| TAGINDEV DS 1X T*1 DEVICE CODE OF ORIGINATING DEV | |
| TAGCLASS DS CL1 T*2 FILE OUTPUT CLASS | |
| TAGID DS 1H FILE NUMBER AT ORIGIN LOCATION | |
| TAGCOPY DS 1H NUMBER OF COPIES REQUESTED | |
| TAGFLAG DS 1X T*3 VM/370 SFBLOK CONTROL FLAGS | |
| TAGFLAG2 DS 1X T*4 VM/370 SFBLOK CONTROL FLAGS | |
| DS 1H SPARE | |
| TAGNAME DS CL12 FILE NAME | |
| TAGTYPE DS CL12 FILE TYPE | |
| TAGDIST DS CL8 FILE DISTRIBUTION CODE | |
| TAGTOLOC DS CL8 DESTINATION LOCATION ID | |
| TAGTOVM DS CL8 DESTINATION VIRTUAL MACHINE ID | |
| TAGPRIOR DS 1H TRANSMISSION PRIORITY | |
| TAGDEV DS 2X ACTIVE FILE'S VIRT DEV ADDR | |
| SPACE | |
| TAGUSELN EQU *-TAGINLOC USABLE TAG INFO LEN *XJE | |
| TAGLEN EQU *-TAGNEXT LENGTH OF THE FILE TAG | |
| EJECT | |
| POP PRINT | |
| SPACE | |
| @@ | |
| //* | |
| //* Installs SYSGEN.NJE38.ASMSRC | |
| //* | |
| //ASMSRC EXEC PGM=PDSLOAD | |
| //STEPLIB DD DSN=SYSC.LINKLIB,DISP=SHR | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT2 DD DSN=SYSGEN.NJE38.ASMSRC,DISP=(NEW,CATLG), | |
| // VOL=SER=PUB001, | |
| // UNIT=3390,SPACE=(CYL,(2,1,10)), | |
| // DCB=(BLKSIZE=6160,LRECL=80,RECFM=FB) | |
| //SYSUT1 DD DATA,DLM=@@ | |
| ./ ADD NAME=NJESYS | |
| * | |
| * | |
| *-- NJE38 - Locate NJE38 information from an ENQ resource | |
| * | |
| * | |
| * Called by NJEINIT,NJERCV,NJETRN,NJE38,NJ38XMIT,NJ38RECV | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 01 Oct 20 - Initial creation v210 | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJESYS CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) Save regs | |
| LR R12,R15 | |
| USING NJESYS,R12 | |
| * | |
| *-- Determine if NJE38 is already active in another address space | |
| * | |
| CHK000 EQU * | |
| L R2,16 Get CVT ptr | |
| USING CVT,R2 | |
| LA R2,CVTFQCB -> ENQ QCB chain anchor | |
| USING QCB,R2 | |
| * | |
| CHK010 EQU * | |
| ICM R2,15,MAJNMAJ -> next major QCB | |
| BZ CHK080 Our guy not found | |
| CLC MAJNAME,NJE38Q Look for our QNAME "NJE38" | |
| BNE CHK010 Nope, go to next QCB | |
| * | |
| L R3,MAJFMIN -> first minor QCB | |
| USING MIN,R3 | |
| * | |
| CHK020 EQU * | |
| LA R4,MINNAME -> minor name | |
| CLC NJERCON,0(R4) Does minor name match? | |
| BE CHK030 Yes. NJE38 is active | |
| C R3,MAJLMIN Is this the last minor QCB? | |
| BE CHK080 Yes, we're done. NJE38 is not active | |
| ICM R3,15,MINNMIN -> next minor name | |
| BZR R14 Just in case no address | |
| B CHK020 Spin through the minor QCBs | |
| * | |
| CHK030 EQU * | |
| LTR R1,R1 Store spool DSN? | |
| BZ CHK040 No | |
| MVC 0(44,R1),12(R4) Save off NETSPOOL dsname | |
| * | |
| CHK040 EQU * | |
| L R1,8(,R4) Get CSABLK ptr from QCB minor | |
| SR R15,R15 RC=0, ENQ data was found | |
| B CHK090 | |
| * | |
| CHK080 EQU * | |
| LA R15,4 RC=4, no ENQ located | |
| * | |
| CHK090 EQU * | |
| ST R1,24(,R13) Return R1 value | |
| ST R15,16(,R13) Return R15 RC | |
| * | |
| LM R14,R12,12(R13) Reload regs | |
| BR R14 Return | |
| * | |
| DS 0D | |
| NJE38Q DC CL8'NJE38' | |
| NJERCON DC CL8'NJEINIT' | |
| * | |
| LTORG , | |
| * | |
| CVT DSECT=YES,PREFIX=NO | |
| IHAQCB | |
| * | |
| END | |
| ./ ADD NAME=NJESPOOL | |
| * | |
| * | |
| *-- NJE38 - "Spool" Services | |
| * | |
| * | |
| * Called by NJEINIT and NJEDRV for spool-like services | |
| * | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 23 Jul 20 - Make CONTENTS return spool full percentage v200 | |
| * 21 Jul 20 - Only part of record buffer area was FREEMAINed v200 | |
| * 01 Jun 20 - Exclusive control error because ENDREQ not issued v130 | |
| * on CONTENTS function against an empty spool. v130 | |
| * 21 May 20 - Add update directory entry functionality v120 | |
| * 08 May 20 - RC 12 errors need error addr in NCBMACAD v110 | |
| * | |
| * | |
| * NJESPOOL - Provide a spooling mechanism "access method" for use by | |
| * NJE38 to hold data files queued for transmission, or to | |
| * hold data files that have been received via transmission | |
| * but not yet retrieved by the destination user. | |
| * | |
| * The main goal of NJESPOOL is to provide a simple way to read and | |
| * write files by the NJE line driver without the line driver having | |
| * to know the vagaries of i/o, record formats, directories, and so on. | |
| * NJESPOOL does the heavier lifting and spool management under the | |
| * covers and unknown to the line driver. | |
| * | |
| * The spool dataset, "NETSPOOL", is a VSAM RRDS-type dataset. All | |
| * blocks in the dataset are one control interval in size. The CI size | |
| * must be 4096, which gives a usable record size of 4089 bytes. The | |
| * NETSPOOL internal format is based on these sizes. | |
| * | |
| * NETSPOOL contains a directory which describes the data files | |
| * present within. There are two directories; one is the current | |
| * directory which describes the true state of NETSPOOL, the other is | |
| * the current-minus-1 diectory, which is the state of NETSPOOL just | |
| * prior to the very last directory update. When new data files are | |
| * added or removed from NETSPOOL, the current directory is copied onto | |
| * current-minus-1 and then the addition or deletion is applied. This | |
| * then becomes the current directory and the directory that was most | |
| * recently current becomes current-minus-1. Thus the directories | |
| * alternate back and forth. The first block of each directory are | |
| * blocks 2 and 3, respectively. If the directory size expands to | |
| * additional blocks, they can be anywhere in the dataset, but the | |
| * very first block of either directory is ALWAYS 2 or 3. | |
| * | |
| * Block #1 contains a fullword pointer that contains the block number | |
| * of whichever directory is current. Thus, it will contain a 2 or 3. | |
| * Alternating directories ensures that in the event of a failure while | |
| * adding or deleting a data file, the changes do not clobber the | |
| * current directory. Only when those updates complete successfully | |
| * is the block 1 pointer to the new current directory updated. | |
| * | |
| * | |
| * The format of the NETSPOOL dataset is very simple. | |
| * Block 1 - contains the block # of the current directory block and | |
| * a few other items. | |
| * Blocks 2-3 - contain the 1st directory block for the current | |
| * and current-minus-1 directories. | |
| * Blocks 4-7 - contains the free space bit map. | |
| * Blocks 8-n - data blocks available for data files or directory blks. | |
| * | |
| * The free space bitmap is simply a 4-block long (4089 * 4 = 16356 | |
| * bytes) string of bits that represent whether a given CI in the | |
| * dataset is used or available. Upon initial formatting, the blocks | |
| * 1-7 are marked as used. The rest of the data blocks are free until | |
| * the last block number that is physically present in the VSAM RRDS | |
| * dataset. The maximum number of blocks supported by this scheme is | |
| * 130,848. This is 873 cylinders of 3380 DASD space, for example. | |
| * For VSAM RRDS NETSPOOL sizes of fewer cylinders, blocks higher than | |
| * the highest available physical block number are marked as used out | |
| * to the end of the bitmap so they will never be allocated. | |
| * | |
| * | |
| * ACCESSING NETSPOOL VIA PROGRAMMING | |
| * | |
| * You may access the NETSPOOL dataset via programming the same way | |
| * that the NJE line driver and NJE38 utilities do: via a NETSPOOL | |
| * CONTROL BLOCK (NCB) and the NSIO macro. | |
| * | |
| * The NCB is a small control block that is something akin to a VSAM | |
| * RPL. It simply contains information about the file being read or | |
| * written and contains pointers to the user buffer, and file | |
| * attributes. | |
| * | |
| * The NSIO macro is used to open or close the NETSPOOL dataset. It is | |
| * also used to read or write data records, and obtain directory | |
| * information. | |
| * | |
| * The NCB and the NSIO macro are used together and provide the | |
| * functions for spool access: | |
| * | |
| * NSIO TYPE=OPEN - Opens the NETSPOOL dataset for i/o | |
| * CLOSE - Closes NETSPOOL and updates directory | |
| * PUT - Writes a single record to the spool | |
| * GET - Reads a single record from the spool | |
| * PURGE - Deletes a data file from the spool | |
| * FIND - Locates a data file by file number | |
| * CONTENTS - Returns the current directory contents | |
| * UDIR - Update a directory entry v120 | |
| * | |
| * All NSIO macros must specify the NCB that it is associated with. | |
| * The spool is not opened for "input" or for "output" in the | |
| * traditional sense. Rather, the first TYPE=GET or TYPE=PUT | |
| * issued establishes the mode. Once the mode is established you | |
| * may not change from PUT to GET, or GET to PUT, without first | |
| * closing the spool and re-opening. The PURGE, FIND, and CONTENTS | |
| * functions do not establish any mode, and can be used any time | |
| * the spool is open. | |
| * | |
| * If you need to open the spool file by two or more tasks or modes | |
| * simultaneously, use multiple NCBs. | |
| * | |
| * VSAM errors are returned via the NCBRTNCD and NCBERRCD fields which | |
| * are analagous to the VSAM RPLRTNCD and RPLERRCD fields. If an | |
| * actual VSAM error occurs, NCBRTNCD will be set to 8 and the NCBERRCD | |
| * field contains the actual VSAM RPLERRCD value. If NCBRTNCD is 12, | |
| * the error code value is an internal value used by NJESPOOL. These | |
| * are: | |
| * | |
| * NCBRTNCD=X'0C' Internal NJESPOOL error | |
| * NCBERRCD=X'01' Invalid function code (not open, close, get, etc). | |
| * X'02' VSAM RRDS ACB is not open | |
| * X'03' NETSPOOL dataset is full | |
| * X'04' File # not found in directory (TYPE=FIND/PURGE) | |
| * X'05' GET attempted in PUT mode, or, | |
| * PUT attempted in GET mode | |
| * X'06' No files in directory (TYPE=CONTENTS) | |
| * | |
| * Refer to the utilities NJ38XMIT and NJ38RECV for examples using | |
| * NCB and NSIO to access the spool. | |
| * | |
| PRINT GEN NJE00030 | |
| REGEQU REGISTER EQUATES NJE00040 | |
| * | |
| * NETSPOOL Internal values | |
| * | |
| ALLOCBLK EQU 4 Starting BLK# of allocation map | |
| ALLOCNUM EQU 4 Number of allocation map blocks | |
| * | |
| * | |
| NJESPOOL CSECT NJE00020 | |
| NJEVER | |
| STM R14,R12,12(R13) SAVE CMS REGS NJE00050 | |
| LR R12,R15 BASE NJE00060 | |
| USING NJESPOOL,R12 ADDRESS IT NJE00070 | |
| LTR R9,R1 NCB ptr to R9 | |
| BZ EXIT16 Exit if no ptr | |
| USING NCB,R9 | |
| CLC NCBEYE,=CL4'NCB' Is it an NCB? | |
| BNE EXIT16 Exit if not | |
| XC NCBRTNCD(2),NCBRTNCD Clear prior error codes | |
| CLI NCBREQ,NCBOPEN Is this an OPEN function? | |
| BE INIT000 Yes, ignore token | |
| L R10,NCBTKN Get caller token | |
| CLC 0(4,R10),=CL4'NSPL' Token point to NSPL work area? | |
| BE INIT010 Yes, looks good | |
| B EXIT16 Exit if token invalid | |
| * | |
| * | |
| INIT000 EQU * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| ST R10,NCBTKN Set area addr as token | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEWK,R10 | |
| MVC NJEEYE,=CL4'NSPL' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| * | |
| INIT010 EQU * | |
| USING NJEWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| L R11,=A(NJECMN) -> common csect | |
| ST R11,ANJECMN Save addr | |
| USING NJECMN,R11 | |
| * | |
| * | |
| INIT100 EQU * | |
| LA R14,* -> location of error source v110 | |
| SR R1,R1 Clear for IC | |
| IC R1,NCBREQ Get request type | |
| SLL R1,2 Multiply by 4 to make index | |
| C R1,=A(INIT120-INIT110) Size of branch table | |
| BH ERR1201 Exit if req type invalid | |
| B INIT110(R1) Branch to requested function | |
| * | |
| INIT110 B ERR1201 00 Invalid function | |
| B OPN000 01 Open NETSPOOL dataset | |
| B CLS000 02 Close NETSPOOL dataset | |
| B PUT000 03 Write a logical record | |
| B GET000 04 Read a logical record | |
| B PUR000 05 Purge a file from NETSPOOL | |
| B FID000 06 Locate a file by file id | |
| B CON000 07 Get a list of files in NETSPOOL | |
| B UDR000 08 Update directory entry v120 | |
| * | |
| INIT120 EQU * Must mark end of branch table | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * NJE00920 | |
| * OPEN DATASET * NJE00920 | |
| * NCBREQ = X'01' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| * | |
| *- Get storage for NETSPOOL block | |
| * | |
| OPN000 EQU * | |
| GETMAIN RU, Get stg for NETSPOOL blocks X | |
| LV=3*4096, X | |
| BNDRY=PAGE | |
| ST R1,BLOCK This is the VSAM AREA | |
| LR R3,R1 R3 for now | |
| LA R2,4089(,R1) -> end of BLOCK record size | |
| ST R2,BLOCKEND Save it | |
| A R1,=F'4096' -> 2nd page | |
| ST R1,PTRBUF This is an internal rec'd buffer | |
| ST R1,PTRPOS Save also as internal write pos | |
| LA R2,4084(,R1) -> end of ptr part of PTRBUF | |
| ST R2,PTRBUFEN Save it (bytes 4084-4089 special | |
| A R1,=F'4096' -> 2nd page | |
| ST R1,BUFF This is an internal rec'd buffer | |
| ST R1,PUTPOS Save also as internal write pos | |
| LA R1,4089(,R1) -> end of BUFF record size | |
| ST R1,BUFFEND Save it | |
| XC PTRBLK,PTRBLK Initialize | |
| XC NEWBLK,NEWBLK Initialize | |
| XC PUTCNT,PUTCNT Initialize (to be placed in TAG) | |
| XC GETCNT,GETCNT Initialize (only used for debug) | |
| * | |
| GENCB BLK=ACB, x | |
| DDNAME=NETSPOOL, x | |
| MACRF=(OUT,KEY,DIR), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,ACBL Save len, addr | |
| * | |
| LA R4,KEY -> block number argument | |
| GENCB BLK=RPL, x | |
| ACB=(*,ACB), x | |
| AREA=(R3), -> block area x | |
| AREALEN=4089, x | |
| RECLEN=4089, x | |
| ARG=(R4), x | |
| OPTCD=(KEY,DIR,MVE,UPD), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,RPLL Save len, addr | |
| * | |
| BAL R14,ENQ000 Get exclusive control | |
| * | |
| L R7,ACB -> ACB | |
| MVC MACLIST(OPENL),OPEN Move macro model | |
| OPEN ((R7)), Open NETSPOOL x | |
| MF=(E,MACLIST) | |
| * | |
| BAL R14,CHKOC Check open/close result | |
| BNZ EXIT08 Exit with VSAM error | |
| OI NJFL1,NJF1OACB Indic ACB open | |
| * | |
| *-- Get NETSPOOL directory block ptr from block 1; determine if | |
| *-- NETSPOOL has been formatted. | |
| * | |
| OPN040 EQU * | |
| MVC KEY,=F'1' | |
| L R7,RPL | |
| GET RPL=(R7) | |
| BAL R14,CHKRPL Check RPL result | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| ENDREQ RPL=(R7) Cancel the update request | |
| BAL R14,CHKRPL Check RPL result | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| BAL R14,DEQ000 Release control | |
| B EXIT00 Otherwise OPEN is complete | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * NJE00920 | |
| * CLOSE DATASET * NJE00920 | |
| * NCBREQ = X'02' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| CLS000 EQU * | |
| SR R5,R5 Clear possible RC | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ CLS090 No | |
| BAL R14,ENQ000 Get exclusive control | |
| * | |
| TM NJFL1,NJF1PUT Processing PUTs against file? | |
| BZ CLS050 N, skip close related PUT funcs. | |
| * | |
| CLC NCBTAG,=A(0) Is tag data present? | |
| BE CLS050 0, Cant write a directory | |
| * | |
| TM NJFL1,NJF1WPND Is physical write pending? | |
| BZ CLS030 No | |
| NI NJFL1,255-NJF1WPND No physical write pending | |
| * | |
| MVC KEY,NEWBLK Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R3,PUTPOS -> logical record position | |
| LA R3,2(,R3) Account for FFFF EOF marker | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,BUFF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| * | |
| CLS030 EQU * | |
| NC PTRBLK,PTRBLK Is ptr block write pending? | |
| BZ CLS040 | |
| MVC KEY,PTRBLK Prep for update of blk to write | |
| XC PTRBLK,PTRBLK Clear block number for recursion | |
| OI NJFL1,NJF1DPND Indic directory add pending | |
| * | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R3,PTRPOS -> ptr record position | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,PTRBUF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| * | |
| CLS040 EQU * | |
| TM NJFL1,NJF1DPND Directory add pending? | |
| BZ CLS050 No | |
| NI NJFL1,255-NJF1DPND Remove directory add pending | |
| * | |
| L R1,NCBTAG -> tag data | |
| USING TAG,R1 | |
| MVC TAGRECNM,PUTCNT Save # records actually written | |
| DROP R1 | |
| * | |
| LA R0,DIRADD Add directory entry function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File to add is in NCB | |
| LR R5,R15 Any RC to R5 | |
| * | |
| CLS050 EQU * | |
| L R7,ACB -> ACB | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE ((R7)), Close the ACB x | |
| MF=(E,MACLIST) | |
| * | |
| NI NJFL1,255-NJF1OACB ACB now closed | |
| BAL R14,DEQ000 Release control | |
| * | |
| CLS090 EQU * | |
| L R1,BLOCK -> NETSPOOL record areas | |
| FREEMAIN RU,LV=3*4096,A=(1) Release it v200 | |
| * | |
| LM R0,R1,RPLL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| LM R0,R1,ACBL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| XC NCBTKN,NCBTKN Clear token | |
| B QUIT000 Exit with RC in R5 | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Write a logical record (not a physical block) NJE00920 | |
| * PUT * NJE00920 | |
| * NCBREQ = X'03' * No ENQ is required when writing the physical NJE00920 | |
| * * blocks as these blocks are allocated exclusively NJE00920 | |
| ******************** to the calling task. NJE00920 | |
| * NJE00920 | |
| PUT000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| TM NJFL1,NJF1GET Processing GETs against file? | |
| BO ERR1205 Yes, cant do PUT now | |
| OI NJFL1,NJF1PUT Indicate PUT in progress | |
| * | |
| NC PTRBLK,PTRBLK Do we have a ptr block? | |
| BNZ PUT020 Yes | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,PTRBLK Save block number of ptr blk | |
| ST R0,INITBLK Save first block # used in PUT | |
| L R0,PTRBUF -> ptr block area | |
| LA R1,4089 Size of physical block | |
| LR R3,R1 Compute length to write out | |
| MVCL R0,R2 Clear the ptr block | |
| MVC PTRPOS,PTRBUF Set write position in block | |
| * | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,NEWBLK Save allocated blk # | |
| MVC PUTPOS,BUFF Set write position in block | |
| L R1,PTRPOS Get current ptr block position | |
| ST R0,0(,R1) Save new blk# in ptr block | |
| LA R1,4(,R1) Next ptr block slot | |
| ST R1,PTRPOS Update position | |
| * | |
| PUT020 EQU * | |
| L R3,PUTPOS Get current position | |
| L R1,BUFFEND -> end of buffer | |
| SR R1,R3 Determine remaining space in blk | |
| LH R4,NCBRECLN Get size of record to write | |
| LA R2,2+2(,R4) Add in overhead | |
| * +2 for length halfword | |
| * +2 for next block marker | |
| CR R1,R2 Is there room to add record? | |
| BL PUT100 No, better get another block | |
| * | |
| L R15,NCBAREA -> to logical record | |
| BCT R4,*+10 Adjust len for execute | |
| PUTREC MVC 2(0,R3),0(R15) | |
| EX R4,PUTREC Move record to block | |
| LA R4,1+2(,R4) Get record len + overhead | |
| * +1 to get back true length | |
| * +2 for length halfword itself | |
| STCM R4,3,0(R3) Store the length | |
| * | |
| TM NCBFL1,NCBPUN Is this PUN type data? | |
| BO PUT050 Y, no special action | |
| TM 2(R3),X'03' Is carriage ctl an immediate? | |
| BO PUT060 Y, Don't count these records | |
| * | |
| PUT050 EQU * | |
| L R1,PUTCNT Get count of records written | |
| LA R1,1(,R1) Bump it | |
| ST R1,PUTCNT Update count | |
| * | |
| PUT060 EQU * | |
| AR R3,R4 Compute next avail byte in blk | |
| MVC 0(2,R3),=X'FFFF' Set current EOF marker in case | |
| * we write no more records | |
| ST R3,PUTPOS Save write position for next | |
| * record; would overwrite the | |
| * FFFF marker on next PUT. | |
| OI NJFL1,NJF1WPND Indicate physical write req'd | |
| B EXIT00 | |
| * | |
| PUT100 EQU * | |
| L R5,NEWBLK Get current blk # we need to wrt | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,NEWBLK Save newly allocated blk # | |
| MVC 0(2,R3),=X'FFFE' Insert ptr indic for next blk | |
| LA R3,2(,R3) -> next write position | |
| * | |
| ST R5,KEY Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,BUFF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| MVC PUTPOS,BUFF Reset write position in new blk | |
| NI NJFL1,255-NJF1WPND No physical write pending | |
| * | |
| *-- Now ensure newly allocated block is also pointed to by ptr block | |
| * | |
| L R3,PTRPOS Get current ptr block position | |
| MVC 0(4,R3),NEWBLK Save new blk# in ptr block | |
| LA R3,4(,R3) Next ptr block slot | |
| C R3,PTRBUFEN Is ptr block full? | |
| BNL PUT200 Yes | |
| ST R3,PTRPOS Update position | |
| B PUT020 Now retry to add next logical | |
| * | |
| *-- Here if we need another ptr block (chain them together) | |
| * | |
| PUT200 EQU * | |
| L R5,PTRBLK Get current blk # we need to wrt | |
| BAL R14,GETBLK Allocate a new phys ptr block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,PTRBLK Save newly allocated blk # | |
| ST R0,0(,R3) Insert ptr to next ptr blk in | |
| * full ptr block | |
| MVI 0(R3),X'FE' Indic "ptr to next ptr blk" and | |
| * not ptr to a data block | |
| LA R3,4(,R3) -> next write position | |
| * | |
| ST R5,KEY Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,PTRBUF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,PTRBUF -> ptr block area | |
| LA R1,4089 Size of physical block | |
| LR R3,R1 Compute length to write out | |
| MVCL R0,R2 Clear the ptr block | |
| MVC PTRPOS,PTRBUF Reset ptr position in new blk | |
| B PUT020 Now retry to add next logical | |
| * NJE00200 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Read a logical record (not a physical block) NJE00920 | |
| * GET * NJE00920 | |
| * NCBREQ = X'04' * No ENQ is required when reading the physical NJE00920 | |
| * * blocks as these blocks are allocated exclusively NJE00920 | |
| ******************** to the calling task. The file id to read must NJE00920 | |
| * be in NSID in the tag data pointed to by NCBTAG | |
| * NJE00920 | |
| GET000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| TM NJFL1,NJF1PUT Processing PUTs against file? | |
| BO ERR1205 Yes, cant do GET now | |
| OI NJFL1,NJF1GET Indicate GET in progress | |
| * | |
| L R7,RPL -> RPL | |
| NC PTRBLK,PTRBLK Do we have a ptr block in prog? | |
| BNZ GET060 Yes, read next logical rec | |
| * | |
| LA R0,DIRLOC Locate file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File id is in tag field TAGID | |
| * | |
| LTR R15,R15 Was file found? | |
| BZ GET010 Yes | |
| C R15,=F'12' Errors processing directory? | |
| BL EXIT08 Exit here if 4 or 8=VSAM errors | |
| B EXIT12 All others Exit12 | |
| * | |
| GET010 EQU * | |
| MODCB RPL=(R7), x | |
| OPTCD=(KEY,DIR,MVE,NUP), No update needed on GETs x | |
| MF=(G,MACLIST) | |
| * | |
| L R3,NCBTAG -> tag data | |
| USING TAG,R3 | |
| MVC GETLIM,TAGRECNM Save off # of records in file | |
| DROP R3 | |
| * | |
| L R3,INITBLK Get 1st block # of file | |
| * | |
| GET020 EQU * ** Get a ptr block | |
| ST R3,KEY Set block retrieval key | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| ST R3,PTRBLK Save ptr blk # | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Put ptr data in ptrbuf | |
| * | |
| L R4,PTRBUF -> ptr block ptrs | |
| ST R4,PTRPOS Maintain ptr position | |
| * | |
| GET030 EQU * | |
| C R4,PTRBUFEN Out of ptrs this block? | |
| BL GET040 No | |
| * | |
| * ** Here if ptr block chains to | |
| * another ptr block | |
| CLI 0(R4),X'FE' ptr to ptrblk indicator? | |
| BNE GET200 EOF No, done with ptrs | |
| SR R3,R3 Clear for IC | |
| ICM R3,7,1(R4) Get ptr to next ptr block | |
| ST R3,KEY Set up for retrieval | |
| B GET020 Go get it | |
| * | |
| GET040 EQU * | |
| ICM R2,15,0(R4) Get a data block # | |
| BZ GET200 EOF Done with ptrs | |
| * | |
| ST R2,KEY Set block retrieval key | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R5,BLOCK -> VSAM i/o area | |
| ST R5,GETPOS Maintain read position | |
| * | |
| GET060 EQU * | |
| L R5,GETPOS -> next logical record to read | |
| CLC 0(2,R5),=X'FFFF' Is this end of file? | |
| BE GET200 Yes | |
| CLC 0(2,R5),=X'FFFE' Skip to next ptr indication? | |
| BE GET100 Yes | |
| * | |
| SR R14,R14 Clear for IC | |
| ICM R14,3,0(R5) Get the record length | |
| BCTR R14,0 Reduce length of length | |
| BCTR R14,0 Reduce length of length | |
| STH R14,NCBRECLN Return length to caller | |
| * | |
| L R15,NCBAREA -> to caller's record buffer | |
| BCT R14,*+10 Adjust len for execute | |
| GETREC MVC 0(0,R15),2(R5) | |
| EX R14,GETREC Move record to user area | |
| LA R5,1+2(R14,R5) Get record len + overhead | |
| * +1 to get back true length | |
| * +2 for length halfword itself | |
| ST R5,GETPOS Save read position | |
| L R1,GETCNT Get count of records read | |
| LA R1,1(,R1) Bump it | |
| ST R1,GETCNT Update count for debug purposes | |
| B EXIT00 Exit with record in NCBAREA | |
| * | |
| GET100 EQU * | |
| L R4,PTRPOS Get ptr position | |
| LA R4,4(,R4) -> next ptr field | |
| ST R4,PTRPOS Maintain ptr position | |
| B GET030 Go process next ptr | |
| * | |
| GET200 EQU * | |
| MVI NCBERRCD,X'04' Indicate EOF | |
| B EXIT08 | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Delete a file from the NETSPOOL dataset NJE00920 | |
| * PURGE * NJE00920 | |
| * NCBREQ = X'05' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| PUR000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRDEL Del file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File to del is in NCB ??? | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Locate a file in the directory by file id NJE00920 | |
| * LOCATE * NJE00920 | |
| * NCBREQ = X'06' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| FID000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRLOC Locate file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File id is in tag field TAGID | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Return a list of files in NETSPOOL dataset NJE00920 | |
| * CONTENTS * NJE00920 | |
| * NCBREQ = X'07' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| CON000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRLST List files function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Update a directory entry by file id v120 NJE00920 | |
| * UDIR * NJE00920 | |
| * NCBREQ = X'08' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| UDR000 EQU * v120 | |
| LA R14,* -> location of error source v120 | |
| TM NJFL1,NJF1OACB Is ACB open? v120 | |
| BZ ERR1202 No v120 | |
| * v120 | |
| LA R0,DIRUPD Update dir function v120 | |
| L R15,=A(NJEDIR) Call directory mgmt v120 | |
| BALR R14,R15 v120 | |
| LR R5,R15 Any RC to R5 v120 | |
| B QUIT000 v120 | |
| * | |
| * | |
| ERR1201 EQU * Invalid NCBREQ function code | |
| MVI NCBERRCD,X'01' Set error code | |
| B EXIT12 | |
| * | |
| ERR1202 EQU * ACB is not open | |
| MVI NCBERRCD,X'02' Set error code | |
| B EXIT12 | |
| * | |
| ERR1203 EQU * NETSPOOL dataset is full | |
| MVI NCBERRCD,X'03' Set error code | |
| B EXIT12 | |
| * | |
| ERR1204 EQU * File # not found in directory | |
| MVI NCBERRCD,X'04' Set error code | |
| B EXIT12 | |
| * | |
| ERR1205 EQU * GET attempted in PUT mode, or, | |
| * PUT attempted in GET mode | |
| MVI NCBERRCD,X'05' Set error code | |
| B EXIT12 | |
| * | |
| ERR1206 EQU * No files in directory (NCBCON) | |
| MVI NCBERRCD,X'06' Set error code | |
| B EXIT12 | |
| * | |
| * NJE00200 | |
| * Exit points NJE00200 | |
| * NJE00200 | |
| * NJE00200 | |
| * NJE00200 | |
| EXIT00 EQU * NJE00210 | |
| SR R5,R5 Set RC=0 | |
| B QUIT000 | |
| * | |
| * Exit04 reasons: | |
| * All VSAM OPEN/CLOSE and RPL errors. | |
| * | |
| EXIT04 EQU * NJE00210 | |
| LA R5,4 Set RC=4 | |
| B QUIT000 | |
| * | |
| * Exit08 reasons: | |
| * All VSAM OPEN/CLOSE and RPL errors. | |
| * | |
| EXIT08 EQU * NJE00210 | |
| C R15,=F'4' Is is really RC 4? | |
| BE EXIT04 Reflect the truth | |
| LA R5,8 Set RC=8 | |
| B QUIT000 | |
| * | |
| * Exit12 reasons: | |
| * NETSPOOL dataset is full (no available blocks) | |
| * NCBREQ contains invalid/unsupported function code | |
| * File is not open | |
| * File # is not found in directory | |
| * GET issued during PUT activity | |
| * PUT issued during GET activity | |
| * | |
| EXIT12 EQU * NJE00210 | |
| ST R14,NCBMACAD Save error address v110 | |
| LA R5,12 Set RC=12 | |
| B QUIT000 | |
| * | |
| * Exit16 reasons: | |
| * R1 = zero on entry | |
| * R1 doesnt point to NCB ('NCB ' in 1st four bytes) | |
| * NCBTKN is zero but NCBREQ is not NCBOPEN | |
| * NCBTKN doesnt point to area containing 'NSPL' | |
| * | |
| EXIT16 EQU * NJE00210 | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| LA R5,16 Set RC=16 | |
| B QUIT090 | |
| * | |
| QUIT000 EQU * | |
| STC R5,NCBRTNCD Set R15 return code | |
| BAL R14,DEQ000 Remove any ENQ | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| CLC NCBREQ(3),=AL1(NCBGET,8,4) EOF on a NCBGET function? | |
| BNE QUIT020 No | |
| ICM R15,15,NCBEODAD Get EODAD address | |
| BZ QUIT020 If none, let 8,4 rtn cd pass | |
| ST R15,12(,R13) Set R14 return to EODAD address | |
| XC NCBRTNCD(2),NCBRTNCD Remove EOF error indicators | |
| SR R5,R5 Set RC=0 | |
| * | |
| QUIT020 EQU * | |
| CLI NCBREQ,NCBCLOSE Is this a close request? | |
| BNE QUIT090 No. Exit without free stgs | |
| * | |
| LR R1,R10 -> NJEWK main work area page | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| * | |
| QUIT090 EQU * | |
| ST R5,16(,R13) Set RC in R15 | |
| LM R14,R12,12(R13) Reload callers's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| * NJE00250 | |
| LTORG NJE00280 | |
| * | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| * | |
| * | |
| DROP R12 | |
| * | |
| * NJE00920 | |
| ********************* NJE00920 | |
| * N J E C M N * NJECMN hosts small routines and NJE00920 | |
| * * frequently used constants NJE00920 | |
| * Common routines * NJE00920 | |
| * and constants * via base register 11 NJE00920 | |
| * * NJE00920 | |
| ********************* NJE00920 | |
| * NJE00920 | |
| NJECMN CSECT NJE00020 | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECMN' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECMN,R11 | |
| USING NJEWK,R10 | |
| * | |
| *-- Check result of VSAM OPEN or CLOSE macro | |
| * | |
| CHKOC EQU * | |
| LTR R15,R15 Did request succeed? | |
| BZR R14 Yes return | |
| ST R14,NCBMACAD Save addr of failing macro | |
| STC R15,NCBRTNCD Set return code | |
| MVC NCBERRCD,ACBERFLG-IFGACB(R7) error code | |
| BR R14 Return with VSAM error | |
| * | |
| *-- Check result of VSAM RPL macros | |
| * | |
| CHKRPL EQU * | |
| LTR R15,R15 Did request succeed? | |
| BZR R14 Yes return | |
| ST R14,NCBMACAD Save addr of failing macro | |
| STC R15,NCBRTNCD Set return code | |
| MVC NCBERRCD,RPLERRCD-IFGRPL(R7) error code | |
| BR R14 Return with VSAM error | |
| * | |
| * | |
| ENQ000 EQU * | |
| TM NJFL1,NJF1ENQ Is ENQ active? | |
| BOR R14 Return if so | |
| * | |
| ST R14,SV14 Save return addr | |
| ENQ (NJE38Q,NJEDSN,E,44,SYSTEM), X | |
| RET=NONE | |
| * | |
| OI NJFL1,NJF1ENQ ENQ active | |
| L R14,SV14 Reload return addr | |
| BR R14 Return | |
| * | |
| * | |
| DEQ000 EQU * | |
| TM NJFL1,NJF1ENQ Is ENQ active? | |
| BZR R14 Return if not | |
| * | |
| ST R14,SV14 Save return addr | |
| DEQ (NJE38Q,NJEDSN,44,SYSTEM), X | |
| RET=NONE | |
| NI NJFL1,255-NJF1ENQ ENQ off | |
| L R14,SV14 Reload return addr | |
| BR R14 Return | |
| * NJE00200 | |
| * NJE00200 | |
| *-- ADDBLK / GETBLK routines NJE00200 | |
| * NJE00200 | |
| *-- Allocate a new physical block. Scan the allocation map for a free NJE00200 | |
| *-- block and mark it as taken, and return the new block number to the NJE00200 | |
| *-- caller. | |
| * | |
| *-- ADDBLK and GETBLK are functionally identical except that ADDBLK | |
| *-- does not ENQ or DEQ on NETSPOOL; it is assumed that the caller | |
| *-- already has done that (the DIR functions). | |
| * | |
| *-- Uses R14-R4,R7. R1-R4 are preserved across call | |
| * NJE00200 | |
| *-- Entry: None NJE00200 | |
| * NJE00200 | |
| *-- Exit: R15 = 0 if ok, else RC from VSAM macro. NJE00200 | |
| * R0 = block # of new block. If R0=0, no blocks available. NJE00200 | |
| * NJE00200 | |
| ADDBLK EQU * | |
| ST R14,SV14GB Save return addr | |
| STM R1,R4,SVGB Save caller's regs | |
| BAL R14,GETB000 Go allocate the block | |
| LTR R15,R15 VSAM RC in R15, set CC | |
| LR R0,R4 Return block # in R0 | |
| LM R1,R4,SVGB Load caller's regs | |
| L R14,SV14GB Load return addr | |
| BR R14 Return | |
| * NJE00200 | |
| GETBLK EQU * | |
| ST R14,SV14GB Save return addr | |
| STM R1,R4,SVGB Save caller's regs | |
| BAL R14,ENQ000 Get exclusive control | |
| BAL R14,GETB000 Go allocate the block | |
| LR R3,R15 Save R15 across DEQ | |
| BAL R14,DEQ000 Release control | |
| LTR R15,R3 Return VSAM RC in R15, set CC | |
| LR R0,R4 Return block # in R0 | |
| LM R1,R4,SVGB Load caller's regs | |
| L R14,SV14GB Load return addr | |
| BR R14 Return | |
| * | |
| GETB000 EQU * | |
| ST R14,SV14B0 Save return addr | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| LA R4,1 Starting relative block # | |
| * | |
| GETB010 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ GETB090 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> allocation map | |
| LA R15,4089 # of entries in map | |
| L R1,=X'FF000000' Set pad char=X'FF' | |
| CLCL R14,R0 Look for a non-FF entry | |
| BE GETB030 all FFs: We're full up in this block | |
| * | |
| LR R1,R14 Copy ptr to map byte | |
| S R1,BLOCK Compute offset from start | |
| SLL R1,3 Each map byte is 8 records | |
| AR R4,R1 Adjust relative block number for | |
| * byte position we located | |
| ICM R1,8,0(R14) Get map byte with the free bit | |
| LA R2,X'80' Create possible opposing bit | |
| * | |
| GETB020 EQU * | |
| SR R0,R0 Clear for shift use | |
| SLDL R0,1 Shift off one bit into R0 | |
| LTR R0,R0 Is this the zero bit? | |
| BZ GETB040 Yes | |
| SRL R2,1 Next opposing bit position | |
| LA R4,1(,R4) Compute next rel blk # | |
| B GETB020 Find that 0 bit | |
| * | |
| GETB030 EQU * | |
| LA R4,4089(,R4) Incr starting relative block # | |
| LA R3,1(,R3) Next map block key | |
| BCT R2,GETB010 Read next map block | |
| * | |
| ENDREQ RPL=(R7) No update | |
| SR R4,R4 Return no block #: ALL FULL | |
| SR R15,R15 No VSAM errors | |
| B GETB090 Done | |
| * | |
| SETMAP OI 0(R14),X'00' Executed instr | |
| * | |
| GETB040 EQU * | |
| EX R2,SETMAP Set the bit in allocation map | |
| * | |
| PUT RPL=(R7) Update the allocation map | |
| BAL R14,CHKRPL Deal with errors | |
| * | |
| GETB090 EQU * | |
| L R14,SV14B0 Load return addr | |
| BR R14 Return | |
| * | |
| * | |
| LTORG | |
| * | |
| WTOMSG WTO ' x | |
| ',MF=L | |
| WTOMSGL EQU *-WTOMSG | |
| * | |
| ENQ ENQ (0),MF=L | |
| ENQL EQU *-ENQ | |
| * | |
| DEQ DEQ (0),MF=L | |
| DEQL EQU *-DEQ | |
| * | |
| DS 0D | |
| NJE38Q DC CL8'NJE38' | |
| NJEDSN DC CL44'NJE38.NETSPOOL' | |
| * | |
| BLANKS DC CL120' ' | |
| NONBLANK DC 64X'FF',X'00',191X'FF' TR Table to locate nonblank | |
| BLANK DC 64X'00',X'FF',100X'00' TR Table to locate blanks | |
| TRTAB$ DC 91X'00',X'FF',164X'00' TR Table to locate '$' | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * NJE00920 | |
| * NJE00920 | |
| ********************* NJE00920 | |
| * * NJE00920 | |
| * N J E D I R * NJE00920 | |
| * * NJE00920 | |
| * Directory * NJE00920 | |
| * Management * NJE00920 | |
| * * NJE00920 | |
| ********************* NJE00920 | |
| * NJE00920 | |
| * | |
| NJEDIR CSECT NJE00020 | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDIR' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| STM R14,R12,12(R13) SAVE CMS REGS NJE00050 | |
| LR R12,R15 BASE NJE00060 | |
| USING NJEDIR,R12 ADDRESS IT NJE00070 | |
| USING NJEWK,R10 | |
| USING NCB,R9 | |
| * | |
| ST R13,NJEDIRSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJEDIRSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| L R11,=A(NJECMN) -> common csect | |
| ST R11,ANJECMN Save addr | |
| USING NJECMN,R11 | |
| * | |
| DIRADD EQU 0 Add new file to directory | |
| DIRDEL EQU 4 Purge a file from directory | |
| DIRLOC EQU 8 Locate a file by ID | |
| DIRLST EQU 12 List directory contents | |
| DIRUPD EQU 16 Update directory entry v120 | |
| * | |
| LR R2,R0 Copy entry code | |
| B *+4(R2) Branch into branch table | |
| B ADD000 0 Add a new directory entry | |
| B DEL000 4 Delete a directory entry | |
| B LOC000 8 Locate a file by ID | |
| B LST000 C List directory contents | |
| B UPD000 10 Update directory entry v120 | |
| * | |
| ADD000 EQU * | |
| LA R0,(10000/8)+1 Byte size of 10,000 bits | |
| ST R0,SPLIDLEN Save the length | |
| GETMAIN RU, Get stg for spool id bitmap x | |
| LV=(0) | |
| ST R1,SPLIDMAP Save stg addr | |
| LR R0,R1 Copy starting addr | |
| L R1,SPLIDLEN Get the length | |
| SR R15,R15 Set pad char | |
| MVCL R0,R14 Initialize the map | |
| * | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| MVC SPLID,SPLNUM Save the last assigned id # | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| * | |
| *-- R2 = starting block number of current directory | |
| *-- R3 = starting block number of replacement directory | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get a replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| *-- Copy all of the directory entries in the current directory over | |
| *-- to the (new) replacement directory (where we will eventually add | |
| *-- a new directory entry). Along the way, build a bit map of all | |
| *-- of the spool file numbers that are in use (they're in the | |
| *-- directory entries) so that we can assign a new unique file # to | |
| *-- the new file in its new directory entry. | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,BLOCK -> replacement directory | |
| L R8,NSRECNM-NSDIR(,R4) Get # directory entries current | |
| LA R1,1(,R8) +1 for new dir ent to be added | |
| ST R1,NSRECNM-NSDIR(,R4) Store (will get copied to repl) | |
| ST R3,NSBLK-NSDIR(,R4) Store starting blk of dir (will | |
| * get copied to replacement dir) | |
| * | |
| ADD050 EQU * | |
| CLC NSLEN-NSDIR(,R4),=X'FFFE' Ptr to next block? | |
| BE ADD100 yes | |
| MVC 0(NSDIRLN,R5),0(R4) Copy existing dir entry to repl | |
| * | |
| LH R7,NSID-NSDIR(,R4) Get file id # for this file | |
| SR R6,R6 Clear for divide | |
| D R6,=F'8' Get byte offset remainder bits | |
| * | |
| A R7,SPLIDMAP -> byte containing bit for | |
| * this file # | |
| LA R1,X'80' Create a bit | |
| SRL R1,0(R6) Adjust to bit for this file # | |
| EX R1,SPLSET Set the bit in the spool id map | |
| * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| LA R5,NSDIRLN(,R5) -> next replacement dir entry | |
| BCT R8,ADD050 Keep copying dir entries | |
| B ADD200 Go add the new dir entry | |
| * | |
| SPLSET OI 0(R7),X'00' Executed instr | |
| * | |
| * | |
| *-- Here if the directory continues onto another block. Get these | |
| *-- blocks, and continue processing individual entries. | |
| * | |
| ADD100 EQU * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update the replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| CLC NSLEN-NSDIR(,R5),=X'FFFE' Repl dir ptr to next block? | |
| BNE ADD190 No; we need to add a block | |
| * | |
| ADD120 EQU * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ICM R3,15,2(R5) Get ptr to next repl dir blk | |
| * | |
| ST R2,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get next replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,BLOCK -> replacement directory | |
| B ADD050 Continue processing | |
| * | |
| ADD190 EQU * | |
| L R3,KEY Get current blk # we just wrote | |
| * | |
| BAL R14,ADDBLK Allocate a new physical block | |
| BNZ ADD900 Exit with VSAM error | |
| LTR R6,R0 Is there a block number? | |
| BZ ADD910 No, NETSPOOL dataset full v130 | |
| * | |
| ST R3,KEY Gotta update blk again with ptr | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| MVC 0(2,R5),=X'FFFE' Insert ptr indic for next blk | |
| STCM R6,15,2(R5) Insert next block # | |
| B ADD100 Now go jump to next dir blks | |
| * | |
| *-- Here when all current directory entries have been copied to the | |
| *-- new (replacement) directory. Add the new directory entry for | |
| *-- the file just written out via PUT actions. | |
| * | |
| ADD200 EQU * | |
| L R1,BLOCKEND -> end of buffer | |
| SR R1,R5 Determine remaining space in blk | |
| LA R4,NSDIRLN Get size of directory entry | |
| LA R4,2+4(,R4) Add in overhead | |
| * +2 for n block marker | |
| * +4 for next block ptr | |
| CR R1,R4 Is there room to add entry? | |
| BL ADD300 No, better get another block | |
| * | |
| USING NSDIR,R5 | |
| XC NSDIR(NSDIRLN),NSDIR Init new entry | |
| MVC NSLEN,=Y(NSDIRLN) Set entry length | |
| MVC NSBLK,INITBLK Set starting blk# of the file | |
| L R6,NCBTAG -> TAG block for file | |
| USING TAG,R6 | |
| MVC NSINLOC(TAGUSELN),TAGINLOC Tag data to dir entry | |
| * | |
| L R1,SPLID Get last assigned file id # | |
| L R0,=F'10000' 10,000 possible spool ids | |
| * | |
| ADD250 EQU * | |
| LA R15,1(,R1) Choose next number | |
| C R15,=F'10000' At the limit? | |
| BL *+8 No | |
| LA R15,1 Reset to 1 | |
| LR R1,R15 Save next possible number | |
| * | |
| SR R14,R14 Clear for divide | |
| D R14,=F'8' Get byte offset remainder bits | |
| * | |
| A R15,SPLIDMAP -> byte containing bit for | |
| * this spool id # | |
| LA R7,X'80' Create a bit | |
| SRL R7,0(R14) Adjust to bit for this id # | |
| EX R7,TMBIT Check bit status in the bitmap | |
| BZ ADD260 Spool id not in use. take it | |
| BCT R0,ADD250 Else try next number | |
| SR R1,R1 Otherwise use id=0000 | |
| B ADD260 | |
| * | |
| TMBIT TM 0(R15),X'00' Executed instr | |
| * | |
| * | |
| * | |
| ADD260 EQU * | |
| ST R1,SPLID Save newly assigned spool id | |
| STCM R1,3,NSID Assign the file id # to file | |
| STCM R1,3,NCBFID Also put it in the NCB | |
| STCM R1,3,TAGID Also, put it in the tag data | |
| DROP R5,R6 NSDIR,TAG | |
| * | |
| LA R4,NSDIRLN(,R5) Skip past entry just added | |
| L R5,BLOCKEND -> end of block | |
| SR R5,R4 Compute length remaining in blk | |
| SR R15,R15 Set pad | |
| MVCL R4,R14 Clear to end of block | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update final replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| *-- Now update block 1 to activate the replacement directory | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R1,BLOCK -> blk #1 in stg | |
| USING BLKONE,R1 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| ST R3,DIRBLK Plug in alternate | |
| MVC SPLNUM,SPLID Save last assigned spool id | |
| DROP R1 | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update block 1 | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| B XITDIR Exit with RC=0 | |
| * | |
| *-- Here if there is no room in a directory block to add the new | |
| *-- file's directory entry. An additional block will be allocated and | |
| *-- chained to the directory entries. | |
| * | |
| ADD300 EQU * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Write back the dir block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| L R4,KEY Get current blk # we just wrote | |
| * | |
| BAL R14,ADDBLK Allocate a new physical block | |
| BNZ ADD900 Exit with VSAM error | |
| LTR R6,R0 Is there a block number? | |
| BZ ADD910 No, NETSPOOL dataset full v130 | |
| * | |
| ST R4,KEY Gotta update blk again with ptr | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| MVC 0(2,R5),=X'FFFE' Insert ptr indic for next blk | |
| STCM R6,15,2(R5) Insert next block # | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Write back the dir block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| ST R6,KEY Now point to newly obtained blk | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| SR R3,R3 Pad | |
| MVCL R0,R2 Clear it | |
| * | |
| L R5,BLOCK -> new block stg | |
| B ADD200 Try again to add new dir entry | |
| * | |
| ADD900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| ADD910 EQU * No space in NETSPOOL | |
| MVC NCBRTNCD(2),=X'0C03' Set to 12,3 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Return that notice | |
| * | |
| * | |
| * | |
| * | |
| * | |
| DEL000 EQU * | |
| GETMAIN RU, Get stg for alloc bitmap x | |
| LV=16384 | |
| STM R0,R1,SPLIDLEN Save len,addr | |
| * | |
| L R7,RPL -> RPL | |
| MODCB RPL=(R7), x | |
| OPTCD=(KEY,DIR,MVE,UPD), Update mode x | |
| MF=(G,MACLIST) | |
| * | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| L R4,SPLIDMAP -> receiving stg area | |
| * | |
| DEL020 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> block just read | |
| LA R15,4089 # of bytes in block | |
| LR R5,R15 Copy len | |
| MVCL R4,R14 Move alloc bitmap to stg area | |
| * | |
| LA R3,1(,R3) Next block number of alloc map | |
| BCT R2,DEL020 Go read them all | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| DROP R2 | |
| * | |
| *-- R2 = starting block number of current directory | |
| *-- R3 = starting block number of replacement directory | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get a replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| *-- Current directory is in BUFF | |
| *-- Replacement directory will be in PTRBUF | |
| * | |
| * | |
| *-- Copy all of the directory entries in the current directory over | |
| *-- to the (new) replacement directory (where we will eventually delete | |
| *-- a directory entry). Along the way, look for the entry to be | |
| *-- purged. | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,PTRBUF -> replacement directory | |
| L R8,NSRECNM-NSDIR(,R4) Get # directory entries current | |
| LR R1,R8 Copy count | |
| BCTR R1,0 Reduce for to-be-deleted file | |
| ST R1,NSRECNM-NSDIR(,R4) Store (will get copied to repl) | |
| ST R3,NSBLK-NSDIR(,R4) Store starting blk of dir (will | |
| * get copied to replacement dir) | |
| L R6,NCBTAG -> TAG data | |
| LH R6,TAGID-TAG(,R6) Get file id number | |
| XC INITBLK,INITBLK Clear file's starting blk # | |
| * | |
| DEL050 EQU * | |
| CLC NSLEN-NSDIR(,R4),=X'FFFE' Ptr to next block? | |
| BE DEL100 yes | |
| CH R6,NSID-NSDIR(,R4) Is this the file to be purged? | |
| BE DEL070 | |
| CLC NSLEN-NSDIR(,R5),=X'FFFE' Ptr to next block? | |
| BE DEL120 yes | |
| MVC 0(NSDIRLN,R5),0(R4) Copy existing dir entry to repl | |
| LA R5,NSDIRLN(,R5) -> next replacement dir entry | |
| * | |
| DEL060 EQU * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| BCT R8,DEL050 Keep copying dir entries | |
| B DEL200 Done with copy | |
| * | |
| DEL070 EQU * | |
| MVC INITBLK,NSBLK-NSDIR(R4) Save starting block # of file | |
| B DEL060 Continue copy | |
| * | |
| * | |
| *-- Get next current dir block (move it to BUFF) | |
| * | |
| DEL100 EQU * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| * | |
| ST R2,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| L R4,BUFF -> current directory | |
| B DEL050 Continue with copy | |
| * | |
| *-- Get next replacement dir block | |
| *-- 1. Write back the replacement we've been copying to (from PTRBUF) | |
| *-- 2. Get next block | |
| *-- 3. Move it to PTFBUF | |
| * | |
| DEL120 EQU * | |
| ST R3,KEY Set blk# of repl dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R0,R14 Move data to i/o buffer | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update the replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| ICM R3,15,2(R5) Get ptr to next current dir blk | |
| * | |
| ST R3,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| L R5,PTRBUF -> replacement directory | |
| B DEL050 Continue with copy | |
| * | |
| *-- Fix up the last replacement dir block | |
| * | |
| DEL200 EQU * | |
| L R1,PTRBUF -> start of buffer | |
| LA R15,4088(,R1) -> end of that buffer - 1 | |
| * | |
| DEL210 EQU * | |
| CR R1,R15 Past end of buffer? | |
| BH DEL230 Y, done searching | |
| CLC 0(2,R1),=X'FFFE' Left over pointer indicator? | |
| BE DEL220 Yes | |
| LA R1,NSDIRLN(,R1) Next dir entry position | |
| B DEL210 | |
| * | |
| DEL220 EQU * | |
| ICM R7,15,2(R1) Pick up the left over block # | |
| BAL R14,FREBLK Go free the block in R7 | |
| * | |
| DEL230 EQU * | |
| LR R0,R5 -> end of used part of ptrbuf | |
| L R1,PTRBUF -> start of buffer | |
| LA R1,4089(,R1) -> end of that buffer | |
| SR R1,R5 Compute length to clear | |
| SR R15,R15 Compute length to write out | |
| MVCL R0,R14 Clear to end of block | |
| * | |
| ST R3,KEY Set blk# of repl dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Re-get for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R0,R14 Move repl data to i/o buffer | |
| * | |
| PUT RPL=(R7) Update the last repl block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| *-- DEL300 is used to free all of the blocks used by the file itself | |
| * | |
| DEL300 EQU * | |
| ICM R7,15,INITBLK Get 1st block # of deleted file | |
| BZ DEL910 If 0, file # wasn't found | |
| * | |
| DEL310 EQU * | |
| ST R7,KEY Set block retreival key | |
| BAL R14,FREBLK Mark the block as free in bitmap | |
| * | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R4,BLOCK -> ptr block ptrs | |
| LA R5,4084(,R4) -> end of ptr block ptrs | |
| * | |
| DEL330 EQU * | |
| ICM R7,15,0(R4) Get a block # | |
| BZ DEL350 Done with ptrs | |
| BAL R14,FREBLK Free the block | |
| LA R4,4(,R4) -> next ptr field | |
| CR R4,R5 At end of ptr block? | |
| BL DEL330 | |
| * ** Here if ptr block chains to | |
| * another ptr block | |
| CLI 0(R4),X'FE' Ptr to ptr blk indicator? | |
| BNE DEL350 No, we've processed last ptr | |
| SR R7,R7 Clear for IC | |
| ICM R7,7,1(R4) Get ptr to next ptr block | |
| B DEL310 | |
| * | |
| *-- Write back the allocation map | |
| * | |
| DEL350 EQU * | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| L R4,SPLIDMAP -> map stg area | |
| * | |
| DEL360 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> block just read | |
| LA R15,4089 # of bytes in block | |
| LR R5,R15 Copy len | |
| MVCL R14,R4 Move alloc bitmap to i/o buffer | |
| * | |
| PUT RPL=(R7) Put the map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| LA R3,1(,R3) Next block number of alloc map | |
| BCT R2,DEL360 Go read them all | |
| * | |
| *-- Now update block 1 to activate the replacement directory | |
| * | |
| DEL400 EQU * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R1,BLOCK -> blk #1 in stg | |
| USING BLKONE,R1 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| ST R3,DIRBLK Plug in alternate | |
| DROP R1 | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update block 1 | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| B XITDIR Exit with RC=0 | |
| * | |
| DEL900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| DEL910 EQU * ** Here if directry entry not found | |
| MVC NCBRTNCD(2),=X'0C04' Set to 12,4 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| *-- Free a block (mark it available in the allocation bitmap) | |
| * | |
| *-- Entry: R7 = block # | |
| * | |
| FREBLK EQU * | |
| BCTR R7,0 Make blk # relative to 0 | |
| SR R6,R6 Clear for divide | |
| D R6,=F'8' Get byte offset remainder bits | |
| * | |
| A R7,SPLIDMAP -> byte containing bit for | |
| * this block | |
| LA R1,X'80' Create a bit | |
| SRL R1,0(R6) Adjust to bit for this blk # | |
| LA R0,X'FF' Create AND mask | |
| XR R1,R0 Compute mask to turn a bit off | |
| EX R1,FREBIT Turn off the bit in the bitmap | |
| BR R14 Return | |
| * | |
| FREBIT NI 0(R7),X'00' Executed instr | |
| * | |
| * | |
| * | |
| * LOC000 - FIND a file by id in the directory. v120 | |
| * UPD000 - UDIR update a directory entry for a specific file. v120 | |
| * | |
| * | |
| *-- UDIR functionality only updates the destination node id and v120 | |
| *-- destination user id within the directory entry from v120 | |
| *-- the TAG data supplied by the caller. No other directory v120 | |
| *-- fields are altered. v120 | |
| * | |
| * | |
| LOC000 EQU * | |
| UPD000 EQU * v120 | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| * | |
| * | |
| L R4,BLOCK -> current directory | |
| USING NSDIR,R4 | |
| L R8,NSRECNM Get # directory entries current | |
| * | |
| L R6,NCBTAG -> TAG data | |
| USING TAG,R6 | |
| XC INITBLK,INITBLK Clear file's starting blk # | |
| * | |
| LOC050 EQU * | |
| CLC NSLEN,=X'FFFE' Ptr to next block? | |
| BNE LOC060 No | |
| * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ST R2,KEY Get next current dir block | |
| * | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| L R4,BLOCK -> next directory block | |
| * | |
| LOC060 EQU * | |
| CLC TAGID,NSID Is this the file we need? | |
| BE LOC070 | |
| * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| BCT R8,LOC050 Keep looking | |
| B LOC100 Done with search | |
| * | |
| LOC070 EQU * | |
| CLI NCBREQ,NCBUDIR Is this UDIR function? v120 | |
| BE UPD100 Yes v120 | |
| * | |
| MVC INITBLK,NSBLK Save starting block # of file | |
| MVC TAGINLOC(TAGUSELN),NSINLOC Return the tag data to callr | |
| * | |
| * | |
| LOC100 EQU * | |
| ENDREQ RPL=(R7) Release the get-for-update | |
| * | |
| NC INITBLK,INITBLK Did we find a file? | |
| BZ LOC910 No, exit with not found error | |
| SR R15,R15 Set RC to 0 | |
| B XITDIR | |
| * | |
| * | |
| UPD100 EQU * v120 | |
| MVC NSTOLOC,TAGTOLOC Update destination node id v120 | |
| MVC NSTOVM,TAGTOVM Update destination user id v120 | |
| MVC TAGINLOC(TAGUSELN),NSINLOC Rtrn tag data to caller v120 | |
| MVC INITBLK,NSBLK Save file's startinblock # v120 | |
| * | |
| PUT RPL=(R7) Update the directory v120 | |
| BAL R14,CHKRPL Deal with errors v120 | |
| BNZ LOC900 Exit if VSAM error v120 | |
| B XITDIR | |
| * | |
| DROP R6 TAG v120 | |
| DROP R4 NSDIR v120 | |
| * | |
| * | |
| LOC900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| LOC910 EQU * ** Here if directry entry not found | |
| MVC NCBRTNCD(2),=X'0C04' Set to 12,4 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| * | |
| * | |
| * | |
| * | |
| LST000 EQU * | |
| XC LISTLEN,LISTLEN Ensure no stray len | |
| XC LISTADDR,LISTADDR Ensure no stray address | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R3,ALMBLK Get blk# of alloc map v200 | |
| L R8,MAXBLK Get blk# in dataset v200 | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| * | |
| *-- Compute spool percentage full from alloc map v200 | |
| * | |
| SR R5,R5 Init blks used counter v200 | |
| LR R6,R8 Copy max blocks in dataset v200 | |
| SRL R6,3 divide by 8 # map bytes represent'g blksv200 | |
| * | |
| LST010 EQU * v200 | |
| ST R3,KEY Get a block of map v200 | |
| L R7,RPL -> RPL v200 | |
| GET RPL=(R7) Get a map block v200 | |
| BAL R14,CHKRPL Deal with errors v200 | |
| BNZ LST900 Exit with VSAM error v200 | |
| * v200 | |
| SR R0,R0 Clear for IC work v200 | |
| L R15,BLOCK -> record v200 | |
| LA R14,4089 # bytes to process v200 | |
| * | |
| LST020 EQU * v200 | |
| CLI 0(R15),X'00' Map byte unallocated? v200 | |
| BE LST050 Dont count any v200 | |
| CLI 0(R15),X'FF' Map byte fully allocated? v200 | |
| BE LST060 Yes, count 8 blocks v200 | |
| LA R4,8 # bits in a byte v200 | |
| IC R0,0(,R15) Get a map byte v200 | |
| * | |
| LST030 EQU * v200 | |
| SR R1,R1 Clear for shift v200 | |
| SRDL R0,1 Move a bit into R1 v200 | |
| LTR R1,R1 Was the bit=1? v200 | |
| BZ LST040 No, dont count it v200 | |
| LA R5,1(,R5) Count the block bit v200 | |
| * | |
| LST040 EQU * v200 | |
| BCT R4,LST030 Scan whole byte v200 | |
| * | |
| LST050 EQU * v200 | |
| BCT R6,LST070 # map bytes remaining to scnv200 | |
| B LST080 Done counting v200 | |
| * | |
| LST060 EQU * v200 | |
| LA R5,8(,R5) All 8 blocks allocated v200 | |
| B LST050 Decr remaining and continue v200 | |
| * | |
| LST070 EQU * v200 | |
| LA R15,1(,R15) -> next map byte v200 | |
| BCT R14,LST020 Keep scanning v200 | |
| LA R3,1(,R3) Bump alloc map block number v200 | |
| B LST010 Get another map block v200 | |
| * | |
| LST080 EQU * v200 | |
| MH R5,=Y(100) Blocks used: prep for % calcv200 | |
| SR R4,R4 Clear for divide v200 | |
| DR R4,R8 Compute % full v200 | |
| AR R4,R4 Double remainder v200 | |
| CR R4,R8 Do we need to round up? v200 | |
| BL LST090 No v200 | |
| LA R5,1(,R5) Round up percent full v200 | |
| * | |
| LST090 EQU * v200 | |
| STH R5,NCBPCT Return % full in NCB v200 | |
| * | |
| *-- Retrieve directory contents v200 | |
| * | |
| LST100 EQU * | |
| ST R2,KEY Get a current dir block | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| * | |
| * | |
| L R4,BLOCK -> current directory | |
| USING NSDIR,R4 | |
| L R8,NSRECNM Get # directory entries | |
| BCTR R8,0 Less 1 for directory itself | |
| STCM R8,3,NCBRECCT Set entries count in NCB | |
| LTR R8,R8 Were there any entries? | |
| BZ LST910 No | |
| SR R0,R0 Clear for multiply | |
| LA R1,NSDIRLN Length of directory entry | |
| MR R0,R8 Compute size of area needed | |
| LR R0,R1 Copy size to r0 | |
| GETMAIN RU, Get stg area to hold entries x | |
| LV=(0) | |
| STM R0,R1,LISTLEN | |
| LR R5,R1 -> where to place entries | |
| LA R4,NSDIRLN(,R4) Skip over directory's own entry | |
| * | |
| * | |
| LST150 EQU * v200 | |
| CLC NSLEN,=X'FFFE' Ptr to next block? | |
| BNE LST160 No v200 | |
| * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ST R2,KEY Get next current dir block | |
| * | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| L R4,BLOCK -> next directory block | |
| * | |
| LST160 EQU * v200 | |
| MVC 0(NSDIRLN,R5),0(R4) Move directory entry to stg area | |
| LA R4,NSDIRLN(,R4) -> next dir entry | |
| LA R5,NSDIRLN(,R5) -> next stg area slot | |
| BCT R8,LST150 Keep loading v200 | |
| * | |
| DROP R4 NSDIR | |
| * | |
| * | |
| LST200 EQU * v200 | |
| ENDREQ RPL=(R7) Release the get-for-update | |
| * | |
| MVC NCBAREA,LISTADDR Return list stg addr | |
| MVC NCBAREAL,LISTLEN Return list stg len | |
| MVC NCBRECLN,=Y(NSDIRLN) Return size of each dir entry | |
| SR R15,R15 Set RC to 0 | |
| B XITDIR | |
| * | |
| * | |
| LST900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| LM R0,R1,LISTLEN Get stg area len, addr | |
| LTR R0,R0 Is there an area? | |
| BZ XITDIR No | |
| FREEMAIN RU,LV=(0),A=(1) Else free it | |
| SR R15,R15 Clear for RC | |
| IC R15,NCBRTNCD Reinsert RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| LST910 EQU * ** Here if no files queued | |
| ENDREQ RPL=(R7) Release the get-for-update v130 | |
| XC NCBAREA,NCBAREA No directory list obtained v110 | |
| MVC NCBRTNCD(2),=X'0C06' Set to 12,6 code | |
| LA R15,12 Set RC | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| B XITDIR Exit with RC in R15 | |
| * | |
| * | |
| XITDIR EQU * | |
| LR R5,R15 Any RC value to R5 | |
| BAL R14,DEQ000 Release the ENQ | |
| * | |
| ICM R1,15,SPLIDMAP Get spool id bitmap stg addr | |
| BZ XITDIR10 Don't have a map | |
| L R0,SPLIDLEN Size of bitmap | |
| FREEMAIN RU,LV=(0),A=(1) Free the bitmap | |
| XC SPLIDMAP,SPLIDMAP Clear unsed ptr | |
| * | |
| XITDIR10 EQU * | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| * | |
| ST R5,16(,R13) Set RC in R15 | |
| LM R14,R12,12(R13) Reload callers's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| * NJE00290 | |
| LTORG | |
| DROP R12 | |
| * NJE00290 | |
| **** Main work area common NJE00290 | |
| **** to all NJExxx CSECTs. NJE00290 | |
| * NJE00290 | |
| NJEWK DSECT | |
| NJEEYE DS CL4'NSPL' Eyecatcher | |
| NJEWKLEN DS F Getmain size of this area | |
| NSOWN DS A -> TCB of caller | |
| ANJECMN DS A -> NJECNM common csect NJE00320 | |
| * | |
| DBLE DS D Work area NJE00310 | |
| TWRK DS 2D Work area | |
| * | |
| MACLIST DS XL160 Macro expansion area | |
| * | |
| SV14 DS A R14 save area | |
| SV14GB DS A R14 save area | |
| SV14B0 DS A R14 save area | |
| SVGB DS 4F R1-R4 save area | |
| SPLIDLEN DS F Length of spool id bitmap stg | |
| SPLIDMAP DS A -> Spool file id bitmap | |
| SPLID DS F Last assigned spool id number | |
| LISTLEN DS F Length of contents stg area | |
| LISTADDR DS A -> directory contents stg area | |
| * | |
| BLOCK DS A -> buffer for NETSPOOL VSAM i/o | |
| BLOCKEND DS A -> end of BLOCK (BLOCK+4089) | |
| PTRBUF DS A -> buffer for NJESPOOL ptr use | |
| PTRBUFEN DS A -> end of PTRBUF (PTRBUF+4089) | |
| BUFF DS A -> buffer for NJESPOOL use | |
| BUFFEND DS A -> end of BUFF (BUFF+4089) | |
| * | |
| * | |
| INITBLK DS F Blk # of first block to be written | |
| * for a new file | |
| PTRBLK DS F Blk # of current phys record for | |
| * pointer block (NCBGET/NCTPUT) | |
| NEWBLK DS F Blk # of current phys record for | |
| * logical i/o (NCBGET/NCTPUT) | |
| PUTPOS DS A Current write position in BUFF (next | |
| * available write position) | |
| GETPOS DS A Current read position in BLOCK (next | |
| * available read position) | |
| PTRPOS DS A Current write position in PTRBUF | |
| * (next available write position) | |
| PUTCNT DS F Number of logical records written | |
| GETCNT DS F Number of logical records read | |
| GETLIM DS F Max logical records in GET file | |
| * | |
| KEY DS F Relative block number key | |
| ACBL DS F ACB length | |
| ACB DS A -> ACB | |
| RPLL DS F RPL length | |
| RPL DS A -> RPL | |
| * | |
| NJFL1 DS X Flag bits | |
| NJF1OACB EQU X'80' 1... .... NETSPOOL ACB is open | |
| NJF1ENQ EQU X'40' .1.. .... Exclusive control of NETSPOOL | |
| NJF1WPND EQU X'20' ..1. .... Physical write is pending | |
| NJF1DPND EQU X'10' ...1 .... Directory add is pending | |
| NJF1PUT EQU X'02' .... ..1. Processing PUTs to file | |
| NJF1GET EQU X'01' .... ...1 Processing GETs from file | |
| * .... xx.. Available | |
| * | |
| NJFL2 DS X Flag bits | |
| NJFL3 DS X Flag bits | |
| NJFL4 DS X Flag bits | |
| * | |
| * | |
| * | |
| * | |
| NJESA DS 18F NJESPOOL OS save area NJE00300 | |
| NJEDIRSA DS 18F NJEDIR OS save area NJE00300 | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEWK | |
| * NJE00930 | |
| * | |
| BLKONE DSECT ** Maps block #1 in NETSPOOL | |
| DIRBLK DS F Block number of current directry | |
| ALMBLK DS F Block number of allocation map | |
| MAXBLK DS F Highest block number in NETSPOOL | |
| SPLNUM DS F Last assigned spool file # | |
| BLKONESZ EQU *-BLKONE Size of dsect | |
| * NJE00930 | |
| * | |
| TYPPRT EQU X'40' PRT dev | |
| TYPPUN EQU X'80' PUN dev | |
| COPY NETSPOOL | |
| COPY TAG | |
| * | |
| IFGACB | |
| IFGRPL | |
| * | |
| END NJESPOOL NJE01000 | |
| ./ ADD NAME=NJEINIT | |
| * | |
| * | |
| *-- NJE38 - Initialization and start up | |
| * | |
| * | |
| * | |
| * Change log: | |
| * | |
| * | |
| * 03 Mar 22 - Avoid 0C4 if no links in CONFIG, APF check, F NJE. v230 | |
| * 10 Dec 20 - Support for registered users and message queuing v220 | |
| * 04 Dec 20 - Expanded internal trace table support v212 | |
| * 29 Nov 20 - Use text-based configuration; alternate routes v211 | |
| * 02 Oct 20 - Use actual length for MGCR SEND cmds v210 | |
| * 01 Oct 20 - Put ENQ existence check in common module v210 | |
| * 10 Aug 20 - Use single NJESPOOL load for all STC NJE38 modules. v210 | |
| * 22 Jul 20 - Make non-swappable to eliminate long-wait delays v200 | |
| * 21 Jul 20 - Slightly delay auto-start of links on start-up. v200 | |
| * 02 Jul 20 - Default userid to CSA in support of TRANSMIT/RECEOVE v200 | |
| * 20 May 20 - Dont pass new file WREs for local node to cmd proc'g v120 | |
| * 05 May 20 - Abend SD23 if SVC 34 parmlist >=130 bytes. v102 | |
| * 04 May 20 - Show CONFIG assembly date and time on start up. v102 | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| PRINT GEN | |
| REGEQU REGISTER EQUATES | |
| GBLC &VERS | |
| * | |
| * User abend codes | |
| * U0038 - Unsupported/unrecognized CIB | |
| * U0039 - VSAM error on NETSPOOL | |
| * | |
| * MSG numbers used: | |
| * | |
| * 0-34 used | |
| * 35 - 39 available | |
| * 42-79 used | |
| * 163 used | |
| * | |
| *-- Program limits | |
| * | |
| TRACESZ EQU 64 Size in K of trace table v212 | |
| RQELIM EQU 256 # of preallocated RQEs | |
| * | |
| * | |
| NJEINIT CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) SAVE CMS REGS | |
| LR R12,R15 BASE | |
| USING NJEINIT,R12 ADDRESS IT | |
| * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEMWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJEM' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| * | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| ST R11,ANJECOM Save in main work area | |
| MVC CMDBLNK,BLANKS Init field | |
| MVC RELAYID,=CL8'RELAY' Set RELAY entity id v220 | |
| LA R1,LINKS -> LINKTABL anchor word v211 | |
| ST R1,ALINKS Plug it into param list v211 | |
| LA R1,ROUTES -> RTE anchor word v211 | |
| ST R1,AROUTES Plug it into param list v211 | |
| LA R1,AUTHS -> AUTHLIST anchor word v211 | |
| ST R1,AAUTHS Plug it into param list v211 | |
| LA R1,REGUSER -> REGUSER anchor word v220 | |
| ST R1,AREGUSER Plug it into param list v220 | |
| * | |
| INIT000 EQU * v200 | |
| SR R1,R1 Dont return spool DSN v210 | |
| L R15,=V(NJESYS) -> ENQ finder v210 | |
| BALR R14,R15 Check if NJE38 already act v210 | |
| LTR R15,R15 Look for RC=0=ENQ was found v210 | |
| BZ ERR999 Branch if NJE38 active v210 | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE000I),NJE000I NJE38 v xx.xx | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| TESTAUTH FCTN=1 Are we authorized on entry? v230 | |
| LTR R15,R15 Check result v230 | |
| BZ INIT005 Branch if authorized v230 | |
| WTO 'NJE034I NJE38 is not APF-authorized' v230 | |
| B QUIT000 v230 | |
| * | |
| INIT005 EQU * v230 | |
| SR R1,R1 v200 | |
| SYSEVENT TRANSWAP v200 | |
| CLM R1,1,=X'00' SYSEVENT RC=0? v200 | |
| BE INIT010 Yes v200 | |
| WTO 'NJE032I NJE38 could not enter non-swappable state' v200 | |
| B INIT020 v200 | |
| * | |
| INIT010 EQU * v200 | |
| WTO 'NJE031I NJE38 is non-swappable' v200 | |
| * | |
| INIT020 EQU * v200 | |
| MVC MACLIST(ESTAEL),ESTAE Move ESTAE parm list | |
| L R6,=A(NJEDMP) Point to local ESTAE rtn | |
| ESTAE (R6), Issue ESTAE X | |
| CT, X | |
| TERM=YES, X | |
| PARAM=(R10), PARAM is work area address X | |
| MF=(E,MACLIST) | |
| * | |
| *-- Scan the configuration and build control blocks | |
| * | |
| MODESET MODE=SUP | |
| SR R0,R0 R0=0 scan entire configuration | |
| LA R1,INITPARM -> parm list to pass to NJESCN | |
| L R15,=V(NJESCN) | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ QUIT000 | |
| * | |
| L R1,LINKS Get LINKTABL anchor v210 | |
| USING LINKTABL,R1 | |
| MVC LCLNODE,LINKID Set LCLNODE in param list v210 | |
| DROP R1 | |
| * | |
| *-- Issue STIMER for keep alive to avoid S 522 abends | |
| * | |
| L R0,=A(NJETMR) -> Timer expiration exit | |
| L R1,=A(INTVL) -> interval | |
| STIMER REAL, Set timer X | |
| (0), X | |
| DINTVL=(1) | |
| * | |
| LOAD EP=NJESPOOL Load spool interface v210 | |
| ST R0,ANJESPL Store entry addr v210 | |
| * | |
| LOAD EP=NJECMX Load command processor | |
| ST R0,ANJECMX Store entry addr of processor | |
| * | |
| BAL R14,NET000 Check NETSPOOL status | |
| BNZ QUIT000 Exit if NETSPOOL is not ready | |
| * | |
| INIT030 EQU * | |
| MODESET MODE=SUP,KEY=ZERO | |
| L R1,PSATOLD-PSA(0) v230 | |
| L R1,TCBJSCB-TCB(,R1) v230 | |
| L R1,JSCBCSCB-IEZJSCB(,R1) v230 | |
| USING CSCB,R1 v230 | |
| MVC CHUNIT(3),=C'NJE' v230 | |
| DROP R1 v230 | |
| * | |
| STIDP CPUID Get the CPU ID | |
| * | |
| GETMAIN RU, Get CSA communication area x | |
| LV=NJ38CSAZ, x | |
| SP=241 | |
| * | |
| ST R1,CSABLK Save addr of CSA stg area | |
| USING NJ38CSA,R1 | |
| XC 0(NJ38CSAZ,R1),0(R1) Clear area | |
| MVC NJ38NODE,LCLNODE Local node name to CSA | |
| MVC NJ38DUSR,DEFUSER Default userid to CSA v200 | |
| MVC NJ38ASCB,PSAAOLD-PSA(0) Move ASCB addr of this space | |
| LA R2,NJ38ECB -> cross memory ECB | |
| ST R2,CSAECBAD Save address locally | |
| DROP R1 NJ38CSA | |
| * | |
| SPKA X'80' Back to user key | |
| * | |
| MVC NJERNAME(8),NJERCON Set rname constant | |
| MVC NJERNAME+8(4),CSABLK CSA stg addr to Rname | |
| * JFCB DSN should already be here | |
| LA R5,NJERNAME | |
| MVC MACLIST(ENQL),ENQ Move macro model | |
| * | |
| ENQ (NJE38Q,(5),E,56,SYSTEM), x | |
| RET=NONE, x | |
| MF=(E,MACLIST) | |
| OI NJFL1,NJF1ENQ Set NJE38 ENQ active | |
| * | |
| GETMAIN RU, Preallocate RQE storage x | |
| LV=RQESZ*RQELIM | |
| ST R1,ARQESTG Save the address | |
| LR R2,R1 Copy length | |
| LR R1,R0 Copy length | |
| LR R0,R2 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the stg | |
| LA R0,RQELIM Get RQE limit | |
| ST R0,RQENUM Save the value | |
| * | |
| * | |
| *- Build trace table v212 | |
| * | |
| GETMAIN RU, Get stg for trace table v212X | |
| LV=TRACESZ*1024, v212X | |
| BNDRY=PAGE v212 | |
| ST R1,ATRACE Save ptr to trace table v212 | |
| MVC 0(5,R1),=CL5'TRACE' v212 | |
| MVI 5(R1),C'T' So eyecatcher TRACETAB v212 | |
| MVI 6(R1),C'A' wont show in a dump v212 | |
| MVI 7(R1),C'B' in this load module v212 | |
| USING TRCCTL,R1 v212 | |
| ST R1,TRCSTRT Set start v212 | |
| ST R1,TRCCURR Set current v212 | |
| AR R0,R1 -> end v212 | |
| ST R0,TRCEND Set end v212 | |
| L R15,=A(NJETRC) -> Trace CSECT v212 | |
| ST R15,TRCRTN Set trace routine EPA v212 | |
| DROP R1 v212 | |
| * | |
| * | |
| *-- Initialize console processing to allow MVS modify and stop | |
| *-- commands to control this address space | |
| * | |
| INIT040 EQU * | |
| MVC MACLIST(EXTRACTL),EXTRACT Move macro model | |
| LA R3,COMMAREA -> area to place comm area addr | |
| EXTRACT (3), Get ptr to comm area X | |
| FIELDS=COMM, X | |
| MF=(E,MACLIST) | |
| * | |
| L R3,COMMAREA -> ptrs to COMM CIB and ECB | |
| USING IEZCOM,R3 Map the communication area | |
| MVC COMMECBA,COMECBPT Save off addr of COMM ECB | |
| ICM R4,15,COMCIBPT Get addr of CIB ptr | |
| BZ INIT060 No CIB, go get one | |
| USING CIBNEXT,R4 Map the CIB | |
| * | |
| CLI CIBVERB,CIBSTART Is this a START CIB? | |
| BNE INIT060 No, set up CIB count | |
| * | |
| QEDIT ORIGIN=COMCIBPT, Free the CIB from the START cmd X | |
| BLOCK=(4) that started this space | |
| * | |
| INIT060 EQU * | |
| QEDIT ORIGIN=COMCIBPT, Set CIB limit to 1 X | |
| CIBCTR=1 | |
| DROP R4 IEZCIB | |
| DROP R3 IEZCOM | |
| * | |
| * | |
| * | |
| *- Initialization Completed | |
| * | |
| INIT090 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE001I),NJE001I Move msg text | |
| MVC MACLIST+51(8),LCLNODE | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| *- Start any auto-startable links | |
| * | |
| * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| ICM R2,15,LNEXT -> first remote link v22x | |
| BZ MAIN000 No auto if no links v22x | |
| * | |
| AUTO000 EQU * | |
| TM LFLAG,LAUTO Is link autostartable? | |
| BZ AUTO010 No | |
| BAL R14,SLNK000 Try to start the link | |
| * | |
| STIMER WAIT,DINTVL=ATTDLY Pause briefly v200 | |
| * | |
| AUTO010 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ AUTO000 Look for another link | |
| DROP R2 LINKTABL | |
| * | |
| * | |
| * | |
| MAIN000 EQU * | |
| BAL R14,BLDL000 Go build the ECB list | |
| BZ QUIT000 No ECBS in list; terminate | |
| * | |
| SPKA 0 Use key 0 for CSA ECB | |
| WAIT 1,ECBLIST=ECBLIST | |
| * | |
| *-- Identify the ECB that was posted | |
| * | |
| MAIN010 EQU * | |
| LA R1,ECBLIST -> our ECBLIST | |
| * | |
| MAIN050 EQU * | |
| ICM R2,15,0(R1) -> ECB v211 | |
| BZ MAIN055 Skip ECB if empty slot v211 | |
| TM 0(R2),X'40' Was this ECB posted? | |
| BO MAIN060 Yes | |
| * | |
| MAIN055 EQU * v211 | |
| TM 0(R1),X'80' Last ECB addr in list? | |
| BO MAIN000 Nothing to do, go WAIT | |
| LA R1,4(,R1) -> next ECB addr | |
| B MAIN050 Keep looking | |
| * | |
| * | |
| MAIN060 EQU * | |
| CLM R2,7,CSAECBAD+1 Was the WRE work ECB posted? | |
| BE WRK000 Hey! We have something to do | |
| * | |
| SPKA X'80' Back to user key for the rest | |
| CLM R2,7,COMMECBA+1 Was the COMM ECB posted? | |
| BE COMM000 Yes | |
| * | |
| *** L R3,0(,R2) Load the ECB content v211 | |
| XC 0(4,R2),0(R2) Clear the ECB | |
| LA R0,LTRMECB-LINKTABL Offset of ECB in LINKTABL v211 | |
| SR R2,R0 -> LINKTABL entry v211 | |
| USING LINKTABL,R2 | |
| *** CLM R3,7,=AL3(255) ECB post code 255? v211 | |
| *** BE MAIN080 Yes, LINKTABL entry delete v211 | |
| * | |
| DETACH LTCBA Detach the subtask | |
| XC LTCBA,LTCBA Mark task terminated | |
| MVI LFLAG,X'00' Clear status flags | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE010I),NJE010I Line is drained | |
| UNPK DBLE(4),LACTLINE(3) Convert CUU of line | |
| TR DBLE(3),HEXTRAN-240 | |
| MVC MACLIST+17(3),DBLE | |
| WTO ,MF=(E,MACLIST) Line xxx is drained | |
| B MAIN010 Look for more work | |
| * | |
| *-- Here to delete a LINKTABL entry (from LINK OFF command) v211 | |
| *-- We arrive here from POST code 255. NJESCN LOFF000 does the POSTv211 | |
| * | |
| DROP R2 LINKTABL v211 | |
| * | |
| *-- Build a new ECBLIST before the wait | |
| * | |
| BLDL000 EQU * | |
| SR R1,R1 Init: no ECBs in list | |
| LA R15,ECBLIST-4 -> 0th ECB list entry | |
| TM NJFL1,NJF1STOP Is main task termination set? | |
| BO BLDL010 Yes, dont add COMM ECBs to list | |
| LA R15,4(,R15) -> next available ECB list slot | |
| L R1,COMMECBA -> COMM ECB | |
| ST R1,0(,R15) Set addr in ECB list | |
| LA R15,4(,R15) -> next available ECB list slot | |
| L R1,CSAECBAD -> WRE work ECB | |
| ST R1,0(,R15) Set addr in ECB list | |
| * | |
| BLDL010 EQU * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| BLDL020 EQU * | |
| CLC LTCBA,=A(0) Is task active for link? | |
| BE BLDL030 Zero, skip this one | |
| LA R15,4(,R15) -> next available ECB list slot | |
| LA R1,LTRMECB -> task's termination ECB | |
| ST R1,0(,R15) Set ECB addr in ECB list | |
| * | |
| BLDL030 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ BLDL020 Scan them all | |
| DROP R2 LINKTABL | |
| LTR R1,R1 Any ECB in the list? | |
| BZR R14 No, return with CC=0 set | |
| OI 0(R15),X'80' Mark end of list | |
| BR R14 Return with ECB list built | |
| * | |
| ********************************************************************** | |
| * * | |
| * WRE FLOWS * | |
| * * | |
| ********************************************************************** | |
| * | |
| * When WREs are created by out-of-address space tasks (such as by | |
| * modules NJE38 by TSO users, or NJ38XMIT by jobs) they are | |
| * created in CSA and chained off the NJE38 CSA block NJ38CSA. The | |
| * WRE ECB is posted via cross memory post. Any WRE posted in this | |
| * manner will first end up here, at WRK000 below. | |
| * | |
| * WRK000 will pull the entire chain of WREs and get it off that queue | |
| * so that these can be processed one at a time while outside tasks may | |
| * continue to add new WREs to the CSA chain. | |
| * | |
| * Each WRE is examined for its destination. If the WRE has a | |
| * destination link id in the LINKs table, or via a route that can be | |
| * forwarded via a destination link, the WRE will be requeued to that | |
| * particular link task at WRK120. | |
| * | |
| * When the link task gets the WRE, it will be processed by NJEDRV | |
| * label COMM000, which will dequeue it and flow continues to | |
| * label WRK000 in that same module. After processing the WRE stg | |
| * is freed. | |
| * | |
| * Back in NJEINIT, if the WRE is destined for the local link (at | |
| * WRK030) flow proceeds to WRK200 where the command processor NJECMD | |
| * is called to examine and process the action. Upon return, the | |
| * WRE storage is freed and the next WRE on the chain is examined, | |
| * if any. | |
| * | |
| * Notes: | |
| * 1. WREs are created in subpool 2 which is shared by other TCBs. | |
| * (Except for out-of-address-space WREs, which are in CSA). | |
| * 2. WREs are sometimes created internally: | |
| * a). in NJEINIT STOP000 to queue a WRE to each active link task | |
| * in order to stop the link. | |
| * b). in NJEINIT CCD000 in order to queue a command that was | |
| * input from the system console to a remote link task. | |
| * 3. Whether the WRE is created from an outside address space or | |
| * internally, they all flow the same way, via the post to the | |
| * ECB in NJ38CSA and being placed on the queue anchor in NJ38CSA. | |
| * | |
| * | |
| * | |
| * Summary: | |
| * | |
| * 1. WRE gets created and posted to CSA anchor | |
| * 2. NJEINIT WRK000 sees the WRE first | |
| * 3. WRE is requeued to a link or handled by NJEINIT/NJECMD | |
| * 4. WRE is freed. | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| *-- WRE work ECB was posted | |
| * | |
| WRK000 EQU * | |
| SPKA 0 This routine must run key=0 | |
| XC 0(4,R2),0(R2) Reinit WRE work ECB | |
| L R2,CSABLK -> CSA communications area | |
| USING NJ38CSA,R2 | |
| * | |
| LM R6,R7,NJ38SWAP Get WRE anchor, sync count | |
| * | |
| WRK010 EQU * | |
| LTR R6,R6 Was WRE Q empty? | |
| BZ MAIN010 Yes, nothing else to do | |
| SR R14,R14 Zero out the WRE Q anchor | |
| LR R15,R7 Copy same sync count | |
| CDS R6,R14,NJ38SWAP Try to empty the WRE Q | |
| BC 7,WRK010 Can't yet, try again | |
| DROP R2 NJ38CSA | |
| * | |
| *-- Distribute the WREs to the various links | |
| * | |
| *-- R6 -> start of WRE chain we dequeued from WRE Q | |
| * | |
| USING WRE,R6 | |
| * | |
| * | |
| WRK030 EQU * | |
| NJETRACE TYPE=TRCIWRE Trace incoming WRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* -> here v220 | |
| ST R15,4(,R14) Save addr of trace request v220 | |
| ST R6,8(,R14) Trace WRE addr v220 | |
| MVC 12(4,R14),WRETYPE Trace type code,len,subpool v220 | |
| MVC 16(8,R14),WRELINK link dest v220 | |
| MVC 24(8,R14),WREUSER userid dest v220 | |
| NJETRACE TYPE=TRCIWRE Trace incoming WRE follow on v220 | |
| OI 0(R14),X'80' Indicate follow on v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 4(8,R14),WREORIG Originator userid v220 | |
| MVC 12(20,R14),WRETXT Trace WRE content v220 | |
| * | |
| CLC WRELINK,LCLNODE Is this WRE for the local node? | |
| BE WRK200 Yes, don't queue it to a link | |
| * | |
| WRK040 EQU * | |
| LA R1,WRELINK -> destination link of WRE | |
| BAL R14,FLNK000 Locate the LINKTABL entry | |
| BZ WRK050 No link found, check routes | |
| * | |
| USING LINKTABL,R2 | |
| TM LFLAG,LCONNECT Is link connected? | |
| BO WRK120 Yes, post the link task | |
| * | |
| *-- Otherwise, look at routes. R1-> WRELINK | |
| * | |
| WRK050 EQU * | |
| BAL R14,RLNK000 Find matching route | |
| BZ WRK150 No matching routes | |
| BAL R14,FLNK000 Locate the LINKTABL entry | |
| BZ WRK150 No link found for this WRE | |
| TM LFLAG,LCONNECT Is link connected? | |
| BZ WRK150 No, skip this WRE | |
| * | |
| * | |
| *-- Here to requeue the WRE to the link WRE chain | |
| * | |
| WRK120 EQU * | |
| NJETRACE TYPE=TRCOWRE Trace outgoing WRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* -> here v220 | |
| ST R15,4(,R14) Save addr of trace request v220 | |
| ST R6,8(,R14) Trace WRE addr v220 | |
| MVC 12(4,R14),WRETYPE Trace type code,len,subpool v220 | |
| MVC 16(8,R14),WRELINK link dest v220 | |
| MVC 24(8,R14),WREUSER userid dest v220 | |
| NJETRACE TYPE=TRCOWRE Trace outgoing WRE follow on v220 | |
| OI 0(R14),X'80' Indicate follow on v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 4(8,R14),WREORIG Originator userid v220 | |
| MVC 12(20,R14),WRETXT Trace WRE content v220 | |
| * | |
| L R8,WRENEXT -> next WRE in CSA chain | |
| * | |
| LM R0,R1,LWRESWAP Get first WRE ptr, sync count | |
| WRK130 EQU * | |
| ST R0,WRENEXT First WRE becomes next | |
| LR R4,R6 -> WRE to be added as first | |
| LA R5,1(,R1) Incr synchronization count | |
| CDS R0,R4,LWRESWAP Update LINK WRE anchor, sync | |
| BC 7,WRK130 Gotta try again | |
| * | |
| LA R1,LECB -> link task notification ECB | |
| POST (1) Tell task | |
| B WRK290 Go get another WRE | |
| * | |
| *-- Release WRE that we cant distribute to a link | |
| * | |
| WRK150 EQU * | |
| B WRK290 | |
| DROP R2 LINKTABL | |
| * | |
| *-- Here if WRE is intended for the local node | |
| * | |
| WRK200 EQU * | |
| SR R15,R15 Clear for IC v220 | |
| IC R15,WRETYPE Get WRE type code v220 | |
| CLM R15,1,=AL1(WRK210HI) Check against highest code v220 | |
| BH WRK280 Dispose of invalid WRE v220 | |
| B WRK210(R15) Branch into table v220 | |
| * | |
| WRK210 EQU * v220 | |
| B WRK280 X'00' Invalid; just delete WRE v220 | |
| B WRK280 X'04' WRENEW; ignore for LCL nodev220 | |
| B WRK215 X'08' WRECMD v220 | |
| B WRK220 X'0C' WREMSG v220 | |
| B WRK240 X'10' WRESTAR v220 | |
| B WRK300 X'14' WREREG v220 | |
| B WRK350 X'18' WREDREG v220 | |
| B WRK400 X'1C' WREQRM v220 | |
| B WRK450 X'20' WREDRM v220 | |
| WRK210HI EQU (*-WRK210-4) Highest code supported v220 | |
| * | |
| * | |
| WRK215 EQU * | |
| SPKA X'80' | |
| MVC CMDAREA,BLANKS Init receiving area | |
| SR R2,R2 Clear for IC | |
| IC R2,WRETXTLN Get cmd image length | |
| EX R2,MVTXT1 Move cmd image | |
| STC R2,CMNDBLEN IBM length of image to CMDBLOK | |
| MVC CMNDLINK,LCLNODE This node is the issuer | |
| MVC CMNDUSER,WREUSER Copy TSO id of issuer | |
| * | |
| L R15,=A(NJECMD) -> command processor | |
| BALR R14,R15 Go there | |
| SPKA X'00' | |
| B WRK280 | |
| * | |
| MVTXT1 MVC CMDAREA(0),WRETXT Executed instr | |
| * | |
| *-- Send the msg response to a local TSO user | |
| * | |
| WRK220 EQU * | |
| CLC WREUSER,=CL8'OP' Message destined for operator? | |
| BE WRK230 Yes | |
| LA R15,WREUSER -> userid to locate | |
| BAL R14,REG000 See if user registered v220 | |
| BNZ WRK280 Yes it was; we queued it v220 | |
| BAL R14,USR800 See if TSO user logged on | |
| BZ WRK280 Skip msg if not | |
| MVC MACLIST(80),BLANKS Init first part | |
| MVC MACLIST+4(9),=C'SE ''From ' | |
| MVC MACLIST+13(8),WREORIG | |
| TRT MACLIST+13(9),BLANK Look for end of orig userid | |
| MVI 0(R1),C':' | |
| LA R1,2(,R1) -> area for msg | |
| MVC 0(104,R1),WRETXT Move msg text v102 | |
| LA R2,MACLIST+111 -> last byte from MTEXT area v210 | |
| LA R0,32 # char to check backwards v210 | |
| * | |
| WRK223 EQU * Only look backwards to col 80 v210 | |
| CLI 0(R2),C' ' Try to find last non-blank v210 | |
| BNE WRK226 Found it v210 | |
| BCTR R2,0 -> prev char v210 | |
| BCT R0,WRK223 Keep scanning v210 | |
| * | |
| WRK226 EQU * v210 | |
| LA R2,1(,R2) -> first blank after last char v210 | |
| MVC 0(8,R2),=C''',USER=(' v210 | |
| MVC 8(12,R2),BLANKS Ensure trailer initted v210 | |
| MVC 8(7,R2),WREUSER Max for TSO userid is 7 v210 | |
| LA R1,8+7(,R2) -> max end of trt v210 | |
| TRT 8(7,R2),BLANK Look for end of userid v210 | |
| MVI 0(R1),C')' Move closing v210 | |
| MVI 1(R1),C' ' Plus 1 blank v210 | |
| LA R0,MACLIST -> start of msg area v210 | |
| SR R1,R0 Compute length of msg v210 | |
| LA R1,1(,R1) Account for blank at end v210 | |
| XC MACLIST(4),MACLIST Clear len, flags v210 | |
| STH R1,MACLIST Insert the msg length v210 | |
| * | |
| LA R1,MACLIST | |
| SR R0,R0 | |
| SVC 34 Issue MGCR SVC | |
| B WRK280 | |
| * | |
| *-- Send the msg response to the system operator | |
| * | |
| WRK230 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(4),=C'From' | |
| MVC MACLIST+9(8),WREORIG Move originating userid | |
| TRT MACLIST+9(9),BLANK Look for end of orig userid | |
| MVI 0(R1),C':' | |
| LA R1,2(,R1) -> area for msg | |
| MVC 0(104,R1),WRETXT Move msg text v102 | |
| WTO ,MF=(E,MACLIST) | |
| B WRK280 | |
| * | |
| *-- Start a link (via a local or remote command) | |
| * | |
| WRK240 EQU * | |
| L R2,WREUSER -> LINKTABL entry of START cmd | |
| BAL R14,SLNK000 Attach the link driver | |
| B WRK280 | |
| * | |
| *-- Clean up spent WRE | |
| * | |
| WRK280 EQU * | |
| SPKA 0 In case WRE isin CSA v220 | |
| L R8,WRENEXT -> next WRE in chain | |
| SR R15,R15 Clear for IC v220 | |
| IC R15,WRESP Get subpool number v220 | |
| LA R0,WRESIZE Size of this WRE v220 | |
| * | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R2,* v220 | |
| STCM R2,7,5(R14) Addr of Freemain to trace v220 | |
| ST R0,8(,R14) Len to trace v220 | |
| ST R6,12(,R14) addr to trace v220 | |
| STC R15,8(,R14) Trace subspool v220 | |
| MVI WRESP,X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free the WRE x | |
| LV=(0), x | |
| A=(6), x | |
| SP=(15) v220 | |
| SPKA X'80' v220 | |
| * | |
| *-- Done processing a WRE; get another | |
| * | |
| WRK290 EQU * | |
| LTR R6,R8 Get next WRE to distribute | |
| BNZ WRK030 Yes have an addr v220 | |
| B MAIN010 All done with WREs | |
| * | |
| * | |
| * Registered User Service Support Notes v220 | |
| * | |
| * The registered user service allows an outside address space | |
| * operating in the same MVS system as NJE38, to 'register' or | |
| * establish a relationship with NJE38 where messages that would | |
| * ordinarily be sent to a user terminal are instead queued in | |
| * storage and presented to the outside address space upon request. | |
| * | |
| * Users wishing to use this service call the NJERLY interface which | |
| * is responsible for establishing the relationship with NJE38. This | |
| * is done using WREs and cross-memory POST. In this way, a batch, | |
| * TSO, or STC address space can capture message traffic destined | |
| * for it before it would arrive at a terminal, and thereby process | |
| * this message or display it in the manner of their choosing. | |
| * | |
| * WREs created by NJERLY are always in CSA. When they are used to | |
| * request service of NJE38, they place the WRE on the NJ38SWAP | |
| * compare and swap chain just like any other outside requester and | |
| * post NJEINIT's CSA ECB. NJEINIT then acts on the request. | |
| * | |
| * NJEINIT never frees the WRE created by NJERLY. That is NJERLY's | |
| * responsibility. | |
| * | |
| * For some functions of the service, the request is ignored if | |
| * important information is missing (unlikely) such as ASCB address | |
| * of NJERLY, or the WRE address. Ignoring the request is all that | |
| * can be done since without either of those pieces, NJEINIT cannot | |
| * issue CM POST back to the NJERLY space to let it know of the error. | |
| * | |
| * When a user joins the service, he registers. NJEINIT will create | |
| * a REGUSERB control block to establish the registration and hold | |
| * the NJERLY requester'e WRE and ASCB address. | |
| * | |
| * Once a user (userid) has registered, any message traffic inbound | |
| * destined for that user will be queued in NJE38 storage and chained | |
| * from REGUSERB, The user can then request a message be returned | |
| * one per request. A post code of 4 (ERNOMSG) is used to indicate | |
| * no messages are queued. | |
| * | |
| * When the user wants to stop using the service, it 'deregisters', | |
| * causing NJEINIT to freemain any queued messages for the user and | |
| * releasing the REGUSERB. Message traffic destined for that user | |
| * resumes being presented to the terminal as before. | |
| * | |
| * In the comments below, the 'registered user WRE' refers to the | |
| * WRE created by NJERLY in CSA by the user address space. | |
| * | |
| * | |
| * | |
| *- WREREG | |
| *- Register a user for queued message services | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Ensure userid is not already registered on REGUSERB chain. | |
| * 2. Create a new REGUSERB for this user | |
| * 3. Issue CM POST to registered user space, function complete. | |
| * | |
| * | |
| * Notes: - On entry, registered user WRE is in R6. | |
| * - Registered users WREs are not freemained; we are not the | |
| * owner. | |
| * - If the registered user WRE has no ASCB addr, we have no | |
| * choice but to ignore the request. | |
| * | |
| WRK300 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| CLC WREASCB,=A(0) Is ASCB present? v220 | |
| BE WRK810 No, invalid. Can't respond v220 | |
| * | |
| ICM R1,15,REGUSER -> first REGUSER v220 | |
| BZ WRK320 None, let's start a chain v220 | |
| USING REGUSERB,R1 v220 | |
| LA R0,ERDUPUSR Assume duplicate user error v220 | |
| * | |
| WRK310 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user already reg? v220 | |
| BE WRK800 Yes, post the error in R0 v220 | |
| ICM R1,15,REGNEXT Keep looking v220 | |
| BNZ WRK310 v220 | |
| * | |
| WRK320 EQU * v220 | |
| GETMAIN RU, Get storage for a REGUSER v220x | |
| LV=REGSIZE, v220x | |
| SP=2 v220 | |
| XC 0(REGSIZE,R1),0(R1) Init stg v220 | |
| MVC REGEYE,=CL4'REGU' Set eye v220 | |
| MVC REGUSRID,WREUSER Userid to be registered v220 | |
| ST R6,REGWRE Save ptr to registration WREv220 | |
| MVC REGNEXT,REGUSER Chain other REGUSERs to thisv220 | |
| ST R1,REGUSER This REGUSER is first v220 | |
| DROP R1 REGUSERB v220 | |
| SR R0,R0 Set RC=0 success v220 | |
| B WRK800 User successfully registeredv220 | |
| * | |
| *- WREDREG | |
| *- Deregister a user from queued message services | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. Get the chain anchor for queued message WREs, if any | |
| * 3. Freemain the REGUSERB. | |
| * 4. Freemain each queued message WRE | |
| * 5. Issue CM POST to registered user space, function complete. | |
| * | |
| * Notes: - On entry, registered user WRE is in R6. | |
| * - Registered users WREs are not freemained; we are not the | |
| * owner. | |
| * - If the registered user WRE has no ASCB addr, we have no | |
| * choice but to ignore the request. | |
| * | |
| WRK350 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| CLC WREASCB,=A(0) Is ASCB present? v220 | |
| BE WRK810 No, invalid. Can't respond v220 | |
| * | |
| LA R0,ERUSERNF Assume user not found v220 | |
| LA R2,REGUSER -> 0th REGUSER entry v220 | |
| ICM R1,15,REGUSER -> first REGUSER v220 | |
| BZ WRK800 None, user indeed isnt foundv220 | |
| USING REGUSERB,R1 v220 | |
| * | |
| WRK360 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user we want? v220 | |
| BE WRK370 Yes v220 | |
| LR R2,R1 Save this REGUSER ptr v220 | |
| ICM R1,15,REGNEXT Get next REGUSER and continuv220 | |
| BNZ WRK360 v220 | |
| B WRK800 Exit with user not found v220 | |
| * | |
| WRK370 EQU * v220 | |
| MVC REGNEXT-REGUSERB(,R2),REGNEXT unchain R1 REGUSER v220 | |
| L R2,REGMSGQ -> MSG WRE chain for user v220 | |
| DROP R1 REGUSERB v220 | |
| * | |
| FREEMAIN RU, Free storage for a REGUSERB v220x | |
| LV=REGSIZE, v220x | |
| A=(1), v220x | |
| SP=2 v220 | |
| * | |
| WRK380 EQU * v220 | |
| LTR R1,R2 Were any WREs chained? v220 | |
| BZ WRK390 No, we're done v220 | |
| L R2,WRENEXT-WRE(,R2) -> next WRE v220 | |
| LA R0,WRESIZE Get size of WRE v220 | |
| * | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* v220 | |
| STCM R15,7,5(R14) Addr of Freemain to trace v220 | |
| STM R0,R1,8(R14) Len, stg addr to trace v220 | |
| MVI 8(R14),2 Trace subspool v220 | |
| MVI WRESP-WRE(R1),X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free storage for a WRE v220x | |
| LV=(0), v220x | |
| A=(1), v220x | |
| SP=2 v220 | |
| B WRK380 Free entire chain v220 | |
| * | |
| WRK390 EQU * v220 | |
| SR R0,R0 Set RC=0 success v220 | |
| B WRK800 User successfully deregisterv220 | |
| * | |
| * | |
| *- WREQRM | |
| *- Queue a message destined for a registered user | |
| * | |
| *- Who requests this service: Internal by NJEINIT, NJECMX, NJEDRV | |
| * as message traffic arrives and needs to be queued. | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. If REGUSERB is not found, userid is not registered. Exit | |
| * with CC=0 and allow the message to go to the user terminal. | |
| * 3. Get the registration WRE address from REGUSERB, exit if none. | |
| * 4. Add this queued message WRE (in R6) to the queued message | |
| * chain REGMSGQ (in REGUSERB). Do not freemain this WRE! | |
| * 5. Issue CM POST to registered user space that message is avail. | |
| * | |
| * Notes: - On entry, a queued message WRE is in R6. | |
| * - The WREs are added to the start of the chain (REGMSGQ) | |
| * because they come to us in reverse order of issuance. | |
| * This puts them back in the right order | |
| * | |
| WRK400 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| ICM R3,15,REGUSER -> first REGUSER v220 | |
| BZ WRK810 No one registered v220 | |
| USING REGUSERB,R3 v220 | |
| * | |
| WRK410 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user the one? v220 | |
| BE WRK420 Yes v220 | |
| ICM R3,15,REGNEXT Keep looking v220 | |
| BNZ WRK410 v220 | |
| B WRK810 Can't find REGUSER v220 | |
| * | |
| WRK420 EQU * v220 | |
| ICM R4,15,REGWRE -> user's registration WRE v220 | |
| BZ WRK810 Ignore if not there v220 | |
| * | |
| MVC WRENEXT,REGMSGQ Add chain to new WRE v220 | |
| ST R6,REGMSGQ Add WRE to anchor v220 | |
| LR R6,R4 User registration WRE to R6 v220 | |
| SR R0,R0 Indicate success v220 | |
| B WRK800 Tell user msg pending v220 | |
| * v220 | |
| * v220 | |
| *- WREDRM | |
| *- Dequeue message for a registered user when they request it | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. If REGUSERB is not found, userid is not registered. Issue | |
| * error to requester. | |
| * 3. Get the first queued message WRE from REGUSERB, issue | |
| * ERNOMSG error if nothing queued. | |
| * 4. Copy the message text from the queued message WRE into the | |
| * registered user WRE. | |
| * 5. Issue CM POST to registered user space, function complete. | |
| * | |
| * Notes: - On entry, the registered user WRE is in R6. | |
| * | |
| * | |
| WRK450 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| ICM R3,15,REGUSER -> first REGUSER v220 | |
| BZ WRK810 No one registered v220 | |
| USING REGUSERB,R3 v220 | |
| * | |
| WRK460 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user the one? v220 | |
| BE WRK470 Yes v220 | |
| ICM R3,15,REGNEXT Keep looking v220 | |
| BNZ WRK460 v220 | |
| B WRK810 Can't find REGUSER v220 | |
| * | |
| WRK470 EQU * v220 | |
| LA R0,ERNOMSG Assume no msgs queued v220 | |
| ICM R5,15,REGMSGQ -> first queued msg WRE v220 | |
| BZ WRK800 No msgs available v220 | |
| * | |
| MVC REGMSGQ,WRENEXT-WRE(R5) Remove 1st queued from chainv220 | |
| DROP R3 REGUSERB v220 | |
| * | |
| MVC WRETXT,WRETXT-WRE(R5) Copy queued msg text to v220 | |
| * registered user WRE v220 | |
| * | |
| LA R0,WRESIZE Get size of WRE v220 | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* v220 | |
| STCM R15,7,5(R14) Addr of Freemain to trace v220 | |
| ST R0,8(,R14) Len to trace v220 | |
| MVI 8(R14),2 Trace subspool v220 | |
| ST R5,12(,R14) Addr to trace v220 | |
| MVI WRESP-WRE(R5),X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free Queued msg WRE v220x | |
| LV=(0), v220x | |
| A=(5), v220x | |
| SP=2 v220 | |
| * | |
| SR R0,R0 Indicate success v220 | |
| B WRK800 Tell user msg pending v220 | |
| * | |
| * | |
| WRK800 EQU * USING WRE,R6 v220 | |
| L R7,WREASCB -> ASCB of requestor v220 | |
| LA R1,WREECB -> WRE's ECB v220 | |
| * | |
| MVC MACLIST(POSTL),POST Move macro model v220 | |
| POST (1),(0), Post requestor's ECB v220x | |
| ASCB=(7), v220x | |
| ERRET=WRK810, v220x | |
| ECBKEY=0, v220x | |
| MF=(E,MACLIST) v220 | |
| * | |
| WRK810 EQU * v220 | |
| B WRK290 All done with WRE v220 | |
| DROP R6 WRE v220 | |
| * | |
| *-- Address space Communications ECB was posted | |
| * | |
| COMM000 EQU * | |
| L R4,COMMAREA -> Communications area | |
| USING IEZCOM,R4 | |
| L R5,COMCIBPT -> CIB | |
| USING CIBNEXT,R5 | |
| CLI CIBVERB,CIBMODFY Modify cmd? | |
| BE MOD000 Yes | |
| CLI CIBVERB,CIBSTOP Stop cmd? | |
| BE STOP000 Yes, let subtasks know | |
| U0038 ABEND 38,DUMP,STEP Shouldnt happen | |
| * | |
| MOD000 EQU * | |
| MVC CMDAREA,BLANKS Init receiving area | |
| LH R2,CIBDATLN Get cmd image length | |
| BCTR R2,0 Adjust for execute | |
| EX R2,MVMOD1 Move cmd image | |
| STC R2,CMNDBLEN IBM length of image to CMDBLOK | |
| * | |
| QEDIT ORIGIN=COMCIBPT,BLOCK=(5) Purge the CIB | |
| * | |
| MVC CMNDLINK,LCLNODE Console operator | |
| MVC CMNDUSER,=CL8'OP' should get any responses | |
| L R15,=A(NJECMD) -> command processor | |
| BALR R14,R15 Go there | |
| B MAIN010 | |
| * | |
| MVMOD1 MVC CMDAREA(0),CIBDATA Executed instr | |
| * | |
| * | |
| * | |
| STOP000 EQU * | |
| QEDIT ORIGIN=COMCIBPT,BLOCK=(5) Purge the CIB | |
| DROP R4 IEZCOM | |
| DROP R5 IEZCIB | |
| * | |
| STOP010 EQU * | |
| OI NJFL1,NJF1STOP Indicate STOP ordered | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| STOP020 EQU * | |
| CLC LTCBA,=A(0) Is task active for link? | |
| BE STOP030 Zero, skip this one | |
| * | |
| BAL R14,GTW000 Get a WRE | |
| LR R4,R1 -> WRE | |
| USING WRE,R4 | |
| MVI WRECODE,X'81' Code for drain link | |
| DROP R4 | |
| BAL R14,PST000 Queue the WRE to link | |
| * | |
| STOP030 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ STOP020 Scan them all | |
| DROP R2 LINKTABL | |
| * | |
| B MAIN010 | |
| * | |
| * | |
| *-- Open then Close NETSPOOL dataset to determine status | |
| * | |
| * NCBRTNCD/ERRCD after call to NCBOPEN | |
| * 0474 = dataset not closed properly (do verify) | |
| * 0874 = dataset not formatted | |
| * | |
| NET000 EQU * | |
| ST R14,SV14 Save return | |
| * | |
| MVC JFCBDCB(NSPOOLN),NSPOOL Move DCB for RDJFCB use | |
| LA R1,JFCB -> JFCB return area | |
| ST R1,JEXLST Set addr in exit list | |
| MVI JEXLST,X'87' Set exlst for JFCB return | |
| LA R1,JFCBDCB -> DCB | |
| USING IHADCB,R1 | |
| LA R0,JEXLST -> exit list | |
| STCM R0,7,DCBEXLSA Store it into DCB | |
| DROP R1 | |
| * | |
| MVC MACLIST(RDJFCBL),RDJFCB Move model | |
| RDJFCB JFCBDCB,MF=(E,MACLIST) Get NETSPOOL DSN | |
| * | |
| LA R3,NCB1 | |
| USING NCB,R3 | |
| * | |
| NSIO TYPE=OPEN, Open NETSPOOL x | |
| NCB=(R3), v210x | |
| ENTRY=ANJESPL v210 | |
| LTR R15,R15 | |
| BZ NET040 | |
| BAL R14,FMT000 | |
| * | |
| NET040 EQU * | |
| NSIO TYPE=CLOSE, x | |
| NCB=(R3), v210x | |
| ENTRY=ANJESPL v210 | |
| DROP R3 | |
| TM NJFL1,NJF1VSER Did VSAM error occur? | |
| BZ NET090 No | |
| CLC LASTRC(2),=X'0474' NETSPOOL needs verify? | |
| BE NET080 | |
| CLC LASTRC(2),=X'0874' NETSPOOL not formatted? | |
| BNE NET070 | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE007I),NJE007I Not formatted msg | |
| WTO ,MF=(E,MACLIST) | |
| B NET090 | |
| * | |
| NET070 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE006I),NJE006I Open failed | |
| WTO ,MF=(E,MACLIST) | |
| B NET090 | |
| * | |
| NET080 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE008I),NJE008I Do verify | |
| WTO ,MF=(E,MACLIST) | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE009I),NJE009I verify complete | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| NET090 EQU * | |
| TM NJFL1,NJF1VSER Set CC: Did VSAM error occur? | |
| L R14,SV14 Reload return | |
| BR R14 Return | |
| * | |
| ERR999 EQU * | |
| WTO 'NJE999I NJE38 is already active' | |
| * | |
| QUIT000 EQU * | |
| ESTAE 0 Turn off ESTAE | |
| * | |
| TTIMER CANCEL Cancel the timer | |
| * | |
| FREEMAIN RU,SP=1 Free all CONFIG related stg | |
| FREEMAIN RU,SP=2 Free all WRE related stg | |
| * | |
| QUIT020 EQU * | |
| DELETE EP=NJECMX Delete command processor | |
| DELETE EP=NJESPOOL Delete spool interface v210 | |
| * | |
| ICM R1,15,ARQESTG -> RQE stg area | |
| BZ QUIT030 Skip free if none v212 | |
| FREEMAIN RU, Free it x | |
| LV=RQESZ*RQELIM, x | |
| A=(1) | |
| * | |
| QUIT030 EQU * v212 | |
| ICM R1,15,ATRACE -> Trace table stg v212 | |
| BZ QUIT070 Skip free if none v212 | |
| FREEMAIN RU, Free it v212x | |
| LV=TRACESZ*1024, v212x | |
| A=(1) v212 | |
| * | |
| QUIT070 EQU * | |
| TM NJFL1,NJF1ENQ Is NJE38 ENQ active? | |
| BZ QUIT080 No | |
| LA R5,NJERNAME -> RNAME | |
| MVC MACLIST(ENQL),ENQ Move macro model | |
| DEQ (NJE38Q,(5),56,SYSTEM), x | |
| RET=NONE, x | |
| MF=(E,MACLIST) | |
| * | |
| QUIT080 EQU * | |
| ICM R5,15,CSABLK -> CSA stg area | |
| BZ QUIT090 Not present | |
| * | |
| SPKA 0 | |
| * | |
| FREEMAIN RU,LV=NJ38CSAZ,A=(5),SP=241 Free CSA area | |
| XC CSABLK,CSABLK | |
| * | |
| SPKA X'80' | |
| * | |
| QUIT090 EQU * | |
| LR R1,R10 -> NJEWK main work area page | |
| L R13,4(,R13) -> caller's sa | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| LM R14,R12,12(R13) Reload system's regs | |
| XR R15,R15 RC=0 | |
| BR R14 Return | |
| * | |
| U0039 EQU * | |
| STM R0,R1,DBLE Save regs across abend SVC | |
| ABEND 39,DUMP,STEP | |
| * | |
| LTORG | |
| * HHMMSSTH | |
| DS 0D v200 | |
| ATTDLY DC CL8'00000050' 1/2 sec | |
| * | |
| EXTRACT EXTRACT MF=L | |
| EXTRACTL EQU *-EXTRACT | |
| ESTAE ESTAE 0,MF=L | |
| ESTAEL EQU *-ESTAE | |
| * | |
| ENQ ENQ (0),MF=L | |
| ENQL EQU *-ENQ | |
| * | |
| DEQ DEQ (0),MF=L | |
| DEQL EQU *-DEQ | |
| * | |
| RDJFCB RDJFCB 0,MF=L | |
| RDJFCBL EQU *-RDJFCB | |
| * | |
| NJE38Q DC CL8'NJE38' | |
| NJERCON DC CL8'NJEINIT' | |
| * | |
| NSPOOL DCB DDNAME=NETSPOOL,DSORG=PS,MACRF=GL,EXLST=0 | |
| NSPOOLN EQU *-NSPOOL | |
| * | |
| * 456789012345678901234567890123456789012345678901 | |
| NJE000I DC C'NJE000I NJE38 &VERS' | |
| NJE001I DC C'NJE001I Initialization complete for local node' | |
| NJE006I DC C'NJE006I Open failed for DD NETSPOOL' | |
| NJE007I DC C'NJE007I NETSPOOL dataset has not been formatted' | |
| NJE008I DC C'NJE008I The NETSPOOL dataset required verification befx | |
| ore start-up' | |
| NJE009I DC C'NJE009I Verification complete. Please restart NJE38' | |
| NJE010I DC C'NJE010I Line xxx is drained' | |
| * | |
| DROP R12 | |
| * | |
| ********************* | |
| * N J E C O M * NJECOM hosts small routines and | |
| * * frequently used constants that | |
| * Common routines * are available to all NJExxx csects | |
| * and constants * via base register 11 | |
| * * | |
| ********************* | |
| * | |
| NJECOM CSECT | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECOM' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECOM,R11 | |
| USING NJEMWK,R10 | |
| * | |
| * FLNK000 - Locate a link table entry by link name | |
| * | |
| * Entry: R1 -> Link name to find (CL8 field padded with blanks) | |
| * Exit: CC=0 link was not found | |
| * CC<>0 link table entry address is in R2 | |
| * | |
| * | |
| * | |
| FLNK000 EQU * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| FLNK010 EQU * | |
| CLC LINKID,0(R1) Find the link entry by name | |
| BE FLNK020 Got it | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BZR R14 Exit CC=0 if not found | |
| B FLNK010 Keep searching | |
| DROP R2 LINKTABL | |
| * | |
| FLNK020 EQU * | |
| LTR R2,R2 Set CC non-zero | |
| BR R14 Return w/LINKTABL entry -> R2 | |
| * | |
| * RLNK000 - Locate a name in the route table | |
| * | |
| * Entry: R1 -> Routed name to find (CL8 field padded with blanks) | |
| * Exit: CC=0 link was not found | |
| * CC<>0 Associated link name address is in R1 | |
| * CC<>0 Named route address is in R15 | |
| * | |
| *-- First determine if the route name we are looking up is actually | |
| *-- a link name. | |
| * | |
| RLNK000 EQU * | |
| ICM R15,15,ROUTES -> RTE list v211 | |
| BZR R14 Exit CC=0 if no RTE list v211 | |
| USING RTE,R15 v211 | |
| * | |
| L R2,LINKS 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| ICM R2,15,LNEXT Skip over local entry v211 | |
| BZR R14 Fail the request if none v211 | |
| SR R0,R0 R0=0 assume name not a link v211 | |
| * | |
| RLNK010 EQU * v211 | |
| CLC LINKID,0(R1) Find the link entry by name v211 | |
| BE RLNK020 Got it v211 | |
| ICM R2,15,LNEXT -> next LINKTABL entry v211 | |
| BNZ RLNK010 Keep looking v211 | |
| B RLNK030 Didn't find a matching link v211 | |
| DROP R2 LINKTABL v211 | |
| * | |
| *-- Here if route we want is a link name too (dont use wildcards) v211 | |
| * | |
| RLNK020 EQU * v211 | |
| BCTR R0,0 Indic route is explicit link nm v211 | |
| * v211 | |
| *-- Search the RTEs for the route name v211 | |
| * v211 | |
| RLNK030 EQU * | |
| STM R4,R7,12(R13) Save work regs v211 | |
| * | |
| RLNK040 EQU * v211 | |
| LA R4,ROUTNAME -> name from route list v211 | |
| LA R5,8 max length v211 | |
| LR R6,R1 -> selected name to locate v211 | |
| LR R7,R5 copy length v211 | |
| CLCL R4,R6 Did we locate the name? v211 | |
| BE RLNK400 Yes, exact match v211 | |
| LTR R0,R0 Must be explicit link name? v211 | |
| BNZ RLNK050 Yes, no wildcard checking v211 | |
| CLI 0(R4),C'*' Wildcard was in the name? v211 | |
| BE RLNK400 Then we matched to that point v211 | |
| * | |
| RLNK050 EQU * | |
| ICM R15,15,ROUTPTR -> Next route entry v211 | |
| BNZ RLNK040 Keep looking v211 | |
| LM R4,R7,12(R13) Restore work regs v211 | |
| BR R14 No matching route v211 | |
| * | |
| *-- Found the RTE with a matching name, now determine what link v211 | |
| *-- to route to. v211 | |
| * | |
| RLNK400 EQU * v211 | |
| LM R4,R7,12(R13) Restore work regs v211 | |
| LA R0,4 # possible routed-to names v211 | |
| LA R1,ROUTNEXT -> first possible name v211 | |
| * | |
| RLNK410 EQU * v211 | |
| L R2,LINKS -> first LINKTABL entry v211 | |
| USING LINKTABL,R2 v211 | |
| ICM R2,15,LNEXT Skip over local entry v211 | |
| BZR R14 Fail the request if none v211 | |
| * | |
| RLNK420 EQU * v211 | |
| CLC 0(8,R1),BLANKS No route-to name? v211 | |
| BE RLNK499 Fail the request v211 | |
| CLC 0(8,R1),LINKID Look for destination link v211 | |
| BE RLNK440 Found it v211 | |
| ICM R2,15,LNEXT -> next LINKTABL entry v211 | |
| BNZ RLNK420 Keep searching v211 | |
| * | |
| RLNK430 EQU * v211 | |
| LA R1,8(,R1) Next alternate route-to v211 | |
| BCT R0,RLNK410 Rescan for matching link v211 | |
| B RLNK499 None found, fail the request v211 | |
| * | |
| RLNK440 EQU * v211 | |
| TM LFLAG,LCONNECT Is the link active? v211 | |
| BZ RLNK430 N, try next route-to link v211 | |
| DROP R2,R15 LINKTABL, RTE v211 | |
| * | |
| RLNK490 EQU * v211 | |
| CLI *,0 Set CC to non-zero v211 | |
| BR R14 Return with link name -> R1 v211 | |
| * | |
| RLNK499 EQU * v211 | |
| CLI *+1,0 Set CC to 0 v211 | |
| BR R14 No matching route/act link foundv211 | |
| * | |
| * SLNK000 - Start a link | |
| * | |
| * Entry: R2 -> LINKTABL entry to be started | |
| * Exit: CC=0 link was started | |
| * CC<>0 link was already started | |
| * | |
| * | |
| * | |
| USING LINKTABL,R2 | |
| SLNK000 EQU * | |
| STM R14,R9,BALRSAVE Save regs used | |
| CLC LTCBA,=A(0) Is link already started? | |
| BNE SLNK090 Exit w/ CC<>0 if addr present | |
| * | |
| XC LTRMECB,LTRMECB Clear from any prior use | |
| LA R1,INITPARM -> INITPARM mapping area | |
| ST R1,LPOINTER Pass addr of area to subtask | |
| L R5,=A(NJEDMP) -> ESTAI exit | |
| LA R9,LTRMECB | |
| LR R1,R2 LINKTABL entry is parameter | |
| * | |
| MVC MACLIST(ATTACHL),ATTACH Move macro model | |
| ATTACH EP=NJEDRV, Attach X | |
| SZERO=YES, Ok to share SP 0 X | |
| SHSPL=SPLIST, Shared subpool list v220X | |
| DPMOD=0, Run task same prty X | |
| SM=SUPV, Run task in Supervisor state X | |
| KEY=PROP, Run task in key 8 X | |
| ECB=(R9), Subtask termination ECB X | |
| ESTAI=((5),(10)), ESTAI exit, work area is param X | |
| SF=(E,MACLIST), Attach macro plist X | |
| MF=(E,(1)) Param plist area | |
| * | |
| ST R1,LTCBA Save attached TCB address | |
| SR R15,R15 Set CC=0 | |
| B SLNK090 Exit with task attached | |
| DROP R2 LINKTABL | |
| * | |
| SLNK090 EQU * | |
| LM R14,R9,BALRSAVE Restore caller regs | |
| BR R14 Exit with CC set | |
| * | |
| SPLIST DC X'02' Number of shared subpools v220 | |
| DC X'01' Share SP 1 v220 | |
| DC X'02' Share SP 2 v220 | |
| DS X Reserved v220 | |
| * | |
| *-- Get a new command type WRE | |
| * | |
| *-- Entry: None | |
| * Exit: R1 -> WRE | |
| * | |
| * | |
| GTW000 EQU * | |
| ST R14,SV14 Save return addr | |
| GETMAIN RU, Get CSA for WRE TYPE=WRECMD x | |
| LV=WRESIZE, v220x | |
| SP=2 v220 | |
| XC 0(WRESIZE,R1),0(R1) Clear stg area v220 | |
| USING WRE,R1 | |
| MVI WRESP,2 Save subpool v220 | |
| MVI WRETYPE,WRECMD CMD/MSG WRE | |
| * | |
| NJETRACE TYPE=TRCGWRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 5(3,R14),SV14+1 Addr of GTW000 caller v220 | |
| STM R0,R1,8(R14) Len, stg addr to trace v220 | |
| MVI 8(R14),2 Trace subpool # v220 | |
| DROP R1 | |
| L R14,SV14 Load return addr | |
| BR R14 | |
| * | |
| *-- Queue the WRE on the Link and post link's ECB | |
| *-- Caller must be PSW key 0 | |
| * | |
| *-- Entry: R2 -> LINKTABL entry | |
| *-- R4 -> WRE | |
| *-- Exit: None | |
| * | |
| PST000 EQU * | |
| USING LINKTABL,R2 | |
| USING WRE,R4 | |
| ST R14,SV14 Save return addr | |
| LM R0,R1,LWRESWAP Get first WRE ptr, sync count | |
| * | |
| PST020 EQU * | |
| ST R0,WRENEXT First WRE becomes next | |
| LA R5,1(,R1) Incr synchronization count | |
| CDS R0,R4,LWRESWAP Update LINK WRE anchor, sync | |
| BC 7,PST020 Gotta try again | |
| * | |
| LA R1,LECB -> link task notification ECB | |
| POST (1) Tell subtask WRE is queued | |
| L R14,SV14 Load return addr | |
| BR R14 | |
| * | |
| DROP R2 LINKTABL | |
| DROP R4 WRE | |
| * | |
| * | |
| *-- Message response to console or local TSO user | |
| * | |
| *=== NOTE === | |
| *=== At present this routine (RSP000) is not called or used, but | |
| *=== is retained here for possible future use. | |
| * | |
| * | |
| *-- Entry: Area "MACLIST" contains a WTO format msg | |
| * Area CMNDUSER=BLANKS send to console | |
| * Area CMNDUSER=userid send to that userid | |
| *-- Exit: None | |
| * | |
| * Area "CMDAREA" is used by this call. | |
| * | |
| * | |
| RSP000 EQU * | |
| ST R14,SV14 Save return addr | |
| CLC CMNDUSER,BLANKS Is there a userid? | |
| BE RSP010 No, respond to console | |
| CLC CMNDUSER,=CL8'OP' Respond to operator | |
| BE RSP010 Y | |
| * | |
| LA R15,CMNDUSER -> userid to locate | |
| BAL R14,USR800 See if TSO user logged on | |
| BZ RSP090 Skip msg if not | |
| MVC CMDAREA,MACLIST+4 Save message text | |
| MVC MACLIST+4(4),=C'SE ''' | |
| MVC MACLIST+8(104),CMDAREA v102 | |
| MVC MACLIST+112(8),=C''',USER=(' v102 | |
| MVC MACLIST+120(12),BLANKS Ensure trailer initted v102 | |
| MVC MACLIST+120(7),CMNDUSER Max for TSO userid is 7 v102 | |
| LA R1,MACLIST+127 v102 | |
| TRT MACLIST+120(7),BLANK v102 | |
| MVI 0(R1),C')' | |
| MVI 1(R1),C' ' | |
| MVC MACLIST(4),=AL2(129,0) max len + 4 overhead v102 | |
| * | |
| SPKA 0 | |
| LA R1,MACLIST | |
| SR R0,R0 | |
| SVC 34 Issue MGCR SVC | |
| SPKA X'80' | |
| B RSP090 | |
| * | |
| RSP010 EQU * | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| RSP090 EQU * | |
| L R14,SV14 Reload return addr | |
| BR R14 | |
| * | |
| *-- Search CSCB chain to see if TSO user is logged on | |
| *-- Entry: R15->8-byte padded field containing TSO userid to find | |
| *-- Exit: CC=0 user was not logged on | |
| *-- CC<>0 user is logged on | |
| * | |
| USR800 EQU * | |
| CLC =CL8'OP',0(R15) Is the userid the operator? | |
| BE USR890 Yes, let it thru | |
| L R1,16 Get CVT ptr | |
| USING CVT,R1 | |
| L R1,CVTASCBH -> highest prty ASCB | |
| USING ASCB,R1 | |
| * | |
| USR810 EQU * | |
| L R2,ASCBCSCB -> CSCB | |
| USING CSCB,R2 | |
| LTR R2,R2 Is there a CSCB? | |
| BZ USR840 No, get next ASCB | |
| * | |
| USR820 EQU * | |
| CLC CHKEY,=XL8'00' Jobname zeroed? | |
| BE USR830 Y, skip this CSCB | |
| CLC CHKEY,=CL8' ' Jobname is blank? | |
| BE USR830 Y, skip this CSCB | |
| CLC CHKEY,0(R15) Is this the userid? | |
| BE USR890 Yes | |
| USR830 EQU * | |
| L R2,CHPTR -> next CSCB | |
| LA R2,0(,R2) Clear high order | |
| LTR R2,R2 Last CSCB? | |
| BNZ USR820 No | |
| BR R14 Return with CC=0 (not found) | |
| * | |
| USR840 EQU * | |
| L R1,ASCBFWDP -> next ASCB | |
| LTR R1,R1 last one? | |
| BNZ USR810 No | |
| BR R14 Return with CC=0 (not found) | |
| * | |
| USR890 EQU * | |
| LTR R14,R14 Set CC=non zero (userid found) | |
| BR R14 Return to caller | |
| * | |
| DROP R1 ASCB | |
| DROP R2 CSCB | |
| * | |
| *-- Special code to intercept messages destined for v220 | |
| *-- registered users v220 | |
| * | |
| * | |
| REG000 EQU * v220 | |
| L R2,AREGUSER -> registered user anchor word v220 | |
| ICM R2,15,0(R2) -> registered user queue v220 | |
| BZR R14 No registered users v220 | |
| * | |
| USING REGUSERB,R2 v220 | |
| REG010 EQU * v220 | |
| CLC REGUSRID,0(R15) Find a matching registered user v220 | |
| BE REG020 Found it v220 | |
| ICM R2,15,REGNEXT -> next REGUSER entry v220 | |
| BNZ REG010 Keep looking v220 | |
| BR R14 Userid was not registered v220 | |
| * | |
| REG020 EQU * v220 | |
| ST R14,SVR14R Save return addr v220 | |
| BAL R14,GTW000 Get a WRE v220 | |
| LR R4,R1 v220 | |
| USING WRE,R4 v220 | |
| MVI WRETYPE,WREQRM Queue registered msg WRE v220 | |
| * | |
| MVC WRELINK,LCLNODE Target WRE to local node task v220 | |
| MVC WREUSER,REGUSRID Dest= registered user id v220 | |
| MVC WREORIG,BLANKS No originating node v220 | |
| MVC WRETXT,BLANKS Init first part v220 | |
| MVC WRETXT(5),=C'From ' v220 | |
| MVC WRETXT+5(8),WREORIG-WRE(R6) From original msg v220 | |
| TRT WRETXT+5(9),BLANK Look for end of orig userid v220 | |
| MVI 0(R1),C':' v220 | |
| LA R1,2(,R1) -> area for msg v220 | |
| MVC 0(104,R1),WRETXT-WRE(R6) Copy msg text v220 | |
| MVI WRETXTLN,L'WRETXT Set the max possible len v220 | |
| * | |
| SPKA 0 v220 | |
| L R15,CSABLK -> NJE38 CSA block v220 | |
| USING NJ38CSA,R15 v220 | |
| LM R0,R1,NJ38SWAP Get first WRE ptr, sync count v220 | |
| * | |
| REG030 EQU * v220 | |
| ST R0,WRENEXT First WRE becomes next v220 | |
| LA R5,1(,R1) Incr synchronization count v220 | |
| CDS R0,R4,NJ38SWAP Update LINK WRE anchor, sync v220 | |
| BC 7,REG030 Gotta try again v220 | |
| * | |
| LA R1,NJ38ECB -> main task notification ECB v220 | |
| POST (1) Wake him up v220 | |
| * | |
| SPKA X'80' v220 | |
| * | |
| DROP R2,R4,R15 REGUSERB,WRE,NJ38CSA v220 | |
| * v220 | |
| REG090 EQU * v220 | |
| L R14,SVR14R Load return addr v220 | |
| LTR R14,R14 Set non-zero CC v220 | |
| BR R14 Ret w/CC non-zero (msg queued) v220 | |
| * | |
| * | |
| *-- Format and display VSAM errors | |
| * | |
| FMT000 EQU * | |
| STM R14,R2,BALRSAVE Save regs used | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE079I),NJE079I Move msg text | |
| MVC MACLIST+55(8),5(R12) Move csect name | |
| TRT MACLIST+55(9),BLANK Look for end of csect name | |
| MVI 0(R1),C'+' | |
| * | |
| LA R15,0(,R14) Clear high, Get addr of call to this rtn | |
| LA R12,0(,R12) Clear high byte | |
| SR R15,R12 Compute offset of call | |
| ST R15,DBLE Save to work area | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC 1(4,R1),TWRK Move call offset to msg | |
| * | |
| LA R15,NCB1 | |
| UNPK TWRK(5),NCBRTNCD-NCB(3,R15) Add zones | |
| TR TWRK(4),HEXTRAN-240 | |
| MVC MACLIST+35(4),TWRK Move rtncd/errcd | |
| * | |
| UNPK TWRK(3),NCBREQ-NCB(2,R15) Add zones | |
| TR TWRK(2),HEXTRAN-240 | |
| MVC MACLIST+45(2),TWRK Move req code | |
| * | |
| L R1,NCBMACAD-NCB(,R15) Get failing VSAM macro addr | |
| LA R1,0(,R1) Clear high byte | |
| S R1,ANJESPL offset into NJESPOOL rtn v210 | |
| ST R1,DBLE | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC MACLIST+50(4),TWRK Move NJESPOOL offset to msg | |
| * | |
| MVC LASTRC(2),NCBRTNCD-NCB(R15) Save off rtncd/errcd | |
| OI NJFL1,NJF1VSER Indicate VSAM error occurred | |
| * | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| FMT090 EQU * | |
| LM R14,R2,BALRSAVE Restore caller regs | |
| BR R14 Exit with CC set | |
| * | |
| * | |
| * | |
| ATTACH ATTACH SF=L | |
| ATTACHL EQU *-ATTACH | |
| POST POST 0,ASCB=0,ERRET=0,MF=L v220 | |
| POSTL EQU *-POST v220 | |
| WTOMSG WTO ' x | |
| ',MF=L | |
| WTOMSGL EQU *-WTOMSG | |
| * | |
| BLANKS DC CL120' ' | |
| NONBLANK DC 64X'FF',X'00',191X'FF' TR Table to locate nonblank | |
| BLANK DC 64X'00',X'FF',191X'00' TR Table to locate blanks | |
| ASTER DC 92X'00',X'FF',163X'00' TR Table to locate asteriskv211 | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * 1 2 3 4 5 | |
| * 456789012345678901234567890123 45678 90123456789012345 | |
| NJE079I DC C'NJE079I NETSPOOL RTNCD/ERRCD=X''0000'',REQ=01,O=1234,Mx | |
| MMMMMMM ' | |
| * | |
| LTORG | |
| * | |
| * * | |
| *********************************************************************** | |
| ** ** | |
| ** TASK ESTAI EXIT ** | |
| ** ** | |
| ** This csect handles all abends trapped by ESTAE during the normal ** | |
| ** execution of the subtask. This exit does not attempt ** | |
| ** any recovery other than to terminate processing. ** | |
| ** An SVC dump is taken on abends. ** | |
| ** ** | |
| ** On entry: R0=ESTAE provide entry code ** | |
| ** R1=SDWA address ** | |
| ** R2=parameter passed on ESTAE macro ** | |
| ** ** | |
| ** ** | |
| ** On exit: If SDWACLUP is 1, then no retry is allowed and this ** | |
| ** exit will allow percolation back to system routines ** | |
| ** to terminate the task. ** | |
| ** ** | |
| ** If SDWACLUP is 0, then retry is allowed. ** | |
| ** ** | |
| ** Security: N/A. ** | |
| ** ** | |
| ** Register usage: ** | |
| ** ** | |
| ** R1 = SDWA address ** | |
| ** R3 = SDWA address ** | |
| ** R10 = Dynamic storage area base ** | |
| ** R12 = This program base ** | |
| ** ** | |
| ** ** | |
| ** ** | |
| *********************************************************************** | |
| * | |
| NJEDMP CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDMP' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| LR R12,R15 SET UP BASE REG | |
| USING NJEDMP,R12 ESTABLISH ADDRESSABILITY | |
| LR R8,R14 SAVE RETURN ADDRESS TO SYSTEM | |
| * | |
| L R10,0(,R1) GET VALUE PASSED TO US (WORKA) | |
| USING NJEMWK,R10 | |
| L R11,ANJECOM -> common code and constants | |
| USING NJECOM,R11 | |
| * | |
| LR R3,R1 SAVE R1 ENTRY CONTENTS | |
| USING SDWA,R3 | |
| LR R5,R0 Save R0 entry code | |
| * | |
| LTR R3,R3 Do we have an SDWA? | |
| BZ NOSDWA Exit if no SDWA | |
| LA R13,MVSSAVE Save area | |
| * | |
| MODESET MODE=SUP, Run this ESTAI exit privileged x | |
| KEY=ZERO to access PSW -> storage | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| L R6,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R6) -> TIOT | |
| MVC MACLIST+4(8),0(R5) Plug in job name | |
| MVC MACLIST+14(5),=C'LINK ' | |
| MVC LKNAME,=CL8' ' Init receiving field | |
| * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| ICM R2,15,LNEXT -> 1st non-lcl LINKTABL v211 | |
| BZ LNK005 Skip if not there v211 | |
| * | |
| LNK000 EQU * | |
| CLM R6,7,LTCBA+1 Look for TCB of failing link | |
| BE LNK010 Found it | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ LNK000 Keep searching | |
| * | |
| LNK005 EQU * v211 | |
| MVC MACLIST+14(5),=C'LMOD ' | |
| MVC MACLIST+19(8),=CL8'NJEINIT' Else it is main task | |
| OI NJFL1,NJF1INIT This is the NJEINIT task | |
| B LNK020 No TCB/link found | |
| * | |
| LNK010 EQU * | |
| MVC MACLIST+19(8),LINKID Move link name | |
| MVC LKNAME,LINKID Save copy of link name | |
| DROP R2 | |
| * | |
| LNK020 EQU * | |
| MVC MACLIST+29(5),=C'ABEND' | |
| L R5,SDWAABCC GET ABEND CODE INFO WORD | |
| N R5,=X'00FFF000' KEEP ONLY THE SYSTEM CODE | |
| BZ USERCDE NONE THERE, MUST BE A USER CODE | |
| C R5,=X'00222000' Operator cancel, no dump? | |
| BE SDUMP040 no | |
| C R5,=X'00013000' 013-OPEN abend? v211 | |
| BE SDUMP040 no dump v211 | |
| * | |
| MVI MACLIST+35,C'S' INDICATE SYSTEM CODE | |
| UNPK FWORK(5),SDWACMPC(3) GET SYSTEM CMP CODE | |
| TR FWORK(3),HEXTRAN-240 | |
| MVC FWORK+3(5),=CL5' ' CLEAR REST OF ABEND CODE | |
| B NOREAS | |
| * | |
| USERCDE EQU * | |
| MVI MACLIST+35,C'U' INDICATE USER ABEND CODE | |
| L R5,SDWAABCC GET ABEND CODE | |
| N R5,=X'00000FFF' KEEP USER ABEND CODE | |
| CVD R5,FSAVE CONVERT CODE TO DECIMAL | |
| UNPK FWORK(4),FSAVE UNPK THE CODE | |
| OI FWORK+3,X'F0' FIX SIGN | |
| MVC FWORK+4(2),=CL2' ' BLANKS AT END OF ABEND CODE | |
| * | |
| NOREAS EQU * | |
| MVC MACLIST+36(6),FWORK MOVE ABEND-REASON TO LINE | |
| MVC ABCODE,MACLIST+36 Save a copy of formatted abcode | |
| * | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(3),=C'PSW' | |
| UNPK FSAVE(9),SDWAEC1(5) Add zones to PSW word 1 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+10(8),FSAVE | |
| UNPK FSAVE(9),SDWAEC1+4(5) Add zones to PSW word 2 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+19(8),FSAVE | |
| * | |
| SR R5,R5 CLEAR FOR IC | |
| IC R5,SDWAILC1 GET THE ILC | |
| CVD R5,FWORK MAKE DECIMAL | |
| MVC MACLIST+29(3),=C'ILC' | |
| UNPK MACLIST+33(2),FWORK UNPK | |
| OI MACLIST+34,X'F0' FIX THE SIGN | |
| * | |
| MVC MACLIST+37(4),=C'INTC' | |
| UNPK FWORK(5),SDWAINC1(3) MAKE INTC DISPLAYABLE | |
| TR FWORK(4),HEXTRAN-240 | |
| MVC MACLIST+42(4),FWORK MOVE INTC TO LINE | |
| * | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(13),=C'DATA NEAR PSW' | |
| MVC MACLIST+19(8),=CL8'UNAVAIL' ASSUME WE CANT GET DATA | |
| L R4,SDWAEC1+4 Get PSW IA | |
| LA R4,0(,R4) Clear high bit | |
| C R4,=F'8' 1st 8 bytes of storage? | |
| BH LOC010 No, its higher than that | |
| SR R4,R4 Yes, just use 0 | |
| B LOC020 | |
| * | |
| LOC010 EQU * | |
| S R4,=F'8' BACK UP BEFORE INTERRUPT ADDR | |
| * | |
| LOC020 EQU * | |
| LRA R0,0(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| LRA R0,14(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| * | |
| ST R4,FWORK SAVE FOR CONVERSION | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES TO ADDRESS | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+19(8),FSAVE MOVE DISPLAYABLE | |
| * | |
| MVC FWORK(4),0(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+29(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),4(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+38(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),8(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+47(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),12(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+56(8),FSAVE MOVE TO LINE | |
| * | |
| UNAVAIL EQU * | |
| WTO ,MF=(E,MACLIST) | |
| *---- | |
| LA R4,4 4 ROWS OF REGISTERS | |
| LA R5,SDWAGR00 POINT TO ABEND REGS | |
| LA R6,REGLIST POINT TO REGISTER ID LITERALS | |
| * | |
| GPR000 EQU * v220 | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(8),0(R6) MOVE REGISTERS ID | |
| LA R15,MACLIST+13 WHERE 1ST REG GOES ON LINE | |
| LA R14,4 4 REGS PER LINE | |
| * | |
| GPR010 EQU * v220 | |
| UNPK FSAVE(9),0(5,R5) UNPK A REGISTER | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC 0(8,R15),FSAVE MOVE TO THE LINE | |
| LA R15,10(,R15) NEXT SPOT ON PRINT LINE | |
| LA R5,4(,R5) NEXT REGISTER | |
| BCT R14,GPR010 KEEP DOING REGS v220 | |
| WTO ,MF=(E,MACLIST) | |
| LA R6,8(,R6) NEXT REGISTER ID | |
| BCT R4,GPR000 GO DISPLAY THE NEXT ROW v220 | |
| * | |
| * | |
| SDUMP000 EQU * | |
| MVI DHDR,C' ' | |
| MVC DHDR+1(29),DHDR | |
| MVI DHDR,29 IBM length of header | |
| L R5,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R5) -> TIOT | |
| MVC DHDR+1(8),0(R5) Use jobname in description | |
| MVC DHDR+11(8),LKNAME Use link name | |
| MVC DHDR+21(7),ABCODE | |
| * | |
| MVC MACLIST(SDUMPL),SDUMP MOVE SDUMP LIST TO WORK | |
| LA R1,MACLIST | |
| SDUMP HDRAD=DHDR, ISSUE SDUMP TO RECORD STATUS x | |
| BUFFER=NO, x | |
| QUIESCE=NO, x | |
| SDATA=(RGN,CSA,LPA,SUM), x | |
| MF=(E,(1)) | |
| * | |
| * | |
| SDUMP040 EQU * | |
| TM NJFL1,NJF1INIT Is this the NJEINIT task? | |
| BZ SDUMP090 No | |
| ICM R5,15,CSABLK -> CSA stg area | |
| BZ SDUMP090 Not present | |
| * | |
| FREEMAIN RU,LV=16,A=(5),SP=241 Free CSA area | |
| XC CSABLK,CSABLK | |
| * | |
| SDUMP090 EQU * | |
| LR R1,R3 SDWA BACK TO R1 | |
| * ** SDWA ADDR MUST BE IN R1 FOR SETRP | |
| SETRP RC=0, No retry X | |
| DUMP=NO Suppress any further dumps | |
| * | |
| NOSDWA EQU * ** NO RETRY AVAILABLE (OR DESIRED) | |
| SR R15,R15 REQUEST PERCOLATION | |
| LR R14,R8 RESTORE RETURN ADDRESS | |
| BR R14 RETURN TO SYSTEM | |
| * | |
| LTORG | |
| * | |
| SDUMP SDUMP MF=L | |
| SDUMPL EQU *-SDUMP | |
| * | |
| REGLIST DC CL8'GR 0-3' | |
| DC CL8'GR 4-7' | |
| DC CL8'GR 8-11' | |
| DC CL8'GR 12-15' | |
| * | |
| LTORG | |
| * | |
| * | |
| * | |
| ********************* | |
| * N J E C M D * Commands issued by TSO users via command | |
| * * module NJE38 also arrive here | |
| * MVS Modify cmd * | |
| * processing * | |
| * * | |
| ********************* | |
| * | |
| NJECMD CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECMD' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| STM R14,R12,12(R13) | |
| LR R12,R15 Base | |
| USING NJECMD,R12 ADDRESS IT | |
| USING NJECOM,R11 | |
| USING NJEMWK,R10 | |
| * | |
| ST R13,NJECMDSA+4 | |
| LA R13,NJECMDSA | |
| * | |
| CMD000 EQU * | |
| BAL R14,LOC000 Announce command being executed | |
| * | |
| CMD010 EQU * | |
| LA R0,TGTCONS Console gets response | |
| LA R1,CMNDBLOK -> local CMDBLOK area | |
| ST R1,ACMDBLOK Set addr in cmd parm list | |
| LA R1,INITPARM -> parm list | |
| L R15,ANJECMX -> Command processor | |
| BALR R14,R15 | |
| B XITCMD00 | |
| * | |
| * | |
| LOC000 EQU * | |
| CLC CMNDUSER,=CL8'OP' Command from operator? | |
| BER R14 Yes, skip location msg | |
| * | |
| ST R14,SV14 Save return addr | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE005I),NJE005I | |
| LA R1,MACLIST+4+L'NJE005I -> next byte | |
| MVC 0(8,R1),LCLNODE Local node | |
| TRT 0(9,R1),BLANK Look for end | |
| MVI 0(R1),C'(' | |
| MVC 1(8,R1),CMNDUSER Local userid | |
| TRT 1(9,R1),BLANK Look for end | |
| MVC 0(12,R1),=CL12') executing:' | |
| LA R1,13(,R1) -> area for msg | |
| SR R15,R15 Clear for IC | |
| IC R15,CMNDBLEN Len of cmd text | |
| C R15,=F'50' Allow 50 char max | |
| BL *+8 We're ok | |
| LA R15,50 Use 50 | |
| EX R15,MVCMTXT1 Move command text to msg | |
| * | |
| WTO ,MF=(E,MACLIST) Issue location executing msg | |
| * | |
| LOC090 EQU * | |
| L R14,SV14 Reload return | |
| BR R14 Return | |
| * | |
| MVCMTXT1 MVC 0(0,R1),CMDAREA executed instr | |
| * | |
| * | |
| * | |
| * | |
| * | |
| XITCMD00 EQU * | |
| L R13,4(,R13) -> NJEREQ save area | |
| LM R14,R12,12(R13) Reload callers regs | |
| SR R15,R15 | |
| BR R14 Return to NJEREQ | |
| * | |
| LTORG | |
| * | |
| * 456789012345678901234567890123456789012345678901 | |
| NJE005I DC C'NJE005I Location ' Location executing | |
| * | |
| * | |
| * | |
| * | |
| *************** | |
| * TIMER * THIS EXIT WILL KEEP THE JOB | |
| * EXPIRATION * ACTIVE EVERY 20 MINUTES, AND | |
| * EXIT * WILL KEEP THE JOB FROM ABENDING | |
| *************** WITH AN S 522 ABEND (WAIT LIMIT) | |
| * | |
| NJETMR CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJETMR' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| STM R14,R12,12(R13) | |
| LR R12,R15 | |
| USING NJETMR,R12 | |
| * | |
| STIMER REAL, RESET THE TIMER AGAIN X | |
| (12), POINT TO THE EXIT ROUTINE X | |
| DINTVL=INTVL INTERVAL | |
| * | |
| LM R14,R12,12(R13) RELOAD REGS | |
| SR R15,R15 | |
| BR R14 RETURN TO SYSTEM | |
| * | |
| DS 0D | |
| * HHMMSSTH | |
| INTVL DC CL8'00200000' 20 MINUTE TIMER | |
| * | |
| DROP R12 | |
| LTORG | |
| * | |
| * | |
| *************** v212 | |
| * GET * v212 | |
| * TRACE * v212 | |
| * ENTRY * v212 | |
| *************** v212 | |
| * | |
| NJETRC CSECT v212 | |
| B 28(,R15) BRANCH AROUND EYECATCHERS v212 | |
| DC AL1(23) LENGTH OF EYECATCHERS v212 | |
| DC CL9'NJETRC' v212 | |
| DC CL9'&SYSDATE' v212 | |
| DC CL5'&SYSTIME' v212 | |
| USING NJETRC,R15 v212 | |
| LR R0,R14 Save return addr v212 | |
| * | |
| TRC000 EQU * v212 | |
| USING TRCCTL,R2 v212 | |
| L R1,TRCCURR -> current trace slot v212 | |
| LA R14,TRCSZ(,R1) -> next slot v212 | |
| C R14,TRCEND At end of table? v212 | |
| BL TRC010 No v212 | |
| L R14,TRCSTRT Y, wrap to beginning v212 | |
| LA R14,TRCSZ(,R14) -> Skip over first slot v212 | |
| * | |
| TRC010 EQU * v212 | |
| CS R1,R14,TRCCURR Set new current v212 | |
| BC 4,TRC000 CC=1; no match; try again v212 | |
| * | |
| XC 0(TRCSZ,R14),0(R14) Clear slot v212 | |
| DROP R2,R15 v212 | |
| * | |
| LR R15,R0 Load return addr to.. R15 !v212 | |
| LM R0,R2,20(R13) Reload the rest v212 | |
| BR R15 Return via R15; v212 | |
| * New trace entry -> R14 v212 | |
| * | |
| * | |
| * | |
| **** Main work area common | |
| **** to all NJExxx CSECTs. | |
| * | |
| NJEMWK DSECT | |
| NJEEYE DS CL4'NJEM' Eyecatcher; main task work area | |
| NJEWKLEN DS F Getmain size of this area | |
| * | |
| DEFUSER DS CL8 Default userid from CONFIG v200 | |
| RELAYID DS CL8 Relay entity id v220 | |
| DBLE DS D Work area | |
| TWRK DS 2D Work area | |
| NCB1 DS XL48 NETSPOOL CB | |
| * | |
| NJEPARMS Define passed parameter list v220 | |
| * | |
| MACLIST DS XL160 Macro expansion area | |
| ANJECOM DS A -> NJECOM csect | |
| COMMAREA DS A -> Console communications area | |
| COMMECBA DS A -> Console communications ECB | |
| REGUSER DS A -> REGUSER chain anchor v220 | |
| LINKS DS A -> LINKTABL chain anchor v211 | |
| ROUTES DS A -> RTE chain anchor v211 | |
| AUTHS DS A -> AUTHLIST chain anchor v211 | |
| CSAECBAD DS A -> WRE ECB in CSA (same as NJ38ECB) | |
| * | |
| ECBLIST DS 66A ECB list, 64 links + 2 COMM ECBs | |
| * | |
| NJFL1 DS X Flag byte | |
| NJF1STOP EQU X'80' 1... .... Console STOP issued | |
| NJF1ENQ EQU X'40' .1.. .... NJE38 system ENQ issued | |
| NJF1VSER EQU X'02' .... ..1. NETSPOOL VSAM error occurred | |
| NJF1INIT EQU X'01' .... ...1 NJEINIT task in RTM | |
| * ..xx xx.. Available | |
| * | |
| NJFL2 DS X Flag byte | |
| * xxxx xxxx Available | |
| * | |
| LASTRC DS X Last RC from NCBRTNCD | |
| LASTERRC DS X Last errcd from NCBERRCD | |
| * | |
| FSAVE DS 2D | |
| FWORK DS D | |
| DHDR DS CL30 | |
| ABCODE DS CL7 | |
| FLAGS DS X | |
| LKNAME DS CL8 Name of failing link | |
| * | |
| * | |
| * Command response target | |
| TGTUSER EQU 0 remote user | |
| TGTCONS EQU 4 MVS system console | |
| CMNDBLOK DS 0XL140 CMDBLOK | |
| CMNDBLEN DS AL1 Command image ibm length | |
| CMNDDMY DS XL3 Rest of CMDBLOK (unused here) | |
| CMNDLINK DS CL8 Node of issuer | |
| CMNDUSER DS CL8 yserid of issuer | |
| CMDAREA DS CL120 Modify command image | |
| * | |
| CMDBLNK DS CL120 For TRT overflow, all blanks | |
| * | |
| JFCBDCB DS (NSPOOLN)X Space for DCB | |
| JEXLST DS A DCB EXLST | |
| * | |
| NJERNAME DS CL12 12 ENQ RNAME,+44 for DSN in JFCB | |
| JFCB DS XL176 Space for JFCB | |
| * | |
| SV14 DS A General use R14 save | |
| SVR14R DS A General use R14 save | |
| NJESA DS 18F NJEINIT OS save area | |
| NJECMDSA DS 18F NJECMD OS save area | |
| MVSSAVE DS 18F ESTAE exit OS save | |
| BALRSAVE DS 16F Local register save area | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEMWK | |
| * | |
| * | |
| *-- System DSECTs | |
| * | |
| * | |
| IEZCOM DSECT | |
| IEZCOM | |
| IEZCIB IEZCIB | |
| IHAPSA | |
| IHASDWA | |
| IKJTCB | |
| IHAASCB | |
| IEZJSCB | |
| * | |
| CSCB DSECT | |
| IEECHAIN MAP FOR A CSCB | |
| CVT DSECT=YES,LIST=YES | |
| DCBD DEVD=DA,DSORG=PS | |
| * | |
| COPY LINKTABL | |
| COPY RTE | |
| COPY AUTHLIST | |
| COPY NETSPOOL | |
| * | |
| *-- NJE38 DSECTs | |
| * | |
| NJEWRE v220 | |
| NJERUSER v220 | |
| NJETRACE TYPE=DSECT v220 | |
| * | |
| END NJEINIT | |
| ./ ADD NAME=NJEFMT | |
| * | |
| * | |
| *-- NJE38 - NETSPOOL Formatter | |
| * | |
| * | |
| * This program formats the NETSPOOL dataset. | |
| * | |
| * | |
| * | |
| * | |
| REGEQU | |
| NJEFMT CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) SAVE CMS REGS | |
| LR R12,R15 BASE | |
| USING NJEFMT,R12 ADDRESS IT | |
| * | |
| GETMAIN RU, GET LOCAL STG AREA X | |
| LV=NJEFSZ | |
| LR R10,R1 | |
| LR R1,R0 COPY LENGTH | |
| LR R2,R0 COPY LENGTH | |
| LR R0,R10 -> NEW STG AREA | |
| SR R15,R15 SET PAD | |
| MVCL R0,R14 CLEAR THE PAGE | |
| * | |
| USING NJEFWK,R10 | |
| ST R13,NJESA+4 SAVE PRV S.A. ADDR | |
| LA R1,NJESA -> MY SAVE AREA | |
| ST R1,8(,R13) PLUG IT INTO PRIOR SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJEF' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area | |
| MVC SYSPRINT(DMYPRTL),DMYPRT Set up DCB | |
| MVC LIST,BLANKS Init print line | |
| * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (SYSPRINT,OUTPUT), Open the print dataset X | |
| MF=(E,MACLIST) | |
| * | |
| MVC LIST(L'MSG001),MSG001 | |
| BAL R14,PUT Write the line | |
| BAL R14,PUT Write blank line | |
| * | |
| GETMAIN RU, Get storage for NETSPOOL block x | |
| LV=4089, x | |
| BNDRY=PAGE | |
| ST R1,BLK Save address | |
| LR R8,R1 Keep in R8 | |
| * | |
| LR R1,R0 Copy length | |
| LR R0,R8 Copy address | |
| SR R15,R15 Clear pad | |
| MVCL R0,R14 Clear the stg | |
| * | |
| GENCB BLK=ACB, x | |
| DDNAME=NETSPOOL, x | |
| MACRF=(OUT,KEY,SEQ), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,ACBL Save len, addr | |
| * | |
| LA R9,KEY -> block number argument | |
| GENCB BLK=RPL, x | |
| ACB=(*,ACB), x | |
| AREA=(R8), -> block area x | |
| AREALEN=4089, x | |
| RECLEN=4089, x | |
| ARG=(R9), x | |
| OPTCD=(KEY,SEQ,MVE), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,RPLL Save len, addr | |
| * | |
| L R7,ACB -> ACB | |
| MVC MACLIST(OPENL),OPEN Move macro model | |
| OPEN ((R7)), Open NETSPOOL x | |
| MF=(E,MACLIST) | |
| LTR R15,R15 Did open succeed? | |
| BNZ OPENFAIL No | |
| OI FLAGS1,FL1OPEN Indic ACB open | |
| * | |
| LA R5,HIRBA -> SHOWCB receipt fields | |
| SHOWCB ACB=(R7), x | |
| AREA=(R5), x | |
| LENGTH=8, x | |
| FIELDS=(HALCRBA,CINV), Hi alloc RBA + CISZ x | |
| MF=(G,MACLIST) | |
| * | |
| CLC CISZ,=F'4096' Ensure CISZ is 4096 | |
| BNE BADCISZ It is not | |
| L R5,HIRBA Get high allocated RBA | |
| SRL R5,12 Divide by 4096 | |
| ST R5,BLKS Save number of blocks in d.set | |
| * | |
| L R6,RPL | |
| USING IFGRPL,R6 | |
| LA R4,1 Init block counter | |
| * | |
| FMT000 EQU * | |
| PUT RPL=(R6) Write a block | |
| * | |
| LTR R15,R15 Any errors? | |
| BZ FMT010 No | |
| CLI RPLRTNCD,X'08' Logical error? | |
| BNE PUTFAIL No, display error | |
| CLI RPLERRCD,X'08' Duplicate block? | |
| BE FMT100 Cluster is already formatted | |
| B PUTFAIL Display all other errors | |
| * | |
| FMT010 EQU * | |
| LA R4,1(,R4) Count blocks | |
| BCT R5,FMT000 Format exact amount | |
| B FMT200 Now go write images | |
| * | |
| *-- Here if NETSPOOL was previously formatted | |
| * | |
| FMT100 EQU * | |
| WTO 'NJEFMT - NETSPOOL dataset is already formatted' | |
| WTO 'NJEFMT - Reformatting will cause loss of all data' | |
| * | |
| FMT110 EQU * | |
| XC OPECB,OPECB Reinit ECB | |
| LA R2,DBLE -> reply area | |
| LA R3,OPECB -> WTOR ECB | |
| MVC MACLIST(WTORDMYL),WTORDMY Move model WTOR | |
| WTOR ,(R2),6,(R3),MF=(E,MACLIST) | |
| * | |
| WAIT 1,ECB=OPECB | |
| CLC DBLE(6),=C'CANCEL' Was cancel chosen? | |
| BE OPERCAN Yes | |
| CLI DBLE,C'U' Was U chosen | |
| BNE FMT110 Reissue msg | |
| * | |
| *-- Switch to direct processing and rewrite fresh initial images | |
| *-- to the directory and allocation map to be a newly formatted file. | |
| * | |
| FMT200 EQU * | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE ((R7)), Close ACB X | |
| MF=(E,MACLIST) | |
| NI FLAGS1,255-FL1OPEN Indic ACB closed | |
| * | |
| MODCB ACB=(R7), Switch to direct x | |
| MACRF=(KEY,DIR,OUT), x | |
| MF=(G,MACLIST) | |
| * | |
| MODCB RPL=(R6), x | |
| OPTCD=(KEY,DIR,UPD), Switch to direct update x | |
| MF=(G,MACLIST) | |
| * | |
| MVC MACLIST(OPENL),OPEN Move macro model | |
| OPEN ((R7)), Open NETSPOOL x | |
| MF=(E,MACLIST) | |
| LTR R15,R15 Did open succeed? | |
| BNZ OPENFAIL No | |
| OI FLAGS1,FL1OPEN Indic ACB open | |
| * | |
| L R2,BLK -> VSAM area | |
| * | |
| FMT210 EQU * | |
| MVC KEY,=F'1' Set block # argument | |
| GET RPL=(6) | |
| LTR R15,R15 Any errors? | |
| BNZ GETFAIL YES | |
| * | |
| LR R0,R2 -> block area | |
| LA R1,4089 Size of block | |
| LM R14,R15,BLK1 Get block data addr, pad+len | |
| MVCL R0,R14 Init the block, SPL ID=0 | |
| MVC 8(4,R2),BLKS Set max # blocks in dataset | |
| * | |
| PUT RPL=(6) Update the block | |
| LTR R15,R15 Any errors? | |
| BNZ PUTFAIL2 YES | |
| * | |
| FMT220 EQU * | |
| MVC KEY,=F'2' Set block # argument | |
| GET RPL=(6) | |
| LTR R15,R15 Any errors? | |
| BNZ GETFAIL YES | |
| * | |
| LR R0,R2 -> block area | |
| LA R1,4089 Size of block | |
| LM R14,R15,BLK2 Get block data addr, pad+len | |
| MVCL R0,R14 Init the block | |
| * | |
| PUT RPL=(6) Update the block | |
| LTR R15,R15 Any errors? | |
| BNZ PUTFAIL2 YES | |
| * | |
| FMT230 EQU * | |
| MVC KEY,=F'3' Set block # argument | |
| GET RPL=(6) | |
| LTR R15,R15 Any errors? | |
| BNZ GETFAIL YES | |
| * | |
| LR R0,R2 -> block area | |
| LA R1,4089 Size of block | |
| LM R14,R15,BLK3 Get block data addr, pad+len | |
| MVCL R0,R14 Init the block | |
| * | |
| PUT RPL=(6) Update the block | |
| LTR R15,R15 Any errors? | |
| BNZ PUTFAIL2 YES | |
| * | |
| *-- Set up allocation map | |
| * | |
| * The allocation map is a bit map, 1 bit for each block in the | |
| * NETSPOOL dataset. A "1" bit means the block is in use. Initially, | |
| * blocks 1-7 will be marked in use as they contain upon formatting: | |
| * block 1 - pointer to directory (A or B) and allocation blocks | |
| * block 2 - initial directory block A | |
| * block 3 - initial directory block B | |
| * blocks 4-7 - allocation bit map | |
| * | |
| * The bitmap contains 4 * 4096 bytes * 8 bits = 130,848 bits. Thus, | |
| * the largest supported NETSPOOL size is about 874 cylinders on a | |
| * 3380 DASD. | |
| * | |
| * The size of the NETSPOOL dataset can of course be smaller and all | |
| * bits past the end of the file should be marked as "in-use" in the | |
| * bitmap so they would never be allocated. | |
| * | |
| * The calculation for this is at FMT250. | |
| * Example: assume 10 cylinder file on 3380 = 150 blocks per cyl, | |
| * or 1500 total blocks in file. | |
| * | |
| * Starting from block 1501 (the first block past the end of the | |
| * dataset) divide by 8 to compute the byte number in the bitmap | |
| * representing block 1501: | |
| * | |
| * 1. 1501 / 8 = 187 remainder 5 | |
| * 2. Make a byte image of X'FF' (all records unavail in byte). | |
| * 3. Shift it to the right by the remainder (adding 0's on the left): | |
| * X'FF' shifted right by 5 = X'07' | |
| * 4. Store the X'07' computed value into byte 187 of the bitmap. | |
| * 5. All subsequent bytes 188 through the end of four blocks are X'FF' | |
| * 6. Write the four blocks to disk. | |
| * | |
| FMT240 EQU * | |
| GETMAIN RU,LV=16384 4 blocks of size | |
| LR R4,R1 | |
| LR R1,R0 COPY LENGTH | |
| LR R0,R4 -> NEW STG AREA | |
| SR R15,R15 SET PAD | |
| MVCL R0,R14 CLEAR THE PAGES | |
| * | |
| MVC 0(1,R4),DATA4 Set up allocation; blocks 1-7 | |
| * are initially in use | |
| FMT250 EQU * | |
| L R7,BLKS Get # blocks in dataset | |
| LA R7,1(,R7) block # of first unavail blk | |
| SR R6,R6 Clear for divide | |
| D R6,=F'8' Get byte offset remainder bits | |
| * | |
| AR R7,R4 -> byte containing bit for | |
| * first record beyond file size | |
| ICM R1,8,=X'FF' Assume all recs in byte unavail | |
| SRL R1,0(R6) Adjust for actual blocks that | |
| * do exist in same byte | |
| STCM R1,8,0(R7) Store it in map | |
| * | |
| LA R0,1(,R7) -> next byte in map | |
| L R1,=F'16384' Stg size | |
| AR R1,R4 Point to end of it | |
| SR R1,R0 Compute length to end | |
| L R15,=X'FF000000' Set all FFs pad char | |
| MVCL R0,R14 All FFs to the end | |
| * | |
| * | |
| LA R3,4 Blk # of allocation map | |
| LA R7,4 # of blocks to process | |
| L R6,RPL -> RPL | |
| * | |
| FMT270 EQU * Write map blocks 4 through 7 | |
| ST R3,KEY Set block # argument | |
| GET RPL=(6) | |
| LTR R15,R15 Any errors? | |
| BNZ GETFAIL YES | |
| * | |
| LR R0,R2 -> block area | |
| LA R1,4089 Size of block | |
| LA R5,4089 Size of block | |
| MVCL R0,R4 Init the block | |
| * | |
| PUT RPL=(6) Update the block | |
| LTR R15,R15 Any errors? | |
| BNZ PUTFAIL2 YES | |
| * | |
| LA R3,1(,R3) next blk # | |
| BCT R7,FMT270 | |
| B EXIT0 Format success | |
| * | |
| *-- Error routines | |
| * | |
| OPENFAIL EQU * | |
| MVC LIST(L'MSG002),MSG002 Open failed | |
| CVD R15,DBLE Convert RC | |
| UNPK LIST+29(2),DBLE | |
| OI LIST+30,X'F0' | |
| USING IFGACB,R7 | |
| UNPK DBLE(3),ACBERFLG(2) | |
| TR DBLE(2),HEXTRAN-240 | |
| MVC LIST+43(2),DBLE Move error value to line | |
| DROP R7 | |
| BAL R14,PUT Write open fail msg | |
| B EXIT8 | |
| * | |
| BADCISZ EQU * | |
| MVC LIST(L'MSG004),MSG004 NETSPOOL dataset definition err | |
| BAL R14,PUT Write msg | |
| MVC LIST(L'MSG005),MSG005 CISZ must be 4096 | |
| BAL R14,PUT Write msg | |
| B EXIT8 | |
| * | |
| OPERCAN EQU * | |
| MVC LIST(L'MSG006),MSG006 Formatting terminated by oper | |
| BAL R14,PUT Write msg | |
| B EXIT8 | |
| * | |
| PUTFAIL EQU * | |
| MVC LIST(L'MSG003),MSG003 PUT failed | |
| CVD R5,DBLE Convert block number | |
| MVC LIST+25(8),=X'4020202020202120' Move edit mask | |
| ED LIST+25(8),DBLE+4 Edit block count | |
| USING IFGRPL,R6 | |
| UNPK TWRK(9),RPLFDBWD(5) | |
| TR TWRK(8),HEXTRAN-240 | |
| MVC LIST+48(2),TWRK+2 Move RTNCD value to line | |
| MVC LIST+50(2),TWRK+6 Move FDBK value to line | |
| DROP R6 | |
| BAL R14,PUT Write open fail msg | |
| B EXIT8 | |
| * | |
| GETFAIL EQU * | |
| MVC LIST(L'MSG007),MSG007 Get failed | |
| CVD R3,DBLE Convert block number | |
| MVC LIST+25(8),=X'4020202020202120' Move edit mask | |
| ED LIST+25(8),DBLE+4 Edit block count | |
| USING IFGRPL,R6 | |
| UNPK TWRK(9),RPLFDBWD(5) | |
| TR TWRK(8),HEXTRAN-240 | |
| MVC LIST+48(2),TWRK+2 Move RTNCD value to line | |
| MVC LIST+50(2),TWRK+6 Move FDBK value to line | |
| DROP R6 | |
| BAL R14,PUT Write open fail msg | |
| B EXIT8 | |
| * | |
| PUTFAIL2 EQU * | |
| MVC LIST(L'MSG008),MSG008 PUT failed | |
| CVD R5,DBLE Convert block number | |
| MVC LIST+26(8),=X'4020202020202120' Move edit mask | |
| ED LIST+26(8),DBLE+4 Edit block count | |
| USING IFGRPL,R6 | |
| UNPK TWRK(9),RPLFDBWD(5) | |
| TR TWRK(8),HEXTRAN-240 | |
| MVC LIST+49(2),TWRK+2 Move RTNCD value to line | |
| MVC LIST+51(2),TWRK+6 Move FDBK value to line | |
| DROP R6 | |
| BAL R14,PUT Write open fail msg | |
| B EXIT8 | |
| * | |
| PUT EQU * | |
| ST R14,SV14 Save return addr | |
| PUT SYSPRINT,LIST | |
| MVC LIST,BLANKS | |
| L R14,SV14 Load return addr | |
| BR R14 Return | |
| * | |
| EXIT8 EQU * | |
| BAL R14,PUT Write blank | |
| MVC LIST(L'MSG999),MSG999 Exited with errors | |
| BAL R14,PUT Write msg | |
| * | |
| LA R15,8 | |
| B QUIT000 | |
| * | |
| EXIT0 EQU * | |
| BAL R14,PUT Write blank | |
| MVC LIST(L'MSG900),MSG900 Exited with success | |
| BAL R14,PUT Write msg | |
| * | |
| SR R15,R15 | |
| * | |
| QUIT000 EQU * | |
| LR R5,R15 Copy exit RC | |
| * | |
| TM FLAGS1,FL1OPEN Is ACB open? | |
| BZ QUIT010 No, skip close | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| L R7,ACB -> ACB | |
| CLOSE ((R7)), Close ACB X | |
| MF=(E,MACLIST) | |
| * | |
| QUIT010 EQU * | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (SYSPRINT), X | |
| MF=(E,MACLIST) | |
| * | |
| LM R0,R1,RPLL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| LM R0,R1,ACBL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| L R1,BLK | |
| FREEMAIN RU,LV=4089,A=(1) | |
| * | |
| LR R1,R10 -> NJEFWK work area | |
| L R13,4(,R13) -> CALLER'S SA | |
| FREEMAIN RU, Free the work area X | |
| LV=NJEFSZ, X | |
| A=(1) | |
| * | |
| ST R5,16(,R13) Save R15 RC | |
| LM R14,R12,12(R13) RELOAD SYSTEM'S REGS | |
| BR R14 Return | |
| * | |
| LTORG | |
| * | |
| DMYPRT DCB DDNAME=SYSPRINT, X | |
| MACRF=(PM), X | |
| DSORG=PS, X | |
| LRECL=80, X | |
| RECFM=FB, X | |
| BLKSIZE=800 | |
| DMYPRTL EQU *-DMYPRT | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| * | |
| WTORDMY WTOR 'NJEFMT - Reply U to proceed with format, or CANCEL', x | |
| MF=L | |
| WTORDMYL EQU *-WTORDMY | |
| * | |
| MSG001 DC C'NJEFMT - NJE38 NETSPOOL FORMAT UTILITY' | |
| * 0123456789012345678901234567890123456789012 345 6789 | |
| MSG002 DC C'Open failed for NETSPOOL, RC=xx,ACBERFLG=X''xx''' | |
| * 012345678901234567890123456789012345678901234567 8901 | |
| MSG003 DC C'PUT failed writing record xxxxxxx, RTNCD-FDBK=X''xxxx'x | |
| '' | |
| MSG004 DC C'NETSPOOL dataset definition error:' | |
| MSG005 DC C' CONTROLINTERVALSIZE must be exactly 4096 bytes' | |
| MSG006 DC C'Formatting terminated by system operator' | |
| MSG007 DC C'GET failed reading record xxxxxxx, RTNCD-FDBK=X''xxxx'x | |
| '' | |
| MSG008 DC C'PUT failed updating record xxxxxxx, RTNCD-FDBK=X''xxxxX | |
| ''' | |
| MSG900 DC C'Format utility completed successfully' | |
| MSG999 DC C'Format utility terminated with errors' | |
| * | |
| BLANKS DC CL80' ' | |
| HEXTRAN DC CL16'0123456789ABCDEF' | |
| * | |
| * | |
| * | |
| * | |
| BLK1 DC A(DATA1),A(DATA1L) Addr and length | |
| DATA1 DC F'2' Blk # of current directory | |
| DC F'4' Blk # of allocation map | |
| DC F'0' # blks in dataset | |
| DC F'0' Last assigned spool file id # | |
| DATA1L EQU *-DATA1 | |
| * | |
| BLK2 DC A(DATA2),A(DATA2L) Addr and length | |
| DATA2 EQU * | |
| DC AL2(NSDIRLN) LEN Length of record | |
| DC AL2(0) RESV1 reserved | |
| DC F'2' BLK blk # of 1st block of file | |
| DC CL8'NETSPOOL' INLOC | |
| DC CL16' ' LINK/INTOD | |
| DC CL8'DIR' INVM | |
| DC AL4(1) RECNM No. records in the file | |
| * Remainder of block is zeros | |
| * | |
| DATA2L EQU *-DATA2 | |
| * | |
| BLK3 DC A(DATA3),A(DATA3L) Addr and length | |
| DATA3 EQU * | |
| DC AL2(NSDIRLN) LEN Length of record | |
| DC AL2(0) RESV1 reserved | |
| DC F'3' BLK blk # of 1st block of file | |
| DC CL8'NETSPOOL' INLOC | |
| DC CL16' ' LINK/INTOD | |
| DC CL8'DIR' INVM | |
| DC AL4(1) RECNM No. records in the file | |
| * Remainder of block is zeros | |
| DATA3L EQU *-DATA3 | |
| * | |
| DATA4 DC B'11111110' Blocks initially allocated are | |
| * blocks 1-7 | |
| * | |
| * The rest of blocks 4 and 5,6,7 are computed at FMT250 and written | |
| * at FMT270. | |
| * | |
| * | |
| * | |
| NJEFWK DSECT | |
| NJEEYE DS CL4'NJEF' EYECATCHER | |
| NJEWKLEN DS F SIZE OF WORK AREA | |
| * | |
| NJESA DS 18F | |
| DBLE DS D | |
| TWRK DS XL16 | |
| MACLIST DS XL128 | |
| LIST DS CL80 PRINT LINE | |
| SV14 DS F R14 save area | |
| OPECB DS F Operator reply ECB | |
| BLK DS A -> NETSPOOL block stg area | |
| KEY DS F Relative block number key | |
| ACBL DS F ACB length | |
| ACB DS A -> ACB | |
| RPLL DS F RPL length | |
| RPL DS A -> RPL | |
| HIRBA DS F High allocated RBA | |
| CISZ DS F CI Size | |
| BLKS DS F Number of relative blocks | |
| * | |
| FLAGS1 DS X | |
| FL1OPEN EQU X'80' 1... .... ACB is open | |
| * | |
| SYSPRINT DS (DMYPRTL)X SYSPRINT DCB | |
| DS 0D Force doubleword boundary | |
| NJEFSZ EQU *-NJEFWK Size of work area | |
| * | |
| COPY NETSPOOL | |
| IFGACB | |
| IFGRPL | |
| END | |
| ./ ADD NAME=NJESCN | |
| * | |
| * | |
| *-- NJE38 - Configuration scan and create | |
| * | |
| * | |
| * Called by NJEINIT (on start up) | |
| * Called by NJECMX (for commands entered by users and operators) | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 04 Dec 20 - Expanded internal trace table support v212 | |
| * 29 Nov 20 - Initial creation v211 | |
| * | |
| * | |
| * | |
| * notes for doc: | |
| * | |
| * -keywords must start in col 1 | |
| * -keywords and values 1-8 bytes only | |
| * -last keyword or value on line must have a trailing blank (e.g, | |
| * column 80 must be blank) | |
| * -CUU must be 3-digit | |
| * -ROUTE names are not validated for existence, or character makeup | |
| * | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJESCN CSECT NJE00020 | |
| NJEVER | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| LA R11,2048 | |
| LA R11,2048(R11,R12) 2nd Base | |
| USING NJESCN,R12,R11 NJE00070 | |
| LR R7,R0 Save input code | |
| LR R8,R1 Save input parm list addr | |
| LR R9,R2 Save input parm list addr | |
| * | |
| LA R0,NJEWKSZ Size of work area | |
| GETMAIN RU, Get local stg area X | |
| LV=(0), X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the stg | |
| * | |
| USING NJEWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJES' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| STM R8,R9,INITPLST Save entry parm list addrs | |
| MVC INITPARM,0(R8) Copy passed parameters | |
| * | |
| INIT000 EQU * | |
| B INIT010(R7) Branch into request table | |
| * | |
| INIT010 EQU * | |
| B SCN000 00 Scan and create configuration | |
| B CMD000 04 Scan a configuration command | |
| * | |
| SCN000 EQU * | |
| MVC CONFIG,DMYDCB Set up DCB | |
| LA R1,JFCBL -> JFCB area | |
| ST R1,EXLST Plug into exit list | |
| MVI EXLST,X'87' Set up for JFCB retrieve | |
| LA R4,CONFIG -> DCB | |
| USING IHADCB,R4 | |
| LA R1,EXLST -> exit list | |
| STCM R1,7,DCBEXLST+1 Plug it into DCB | |
| * | |
| MVC MACLIST(RDJFCBL),RDJFCB Move macro model | |
| RDJFCB CONFIG,MF=(E,MACLIST) | |
| * | |
| MVC MACLIST(OPENL),OPEN Move macro model | |
| OPEN (CONFIG,INPUT), Open dataset x | |
| MF=(E,MACLIST) | |
| TM DCBOFLGS,DCBOFOPN Did DCB open ok? | |
| BZ EXIT08 No | |
| DROP R4 IHADCB | |
| OI NJFL1,F1OPEN Indicate DCB is open | |
| * | |
| LA R3,JFCBL | |
| USING JFCB,R3 | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE049I),NJE049I Using configuration DSN | |
| MVC WTOTXT+28(44),JFCBDSNM Move DSN | |
| TM JFCBIND1,JFCPDS Using PDS member? | |
| BZ SCN030 No | |
| TRT WTOTXT+28(45),BLANK Look for end of DSN | |
| MVI 0(R1),C'(' | |
| MVC 1(8,R1),JFCBELNM Move member name | |
| TRT 0(10,R1),BLANK Look for end of member name | |
| MVI 0(R1),C')' | |
| DROP R3 JFCB | |
| * | |
| SCN030 EQU * | |
| WTO ,MF=(E,WTOMSG) Write the using config msg | |
| SR R9,R9 Init record counter | |
| * | |
| SCN040 EQU * | |
| GET CONFIG,REC Get a record from CONFIG DD | |
| LA R1,REC -> RECORD | |
| LA R9,1(,R9) Bump record count | |
| CLI 0(R1),C'*' Comment line? | |
| BE SCN040 Yes, skip it | |
| CLI 0(R1),C' ' Blank leading off the line? | |
| BE ERR073 Yes, this is invalid | |
| * | |
| OC REC,BLANKS Upper case the record | |
| LA R15,80 Scan length of input line | |
| B CTK000 Join common code | |
| * | |
| SCN100 EQU * End of scan of one record | |
| B SCN040 Scan next | |
| * | |
| * | |
| * | |
| CMD000 EQU * | |
| L R2,ACMDBLOK -> CMDBLOK | |
| USING CMDBLOK,R2 | |
| MVC REC,BLANKS Init receiving field | |
| IC R1,CMDBLEN Len of command text | |
| EX R1,OCCMD Move and uppercase cmd image | |
| DROP R2 CMDBLOK | |
| LA R15,120 Max len of command image | |
| LA R1,REC -> Command image | |
| * | |
| CTK000 EQU * | |
| BAL R14,TKN000 Parse and tokenize the cmd | |
| LA R15,TOKENS-L'TOKENS -> 0th length/token in list | |
| BAL R14,GETTKN Get 1st token | |
| * | |
| CLC =CL8'LOCAL',1(R15) Local? | |
| BE LCL000 Yes | |
| CLC =CL8'LINK',1(R15) Link? | |
| BE LNK000 Yes | |
| CLC =CL8'ROUTE',1(R15) Route? | |
| BE RTE000 Yes | |
| CLC =CL8'AUTH',1(R15) Auth? | |
| BE AUTH000 Yes | |
| B ERR076 Unknown configuration statement | |
| * | |
| OCCMD OC REC(0),CMDTEXT-CMDBLOK(R2) Executed instr | |
| * | |
| RETURN EQU * R7 branch table index | |
| B SCN040 00 Read another config record | |
| B EXIT00 04 End of command processing | |
| * | |
| *-- LOCAL | |
| * | |
| LCL000 EQU * | |
| L R1,ALINKS -> LINKS anchor word | |
| NC 0(4,R1),0(R1) Was LOCAL processed? | |
| BNZ ERR052 Y, only one LOCAL allowed | |
| LA R0,LINKLEN Length of LINKTABL entry | |
| BAL R14,GETSTG Get stg for entry | |
| LR R8,R1 | |
| XC 0(LINKLEN,R8),0(R8) Initialize entry | |
| USING LINKTABL,R8 | |
| * | |
| BAL R14,GETTKN Get next token | |
| BZ ERR075 No local name | |
| MVC LINKID,1(R15) Local node name to entry | |
| TRT LINKID,VALDNAME Valid node name? | |
| BNZ ERR043 No | |
| * | |
| MVC LDEFUSER,DEFUSER Set default userid | |
| BAL R14,GETTKN Get next tkn (should be DEFUSER) | |
| BZ LCL090 No other tokens | |
| CLC =CL8'DEFUSER',1(R15) Was this the DEFUSER keyword? | |
| BNE ERR055 No, error | |
| BAL R14,GETTKN Get next tkn (should be userid) | |
| BZ ERR075 Missing userid | |
| MVC LDEFUSER,1(R15) Set default userid of choice | |
| DROP R8 LINKTABL | |
| * | |
| LCL090 EQU * | |
| L R15,ALINKS -> LINKS anchor word | |
| ST R8,0(,R15) Start LINKS chain | |
| B RETURN(R7) Resume scan | |
| * | |
| * | |
| *-- LINK | |
| * | |
| LNK000 EQU * | |
| L R1,ALINKS -> LINKS anchor word | |
| NC 0(4,R1),0(R1) Was LOCAL processed? | |
| BZ ERR053 No; it is required | |
| LA R8,BLDBUF Temp area to build entry | |
| XC 0(LINKLEN,R8),0(R8) Initialize entry | |
| USING LINKTABL,R8 | |
| MVC LBUFF,=H'1012' Set default buffer size | |
| * | |
| BAL R14,GETTKN Get next token | |
| BZ ERR075 No link name | |
| MVC LINKID,1(R15) Link node name to entry | |
| TRT LINKID,VALDNAME Valid node name? | |
| BNZ ERR043 No | |
| * | |
| LNK010 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ LNK050 None | |
| * | |
| CLC =CL8'LINE',1(R15) Was it a LINE keyword? | |
| BE LNE000 Yes | |
| CLC =CL8'BUFF',1(R15) Was it a BUFF keyword? | |
| BE BUF000 Yes | |
| CLC =CL8'AUTO',1(R15) Was it a AUTO keyword? | |
| BE ATO000 Yes | |
| CLC =CL8'OFF',1(R15) Was it the OFF keyword? | |
| BE LOFF000 Yes | |
| B ERR055 Unrecognized keyword | |
| * | |
| LNK050 EQU * | |
| TM NJFL2,F2LINE Was line CUU found? | |
| BZ ERR077 No, its required | |
| * | |
| *-- LINK successfully scanned. Now add the LINKTABL entry to chain. | |
| * | |
| L R2,ALINKS -> LINKS anchor word (0th entry) | |
| L R2,0(,R2) -> First LINKTABL e.g. LOCAL | |
| * | |
| LNK060 EQU * | |
| ICM R3,15,LNEXT-LINKTABL(R2) -> next LINKTABL entry | |
| BZ LNK080 Found the end | |
| CLC LINKID,LINKID-LINKTABL(R3) Match on link name? | |
| BE LNK120 Yes, trying to add duplicate | |
| * | |
| LNK070 EQU * | |
| LR R2,R3 Copy next entry ptr | |
| B LNK060 Keep scanning for end | |
| * | |
| LNK080 EQU * | |
| LA R0,LINKLEN Size of LINKTABL entry | |
| BAL R14,GETSTG Get an actual entry | |
| MVC 0(LINKLEN,R1),0(R8) Make build entry a permanent one | |
| ST R1,LNEXT-LINKTABL(,R2) Add R1 LINKTABL to chain end | |
| * | |
| LNK090 EQU * | |
| LTR R7,R7 Doing CONFIG scan? | |
| BZ SCN100 Yes, Resume scan | |
| * | |
| *--Issue LINK cmd success msg | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE066I),NJE066I | |
| MVC WTOTXT+13(8),LINKID Move link name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(7,R1),=CL7'defined' | |
| LA R0,22(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B SUCCMSG Issue success msg and exit | |
| * | |
| LNK120 EQU * ** Here for duplicate entry | |
| *--Issue LINK cmd duplicate msg | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE048E),NJE048E | |
| MVC WTOTXT+13(8),LINKID Move link name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(20,R1),=CL20'duplicate definition' | |
| LTR R7,R7 Doing CONFIG scan? | |
| BZ LNK130 Yes, issue duplicate msg | |
| MVC 1(20,R1),=CL20'is already defined' | |
| * | |
| LNK130 EQU * | |
| LA R0,34(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B ERRTYPE(R7) Issue dup msg | |
| * | |
| LNE000 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ ERR075 Missing CUU | |
| CLI 0(R15),X'02' Check keyword length | |
| BNE ERR078 Not valid CUU | |
| LR R3,R1 Save R1 across TRT | |
| TRT 1(3,R15),INVALHEX Valid hex chars? | |
| BNZ ERR078 Not valid cuu | |
| * | |
| LR R1,R3 Restore R1 | |
| MVC TWRK(3),1(R15) Move the character CUU | |
| TR TWRK(3),TRANHEX-192 Make all A-F chars = xFA-XFF | |
| * | |
| PACK DBLE(3),TWRK(4) Strip the zones | |
| MVC LDEFLINE,DBLE Move to LINKTABL entry | |
| OI NJFL2,F2LINE Indicate valid LINE CUU found | |
| B LNK010 Continue LINK token eval | |
| * | |
| BUF000 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ ERR075 Missing buffersize | |
| SR R3,R3 Clear for IC | |
| IC R3,0(,R15) Length of value characters | |
| EX R3,BFMVC Make a copy of value | |
| EX R3,BFOC Force copy to be numeric | |
| EX R3,BFCLC Was original numeric? | |
| BNE ERR054 Invalid BUFF value | |
| EX R3,BFPACK Pack the value | |
| CVB R0,DBLE Get binary value | |
| CH R0,=H'300' Too small? | |
| BL ERR054 Yes | |
| CH R0,=H'4020' Too large? | |
| BH ERR054 Yes | |
| STH R0,LBUFF Else set specified BUFF size | |
| B LNK010 Continue LINK token eval | |
| * | |
| BFMVC MVC DBLE(0),1(R15) executed instr | |
| BFOC OC DBLE(0),=8C'0' executed instr | |
| BFCLC CLC DBLE(0),1(R15) executed instr | |
| BFPACK PACK DBLE(8),1(0,R15) executed instr | |
| * | |
| ATO000 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ ERR075 Missing YES/NO | |
| CLC =CL8'YES',1(R15) Was it yes? | |
| BE ATO020 | |
| CLC =CL8'NO',1(R15) Was it no? | |
| BE LNK010 Line will not be autostartable | |
| B ERR078 Unrecognized value | |
| * | |
| ATO020 EQU * | |
| OI LFLAG,LAUTO Set line auto-startable | |
| B LNK010 Continue LINK token eval | |
| * | |
| LOFF000 EQU * | |
| LTR R7,R7 Doing config scan? | |
| BZ ERR055 OFF not recognized in CONFIG | |
| L R2,ALINKS -> LINKS anchor word | |
| L R2,0(,R2) -> 1st entry (LOCAL entry) | |
| * | |
| LOFF010 EQU * | |
| ICM R3,15,LNEXT-LINKTABL(R2) -> next link entry | |
| BZ LOFF050 Found the end, linkid not fnd | |
| CLC LINKID,LINKID-LINKTABL(R3) Match on name? | |
| BNE LOFF020 No, next | |
| * | |
| TM LFLAG-LINKTABL(R3),LCONNECT+LACTIVE+LDRAIN Link busy? | |
| BNZ ERR046 Yes, can't remove it | |
| CLC LTCBA-LINKTABL(,R3),=A(0) Task active on link? | |
| BNE ERR046 Nonzero, can't remove it | |
| * | |
| * Remove the matching entry from the LINKTABL chain: | |
| MVC LNEXT-LINKTABL(,R2),LNEXT-LINKTABL(R3) | |
| * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE046I),NJE046I | |
| MVC WTOTXT+13(8),LINKID-LINKTABL(R3) Move link name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(7,R1),=CL7'deleted' | |
| LA R2,13+8(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R2,R1 Compute length to display | |
| FREEMAIN RU, Free entry that was removed v211x | |
| LV=LINKLEN, v211x | |
| A=(3), v211x | |
| SP=1 v211 | |
| * | |
| *** LA R3,LTRMECB-LINKTABL(,R3) -> task termination ECB | |
| *** POST (3),255 Signal NJEINIT to delete link | |
| * | |
| LR R0,R2 Msg length to R0 | |
| B SUCCMSG Issue success msg | |
| * | |
| LOFF020 EQU * | |
| LR R2,R3 Copy next entry | |
| B LOFF010 Keep scanning for end | |
| * | |
| LOFF050 EQU * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE045I),NJE045I | |
| MVC WTOTXT+13(8),LINKID Move name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(14,R1),=CL14'is not defined' | |
| LA R0,13+15(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B SUCCMSG Issue success msg | |
| DROP R8 LINKTABL | |
| * | |
| *-- ROUTE | |
| * | |
| RTE000 EQU * | |
| L R1,ALINKS -> LINKS anchor word | |
| NC 0(4,R1),0(R1) Was LOCAL processed? | |
| BZ ERR053 No; it is required | |
| LA R8,BLDBUF Temp area to build entry | |
| XC 0(ROUTSIZE,R8),0(R8) Initialize entry | |
| USING RTE,R8 | |
| MVC ROUTALT1,BLANKS Init | |
| MVC ROUTALT2,BLANKS Init | |
| MVC ROUTALT3,BLANKS Init | |
| * | |
| BAL R14,GETTKN Get next token | |
| BZ ERR075 No link name | |
| MVC ROUTNAME,1(R15) Route node name destination | |
| TRT ROUTNAME,VALDNAME Valid node name? | |
| BZ RTE010 Yes | |
| CLM R2,1,=C'*' Was wildcard in use? | |
| BNE ERR043 No. The name contains inv char | |
| * | |
| RTE010 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ RTE050 None | |
| * | |
| CLC =CL8'TO',1(R15) Was it the TO keyword? | |
| BE TO000 Yes | |
| CLC =CL8'ALT',1(R15) Was it a ALT keyword? | |
| BE ALT000 Yes | |
| CLC =CL8'OFF',1(R15) Was it the OFF keyword? | |
| BE ROFF000 Yes | |
| B ERR055 Unrecognized keyword | |
| * | |
| RTE050 EQU * | |
| TM NJFL2,F2RTO Was ROUTE TO processed? | |
| BZ ERR051 No, its required | |
| * | |
| *-- ROUTE successfully scanned. | |
| * | |
| * 1. first check for existing name; if so, update existing. | |
| * 2. else add new route in collating sequence, except that the | |
| * wildcard character (if present) is treated as a X'FF' character | |
| * in order to force wildcard routes after all explicity named | |
| * routes. | |
| * | |
| L R2,AROUTES -> ROUTES anchor word (0th RTE) | |
| * | |
| RTE060 EQU * | |
| ICM R3,15,ROUTPTR-RTE(R2) -> next RTE entry | |
| BZ RTE080 Found the end | |
| CLC ROUTNAME,ROUTNAME-RTE(R3) Match on name? | |
| BE RTE070 Yes, update duplicate | |
| LR R2,R3 Copy next entry | |
| B RTE060 Keep scanning for end | |
| * | |
| *-- Update existing route | |
| RTE070 EQU * | |
| L R0,ROUTPTR-RTE(,R3) Save RTE next ptr | |
| MVC 0(ROUTSIZE,R3),0(R8) Update&replace existing route | |
| ST R0,ROUTPTR-RTE(,R3) Restore the next ptr | |
| B RTE200 Issue success msg | |
| * | |
| *-- Add new route to chain in collating seq based on route name | |
| RTE080 EQU * | |
| L R2,AROUTES -> ROUTES anchor word (0th RTE) | |
| MVC DBLE,ROUTNAME Copy name we want to add | |
| TR DBLE,ASTER Set any * char high | |
| * | |
| RTE090 EQU * | |
| ICM R3,15,ROUTPTR-RTE(R2) -> next RTE entry | |
| BZ RTE100 Found the end; add to end | |
| MVC TWRK,ROUTNAME-RTE(R3) Copy name in chained RTE | |
| TR TWRK,ASTER Set any * char high | |
| CLC DBLE,TWRK Locate place to insert RTE | |
| BL RTE100 | |
| LR R2,R3 Copy next entry | |
| B RTE090 Keep scanning for end | |
| * | |
| RTE100 EQU * | |
| LA R0,ROUTSIZE Length of RTE entry | |
| BAL R14,GETSTG Get stg for entry | |
| MVC 0(ROUTSIZE,R1),0(R8) Make build entry a permanent one | |
| ST R1,ROUTPTR-RTE(,R2) Insert R1 RTE into chain | |
| ST R3,ROUTPTR-RTE(,R1) R1 RTE now points to next RTE | |
| * | |
| RTE200 EQU * | |
| LTR R7,R7 Doing CONFIG scan? | |
| BZ SCN100 Yes, Resume scan | |
| * | |
| *--Issue ROUTE cmd success msg | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE065I),NJE065I | |
| MVC WTOTXT+13(8),ROUTNAME Move route name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(19,R1),=CL19'routed through link' | |
| MVC 21(8,R1),ROUTNEXT Move link name to msg | |
| LA R0,21+8(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B SUCCMSG Issue success msg and exit | |
| * | |
| TO000 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ ERR075 Missing node id | |
| MVC ROUTNEXT,1(R15) Move the route-to link id | |
| TRT ROUTNEXT,VALDNAME Valid node name? | |
| BNZ ERR043 Invalid node name if not | |
| OI NJFL2,F2RTO Indicate ROUTE TO processed | |
| B RTE010 Continue route scan | |
| * | |
| ALT000 EQU * | |
| LA R3,ROUTALT1 -> first alternate node id slot | |
| LA R4,3 Max number of alternates | |
| * | |
| ALT010 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ RTE050 Done with route scan | |
| MVC 0(8,R3),1(R15) Move the route alternate id | |
| LA R3,8(,R3) -> next alternate slot | |
| BCT R4,ALT010 Continue route scan | |
| B RTE050 Done with route scan | |
| * | |
| ROFF000 EQU * | |
| LTR R7,R7 Doing config scan? | |
| BZ ERR055 OFF not recognized in CONFIG | |
| L R2,AROUTES -> ROUTES anchor (0th entry) | |
| * | |
| ROFF010 EQU * | |
| ICM R3,15,ROUTPTR-RTE(R2) -> next RTE entry | |
| BZ ROFF050 Found the end, user/node not fnd | |
| CLC ROUTNAME,ROUTNAME-RTE(R3) Match on name? | |
| BNE ROFF020 No, next | |
| * | |
| * Remove the matching entry from the RTE chain: | |
| MVC ROUTPTR-RTE(,R2),ROUTPTR-RTE(R3) | |
| * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE064I),NJE064I | |
| MVC WTOTXT+23(8),ROUTNAME-RTE(R3) Move route name to msg | |
| TRT WTOTXT+23(9),BLANK Look for end | |
| MVC 1(7,R1),=CL7'deleted' | |
| LA R2,23+8(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R2,R1 Compute length to display | |
| FREEMAIN RU, Free entry that was removed x | |
| LV=ROUTSIZE, x | |
| A=(3), x | |
| SP=1 | |
| LR R0,R2 Msg length to R0 | |
| B SUCCMSG Issue success msg | |
| * | |
| ROFF020 EQU * | |
| LR R2,R3 Copy next entry | |
| B ROFF010 Keep scanning for end | |
| * | |
| ROFF050 EQU * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE063I),NJE063I | |
| MVC WTOTXT+13(8),ROUTNAME Move name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(13,R1),=CL13'is not routed' | |
| LA R0,13+14(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B SUCCMSG Issue success msg | |
| DROP R8 RTE | |
| * | |
| *-- AUTH | |
| * | |
| AUTH000 EQU * | |
| L R1,ALINKS -> LINKS anchor word | |
| NC 0(4,R1),0(R1) Was LOCAL processed? | |
| BZ ERR053 No; it is required | |
| LA R8,BLDBUF Temp area to build entry | |
| XC 0(AUTHSIZE,R8),0(R8) Initialize entry | |
| USING AUTHLIST,R8 | |
| * | |
| BAL R14,GETTKN Get next token | |
| BZ ERR075 No userid | |
| MVC AUTHUSER,1(R15) Authorized userid | |
| * | |
| AUTH010 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ AUTH050 None | |
| * | |
| CLC =CL8'AT',1(R15) Was it the AT keyword? | |
| BE AT000 Yes | |
| CLC =CL8'OFF',1(R15) Was it the OFF keyword? | |
| BE AOFF000 Yes | |
| B ERR055 Unrecognized keyword | |
| * | |
| AUTH050 EQU * | |
| TM NJFL2,F2AAT Was AUTH AT processed? | |
| BZ ERR050 No, its required | |
| * | |
| *-- AUTH successfully scanned. Now add the AUTH entry to chain. | |
| * | |
| L R2,AAUTHS -> AUTHS anchor word (0th entry) | |
| * | |
| AUTH060 EQU * | |
| ICM R3,15,AUTHPTR-AUTHLIST(R2) -> next AUTHLIST entry | |
| BZ AUTH080 Found the end | |
| CLC AUTHUSER,AUTHUSER-AUTHLIST(R3) Match on userid? | |
| BNE AUTH070 No, next | |
| CLC AUTHNODE,AUTHNODE-AUTHLIST(R3) Match on node? | |
| BE AUTH120 Yes, trying to add duplicate | |
| * | |
| AUTH070 EQU * | |
| LR R2,R3 Copy next entry ptr | |
| B AUTH060 Keep scanning for end | |
| * | |
| AUTH080 EQU * | |
| LA R0,AUTHSIZE Size of AUTHLIST entry | |
| BAL R14,GETSTG Get an actual entry | |
| MVC 0(AUTHSIZE,R1),0(R8) Make build entry a permanent one | |
| ST R1,AUTHPTR-AUTHLIST(,R2) Add R1 AUTHLIST to chain end | |
| * | |
| AUTH090 EQU * | |
| LTR R7,R7 Doing CONFIG scan? | |
| BZ SCN100 Yes, Resume scan | |
| * | |
| *--Issue AUTH cmd success msg | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE068I),NJE068I | |
| MVC WTOTXT+13(8),AUTHUSER Move auth name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(2,R1),=CL2'at' | |
| MVC 4(8,R1),AUTHNODE Move link name to msg | |
| TRT 4(9,R1),BLANK Look for end | |
| MVC 1(17,R1),=CL17'is now authorized' | |
| LA R0,18(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B SUCCMSG Issue success msg and exit | |
| * | |
| AUTH120 EQU * ** Here for duplicate entry | |
| LTR R7,R7 Doing CONFIG scan? | |
| BZ SCN100 Yes, skip duplicate msg | |
| *--Issue AUTH cmd duplicate msg | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE067I),NJE067I | |
| MVC WTOTXT+13(8),AUTHUSER Move auth name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(2,R1),=CL2'at' | |
| MVC 4(8,R1),AUTHNODE Move link name to msg | |
| TRT 4(9,R1),BLANK Look for end | |
| MVC 1(21,R1),=CL21'is already authorized' | |
| LA R0,22(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B ERRMSG Issue dup msg to cmd issuer | |
| * | |
| AT000 EQU * | |
| BAL R14,GETTKN Get next tkn | |
| BZ ERR075 Missing node id | |
| MVC AUTHNODE,1(R15) Move the auth node id to list | |
| TRT AUTHNODE,VALDNAME Valid node name? | |
| BNZ ERR043 No | |
| OI NJFL2,F2AAT Indicate AUTH AT processed | |
| B AUTH010 Continue AUTH scan | |
| * | |
| AOFF000 EQU * | |
| LTR R7,R7 Doing config scan? | |
| BZ ERR055 OFF not recognized in CONFIG | |
| L R2,AAUTHS -> AUTHS anchor word (0th entry) | |
| * | |
| AOFF010 EQU * | |
| ICM R3,15,AUTHPTR-AUTHLIST(R2) -> next AUTHLIST entry | |
| BZ AOFF050 Found the end, user/node not fnd | |
| CLC AUTHUSER,AUTHUSER-AUTHLIST(R3) Match on userid? | |
| BNE AOFF020 No, next | |
| CLC AUTHNODE,AUTHNODE-AUTHLIST(R3) Match on node? | |
| BNE AOFF020 No, next | |
| * | |
| * Remove the matching entry from the AUTHLIST chain: | |
| MVC AUTHPTR-AUTHLIST(,R2),AUTHPTR-AUTHLIST(R3) | |
| * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE070I),NJE070I | |
| MVC WTOTXT+13(8),AUTHUSER-AUTHLIST(R3) Move auth name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(2,R1),=CL2'at' | |
| MVC 4(8,R1),AUTHNODE-AUTHLIST(R3) Move node name to msg | |
| TRT 4(9,R1),BLANK Look for end | |
| MVC 1(23,R1),=CL23'is no longer authorized' | |
| LA R2,24(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R2,R1 Compute length to display | |
| FREEMAIN RU, Free entry that was removed x | |
| LV=AUTHSIZE, x | |
| A=(3), x | |
| SP=1 | |
| LR R0,R2 Msg length to R0 | |
| B SUCCMSG Issue success msg | |
| * | |
| AOFF020 EQU * | |
| LR R2,R3 Copy next entry | |
| B AOFF010 Keep scanning for end | |
| * | |
| AOFF050 EQU * | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE069I),NJE069I | |
| MVC WTOTXT+13(8),AUTHUSER Move auth name to msg | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(2,R1),=CL2'at' | |
| MVC 4(8,R1),AUTHNODE Move link name to msg | |
| TRT 4(9,R1),BLANK Look for end | |
| MVC 1(36,R1),=CL36'was not found in authorization table' | |
| LA R0,37(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| DROP R8 AUTHLIST | |
| B SUCCMSG Issue success msg | |
| * | |
| * | |
| *-- Get next tokenized length/value pair | |
| * Entry: R15 -> Current pair | |
| * Exit: CC =0, R15 unchanged, no more tokens | |
| * CC ¬=0, R15 -> next pair | |
| * | |
| GETTKN EQU * | |
| LA R15,L'TOKENS(,R15) -> next length/token pair | |
| CLI 0(R15),X'FF' No length available? | |
| BNER R14 Exit with pair -> R15 | |
| S R15,=A(L'TOKENS) Back to previous token | |
| CLI *+1,0 Set CC=0 | |
| BR R14 Exit with tkn ptr not changed | |
| * | |
| *-- Get a storage area | |
| * Entry: R0 = length to obtain | |
| * Exit: R1 -> new stg area | |
| * | |
| GETSTG EQU * | |
| STM R14,R15,SV14GT Save regs | |
| GETMAIN RU, Get requested stg for block x | |
| LV=(0), x | |
| SP=1 All configuration elements SP=1 | |
| LM R14,R15,SV14GT Reload regs | |
| BR R14 Return with stg addr in R1 | |
| * | |
| TKN000 EQU * | |
| MVI NJFL2,0 Clear tokenization ctl flags | |
| LR R5,R1 Save start of parse position | |
| LR R3,R1 Start position to R3 | |
| BCTR R15,0 Make scan length IBM length | |
| MVC TOKENS(12*8),TKNINIT Init receiving fields | |
| LA R6,TOKENS -> token area | |
| * | |
| TKN040 EQU * | |
| EX R15,SCANBL Look for blank at end of token | |
| *SCANBL TRT 0(0,R3),BLANK | |
| BZ ERR074 Syntax error | |
| SR R1,R3 Compute token length | |
| C R1,=F'8' Max length of token is 8 | |
| BH ERR074 Syntax error | |
| BCTR R1,0 | |
| EX R1,MVTKN Save the token | |
| *MVTKN MVC 1(0,R6),0(R3) | |
| STC R1,0(,R6) Save its length | |
| LA R6,9(,R6) -> next token area | |
| LA R1,1(,R1) Restore length relative to 1 | |
| AR R3,R1 -> next byte in line | |
| SR R15,R1 Reduce remaining length | |
| BNPR R14 Done with line | |
| * | |
| EX R15,SCANNBL Look for next token | |
| *SCANNBL TRT 0(0,R3),NONBLANK | |
| BZR R14 Nothing else on line | |
| SR R1,R3 Compute length to that token | |
| AR R3,R1 -> next byte in line | |
| SR R15,R1 Reduce remaining length | |
| BNPR R14 Done with line | |
| * | |
| TKN090 EQU * | |
| B TKN040 Continue scanning | |
| * | |
| SCANBL TRT 0(0,R3),BLANK executed instr | |
| SCANNBL TRT 0(0,R3),NONBLANK executed instr | |
| MVTKN MVC 1(0,R6),0(R3) executed instr | |
| * | |
| EOD000 EQU * | |
| B EXIT00 | |
| * | |
| * | |
| ERR043 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE042E),NJE042E Node name invalid chars | |
| LA R0,L'NJE042E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR046 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE044E),NJE044E LINK is not inactive | |
| MVC WTOTXT+13(8),LINKID-LINKTABL(R8) LINK name | |
| TRT WTOTXT+13(9),BLANK Look for end | |
| MVC 1(15,R1),=CL15'is still active' | |
| LA R0,13+16(,R1) -> end of msg | |
| LA R1,WTOTXT -> start of msg | |
| SR R0,R1 Compute length to display | |
| B ERRTYPE(R7) | |
| * | |
| ERR050 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE050E),NJE050E AUTH AT required | |
| LA R0,L'NJE050E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR051 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE051E),NJE051E ROUTE TO required | |
| LA R0,L'NJE051E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR052 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE052E),NJE052E More than one LOCAL stmt | |
| LA R0,L'NJE052E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR053 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE053E),NJE053E No LOCAL stmt | |
| LA R0,L'NJE053E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR054 EQU * | |
| S R15,=A(L'TOKENS) Back to previous token | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE054E),NJE054E invalid BUFF value | |
| LA R0,L'NJE054E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR055 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE055E),NJE055E invalid value after keywd | |
| MVC WTOTXT+29(8),0(R3) Show failed keyword | |
| LA R0,L'NJE055E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR073 EQU * | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE073E),NJE073E keywd not in col 1 | |
| LA R0,L'NJE073E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR074 EQU * | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE074E),NJE074E syntax error | |
| SR R3,R5 Compute column number | |
| LA R3,1(,R3) Make rel to 1 | |
| CVD R3,DBLE | |
| UNPK WTOTXT+53(2),DBLE | |
| OI WTOTXT+54,X'F0' Fix sign | |
| LA R0,L'NJE074E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR075 EQU * | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE075E),NJE075E syntax error | |
| MVC WTOTXT+36(8),0(R3) Show failed keyword | |
| LA R0,L'NJE075E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR076 EQU * | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE076E),NJE076E unknown config stmt type | |
| LA R0,L'NJE076E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR077 EQU * | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE077E),NJE077E line addr required | |
| LA R0,L'NJE077E Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERR078 EQU * | |
| S R15,=A(L'TOKENS) Back to previous token | |
| LA R3,1(,R15) -> failing keyword token | |
| BAL R14,CFGERR Show failing stmt | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE078E),NJE078E invalid value after keywd | |
| MVC WTOTXT+46(8),0(R3) Show failed keyword | |
| LA R0,L'NJE078E+8 Length of msg | |
| B ERRTYPE(R7) | |
| * | |
| ERRTYPE EQU * R7 branch table index | |
| B ERRWTO 00 Issue WTO to console | |
| B ERRMSG 04 Return msg len/text to caller | |
| * | |
| ERRWTO EQU * | |
| WTO ,MF=(E,WTOMSG) | |
| B EXIT08 | |
| * | |
| ERRMSG EQU * | |
| L R1,AMTEXT -> callers MTEXT area | |
| MVC 0(120,R1),WTOTXT Pass back the msg text | |
| B EXIT08 and exit to caller with error | |
| * | |
| SUCCMSG EQU * | |
| L R1,AMTEXT -> callers MTEXT area | |
| MVC 0(120,R1),WTOTXT Pass back the msg text | |
| B EXIT00 and exit to caller with success | |
| * | |
| CFGERR EQU * | |
| LTR R7,R7 Processing CONFIG member? | |
| BNZR R14 No; skip config msgs | |
| ST R14,SV14CF Save return | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(L'NJE072E),NJE072E | |
| CVD R9,DBLE convert record # | |
| MVC WTOTXT+45(3),=X'202120' Move edit mask | |
| ED WTOTXT+44(4),DBLE+6 Edit record number | |
| WTO ,MF=(E,WTOMSG) | |
| MVC WTOMSG,WTO Move WTO model | |
| MVC WTOTXT(7),NJE072E Move just msg number | |
| MVI WTOTXT+8,C'''' Move apost | |
| MVC WTOTXT+09(52),REC Move first part of record image | |
| MVI WTOTXT+61,C'''' Move apost | |
| WTO ,MF=(E,WTOMSG) | |
| L R14,SV14CF Load return | |
| BR R14 | |
| * | |
| EXIT08 EQU * | |
| LR R6,R0 Msg length to R6 for now | |
| LA R5,8 RC=8 | |
| B XIT000 | |
| * | |
| EXIT00 EQU * | |
| LR R6,R0 Possible msg len to R6 for now | |
| SR R5,R5 RC=0 | |
| * NJE00200 | |
| XIT000 EQU * NJE00210 | |
| TM NJFL1,F1OPEN Is DCB open? | |
| BZ XIT010 No | |
| MVC MACLIST(CLOSEL),CLOSE Move macro model | |
| CLOSE (CONFIG), x | |
| MF=(E,MACLIST) | |
| FREEPOOL CONFIG | |
| * | |
| XIT010 EQU * | |
| * | |
| XIT090 EQU * | |
| LR R1,R10 -> NJEWK main work area page | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| STM R5,R6,16(R13) Set RC, msg len in SA R15, R0 | |
| * | |
| FREEMAIN RU, x | |
| LV=NJEWKSZ, x | |
| A=(1) | |
| LM R14,R12,12(R13) Reload system's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| DROP R12 | |
| LTORG , | |
| * | |
| DMYDCB DCB DDNAME=CONFIG, x | |
| MACRF=GM, x | |
| DSORG=PS, x | |
| LRECL=80, x | |
| RECFM=FB, x | |
| EODAD=EOD000 | |
| DMYDCBL EQU *-DMYDCB | |
| * | |
| * 1234567890123456789012345678901234567890123456789012345 | |
| WTO WTO ' x | |
| x | |
| ',MF=L | |
| * 67890123456789012345678901234567890123456789012345678901 | |
| WTOL EQU *-WTO | |
| * | |
| * | |
| DS 0D | |
| BLANKS DC CL120' ' | |
| NONBLANK DC 64X'FF',X'00' TR Table to locate nonblank | |
| INVALHEX DC 193X'FF' TR table to locate invalid hex | |
| DC 6X'00' A-F | |
| DC 41X'FF' | |
| DC 10X'00' 0-9 | |
| DC 6X'FF' | |
| BLANK DC 64X'00',X'FF',191X'00' TR Table to locate blanks | |
| * | |
| ASTER DC 256AL1(*-ASTER) TR table to set asterisk high | |
| ORG ASTER+C'*' Set * high, only | |
| DC X'FF' | |
| ORG , | |
| * | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * 0 1 2 3 4 5 6 7 8 9 A B C D E F | |
| TRANHEX DC X'00FAFBFCFDFEFF000000000000000000' C | |
| DC X'00000000000000000000000000000000' D | |
| DC X'00000000000000000000000000000000' E | |
| DC X'F0F1F2F3F4F5F6F7F8F9000000000000' F | |
| * | |
| * 0 1 2 3 4 5 6 7 8 9 A B C D E F | |
| VALDNAME DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 0 Invalid node name | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 1 characters | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 2 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 3 | |
| DC X'00FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 4 Blank=ok/delim | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFF5CFFFFFF' 5 * indicator | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 6 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 7 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 8 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 9 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' A | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' B valid = | |
| DC X'FF000000000000000000FFFFFFFFFFFF' C C1-C9 | |
| DC X'FF000000000000000000FFFFFFFFFFFF' D D1-D9 | |
| DC X'FFFF0000000000000000FFFFFFFFFFFF' E E2-E9 | |
| DC X'00000000000000000000FFFFFFFFFFFF' F F0-F9 | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| RDJFCB RDJFCB 0,MF=L | |
| RDJFCBL EQU *-RDJFCB | |
| * | |
| DEFUSER DC CL8'HERC01' Default userid for LOCAL | |
| * | |
| TKNINIT DC 12X'FF4040404040404040' byte 0=IBM len, bytes 1-8 blank | |
| * 1 2 3 4 5 NJE00250 | |
| * 01234567890123456789012345678901234567890123456789012 | |
| NJE042E DC C'NJE042E Node names must contain A-Z, 0-9 only' | |
| NJE044E DC C'NJE044E Link ' is not inactive' | |
| NJE045I DC C'NJE045I Link ' is not defined | |
| NJE046I DC C'NJE046I Link ' xxx deleted | |
| NJE048E DC C'NJE048I Link ' xxx duplicate definition | |
| NJE049I DC C'NJE049I Using configuration ' | |
| NJE050E DC C'NJE050E ''AT'' keyword is required with AUTH' | |
| NJE051E DC C'NJE051E ''TO'' keyword is required with ROUTE' | |
| NJE052E DC C'NJE052E Only one LOCAL statement allowed' | |
| NJE053E DC C'NJE053E LOCAL statement must preceed LINK, ROUTE, or A* | |
| UTH' | |
| NJE054E DC C'NJE054E Invalid BUFF value; range is 300 to 4020' | |
| NJE055E DC C'NJE055E Unrecognized keyword x' | |
| NJE063I DC C'NJE063I Node xxxxxxxx ' is not routed | |
| NJE064I DC C'NJE064I Route for node ' xxxxxxxx deleted | |
| NJE065I DC C'NJE065I Node xxxxxxxx ' routed through link xxxx | |
| NJE066I DC C'NJE066I Link ' xxx defined' | |
| NJE067I DC C'NJE067I User ' xxx at yyy is already authorized' | |
| NJE068I DC C'NJE068I User ' xxx at yyy is now authorized | |
| NJE069I DC C'NJE069I User ' xxx at yyy not in authorization lst | |
| NJE070I DC C'NJE070I User ' xxx at yyy removed from auth list | |
| NJE072E DC C'NJE072E Configuration syntax error in record xxx' | |
| NJE073E DC C'NJE073E Keyword is not in column 1' | |
| NJE074E DC C'NJE074E Syntax, keyword, or value error after column x* | |
| x' | |
| NJE075E DC C'NJE075E Missing value after keyword x' | |
| NJE076E DC C'NJE076E Unrecognized configuration statement type' | |
| NJE077E DC C'NJE077E LINE address required on LINK statement' | |
| NJE078E DC C'NJE078E Invalid/incorrect value after keyword x' | |
| * NJE00930 | |
| * NJE043E NJE00930 | |
| * NJE047E NJE00930 | |
| * NJE056I NJE00930 | |
| * NJE057I NJE00930 | |
| * NJE058I NJE00930 | |
| * NJE059I all NJECMX msgs NJE00930 | |
| * NJE060I NJE00930 | |
| * NJE061I NJE00930 | |
| * NJE062I NJE00930 | |
| * NJE071I NJE00930 | |
| * NJE00930 | |
| COPY LINKTABL NJE00940 | |
| COPY RTE NJE00940 | |
| COPY AUTHLIST NJE00940 | |
| COPY NETSPOOL NJE00940 | |
| * | |
| **** Main work area NJE00290 | |
| * NJE00290 | |
| NJEWK DSECT | |
| NJEEYE DS CL4'NJES' Eyecatcher | |
| NJEWKLEN DS F Getmain size of this area | |
| * | |
| DBLE DS D Work area NJE00310 | |
| TWRK DS 2D Work area | |
| MACLIST DS XL64 Macro expansion area | |
| REC DS CL120 Input record or command area | |
| TOKENS DS 12CL9 Parsed keyword tokens (1 len,8 tkn) | |
| * | |
| NJEPARMS Passed parameter list v220 | |
| * | |
| * | |
| INITPLST DS A -> entry parm list in R1 | |
| AMTEXT DS A -> MTEXT field in NJECMX | |
| SV14CF DS A R14 save | |
| SV14GT DS A,A R14-15 save | |
| * | |
| NJFL1 DS X Flag bits | |
| F1OPEN EQU X'80' 1... .... CONFIG DCB is open | |
| * | |
| NJFL2 DS X token scan and ctl flags | |
| F2LINE EQU X'80' 1... .... LINE keyword found | |
| F2RTO EQU X'40' .1.. .... ROUTE TO keyword found | |
| F2AAT EQU X'20' ..1. .... AUTH AT keyword found | |
| * | |
| DS 0F | |
| EXLST DS A X'87'+AL3(JFCBL) | |
| JFCBL DS XL176 | |
| CONFIG DS XL(DMYDCBL) CONFIG DCB | |
| WTOMSG DS 0XL(WTOL) WTO header | |
| DS F Header area | |
| WTOTXT DS XL(WTOL-4) WTO text area | |
| * | |
| BLDBUF DS XL(LINKLEN) Build area for LINK,RTE,AUTH entries | |
| * | |
| NJESA DS 18F NJESCN OS save area NJE00300 | |
| BALRSAVE DS 16F Local rtns register save NJE00300 | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEWK | |
| * | |
| DCBD DSORG=PS,DEVD=DA | |
| JFCB DSECT | |
| IEFJFCBN LIST=YES | |
| * | |
| END NJESCN NJE01000 | |
| ./ ADD NAME=NJESYS | |
| * | |
| * | |
| *-- NJE38 - Locate NJE38 information from an ENQ resource | |
| * | |
| * | |
| * Called by NJEINIT,NJERCV,NJETRN,NJE38,NJ38XMIT,NJ38RECV | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 01 Oct 20 - Initial creation v210 | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJESYS CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) Save regs | |
| LR R12,R15 | |
| USING NJESYS,R12 | |
| * | |
| *-- Determine if NJE38 is already active in another address space | |
| * | |
| CHK000 EQU * | |
| L R2,16 Get CVT ptr | |
| USING CVT,R2 | |
| LA R2,CVTFQCB -> ENQ QCB chain anchor | |
| USING QCB,R2 | |
| * | |
| CHK010 EQU * | |
| ICM R2,15,MAJNMAJ -> next major QCB | |
| BZ CHK080 Our guy not found | |
| CLC MAJNAME,NJE38Q Look for our QNAME "NJE38" | |
| BNE CHK010 Nope, go to next QCB | |
| * | |
| L R3,MAJFMIN -> first minor QCB | |
| USING MIN,R3 | |
| * | |
| CHK020 EQU * | |
| LA R4,MINNAME -> minor name | |
| CLC NJERCON,0(R4) Does minor name match? | |
| BE CHK030 Yes. NJE38 is active | |
| C R3,MAJLMIN Is this the last minor QCB? | |
| BE CHK080 Yes, we're done. NJE38 is not active | |
| ICM R3,15,MINNMIN -> next minor name | |
| BZR R14 Just in case no address | |
| B CHK020 Spin through the minor QCBs | |
| * | |
| CHK030 EQU * | |
| LTR R1,R1 Store spool DSN? | |
| BZ CHK040 No | |
| MVC 0(44,R1),12(R4) Save off NETSPOOL dsname | |
| * | |
| CHK040 EQU * | |
| L R1,8(,R4) Get CSABLK ptr from QCB minor | |
| SR R15,R15 RC=0, ENQ data was found | |
| B CHK090 | |
| * | |
| CHK080 EQU * | |
| LA R15,4 RC=4, no ENQ located | |
| * | |
| CHK090 EQU * | |
| ST R1,24(,R13) Return R1 value | |
| ST R15,16(,R13) Return R15 RC | |
| * | |
| LM R14,R12,12(R13) Reload regs | |
| BR R14 Return | |
| * | |
| DS 0D | |
| NJE38Q DC CL8'NJE38' | |
| NJERCON DC CL8'NJEINIT' | |
| * | |
| LTORG , | |
| * | |
| CVT DSECT=YES,PREFIX=NO | |
| IHAQCB | |
| * | |
| END | |
| ./ ADD NAME=NJETRN | |
| * | |
| *-- NJE38 - TSO TRANSMIT | |
| * | |
| * Command line format: | |
| * | |
| * TRANSMIT node.userid | |
| * DATASET( ) | |
| * OUTDATASET( ) | |
| * VOLSER( ) | |
| * UNIT( ) | |
| * PDS | SEQUENTIAL | |
| * QUIET | |
| * | |
| * where: | |
| * | |
| * node.userid - specifies the destination of the transmission | |
| * | |
| * DATASET( ) - specifies the dsname of the dataset to be | |
| * transmitted. May optionally specify a member. | |
| * | |
| * OUTDATASET( ) - optional. Specifies the encoded file is to be | |
| * written to this dataset instead of being | |
| * transmitted. 'node.userid' may be omitted if | |
| * OUTDATASET is specified, but if it is present | |
| * then the specified node and userid will be part | |
| * of the encoded data instead of meaningless | |
| * defaults. If OUTDATASET is specified, the | |
| * named dataset will be used if it exists, other- | |
| * wise it will be created. | |
| * The contents of OUTDATASET can be input to a | |
| * RECEIVE command by the use of RECEIVE INDATASET. | |
| * | |
| * VOLSER( ) - optional. Specifies a volume where OUTDATASET | |
| * should be created. If not specified, a PUBLIC | |
| * volume will be selected. | |
| * | |
| * UNIT( ) - optional. Specifies a unit name where OUTDATASET | |
| * should be created. If not specified, SYSDA is | |
| * the default unit name. | |
| * | |
| * PDS - If specified, indicates that the member name | |
| * specified with DATASET is to be transmitted | |
| * with IEBCOPY unload, thereby preserving the | |
| * user directory data in the source PDS. | |
| * | |
| * SEQUENTIAL - DEFAULT. Indicates that any member name specified | |
| * with DATASET is to be transmitted as a sequential | |
| * file; no directory information is part of the | |
| * transmission. SEQL must be specified or defaulted | |
| * if the destination host is a VM system. | |
| * | |
| * QUIET - If specified, indicates that all informational | |
| * messages from TRANSMIT are suppressed. Error | |
| * messages will always be displayed. | |
| * | |
| * | |
| * Examples (a user is logged on to TSO with userid FRED: | |
| * | |
| * 1. Send member COBSRC from FRED.MY.PDS to user HERC01 at | |
| * node MVSA. The directory information associated with COBSRC | |
| * is to be part of the transmission: | |
| * | |
| * TRANSMIT mvsa.herc01 da(my.pds(cobsrc)) pds | |
| * | |
| * 2. Encode dataset HERC02.COBOL.LISTING into FRED.NETLIB: | |
| * | |
| * TRANSMIT da('herc02.cobol.listing') out(netlib) | |
| * | |
| * 3. Send macro GETQ from FRED.MACLIB to CMSUSER at VMSYS1. | |
| * | |
| * TRANSMIT vmsys1.cmsuser da(maclib(getq)) | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 24 Apr 21 - Use TSO userid as default user if no security and v222 | |
| * NJE38 is not active. v222 | |
| * 15 Feb 21 - Not picking up jobname when run as an STC. v221 | |
| * 10 Dec 20 - Support for registered users and message queuing v220 | |
| * 01 Oct 20 - Put ENQ existence check in common module v210 | |
| * 09 Aug 20 - Improve TSO attention key handling v201 | |
| * 24 Jul 20 - Fix S013-18 if DATASET member not found v200 | |
| * 15 Jul 20 - Don't display final record count. v200 | |
| * 12 Jul 20 - Add support for the UNIT parameter. v200 | |
| * 21 Jun 20 - Initial creation | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJETRN CSECT NJE00020 | |
| NJEVER | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJETRN,R12 NJE00070 | |
| LR R8,R1 Copy input parm addr | |
| * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJET' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| ST R8,CPARMS Save ptr to input parms | |
| MVC LCLNODE,=CL8'ORIGNODE' Set default local node | |
| MVC DESTNODE,=CL8'DESTNODE' Set default | |
| MVC DESTUSER,=CL8'DESTUSER' Set default | |
| MVC PBREM,=F'80' Initialize | |
| LA R1,REC -> output record area | |
| ST R1,PBRPS Initialize | |
| * | |
| INIT000 EQU * | |
| MVC MACLIST(ESTAEL),ESTAE Move ESTAE parm list | |
| L R6,=A(NJEDMP) Point to local ESTAE rtn | |
| ESTAE (R6), Issue ESTAE X | |
| CT, X | |
| TERM=YES, X | |
| PARAM=(R10), PARAM is work area address X | |
| MF=(E,MACLIST) | |
| * | |
| *-- Establish TSO userid issuing this command | |
| * | |
| TESTAUTH FCTN=1 Are we authorized on entry? | |
| LTR R15,R15 Check result | |
| BNZ INIT010 Branch if not authorized | |
| OI FLAGS1,F1APF Indicate authorized on entry | |
| * | |
| INIT010 EQU * | |
| L R2,PSATOLD-PSA(0) -> my TCB | |
| L R2,TCBTIO-TCB(R2) -> my TIOT | |
| LA R4,TIOCNJOB-IEFTIOT(R2) -> TIOT jobname v222 | |
| LR R3,R4 Assume will use jobname v222 | |
| * | |
| L R2,PSAAOLD-PSA(0) -> my ASCB | |
| L R6,ASCBTSB-ASCB(,R2) -> TSB (or 0) | |
| L R2,ASCBASXB-ASCB(,R2) -> my ASXB | |
| ICM R2,15,ASXBSENV-ASXB(R2) -> my ACEE | |
| BZ INIT015 Exit if no ACEE | |
| * | |
| USING ACEE,R2 | |
| CLI ACEEUSRL,X'00' No userid available? | |
| BE INIT015 Exit if unavail | |
| CLI ACEEUSR,X'00' Userid not formed correctly? | |
| BE INIT015 Exit if unavail | |
| LA R3,ACEEUSR -> Userid | |
| OI FLAGS1,F1ACEE Valid ACEE found | |
| CLC ACEEUSR,=CL8'STC' Is this a started task? v221 | |
| BNE INIT015 No, use ACEEUSR id v221 | |
| LR R3,R4 Make the TIOT jobname the idv221 | |
| DROP R2 ACEE | |
| * | |
| INIT015 EQU * | |
| MVC USERID,0(R3) Set the userid | |
| TM FLAGS1,F1APF Authorized at entry? | |
| BO INIT040 yes. | |
| CLC USERID,=CL8'HERC01' Special access id? | |
| BE INIT020 Yes | |
| CLC USERID,=CL8'HERC02' Special access id? | |
| BNE INIT030 No | |
| * | |
| INIT020 EQU * | |
| OI FLAGS1,F1AUSR Indicate special authorized user | |
| SR 0,0 Use authorization SVC | |
| LA 1,1 For TK4- HERC01/HERC02 only | |
| SVC 244 Get authorized | |
| B INIT040 | |
| * | |
| INIT030 EQU * | |
| TM FLAGS1,F1APF Authorized at entry? | |
| BZ ERR006 No, issue error | |
| * | |
| INIT040 EQU * | |
| LA R6,0(,R6) Clear high order byte | |
| LTR R6,R6 Was there a TSB address | |
| BNZ INIT050 There was. Running in TSO userid | |
| OI FLAGS1,F1BATCH Indicate batch TSO | |
| TM FLAGS1,F1ACEE Valid ACEE found? | |
| BO INIT050 Yes, go with ACEE userid | |
| BAL R2,CHK000 See if NJE38 is active v210 | |
| BNZ INIT050 NJE38 not act; use jobname v222 | |
| MVC USERID,DEFUSER Use default userid | |
| * | |
| INIT050 EQU * | |
| L R2,4(,R8) -> UPT from input parms | |
| USING UPT,R2 | |
| MVC PREFIX,BLANKS Init receiving field | |
| SR R1,R1 Clear for IC | |
| ICM R1,1,UPTPREFL Get prefix length | |
| BZ INIT060 No prefix value in use | |
| BCT R1,*+10 Adjust for execute | |
| MVC PREFIX(0),UPTPREFX executed instr | |
| EX R1,*-6 Copy the prefix value | |
| DROP R2 UPT | |
| * | |
| INIT060 EQU * | |
| MVC STAXLIST(STAXL),STAX Move STAX parm list | |
| LA R5,LIST -> input buffer from attn | |
| LA R6,STAXXIT Point to local exit | |
| STAX (R6), Set exit for attention X | |
| OBUF=(ATTNMSG,L'ATTNMSG), x | |
| IBUF=((5),80), x | |
| USADDR=(10), Parameter is our work area x | |
| MF=(E,MACLIST) | |
| * | |
| *-- Parse command line | |
| * | |
| SR R0,R0 Code 0: parse command line | |
| L R15,=A(NJEPAR) -> parse routine | |
| BALR R14,R15 | |
| * | |
| TM FLAGS1,F1ATTN Was ATTN pressed? v201 | |
| BO EXIT08 Y, immediate exit v201 | |
| * | |
| B INIT070(R15) Branch into table on RC | |
| INIT070 B INIT080 Continue | |
| B ERR004 No parameters entered | |
| B ERR005 Invalid node.user entered | |
| B ERR001 Display IJKPARS RC | |
| * | |
| INIT080 EQU * | |
| LA R2,MSG000 Issue hello msg | |
| BAL R14,PUTLINE | |
| LA R2,MSGBLNK Issue blank line | |
| BAL R14,PUTLINE | |
| * | |
| *-- Check if we have the required parameters: | |
| * | |
| *-- 1. DATASET is required. No exceptions. | |
| *-- 2. Either one of: | |
| *-- a. OUTDATASET, or, | |
| *-- b. node.userid | |
| *-- 3. If node.user specified, we need NJE38 to be active. | |
| * | |
| TM FLAGS3,F3INDS Was DATASET specified? | |
| BZ ERR002 N, it is required | |
| TM FLAGS3,F3OUTDS Was OUTDATASET specified? | |
| BO INIT090 Y, we don't need NJE38 | |
| TM FLAGS3,F3DEST Do we have a node.user? | |
| BZ ERR011 No, bail out. | |
| * | |
| BAL R2,CHK000 Determine NJE38 status v210 | |
| BNZ ERR013 NJE38 is not active v210 | |
| * | |
| *-- Set up user selected input dataset | |
| * | |
| *-- 1. Dynamically allocate it (also return DSORG and VOLSER). | |
| *-- 2. OBTAIN the DSCB for the dataset to get DCB attributes. | |
| *-- 3. Use DEVTYPE and TRKCALC along with the DSCB last used TTR to | |
| *-- determine how many blocks were used in the dataset. | |
| *-- 4. If it was a PDS, count the number of directory blocks. | |
| * | |
| INIT090 EQU * | |
| MVC TDSNAME,INPUTDS Set DSNAME of user dataset | |
| MVC TMEMBER,INMEM Set member name (or null) | |
| * | |
| LA R0,DYNINDS 24 allocate input dataset | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 Any errors? | |
| BNZ EXIT08 Exit if allocation error | |
| TM TDSORG,X'42' Is it DSORG=PO/PS ? | |
| BZ ERR003 No, can't support it | |
| * | |
| MVC DDSYSUT1,TDDNAME Save off the DDNAME returned | |
| TM FLAGS3,F3PDS Was PDS forced? | |
| BO INIT100 Y, use IEBCOPY instead of PS mbr | |
| TM FLAGS3,F3INMEM Was a member name specified? | |
| BZ INIT100 No, DSORG is what it is | |
| MVC TDSORG,=X'4000' Member makes it DSORG=PS | |
| * | |
| INIT100 EQU * | |
| XC CAMWORK,CAMWORK Init CAMLST work area | |
| MVC CAMLST,DMYLST Move dummy CAMLST to area | |
| LA R1,CAMLST -> CAMLST | |
| LA R4,TDSNAME -> DATASET NAME | |
| ST R4,4(,R1) Put in CAMLST | |
| LA R4,TVOLSER -> VOLSER | |
| ST R4,8(,R1) Put in CAMLST | |
| LA R4,CAMWORK -> AT WORK AREA | |
| ST R4,12(,R1) Put in CAMLST | |
| * | |
| OBTAIN (1) Get the format 1 DSCB | |
| LA R4,CAMWORK-44 -> DSCB we obtained (less DSN) | |
| USING DSCBF1,R4 | |
| LTR R15,R15 SUCCESSFUL? | |
| BNZ ABEND101 No | |
| * | |
| INIT110 EQU * | |
| LA R7,INMF02A -> first INMR02 data items | |
| USING INMFIELD,R7 | |
| MVC DSORG,TDSORG Set DSORG | |
| SR R0,R0 Clear for IC | |
| ICM R0,3,DS1BLKL | |
| ST R0,BLKSIZE Set BLKSIZE | |
| ICM R0,3,DS1LRECL | |
| ST R0,LRECL Set LRECL | |
| MVC RECFM,DS1RECFM Set RECFM | |
| MVC DSNAME,INPUTDS Set DSNAME | |
| MVC UTLNAME,=CL8'INMCOPY' Assume utility is sequential cpy | |
| TM DSORG,X'40' Is DSORG=PS? | |
| BO INIT120 Yes | |
| MVC UTLNAME,=CL8'IEBCOPY' Utility is for partitioned | |
| * | |
| * | |
| INIT120 EQU * | |
| DEVTYPE TDDNAME,DEVINFO,DEVTAB Get device info | |
| LTR R15,R15 Success? | |
| BNZ ABEND102 No | |
| * | |
| INIT130 EQU * | |
| MVC MACLIST(TRKCALCL),TRKCALC Move macro model | |
| TRKCALC FUNCTN=TRKCAP, Calc track capacity for this blkszX | |
| REGSAVE=YES, Save all regs X | |
| TYPE=DEVUCBTY+3, Point to device type byte X | |
| R=1, Record 1 = calc for entire track X | |
| K=0, No Keys X | |
| DD=DS1BLKL, Use the BLKSIZE from DSCB X | |
| MF=(E,MACLIST) R0 = # blks per track on exit | |
| * | |
| * | |
| SR R1,R1 Clear | |
| L R3,BLKSIZE Get current block size | |
| MR R2,R0 Compute bytes per track | |
| SR R1,R1 Clear | |
| ICM R1,3,DS1LSTAR Get TT of last used TTR | |
| LA R1,1(,R1) One extra for partial last track | |
| MR R2,R1 Compute approx bytes in file | |
| ST R3,FILESIZE Set approx file size in bytes | |
| DROP R4 DSCBF1 | |
| * | |
| *-- If input dataset is a PDS, count the number of directory blocks. | |
| *-- Then, use IEBCOPY to unload the PDS into a sequential file. | |
| * | |
| TM DSORG,X'40' Is DSORG=PS? | |
| BO OUT000 Y, done with input dataset | |
| * | |
| OI FLAGS1,F1INPDS INDS is a PDS dataset | |
| MVC INDS(DMYINDSL),DMYINDS Set up DCB | |
| LA R6,INDS -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBDDNAM,DDSYSUT1 Set DCB DDNAME | |
| MVC DCBBLKSI,=Y(256) Set up to read dir blocks | |
| MVC DCBLRECL,=Y(256) Set up to read dir blocks | |
| MVI DCBRECFM,DCBRECF RECFM=F | |
| LA R1,INIT150 -> temporary EOF addr | |
| ST R1,DCBEODAD Set it | |
| DROP R6 | |
| * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (INDS,INPUT), Open the input dataset X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2INOPN Indicate DCB is open | |
| SR R2,R2 Init directory blocks counter | |
| * | |
| INIT140 EQU * | |
| GET INDS Get a dir block | |
| LA R2,1(,R2) Count it | |
| B INIT140 | |
| * | |
| INIT150 EQU * | |
| ST R2,DIRBLKS Set DIRBLKS value | |
| TM FLAGS2,F2INOPN Is INDS DCB open? | |
| BZ UNLD000 No | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (INDS), Close it X | |
| MF=(E,MACLIST) | |
| NI FLAGS2,255-F2INOPN Indicate DCB is closed | |
| * | |
| *-- If DATASET is a PDS, prepare to call IEBCOPY to unload it. | |
| * | |
| *-- 1. Create sequential dataset for IEBCOPY to unload into. | |
| *-- 2. Allocate other required IEBCOPY datasets. | |
| *-- 3. If user specified a member name in DATASET, build IEBCOPY | |
| *-- control statements. | |
| *-- 4. Invoke IEBCOPY to unload the entire PDS or single member. | |
| * | |
| UNLD000 EQU * | |
| LA R6,INMF02A -> 1st INMR02 record | |
| LA R7,INMF02B -> 2nd INMR02 record | |
| USING INMFIELD,R7 | |
| * | |
| *-- Filling dynamic allocation text units for unload PS dataset | |
| * | |
| LA R1,3120 Use 3120 for IEBCOPY SYSUT2 | |
| STH R1,TBLKSIZE Set dynalloc block size | |
| STCM R1,7,TBLKLEN Set dynalloc space blk len | |
| * | |
| L R3,FILESIZE-INMFIELD(R6) Get INDS size | |
| ST R3,FILESIZE Use as temporary DS size | |
| SR R2,R2 Clear for divide | |
| DR R2,R1 Compute # blocks needed | |
| LA R3,1(,R3) Always round up | |
| LR R1,R3 Return primary blocks in R1 | |
| SRL R3,2 Compute 1/4th of needed amt | |
| LA R2,1(,R3) Round up = secondary blks needed | |
| * | |
| STCM R1,7,TPRIME Set primary space in blocks | |
| STCM R2,7,TSECND Set secondary space in blocks | |
| * | |
| MVC TDSORG,=X'4000' Always PS | |
| * | |
| * | |
| *-- Call NJEDYN to allocate the unload output dataset as "SYSUT2" | |
| * | |
| LA R0,DYNUNLD 10 allocate unload dataset | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| * | |
| B UNLD020(R15) Branch on RC | |
| UNLD020 B UNLD040 00 Normal, proceed | |
| B EXIT08 04 Dataset exists, shouldnt happen | |
| B EXIT08 08 All other errors | |
| * | |
| *-- Prepare to launch IEBCOPY | |
| * | |
| UNLD040 EQU * | |
| MVC DDSYSUT2,TDDNAME Set replacement SYSUT2 DD | |
| * | |
| *-- Call NJEDYN to allocate the SYSIN dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSIN 08 allocate SYSIN for IEBCOPY | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSIN,TDDNAME Save generated DDNAME | |
| * | |
| *-- Call NJEDYN to allocate the SYSPRINT dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSPR 12 allocate SYSPRINT for IEBCOPY | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSPR,TDDNAME Save generated DDNAME | |
| * | |
| *-- Call NJEDYN to allocate the SYSUT4 dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSU4 14 allocate SYSUT4 temporary | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSUT4,TDDNAME Set replacement SYSUT4 DD | |
| * | |
| TM FLAGS3,F3INMEM Was a member name specified? | |
| BZ UNLD080 No, skip ctl card build | |
| BAL R14,CTL000 Build IEBCOPY control statements | |
| * | |
| *-- Invoke IEBCOPY | |
| * | |
| UNLD080 EQU * | |
| MVC CPYPLIST,COPYPARM Move IEBCOPY parms to 24-bit stg | |
| MVC DDLISTL,=AL2(DDLISTSZ) Set IEBCOPY DD list length | |
| LA R2,CPYPLIST | |
| LA R3,DDLISTL | |
| MVC MACLIST(LINKL),LINK Move macro model | |
| LINK EP=IEBCOPY, x | |
| PARAM=((R2),(R3)), x | |
| VL=1, x | |
| MF=(E,MACLIST) | |
| LTR R5,R15 Copy RC to R5 | |
| BNZ ERR018 Exit on error | |
| * | |
| *-- Find out what we can about the IEBCOPY unloaded dataset | |
| * | |
| *-- 1. OBTAIN the DSCB for the dataset to get DCB attributes. | |
| *-- 2. Use DEVTYPE and TRKCALC along with the DSCB last used TTR to | |
| *-- determine how many blocks were used in the dataset. | |
| * | |
| UNLD100 EQU * | |
| XC CAMWORK,CAMWORK Init CAMLST work area | |
| MVC CAMLST,DMYLST Move dummy CAMLST to area | |
| LA R1,CAMLST -> CAMLST | |
| LA R4,TDSNAME -> DATASET NAME | |
| ST R4,4(,R1) Put in CAMLST | |
| LA R4,TVOLSER -> VOLSER | |
| ST R4,8(,R1) Put in CAMLST | |
| LA R4,CAMWORK -> AT WORK AREA | |
| ST R4,12(,R1) Put in CAMLST | |
| * | |
| OBTAIN (1) Get the format 1 DSCB | |
| LA R4,CAMWORK-44 -> DSCB we obtained (less DSN) | |
| USING DSCBF1,R4 | |
| LTR R15,R15 SUCCESSFUL? | |
| BNZ ABEND103 No | |
| * | |
| UNLD110 EQU * | |
| LA R7,INMF02B -> 2nd INMR02 data items | |
| USING INMFIELD,R7 | |
| MVC DSORG,TDSORG Set DSORG | |
| SR R0,R0 Clear for IC | |
| ICM R0,3,DS1BLKL | |
| ST R0,BLKSIZE Set BLKSIZE | |
| ICM R0,3,DS1LRECL | |
| ST R0,LRECL Set LRECL | |
| MVC RECFM(1),DS1RECFM Set RECFM | |
| MVI RECFM+1,X'02' Indicate shortened variable fmt | |
| XC DSNAME,DSNAME No DSNAME in INMR02B | |
| MVC UTLNAME,=CL8'INMCOPY' Utility is sequential cpy | |
| * | |
| * | |
| UNLD120 EQU * | |
| DEVTYPE TDDNAME,DEVINFO,DEVTAB Get device info | |
| LTR R15,R15 Success? | |
| BNZ ABEND104 No | |
| * | |
| UNLD130 EQU * | |
| MVC MACLIST(TRKCALCL),TRKCALC Move macro model | |
| TRKCALC FUNCTN=TRKCAP, Calc track capacity for this blkszX | |
| REGSAVE=YES, Save all regs X | |
| TYPE=DEVUCBTY+3, Point to device type byte X | |
| R=1, Record 1 = calc for entire track X | |
| K=0, No Keys X | |
| DD=DS1BLKL, Use the BLKSIZE from DSCB X | |
| MF=(E,MACLIST) R0 = # blks per track on exit | |
| * | |
| * | |
| SR R1,R1 Clear | |
| L R3,BLKSIZE Get current block size | |
| MR R2,R0 Compute bytes per track | |
| SR R1,R1 Clear | |
| ICM R1,3,DS1LSTAR Get TT of last used TTR | |
| LA R1,1(,R1) One extra for partial last track | |
| MR R2,R1 Compute approx bytes in file | |
| ST R3,FILESIZE Set approx file size in bytes | |
| DROP R4 DSCBF1 | |
| * | |
| *-- Prep OUTDATASET if specified | |
| * | |
| *-- Determine if it exists, | |
| *-- If yes, DSORG must be PS unless OUTDS member coded. | |
| *-- If no, create it, 3120/80/FB, | |
| *-- and create as PDS if user specified a OUTDS member, else SEQL, | |
| *-- using estimated file size from input dataset. | |
| * | |
| OUT000 EQU * | |
| TM FLAGS3,F3OUTDS Did user specify OUTDATASET? | |
| BZ OPN000 No, transmit to NETSPOOL | |
| * | |
| OUT200 EQU * | |
| MVC CAMLST,LOCATLST Move modem CAMLST | |
| XC BUFF,BUFF Clear sufficient camlst workarea | |
| XC REC,REC Clear more | |
| LA R1,CAMLST -> CAMLST | |
| LA R2,OUTPUTDS -> DATASET name | |
| ST R2,4(,R1) Place in CAMLST | |
| LA R2,CAMWORK -> CAMLST work area | |
| ST R2,12(,R1) Place in CAMLST | |
| * | |
| LOCATE (1) Does dataset exist? | |
| LTR R15,R15 Any errors? | |
| BNZ OUT240 Yes, dataset doesn't exist | |
| OI FLAGS2,F2EXIST Indicate OUTDATASET exists | |
| * | |
| *-- Find out about this existing OUTDATASET | |
| * | |
| OUT210 EQU * | |
| LA R4,CAMWORK -> CAMLST work area | |
| USING VOLLIST,R4 Address the volume list | |
| MVC TVOLSER,VOLSER Save off the volume | |
| DROP R4 VOLLIST | |
| * | |
| XC CAMWORK,CAMWORK Init CAMLST work area | |
| MVC CAMLST,DMYLST Move dummy CAMLST to area | |
| LA R1,CAMLST -> CAMLST | |
| LA R4,OUTPUTDS -> DATASET NAME | |
| ST R4,4(,R1) Put in CAMLST | |
| LA R4,TVOLSER -> VOLSER | |
| ST R4,8(,R1) Put in CAMLST | |
| LA R4,CAMWORK -> AT WORK AREA | |
| ST R4,12(,R1) Put in CAMLST | |
| * | |
| OBTAIN (1) Get the format 1 DSCB | |
| LA R4,CAMWORK-44 -> DSCB we obtained (less DSN) | |
| USING DSCBF1,R4 | |
| LTR R15,R15 SUCCESSFUL? | |
| BNZ ABEND105 No | |
| * | |
| OUT220 EQU * | |
| TM DS1DSORG,X'40' Is it a Seql dataset? | |
| BO OUT230 Yes | |
| TM DS1DSORG,X'02' Is it a PDS dataset? | |
| BZ ERR007 No, error; must be PS or PO | |
| TM FLAGS3,F3OUTMEM Did user also code member name? | |
| BZ ERR008 N, mem req'd if PO | |
| B OUT250 Y, proceed with allocation | |
| * | |
| *-- Whether OUTDATASET existed or not, ignore any member name | |
| *-- coded on OUTDATASET if the dataset is PS. | |
| * | |
| OUT230 EQU * | |
| NI FLAGS3,255-F3OUTMEM Ignore any user member name | |
| B OUT250 And go allocate it | |
| * | |
| *-- OUTDATASET didn't exist, prepare to create it | |
| * | |
| OUT240 EQU * | |
| LA R2,3120 3120 = NETDATA output blksize | |
| STH R2,TBLKSIZE Set per NETDATA std | |
| STCM R2,7,TBLKLEN Set per NETDATA std | |
| MVC TLRECL,=H'80' Set per NETDATA std | |
| MVI TRECFM,X'90' Set FB per NETDATA std | |
| MVC TDSORG,=X'4000' Set PS per NETDATA std | |
| SR R0,R0 Clear for divide | |
| L R1,FILESIZE Get # bytes in input file | |
| DR R0,R2 Compute # of 3120 blks needed | |
| * | |
| LR R2,R1 Copy # blks needed | |
| SRA R1,3 div by 8 Compute 12% for NETDATA overhead | |
| AR R1,R2 Get # blks + 12% | |
| STCM R1,7,TPRIME Set # primary space blocks | |
| SRA R2,2 div by 4 Compute 25% for secondary | |
| STCM R2,7,TSECND Set # secondary space blocks | |
| * | |
| OUT250 EQU * | |
| MVC TDSNAME,OUTPUTDS Set DSNAME for allocation | |
| MVC TMEMBER,OUTMEM Set possible member name | |
| MVC TVOLSER,OUTVOL Set possible volser override | |
| * | |
| LA R0,DYNOUTDS 32 allocate OUTDATASET | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 Any errors? | |
| BNZ EXIT08 Exit if allocation error | |
| * | |
| MVC DDOUTDS,TDDNAME Save DD returned | |
| MVC OUTDS(DMYOUTDL),DMYOUTDS Set up DCB | |
| LA R6,OUTDS -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBDDNAM,DDOUTDS Set DCB DDNAME | |
| DROP R6 IHADCB | |
| * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (OUTDS,OUTPUT), Open the OUTDATASET X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2OUTOPN Indicate DCB is open | |
| B TRN000 Start transmitting to OUTDATASET | |
| * | |
| *-- Open NETSPOOL if not using OUTDATASET | |
| * | |
| OPN000 EQU * | |
| BAL R2,CHK000 Determine NJE38 status v210 | |
| BNZ ERR013 NJE38 is not active v210 | |
| * | |
| MVC DDNETSPL,=CL8'NETSPOOL' Set NETSPOOL DDN (for unalloc) | |
| MVC TDDNAME,DDNETSPL NETSPOOL DD | |
| MVC TDSNAME,SPLDSN Set spool DSN | |
| LA R0,DYNETSPL 28 allocate NETSPOOL | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| * | |
| LA R8,NCB1 -> NCB | |
| USING NCB,R8 | |
| MVI NCBFL1,TYPPUN Only outputting punch type recs | |
| * | |
| NSIO TYPE=OPEN, x | |
| NCB=(R8) | |
| C R15,=F'4' NETSPOOL needs verify? | |
| BE ERR025 Yes | |
| BL OPN010 Everything is good | |
| BAL R14,FMT000 Display Open error | |
| CLC NCBRTNCD(2),=AL1(8,152) X'0898' Security denied access? | |
| BE ERR014 Yes, special message | |
| B EXIT08 Exit on VSAM error | |
| * | |
| OPN010 EQU * | |
| OI FLAGS2,F2NCBOPN Indicate NETSPOOL is open | |
| * | |
| *-- Create the NETDATA and transmit the results to the destination | |
| *-- node, or store it in the OUTDATASET. | |
| * | |
| *-- DDNAME setup below at TRN000 may look confusing. To explain: | |
| *-- The NETDATA is always built from a sequential dataset. So the | |
| *-- INDS DCB here represents either the original user specified | |
| *-- input DATASET -or - the IEBCOPY unloaded sequential dataset from | |
| *-- the original PDS. | |
| * | |
| *-- If the original was sequential, it is already allocated at the | |
| *-- DDSYSUT1 ddname. | |
| *-- If the original was a PDS, then the IEBCOPY unload dataset is | |
| *-- allocated at the DDSYSUT2 ddname. | |
| * | |
| * | |
| TRN000 EQU * | |
| MVC INDS(DMYINDSL),DMYINDS Set up DCB | |
| LA R6,INDS -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBDDNAM,DDSYSUT2 PDS: Set DCB DDNAME (iebcopy UNLD DD) | |
| * | |
| TM FLAGS1,F1INPDS Is input dataset a PDS? | |
| BO TRN210 Yes | |
| MVC DCBDDNAM,DDSYSUT1 SEQ: Set DCB DDNAME (input DS DD) | |
| * | |
| TRN210 EQU * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (INDS,INPUT), Open the input dataset X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2INOPN Indicate DCB is open | |
| DROP R6 IHADCB | |
| * | |
| TRN220 EQU * | |
| L R15,=A(NJENET) -> NETDATA build and write | |
| BALR R14,R15 Go write NETDATA | |
| LTR R15,R15 Any errors? | |
| BNZ ERR010 Write i/o error | |
| * | |
| TRN300 EQU * | |
| TM FLAGS2,F2NCBOPN Was spool open? | |
| BZ TRN350 No | |
| * | |
| L R5,16 -> CVT | |
| L R5,CVTSMCA-CVT(,R5) -> SMCA | |
| LA R5,SMCASID-SMCABASE(,R5) -> system id | |
| * | |
| *-- Fill in the tag data to satisfy the DMTXJE RSCS line driver used | |
| *-- by NJE38. | |
| * | |
| TRN310 EQU * | |
| LA R6,TAGDATA -> tag data area | |
| USING TAG,R6 | |
| * | |
| STCK TAGINTOD Time of spool file creation | |
| * | |
| MVC TAGDEV,=X'000C' Pseudo card rdr CUU | |
| MVC TAGINLOC,LCLNODE Local node name of origin | |
| MVC TAGINVM,USERID Userid of origin | |
| MVC TAGRECNM,OUTRECS # of records written | |
| MVC TAGRECLN,=Y(80) Move record length | |
| MVI TAGINDEV,TYPPUN data type (PRT/PUN) | |
| MVC TAGCLASS,=C'A' Spool class | |
| MVC TAGCOPY,=H'1' # copies | |
| MVC TAGNAME,BLANKS Init receiving field | |
| MVC TAGNAME(8),USERID Insert userid | |
| MVC TAGTYPE,=CL12'OUTPUT' | |
| MVC TAGDIST,BLANKS Init receiving field | |
| MVC TAGDIST(4),0(R5) Insert system id | |
| MVC TAGTOLOC,DESTNODE destination node | |
| MVC TAGTOVM,DESTUSER destination userid | |
| MVC TAGPRIOR,=H'1' priority | |
| DROP R6 TAG | |
| * | |
| TRN320 EQU * | |
| NSIO TYPE=CLOSE, Close NETSPOOL x | |
| NCB=(R8), x | |
| TAG=(R6) Pass TAG data | |
| NI FLAGS2,255-F2NCBOPN Indicate NETSPOOL is closed | |
| * | |
| *-- Let NJE38 know that a new file was just placed into the spool so | |
| *-- it can be queued for transmission. | |
| * | |
| BAL R2,CHK000 Determine NJE38 status v210 | |
| BNZ TRN350 NJE38 is not active v210 | |
| CLC DESTNODE,LCLNODE Trying to send file locally? | |
| BE TRN350 Y, but skip the POST | |
| * | |
| LR R7,R1 -> NJE38 CSA ptr to R7 v210 | |
| USING NJ38CSA,R7 | |
| * | |
| MODESET MODE=SUP,KEY=ZERO | |
| * | |
| GETMAIN RU, Get CSA for WRE TYPE=WRENEW x | |
| LV=WRESIZE, v220x | |
| SP=241 | |
| XC 0(WRESIZE,R1),0(R1) Clear stg area v220 | |
| USING WRE,R1 | |
| MVI WRESP,241 Save subpool v220 | |
| MVI WRETYPE,WRENEW "New file in spool" WRE | |
| MVC WRELINK,DESTNODE Set destination node | |
| MVC WREUSER,DESTUSER Set destination userid | |
| * | |
| LM R2,R3,NJ38SWAP Get first WRE ptr, sync count | |
| TRN340 EQU * | |
| ST R2,WRENEXT First WRE becomes next | |
| LR R4,R1 -> WRE to be added as first | |
| LA R5,1(,R3) Incr synchronization count | |
| CDS R2,R4,NJ38SWAP Update CSA WRE anchor, sync | |
| BC 7,TRN340 Gotta try again | |
| * | |
| LA R6,NJ38ECB -> NJE38 external WRE ECB | |
| L R7,NJ38ASCB -> NJE38 ASCB | |
| DROP R7 NJ38CSA | |
| * | |
| MVC MACLIST(POSTL),POST Move macro model | |
| POST (6), Wake up NJE38 to new spool file x | |
| ASCB=(7), x | |
| ERRET=TRN350, Exit if can't do the post x | |
| ECBKEY=0, x | |
| MF=(E,MACLIST) | |
| * | |
| MODESET MODE=PROB,KEY=NZERO | |
| * | |
| TRN350 EQU * | |
| * | |
| * | |
| *-- Transmission complete. Issue # records sent and terminate. | |
| * | |
| * | |
| TRN900 EQU * | |
| LA R2,MSGBLNK | |
| BAL R14,PUTLINE Write blank line | |
| * | |
| MVC LIST,BLANKS | |
| * | |
| *-- Record count not displayed until discrepancy with NJE counts v200 | |
| *-- can be resolved. v200 | |
| * v200 | |
| * L R15,OUTRECS # of output records written v200 | |
| * CVD R15,DBLE unpk count v200 | |
| * MVC LIST+4(11),=X'2020206B2020206B202120' v200 | |
| * LA R1,LIST+14 In case no significance v200 | |
| * EDMK LIST+3(12),DBLE+3 Edit result v200 | |
| * MVC LIST+4(12),0(R1) left justify displayed digitv200 | |
| * TRT LIST+4(12),BLANK Look for end v200 | |
| * LA R1,1(,R1) Skip the blank v200 | |
| MVC LIST+4(L'MSG009T),MSG009T Move 'file successfully' v200 | |
| LA R1,LIST+L'MSG009T+4 -> next available byte v200 | |
| * | |
| TM FLAGS3,F3OUTDS Using OUTDATASET? | |
| BO TRN910 | |
| MVC 0(10,R1),=C'queued to ' | |
| MVC 10(8,R1),DESTNODE | |
| TRT 10(9,R1),BLANK Look for end of node id | |
| MVI 0(R1),C'.' Set dot | |
| MVC 1(8,R1),DESTUSER Move userid | |
| LA R1,9(,R1) -> next available byte | |
| B TRN920 | |
| * | |
| TRN910 EQU * | |
| MVC 0(12,R1),=C'written to ''' | |
| MVC 12(44,R1),OUTPUTDS Move OUTDATASET name | |
| TRT 12(45,R1),BLANK Look for end of DSN | |
| MVI 0(R1),C'''' Set dot | |
| LA R1,1(,R1) -> next available byte | |
| * | |
| TRN920 EQU * | |
| LA R2,LIST -> msg | |
| MVC 0(4,R2),MSG009 Move RDW and flags | |
| SR R1,R2 | |
| STH R1,LIST Set updated RDW | |
| BAL R14,PUTLINE | |
| B EXIT00 | |
| * | |
| * | |
| *--Error routines | |
| * | |
| ERR001 EQU * | |
| MVC LIST(4+L'MSG001T),MSG001 Move msg to work area | |
| CVD R15,DBLE unpk IKJPARS RC | |
| UNPK LIST+57(2),DBLE | |
| OI LIST+58,X'F0' Fix sign | |
| LA R2,LIST -> msg | |
| B ERRPUT | |
| * | |
| ERR002 EQU * | |
| LA R2,MSG002 Input dataset is required | |
| B ERRPUT Write it | |
| * | |
| ERR003 EQU * | |
| LA R2,MSG003 Input dataset not PS or PO | |
| B ERRPUT Write it | |
| * | |
| ERR004 EQU * | |
| LA R2,MSG004 No parameters entered on cmd lin | |
| B ERRPUT Write it | |
| * | |
| ERR005 EQU * | |
| LA R2,MSG005 Invalid node.user specified | |
| B ERRPUT Write it | |
| * | |
| ERR006 EQU * | |
| LA R2,MSG006 Not APF authorized | |
| B ERRPUT | |
| * | |
| ERR007 EQU * | |
| LA R2,MSG008 OUTDATASET not SEQ or PDS | |
| B ERRPUT | |
| * | |
| ERR008 EQU * | |
| LA R2,MSG008 OUTDATASET is PDS but no mem | |
| B ERRPUT | |
| * | |
| ERR010 EQU * | |
| MVC LIST(4+L'MSG010T),MSG010 Move msg text | |
| LA R1,=CL10'OUTDATASET' Assume writing to OUTDATASET | |
| TM FLAGS3,F3OUTDS Using OUTDATASET? | |
| BO *+8 We are | |
| LA R1,=CL10'NETSPOOL' NO, its NETSPOOL | |
| MVC LIST+4+L'MSG010T(9),0(R1) Move source of error | |
| LH R1,LIST Get current msg length | |
| LA R1,10(,R1) Add on the source length | |
| STH R1,LIST Put back | |
| LA R2,LIST Write i/o error on OUTDS/SPOOL | |
| B ERRPUT | |
| * | |
| ERR011 EQU * | |
| LA R2,MSG011 No destination node.user | |
| B ERRPUT | |
| * | |
| ERR013 EQU * | |
| LA R2,MSG013 NJE38 is not active | |
| B ERRPUT | |
| * | |
| ERR014 EQU * | |
| LA R2,MSG014 Security denied NETSPOOL access | |
| B ERRPUT | |
| * | |
| *-- Member not found in DATASET (come here from ESTAE 013-18) v200 | |
| * | |
| ERR015 EQU * v200 | |
| LA R13,NJESA Ensure using proper SA sincev200 | |
| * we came here from ESTAE v200 | |
| * | |
| MVC LIST(4+L'MSG015T),MSG015 Member not found msg v200 | |
| MVC LIST+11(8),INMEM Plug missing member name v200 | |
| * v200 | |
| LA R2,LIST -> start of msg v200 | |
| B ERRPUT v200 | |
| * | |
| *-- TRANSMIT ended because IEBCOPY failed | |
| * | |
| ERR018 EQU * | |
| LA R2,MSGBLNK -> blank line msg | |
| BAL R14,PUTLINE | |
| * | |
| MVC LIST(4+L'MSG018T),MSG018 IEBCOPY fail msg | |
| CVD R5,DBLE Convert IEBCOPY RC | |
| UNPK LIST+38(2),DBLE | |
| OI LIST+39,X'F0' Fix sign | |
| * | |
| LA R2,LIST -> start of msg | |
| B ERRPUT Display failure | |
| * | |
| ERR025 EQU * | |
| LA R2,MSG025 Need to run VERIFY | |
| B ERRPUT | |
| * | |
| ERRPUT EQU * | |
| BAL R14,PUTLINE | |
| B EXIT08 | |
| * | |
| ***************** | |
| * EXIT FROM * | |
| * TRANSMIT * | |
| ***************** | |
| * | |
| * | |
| * | |
| EXIT00 EQU * | |
| SR R15,R15 Set RC=0 | |
| B XIT000 Clean up and exit | |
| * | |
| EXIT08 EQU * | |
| LA R15,8 Set RC=8 | |
| B XIT000 Clean up and exit | |
| * | |
| XIT000 EQU * | |
| LA R13,NJESA Ensure using proper SA in case | |
| * we've come here due to ESTAE | |
| LR R5,R15 Save RC across shutdown | |
| ESTAE 0 Disable ESTAE | |
| * | |
| TM FLAGS2,F2INOPN Is input dataset open? | |
| BZ XIT010 No | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (INDS), Close it X | |
| MF=(E,MACLIST) | |
| * | |
| XIT010 EQU * | |
| TM FLAGS2,F2OUTOPN Is OUTDATASET open? | |
| BZ XIT020 No | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (OUTDS), Close it X | |
| MF=(E,MACLIST) | |
| * | |
| XIT020 EQU * | |
| TM FLAGS2,F2NCBOPN Is NETSPOOL open? | |
| BZ XIT030 No | |
| SR R6,R6 Ensure no tag data | |
| LA R1,NCB1 -> NCB | |
| NSIO TYPE=CLOSE, Close the spool x | |
| NCB=(R1),TAG=(R6) | |
| * | |
| XIT030 EQU * | |
| * NJE00200 | |
| XIT040 EQU * NJE00210 | |
| LA R3,DDLIST -> list of DD's we allocated | |
| LA R4,UNLISTSZ/8 # of DD list entries | |
| * | |
| XIT050 EQU * | |
| CLC =XL8'00',0(R3) Unassigned DD? | |
| BE XIT060 Skip to next | |
| * | |
| MVC UDDNAME,0(R3) | |
| LA R0,UNDYN 00 unalloc | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| * | |
| XIT060 EQU * NJE00210 | |
| LA R3,8(,R3) -> next DD entry | |
| BCT R4,XIT050 Continue unallocation scan | |
| * | |
| XIT070 EQU * NJE00210 | |
| TM FLAGS1,F1AUSR Special authorized user? | |
| BZ XIT080 Y, Don't need Auth SVC | |
| SR 0,0 Use authorization SVC | |
| SR 1,1 For HERC01/HERC02 only | |
| SVC 244 Get un-authorized | |
| * | |
| XIT080 EQU * NJE00210 | |
| * | |
| QUIT EQU * NJE00210 | |
| LR R1,R10 -> NJEWK main work area page | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| ST R5,16(,R13) Set exit RC | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| LM R14,R12,12(R13) Reload system's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| * | |
| *-- User ABENDs issued | |
| * | |
| ABEND101 EQU * | |
| LA R1,101 OBTAIN failed for input DATASET | |
| B ABEND | |
| * | |
| ABEND102 EQU * | |
| LA R1,102 DEVTYPE failed for input DATASET | |
| B ABEND | |
| * | |
| ABEND103 EQU * | |
| LA R1,103 OBTAIN failed for IEBCOPY UNLD | |
| B ABEND | |
| * | |
| ABEND104 EQU * | |
| LA R1,104 DEVTYPE failed for IEBCOPY UNLD | |
| B ABEND | |
| * | |
| ABEND105 EQU * | |
| LA R1,105 OBTAIN failed for OUTDATASET | |
| B ABEND | |
| * | |
| *ABEND106 EQU * DSNAME build failure, See | |
| * label B2DSN020 in CSECT NJENET | |
| * | |
| ABEND ABEND (1),DUMP,STEP | |
| DROP R12 | |
| * | |
| *-- STAX attention exit | |
| * | |
| *-- Doesn't do anything, but allows us to deallocate and get un- | |
| *-- authorized rather than a native TSO abort. | |
| * | |
| STAXXIT EQU * | |
| STM R14,R12,12(R13) Save | |
| LR R12,R15 Get base | |
| USING STAXXIT,R12 | |
| L R10,8(,R1) -> NJEWK area | |
| USING NJEWK,R10 | |
| OI FLAGS1,F1ATTN Indicate ATTN pressed v201 | |
| LM R14,R12,12(R13) Load | |
| DROP R12 | |
| BR R14 Return | |
| * | |
| LTORG , | |
| * | |
| DMYINDS DCB DDNAME=INDS, X | |
| MACRF=(GL), X | |
| DSORG=PS, X | |
| BFTEK=A, X | |
| EODAD=EOD000 | |
| DMYINDSL EQU *-DMYINDS | |
| * | |
| DMYOUTDS DCB DDNAME=OUTDS, X | |
| MACRF=(PM), X | |
| DSORG=PS, X | |
| BLKSIZE=3120, X | |
| LRECL=80, X | |
| RECFM=FB | |
| DMYOUTDL EQU *-DMYOUTDS | |
| * | |
| * | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| LINK LINK EP=0,SF=L | |
| LINKL EQU *-LINK | |
| ESTAE ESTAE 0,MF=L | |
| ESTAEL EQU *-ESTAE | |
| STAX STAX 0,OBUF=(0,0),IBUF=(0,0),USADDR=0,MF=L | |
| STAXL EQU *-STAX | |
| DMYLST CAMLST SEARCH,0,0,0 | |
| DMYLSTL EQU *-DMYLST | |
| LOCATLST CAMLST NAME,0,,0 | |
| TRKCALC TRKCALC MF=L | |
| TRKCALCL EQU *-TRKCALC | |
| POST POST 0,ASCB=0,ERRET=0,MF=L | |
| POSTL EQU *-POST | |
| * | |
| COPYPARM DC AL2(L'COPYOPT) | |
| COPYOPT DC C'WORK=0512K' | |
| COPYPRML EQU *-COPYPARM TOTAL LENGTH OF PARM OPTION | |
| * | |
| ATTNMSG DC C'COMMAND TERMINATED DUE TO ATTENTION; PRESS ENTER TWICE' | |
| * v201 | |
| ********************* | |
| * N J E C O M * NJECOM hosts small routines and | |
| * * frequently used constants that | |
| * Common routines * are available to all NJERxx csects | |
| * and constants * via base register 11 | |
| * * | |
| ********************* | |
| * | |
| NJECOM CSECT | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECOM' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECOM,R11 | |
| * | |
| *-- Write a record to the NJE38 spool, or to OUTDATASET | |
| * | |
| *-- Entry: None | |
| *-- Exit: RC=0 if write ok, RC=8 if write error. | |
| * | |
| PUT000 EQU * | |
| ST R14,SV14PUT Save return reg | |
| * | |
| TM FLAGS3,F3OUTDS Did user specify OUTDATASET? | |
| BZ PUT050 No, transmit to NETSPOOL | |
| * | |
| PUT OUTDS,REC Write the record | |
| SR R15,R15 Set RC=0 | |
| B PUT090 | |
| * | |
| PUT050 EQU * | |
| LA R1,NCB1 | |
| NSIO TYPE=PUT, Write the record to spool x | |
| NCB=(R1), x | |
| AREA=REC, x | |
| RECLEN=80 | |
| LTR R15,R15 Any errors? | |
| BZ PUT090 No | |
| BAL R14,FMT000 Display error | |
| LA R15,8 Set RC=8 | |
| * | |
| PUT090 EQU * | |
| LA R1,1 Get 1 | |
| A R1,OUTRECS Bump record count | |
| ST R1,OUTRECS Update output counter | |
| L R14,SV14PUT Load return reg | |
| BR R14 Return with RC in R15 | |
| * | |
| *-- Build IEBCOPY control statements | |
| * | |
| *-- Used if a member name was specified on DATASET and the PDS option | |
| *-- was specified. | |
| * | |
| *-- Entry: None | |
| *-- Exit: None; card images written to the SYSIN dataset. | |
| * | |
| CTL000 EQU * | |
| ST R14,SV14SI Save return reg | |
| * | |
| L R15,=A(DMYOUTDS) -> DCB to use as model | |
| MVC SYSINDS(DMYOUTDL),0(R15) Set up DCB model | |
| LA R6,SYSINDS -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBDDNAM,DDSYSIN Set DCB DDNAME | |
| DROP R6 IHADCB | |
| * | |
| L R15,=A(OPEN) -> model list | |
| MVC MACLIST(OPENL),0(R15) Move OPEN list | |
| OPEN (SYSINDS,OUTPUT), Open the SYSIN dataset X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2SYSOPN Indicate DCB is open | |
| * | |
| *-- Build IEBCOPY control statements to select one member | |
| * | |
| MVC REC,BLANKS Init record image | |
| MVC REC+1(10),=C'COPY INDD=' | |
| MVC REC+11(8),DDSYSUT1 Set SYSUT1 DD name | |
| TRT REC+11(9),BLANK Look for end | |
| MVC 0(7,R1),=C',OUTDD=' | |
| MVC 7(8,R1),DDSYSUT2 Set SYSUT2 DD name | |
| PUT SYSINDS,REC Write the COPY ctrl stmt | |
| * | |
| MVC REC,BLANKS Init image | |
| MVC REC+1(5),=C'S M=(' | |
| MVC REC+6(8),INMEM User specified member name | |
| TRT REC+6(9),BLANK Look for end | |
| MVI 0(R1),C')' End selection list | |
| PUT SYSINDS,REC | |
| * | |
| TM FLAGS2,F2SYSOPN Is SYSINDS open? | |
| BZ CTL090 No | |
| L R15,=A(CLOSE) -> model list | |
| MVC MACLIST(CLOSEL),0(R15) Move close list | |
| CLOSE (SYSINDS), Close it X | |
| MF=(E,MACLIST) | |
| * | |
| CTL090 EQU * | |
| L R14,SV14SI Load return reg | |
| BR R14 Return | |
| * | |
| * | |
| *-- Format VSAM NETSPOOL errors | |
| * | |
| * | |
| FMT000 EQU * | |
| STM R14,R2,PARSA+12 Borrow NJEPAR save area | |
| LA R15,0(,R14) Clear high, Get addr of call to this rtn | |
| L R2,NJESA+4 -> system provided FSA | |
| L R2,16(,R2) Get R15's entry point addr | |
| LA R2,0(,R2) Ensure high byte clear | |
| SR R15,R2 Compute offset of call | |
| MVC LIST+0(4+L'MSG024T),MSG024 Move msg text | |
| MVC LIST+55(8),5(R2) Move csect name | |
| TRT LIST+55(9),BLANK Look for end of csect name | |
| MVI 0(R1),C'+' | |
| * | |
| ST R15,DBLE Save call offset to work area | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC 1(4,R1),TWRK Move call offset to msg | |
| * | |
| LA R15,NCB1 | |
| UNPK TWRK(5),NCBRTNCD-NCB(3,R15) Add zones | |
| TR TWRK(4),HEXTRAN-240 | |
| MVC LIST+35(4),TWRK Move rtncd/errcd | |
| * | |
| UNPK TWRK(3),NCBREQ-NCB(2,R15) Add zones | |
| TR TWRK(2),HEXTRAN-240 | |
| MVC LIST+45(2),TWRK Move req code | |
| * | |
| L R1,NCBMACAD-NCB(,R15) Get failing VSAM macro addr | |
| LA R1,0(,R1) Clear high byte | |
| S R1,=V(NJESPOOL) Compute offset into NJESPOOL rtn | |
| ST R1,DBLE | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC LIST+50(4),TWRK Move NJESPOOL offset to msg | |
| * | |
| LA R2,LIST | |
| BAL R14,PUTLINE | |
| * | |
| FMT090 EQU * | |
| LM R14,R2,PARSA+12 Restore caller regs | |
| BR R14 Return | |
| * | |
| *-- Write a single line to terminal | |
| * | |
| *-- Entry: R2 -> output msg (RDW+msg text) | |
| *-- Exit: R15 = RC from PUTLINE | |
| * | |
| PUTLINE EQU * | |
| TM FLAGS3,F3QUIET QUIET mode enabled? | |
| BZ PUT010 No, proceed | |
| CLI 3(R2),1 Suppress this msg in QUIET mode? | |
| BER R14 Yes | |
| * | |
| PUT010 EQU * | |
| ST R14,SV14LN Save return | |
| XC PUTECB,PUTECB Clear PUTLINE ECB | |
| L R15,CPARMS -> command input CPPL | |
| USING CPPL,R15 | |
| LA R1,IOPLAREA -> IOPL | |
| USING IOPL,R1 | |
| MVC IOPLUPT,CPPLUPT Set UPT ptr | |
| MVC IOPLECT,CPPLECT Set ECT ptr | |
| DROP R15 CPPL | |
| * | |
| MVC TWRK(PBL),PB Move macro model | |
| PUTLINE PARM=TWRK, Write a line x | |
| ECB=PUTECB, x | |
| OUTPUT=((R2),TERM,SINGLE,DATA), x | |
| MF=(E,(1)) | |
| DROP R1 IOPL | |
| L R14,SV14LN Load return | |
| BR R14 | |
| * | |
| *-- Get status of NJE38 | |
| * | |
| *-- Entry: R1=0 (no spool dsn needed), or, R1-> 44-char spool DSN area | |
| *-- Exit: RC=0 NJE38 is active; R1-> NJE38 CSA block | |
| *-- RC<>0 NJE is not active. | |
| * | |
| * | |
| CHK000 EQU * | |
| LA R1,SPLDSN => where to place spool DSN v210 | |
| L R15,=V(NJESYS) -> ENQ finder v210 | |
| BALR R14,R15 Check if NJE38 already act v210 | |
| LTR R15,R15 Set CC (RC=0 NJE38 active) v210 | |
| BNZR R2 Return if NJE38 inactive v210 | |
| MVC LCLNODE,NJ38NODE-NJ38CSA(R1) Save off lcl node namev210 | |
| MVC DEFUSER,NJ38DUSR-NJ38CSA(R1) Save off default user v210 | |
| BR R2 Return; NJE38 active v210 | |
| * | |
| LTORG | |
| * | |
| PB PUTLINE MF=L | |
| PBL EQU *-PB | |
| * | |
| NJE38Q DC CL8'NJE38' QNAME | |
| NJERCON DC CL8'NJEINIT' RNAME (first 8 bytes) | |
| * | |
| * | |
| * | |
| BLANKS DC CL120' ' | |
| NONBLANK DC 64X'FF',X'00',191X'FF' TR Table to locate nonblank | |
| BLANK DC 64X'00',X'FF',191X'00' TR Table to locate blanks | |
| DOTS DC 75X'00',X'FF',180X'00' TR Table to locate '.' char | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * | |
| NONALNUM EQU * 0 1 2 3 4 5 6 7 8 9 A B C D E F | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 0 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 1 Allow alpha- | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 2 numeric only | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 3 and '.' | |
| DC X'FFFFFFFFFFFFFFFFFFFFFF00FFFFFFFF' 4 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 5 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 6 | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' 7 | |
| DC X'FF000000000000000000FFFFFFFFFFFF' 8 | |
| DC X'FF000000000000000000FFFFFFFFFFFF' 9 | |
| DC X'FFFF0000000000000000FFFFFFFFFFFF' A | |
| DC X'FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF' B | |
| DC X'FF000000000000000000FFFFFFFFFFFF' C | |
| DC X'FF000000000000000000FFFFFFFFFFFF' D | |
| DC X'FFFF0000000000000000FFFFFFFFFFFF' E | |
| DC X'00000000000000000000FFFFFFFFFFFF' F | |
| * | |
| *-- TRANSMIT messages | |
| * | |
| *-- Note: a '1' after the length indicates suppress this msg if QUIET | |
| * | |
| MSGBLNK DC Y(4+L'MSGBLNKT,1) | |
| MSGBLNKT DC C' ' | |
| * | |
| MSG000 DC Y(4+L'MSG000T,1) | |
| MSG000T DC C'NJE38 TRANSMIT &VERS' | |
| * | |
| MSG001 DC Y(4+L'MSG001T,0) | |
| MSG001T DC C'Error parsing TRANSMIT command parameters. IKJPARS RC=x | |
| yy (dec)' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| * | |
| MSG002 DC Y(4+L'MSG002T,0) | |
| MSG002T DC C'DATASET(dsname) parameter is missing; it is required' | |
| * | |
| MSG003 DC Y(4+L'MSG003T,0) | |
| MSG003T DC C'Input dataset must be sequential or partitioned (DSORGx | |
| =PS/PO)' | |
| * NJE00250 | |
| * | |
| MSG004 DC Y(4+L'MSG004T,0) | |
| MSG004T DC C'No transmit parameters were specified' | |
| * | |
| MSG005 DC Y(4+L'MSG005T,0) | |
| MSG005T DC C'Invalid node.user specification' | |
| * | |
| MSG006 DC Y(4+L'MSG006T,0) | |
| MSG006T DC C'The TRANSMIT command is not APF-authorized' | |
| * | |
| MSG007 DC Y(4+L'MSG007T,0) | |
| MSG007T DC C'OUTDATASET must specify a sequential dataset or PDS wix | |
| th a member name' | |
| * | |
| MSG008 DC Y(4+L'MSG008T,0) | |
| MSG008T DC C'OUTDATASET specifies a PDS; a member name is required' | |
| * | |
| MSG009 DC Y(4+L'MSG009T,1) | |
| MSG009T DC C'File successfully ' queued to/written to v200 | |
| * | |
| MSG010 DC Y(4+L'MSG010T,0) | |
| MSG010T DC C'I/O error writing ' | |
| * | |
| * | |
| MSG011 DC Y(4+L'MSG011T,0) | |
| MSG011T DC C'A destination node.userid was not specified' | |
| * | |
| MSG012 DC Y(4+44+L'MSG012T,0) | |
| MSG012T DC C'Allocation error xxxxxxxx, DSN=' | |
| * | |
| MSG013 DC Y(4+L'MSG013T,0) | |
| MSG013T DC C'NJE38 is not active' | |
| * | |
| * | |
| MSG014 DC Y(4+L'MSG014T,0) | |
| MSG014T DC C'Access to the NETSPOOL dataset denied due to security x | |
| settings' | |
| * | |
| MSG015 DC Y(4+L'MSG015T,0) v200 | |
| MSG015T DC C'Member xxxxxxxx was not found' v200 | |
| * | |
| MSG018 DC Y(4+L'MSG018T,0) | |
| MSG018T DC C'Transmit failed due to IEBCOPY RC=xx' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| * | |
| MSG024 DC Y(4+L'MSG024T,0) | |
| MSG024T DC C'ERROR: NETSPOOL RTNCD/ERRCD=X''0000'',REQ=01,O=1234,Mx | |
| MMMMMMM ' | |
| * | |
| MSG025 DC Y(4+L'MSG025T,0) | |
| MSG025T DC C'Unable to open NETSPOOL. Run IDCAMS VERIFY against thex | |
| NETSPOOL dataset' | |
| * | |
| MSG027 DC Y(4+L'MSG027T,0) | |
| MSG027T DC C' exists' | |
| * | |
| MSG031 DC Y(4+L'MSG031T,0) | |
| MSG031T DC C' does not exist' | |
| * | |
| * NJE00250 | |
| * NJE00250 | |
| ********************* | |
| * N J E D Y N * NJEDYN handles the various | |
| * * dynamic allocations required | |
| * Handle DYNALLOC * and their unallocations as well. | |
| * * | |
| ********************* | |
| * | |
| * USING INMFIELD,R7 -> R7 at entry | |
| * | |
| NJEDYN CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDYN' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJEDYN,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,DYNSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,DYNSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC LS99RB,CPS99RB init THE S99RB | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| ST R1,LS99PTR Set parameter word | |
| OI LS99PTR,X'80' Set VL | |
| LA R6,TXTPTRS -> start of text unit list | |
| ST R6,S99TXTPP Put in S99RB | |
| DROP R1 S99RB | |
| * | |
| UNDYN EQU 0 00 unallocate DDNAME | |
| DYNUNDEF EQU 4 04 unused, undefined | |
| DYNSYSIN EQU 8 08 Allocate SYSIN for IEBCOPY | |
| DYNSYSPR EQU 12 0C Allocate SYSPRINT for IEBCOPY | |
| DYNUNLD EQU 16 10 Allocate unload dataset IEBCOPY | |
| DYNSYSU4 EQU 20 14 Allocate SYSUT4 IEBCOPY | |
| DYNINDS EQU 24 18 Allocate user input dataset | |
| DYNETSPL EQU 28 1C Allocate NETSPOOL | |
| DYNOUTDS EQU 32 20 Allocate OUTDATASET | |
| * | |
| LR R5,R0 Copy action code | |
| B DYN000(R5) Branch into table | |
| * | |
| DYN000 B DYN010 00 Perform DDNAME Unallocation | |
| DC AL4(0) 04 undefined | |
| B DYN200 08 Allocate SYSIN for IEBCOPY | |
| B DYN300 0C Allocate SYSPRINT for IEBCOPY | |
| B DYN400 10 Allocate unload dataset IEBCOPY | |
| B DYN500 14 Allocate SYSUT4 IEBCOPY | |
| B DYN600 18 Allocate user input dataset | |
| B DYN700 1C Allocate NETSPOOL | |
| B DYN800 20 Allocate OUTDATASET | |
| * | |
| DYN010 EQU * | |
| MVC UTXT,UTXTD Init text unit | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| MVI S99VERB,S99VRBUN Set verb code to unallocation | |
| DROP R1 S99RB | |
| * | |
| LA R0,UTXT -> UNALLOC DD text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Deallocate the DD | |
| * | |
| *-- SYSIN for IEBCOPY | |
| * | |
| * Equivalent JCL (if command line SEQL specified or defaulted): | |
| * //SYS00000 DD DUMMY | |
| * | |
| * | |
| * Equivalent JCL (if command line PDS specified and a member name | |
| * was coded in DATASET): | |
| * //SYS00000 DD DISP=(NEW,DELETE),UNIT=SYSDA, | |
| * // SPACE=(CYL,1) | |
| * | |
| * | |
| DYN200 EQU * | |
| TM FLAGS3,F3PDS PDS copy forced? | |
| BO DYN220 Y, we need to set up for | |
| * IEBCOPY control statements | |
| * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT16,TXT16D | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT16 -> DUMMY | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| DYN220 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT03,TXT03D DISP 1 | |
| MVC TXT04,TXT04D DISP 2 | |
| MVC TXT06,TXT06D PRIME | |
| MVC TXT10,TXT10D UNIT | |
| MVC TXT19,TXT19D CYL | |
| * | |
| MVI TXT04+6,X'04' Adjust to DISP=,DELETE | |
| MVC TXT06+6(3),=XL3'01' 1 cylinders | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=NEW | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP=,DELETE | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> Primary space | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT19 -> SPACE CYL | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- SYSPRINT for IEBCOPY | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD SYSOUT=*,TERM=TS | |
| * | |
| DYN300 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT16,TXT16D | |
| MVC TXT17,TXT17D | |
| MVC TXT18,TXT18D | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| TM FLAGS3,F3QUIET QUIET mode enabled? | |
| BO DYN310 Yes, use DUMMY | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT17 -> SYSOUT=* | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT18 -> TERM=TS | |
| ST R0,0(,R6) Plug into ptr list | |
| B DYN320 | |
| * | |
| DYN310 EQU * | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT16 -> DUMMY | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN320 EQU * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Temporary dataset that IEBCOPY will unload into | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,DELETE),UNIT=SYSDA, | |
| * // SPACE=(4096,(pri,sec)), | |
| * // DCB=(BLKSIZE=4096,DSORG=PS) | |
| * | |
| DYN400 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D DSN | |
| MVC TXT03,TXT03D DISP1 | |
| MVC TXT04,TXT04D DISP2 | |
| MVC TXT05,TXT05D Blklen | |
| MVC TXT06,TXT06D Prime | |
| MVC TXT07,TXT07D Second | |
| MVC TXT09,TXT09D volume | |
| MVC TXT10,TXT10D unit | |
| MVC TXT12,TXT12D BLKSIZE | |
| MVC TXT13,TXT13D DSORG | |
| * | |
| LA R0,TXT01 -> Return DDNAME text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP text unit 1 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP text unit 2 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT05 -> BLKLEN text unit 2 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> PRIMARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT07 -> SECONDARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT12 -> BLKSIZE text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> DSORG text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT09 -> VOLSER text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| * | |
| MVI TXT04+6,X'04' Set DISP=,DELETE | |
| MVC TXT09(2),=Y(DALRTVOL) Set to return VOLSER | |
| MVC TXT02(2),=Y(DALRTDSN) Set to return DSN | |
| B DYN900 Go allocate | |
| * | |
| *-- SYSUT4 for IEBCOPY | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,DELETE),UNIT=SYSDA, | |
| * // SPACE=(CYL,5) | |
| * | |
| DYN500 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT03,TXT03D DISP 1 | |
| MVC TXT04,TXT04D DISP 2 | |
| MVC TXT06,TXT06D PRIME | |
| MVC TXT10,TXT10D UNIT | |
| MVC TXT19,TXT19D CYL | |
| * | |
| MVI TXT04+6,X'04' Adjust to DISP=,DELETE | |
| MVC TXT06+6(3),=XL3'05' 5 cylinders | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=NEW | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP=,DELETE | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> Primary space | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT19 -> SPACE CYL | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Dataset user.input.dataset from command line | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=SHR,DSNAME=user.input.dataset(mem) | |
| * | |
| DYN600 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT09,TXT09D | |
| MVC TXT13,TXT13D | |
| MVC TXT21,TXT21D | |
| * | |
| MVI TXT03+6,X'08' set DISP=SHR | |
| MVC TXT09(2),=Y(DALRTVOL) Set to return VOLSER | |
| MVC TXT13(2),=Y(DALRTORG) Set to return DSORG | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=SHR | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT09 -> RETURN VOLSER | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> RETURN DSORG | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| TM FLAGS3,F3PDS Was PDS specified? | |
| BO DYN610 Yes, we'll use IEBCOPY, no mbr | |
| TM FLAGS3,F3INMEM Was a member specified? | |
| BZ DYN610 No | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT21 -> MEMBER | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN610 EQU * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Dataset NETSPOOL | |
| * | |
| * Equivalent JCL: | |
| * //NETSPOOL DD DISP=SHR,DSNAME=NJE38.NETSPOOL | |
| * | |
| * | |
| DYN700 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| * | |
| MVC TXT01(2),=Y(DALDDNAM) Use fixed DD | |
| MVI TXT03+6,X'08' set DISP=SHR | |
| * | |
| LA R0,TXT01 -> DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=SHR | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Dataset created for OUTDATASET | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,CATLG),UNIT=unitname, | |
| * // SPACE=(3120,(pri,sec)), | |
| * // DCB=(BLKSIZE=3120,LRECL=80,RECFM=FB,DSORG=PS), | |
| * // DSN=dsname,VOL=SER=volser | |
| * | |
| DYN800 EQU * | |
| TM FLAGS2,F2EXIST Does OUTDATASET exist? | |
| BO DYN850 Yes, don't create it | |
| * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT04,TXT04D | |
| MVC TXT05,TXT05D | |
| MVC TXT06,TXT06D | |
| MVC TXT07,TXT07D | |
| MVC TXT08,TXT08D | |
| MVC TXT09,TXT09D | |
| MVC TXT10,TXT10D | |
| MVC TXT12,TXT12D | |
| MVC TXT13,TXT13D | |
| MVC TXT14,TXT14D | |
| MVC TXT15,TXT15D | |
| MVC TXT21,TXT21D | |
| * | |
| LA R0,TXT01 -> Return DDNAME text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP text unit 1 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP text unit 2 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT12 -> BLKSIZE text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT05 -> BLKLEN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT14 -> LRECL text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT15 -> RECFM text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> PRIMARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT07 -> SECONDARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> DSORG text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| TM FLAGS3,F3VOLSER Was there a volser? | |
| BZ DYN810 No | |
| * | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT09 -> VOLSER text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN810 EQU * | |
| TM FLAGS3,F3OUTMEM Was a member specified? | |
| BZ DYN820 No | |
| MVC TDSORG,=X'0200' Force DSORG to PO if member | |
| MVC TDIRBLKS,=AL3(5) Set 5 directory blocks | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT08 -> DIRBLKS | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT21 -> MEMBER | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN820 EQU * | |
| TM FLAGS2,F2UNIT User specified unit? v200 | |
| BZ DYN890 No v200 | |
| MVC TUNIT,OUTUNIT Use user specified unit namev200 | |
| * | |
| DYN890 EQU * v200 | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Allocate existing OUTDATASET (with optional member) | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=SHR,DSNAME=out.data.set(mem) | |
| * | |
| DYN850 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT21,TXT21D | |
| * | |
| MVI TXT03+6,X'08' set DISP=SHR | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=SHR | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| TM FLAGS3,F3OUTMEM Was a member specified? | |
| BZ DYN860 No | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT21 -> MEMBER | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN860 EQU * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Allocate the dataset | |
| * | |
| DYN900 EQU * | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| OI S99FLAG1,S99NOCNV FORCE NEW ALLOCATION | |
| DROP R1 | |
| LA R1,LS99PTR POINTER TO S99 PTR | |
| SVC 99 ISSUE DYNALLOC | |
| LTR R15,R15 Any errors? | |
| BZ XITDYN00 No | |
| * | |
| LA R1,LS99RB | |
| USING S99RB,R1 | |
| UNPK TWRK(9),S99ERROR(5) Add zones to error code | |
| DROP R1 | |
| TR TWRK(8),HEXTRAN-240 | |
| * | |
| CLI TWRK+1,C'7' Class 7 error code? | |
| BNE ERR012 No | |
| LA R1,DYNINDS Code for the input dataset? | |
| CR R1,R5 Was alloc for DYNINDS? | |
| BE ERR031 Yes, dataset does not exist | |
| * | |
| ERR012 EQU * | |
| MVC LIST(4+L'MSG012T),MSG012 Dyn alloc failure msg | |
| MVC LIST+21(8),TWRK Error codes to line | |
| MVC LIST+35(44),TDSNAME Move DSNAME | |
| LA R2,LIST -> msg | |
| BAL R14,PUTLINE Display it | |
| B XITDYN08 | |
| * | |
| ERR031 EQU * | |
| MVC LIST,BLANKS | |
| MVC LIST+4(9),=C'Dataset ''' | |
| MVC LIST+13(44),TDSNAME Move name | |
| TRT LIST+13(45),BLANK Look for end of name | |
| MVI 0(R1),C'''' Close apost | |
| LA R1,1(,R1) Skip apost | |
| MVC 0(L'MSG031T,R1),MSG031T Move rest of msg | |
| LA R1,L'MSG031T(,R1) point to end | |
| XC LIST(4),LIST Clear RDW area | |
| LA R2,LIST -> start of RDW+msg | |
| SR R1,R2 Compute total length | |
| STH R1,LIST Plug RDW | |
| BAL R14,PUTLINE Inform user | |
| B XITDYN04 And exit with dataset doesnt exist | |
| * | |
| * | |
| *-- Exit | |
| * | |
| XITDYN00 EQU * | |
| SR R15,R15 Set RC=0; alloc/dealloc ok | |
| B XITDYN | |
| * | |
| XITDYN04 EQU * | |
| LA R15,4 Set RC=4; Exit for special action | |
| B XITDYN | |
| * | |
| XITDYN08 EQU * | |
| LA R15,8 Set RC=8; allocation error | |
| * | |
| XITDYN EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| ST R15,16(,R13) Set RC | |
| LM R14,R12,12(R13) Reload callers regs | |
| BR R14 Return with RC | |
| * | |
| LTORG | |
| * DROP R7 INMFIELD | |
| * | |
| * | |
| * | |
| *-- Text unit skeletons | |
| * | |
| *-- Note: EXPDT is included for completeness but is not used. | |
| * | |
| * | |
| * | |
| TXT01D DC Y(DALRTDDN),AL2(1),AL2(8) RETURN DDNAME | |
| TXT02D DC Y(DALDSNAM),AL2(1),AL2(44) DSNAME | |
| TXT03D DC Y(DALSTATS),AL2(1),AL2(1),X'04' DISP=(NEW,) | |
| TXT04D DC Y(DALNDISP),AL2(1),AL2(1),X'02' DISP=(,CATLG) | |
| TXT05D DC Y(DALBLKLN),AL2(1),AL2(3) BLK TEXT KEY, BLKLEN | |
| TXT06D DC Y(DALPRIME),AL2(1),AL2(3) PRIMARY SPACE UNITS | |
| TXT07D DC Y(DALSECND),AL2(1),AL2(3) SECONDARY SPACE UNITS | |
| TXT08D DC Y(DALDIR),AL2(1),AL2(3) DIRECTORY BLOCKS | |
| TXT09D DC Y(DALVLSER),AL2(1),AL2(6) VOLSER | |
| TXT10D DC Y(DALUNIT),AL2(1),AL2(8),CL8'SYSDA' UNIT default v200 | |
| TXT11D DC Y(DALEXPDT),AL2(1),AL2(5) EXPDT C'YYDDD' | |
| TXT12D DC Y(DALBLKSZ),AL2(1),AL2(2) BLKSIZE | |
| TXT13D DC Y(DALDSORG),AL2(1),AL2(2) DSORG | |
| TXT14D DC Y(DALLRECL),AL2(1),AL2(2) LRECL | |
| TXT15D DC Y(DALRECFM),AL2(1),AL2(1) RECFM | |
| TXT16D DC Y(DALDUMMY),AL2(0) DUMMY | |
| TXT17D DC Y(DALSYSOU),AL2(0) SYSOUT | |
| TXT18D DC Y(DALTERM),AL2(0) TERM | |
| TXT19D DC Y(DALCYL),AL2(0) CYLINDER | |
| TXT20D DC Y(DALCLOSE),AL2(0) FREE=CLOSE | |
| TXT21D DC Y(DALMEMBR),AL2(1),AL2(8) MEMBER | |
| * | |
| UTXTD DC Y(DUNDDNAM),AL2(1),AL2(8) DD for deallocation | |
| * | |
| DS 0F | |
| CPS99RB DS 0XL20 DEFINE INITIAL S99RB | |
| DC AL1(20) LENGTH OF REQ BLOCK | |
| DC AL1(1) VERB CODE: ALLOCATION | |
| DC X'20' FLAGS: NO MOUNTS,OFFLINE VOLS | |
| DC X'00' FLAGS | |
| DC AL2(0) ERROR REASON CODE | |
| DC AL2(0) INFO REASON CODE | |
| DC A(0) ADDR OF TEXT PTRS | |
| DC A(0) ADDR OF RBX | |
| DC AL4(0) MORE FLAGS | |
| * NJE00250 | |
| * | |
| * | |
| ********************* | |
| * N J E N E T * NJENET converts the incoming | |
| * * files into NETDATA format and | |
| * Output NETDATA * writes 80-byte records to the spool | |
| * * or OUTDATASET destination. | |
| ********************* | |
| * | |
| NJENET CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJENET' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs | |
| LR R12,R15 Base | |
| USING NJENET,R12 | |
| USING NJEWK,R10 | |
| ST R13,NETSA+4 SAVE prv S.A. ADDR | |
| LA R1,NETSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| * | |
| **************** | |
| * BUILD INMR01 * | |
| **************** | |
| * | |
| USING INMFIELD,R7 | |
| LA R7,INMF01 -> INMR01 fields | |
| LA R3,BUFF -> build buffer | |
| MVI 0(R3),0 Init control record length | |
| MVI 1(R3),X'E0' Indicate 1 segment, ctl record | |
| MVC 2(6,R3),INMR01 Create INMR01 | |
| LA R3,8(,R3) -> next available byte | |
| * | |
| BAL R14,B1LRECL Build the LRECL | |
| BAL R14,B1FNODE Build the FNODE | |
| BAL R14,B1FUID Build the FUID | |
| BAL R14,B1TNODE Build the TNODE | |
| BAL R14,B1TUID Build the TUID | |
| BAL R14,B1FTIME Build the time stamp | |
| BAL R14,B1NUMF Build the number of files | |
| * | |
| LA R1,BUFF -> start of build buffer | |
| SR R3,R1 Compute INMR01 total length | |
| STC R3,0(,R1) Plug into length byte | |
| * | |
| LR R0,R3 Length to R0 | |
| BAL R14,PUTBYTES Write the entire segment | |
| * | |
| **************** | |
| * BUILD INMR02 * | |
| **************** | |
| * | |
| LA R7,INMF02A -> 1st INMR02 fields | |
| LA R3,BUFF -> build buffer | |
| MVI 0(R3),0 Init control record length | |
| MVI 1(R3),X'E0' Indicate 1 segment, ctl record | |
| MVC 2(6,R3),INMR02 Create INMR02 | |
| MVC 8(4,R3),=F'1' Set file number to 1 | |
| LA R3,12(,R3) -> next available byte | |
| * | |
| BAL R14,B2UTIL Build the Utility name | |
| BAL R14,B2FSIZE Build the file size | |
| BAL R14,B2DIRBLK Build the dir blocks | |
| BAL R14,B2LRECL Build the LRECL | |
| BAL R14,B2DSORG Build the DSORG | |
| BAL R14,B2BLKSI Build the BLKSIZE | |
| BAL R14,B2RECFM Build the RECFM | |
| BAL R14,B2DSN Build the DSNAME | |
| * | |
| LA R1,BUFF -> start of build buffer | |
| SR R3,R1 Compute INMR02 total length | |
| STC R3,0(,R1) Plug into length byte | |
| * | |
| LR R0,R3 Length to R0 | |
| BAL R14,PUTBYTES Write the entire segment | |
| * | |
| **************** | |
| * BUILD INMR02 * Second INMR02 is build if input DS was a PDS | |
| **************** | |
| * | |
| TM FLAGS1,F1INPDS Was input DS a PDS? | |
| BZ INM3 No, dont need 2nd INMR02 | |
| LA R7,INMF02B -> 2nd INMR02 fields | |
| LA R3,BUFF -> build buffer | |
| MVI 0(R3),0 Init control record length | |
| MVI 1(R3),X'E0' Indicate 1 segment, ctl record | |
| MVC 2(6,R3),INMR02 Create INMR02 | |
| MVC 8(4,R3),=F'1' Set file number to 1 | |
| LA R3,12(,R3) -> next available byte | |
| * | |
| BAL R14,B2UTIL Build the Utility name | |
| BAL R14,B2FSIZE Build the file size | |
| BAL R14,B2LRECL Build the LRECL | |
| BAL R14,B2DSORG Build the DSORG | |
| BAL R14,B2BLKSI Build the BLKSIZE | |
| BAL R14,B2RECFM Build the RECFM | |
| * | |
| LA R1,BUFF -> start of build buffer | |
| SR R3,R1 Compute INMR02 total length | |
| STC R3,0(,R1) Plug into length byte | |
| * | |
| LR R0,R3 Length to R0 | |
| BAL R14,PUTBYTES Write the entire segment | |
| * | |
| **************** | |
| * BUILD INMR03 * | |
| **************** | |
| * | |
| INM3 EQU * | |
| LA R7,INMF02A -> 1st INMR02 fields | |
| L R0,FILESIZE Get size from prev INMR02 buffer | |
| LA R7,INMF03 -> INMR03 fields | |
| ST R0,FILESIZE Plug it into INMR03 buffer | |
| LA R3,BUFF -> build buffer | |
| MVI 0(R3),0 Init control record length | |
| MVI 1(R3),X'E0' Indicate 1 segment, ctl record | |
| MVC 2(6,R3),INMR03 Create INMR02 | |
| LA R3,8(,R3) -> next available byte | |
| * | |
| BAL R14,B3FSIZE Build the file size | |
| BAL R14,B3LRECL Build the LRECL | |
| BAL R14,B3DSORG Build the DSORG | |
| BAL R14,B3RECFM Build the RECFM | |
| * | |
| LA R1,BUFF -> start of build buffer | |
| SR R3,R1 Compute INMR03 total length | |
| STC R3,0(,R1) Plug into length byte | |
| * | |
| LR R0,R3 Length to R0 | |
| BAL R14,PUTBYTES Write the entire segment | |
| DROP R7 INMFIELD | |
| * | |
| **************** | |
| * PERFORM * | |
| * "INMCOPY" * | |
| * FUNCTION * | |
| **************** | |
| * | |
| CPY000 EQU * | |
| LA R4,INDS -> INDS DCB | |
| USING IHADCB,R4 | |
| LA R9,253 Segment size (less len,ctl bytes | |
| * | |
| CPY020 EQU * | |
| GET INDS Get input record | |
| LR R2,R1 -> record to R2 | |
| LH R3,DCBLRECL Get record length | |
| MVI CTL,X'80' Assume starting new segment | |
| * | |
| TM DCBRECFM,DCBRECF RECFM=F (or U) records? | |
| BO CPY060 Handle them same way | |
| LH R3,0(,R2) Get length from RDW | |
| S R3,=F'4' Remove length of RDW | |
| LA R2,4(,R1) Skip over RDW | |
| * | |
| CPY060 EQU * | |
| LR R5,R3 Working length to R5 | |
| CR R3,R9 LRECL <= max segment size? | |
| BNH CPY070 Yes | |
| LR R5,R9 Else limit to max segment | |
| * | |
| CPY070 EQU * | |
| SR R3,R5 Compute remaining length | |
| BCTR R5,0 Adjust working len for execute | |
| EX R5,MVCREC Move record to build buffer | |
| LA R2,1(R5,R2) -> next avail byte in record | |
| LA R0,3(,R5) Account for ex, len & ctl bytes | |
| STC R0,BUFF Set the segment length | |
| LTR R3,R3 Is length remaining? | |
| BNZ CPY080 Yes | |
| OI CTL,X'40' Indicate this is last segment | |
| * | |
| CPY080 EQU * | |
| MVC BUFF+1(1),CTL Set segment control | |
| BAL R14,PUTBYTES Write the netdata | |
| TM CTL,X'40' Did we process the final seg? | |
| BO CPY020 Yes, time for a new record | |
| MVI CTL,X'00' Clear segment ctl | |
| B CPY060 Go get another | |
| * | |
| MVCREC MVC BUFF+2(0),0(R2) executed instr | |
| * | |
| EOD000 EQU * | |
| LA R3,BUFF -> build buffer | |
| MVI 0(R3),8 Init control record length | |
| MVI 1(R3),X'E0' Indicate 1 segment, ctl record | |
| MVC 2(6,R3),INMR06 Create INMR06 | |
| * | |
| LA R0,8 Write the INMR06 record | |
| BAL R14,PUTBYTES | |
| * | |
| XC BUFF,BUFF | |
| L R1,PBREM Get # bytes remaining in REC | |
| LA R0,1(,R1) +1 more to force record write | |
| BAL R14,PUTBYTES Write a last full record | |
| DROP R4 IHADCB | |
| B XITNET00 NETDATA build complete | |
| * | |
| * | |
| * | |
| *-- NETDATA text unit key build routines | |
| * | |
| * | |
| USING INMFIELD,R7 | |
| B1LRECL EQU * | |
| MVC 0(2,R3),INMLRECL Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| MVC 6(4,R3),=A(80) LRECL always 80 for INMR01 | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1FNODE EQU * | |
| MVC 0(2,R3),INMFNODE Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 6(8,R3),LCLNODE Use local node name | |
| LA R1,6+8(,R3) If TRT fails | |
| TRT 6(8,R3),BLANK Look for end of name | |
| LA R2,6(,R3) -> start of name | |
| SR R1,R2 Compute length of name | |
| STCM R1,3,4(R3) Set length of name | |
| LA R3,6(R1,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1FUID EQU * | |
| MVC 0(2,R3),INMFUID Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 6(8,R3),USERID Use userid | |
| LA R1,6+8(,R3) If TRT fails | |
| TRT 6(8,R3),BLANK Look for end of name | |
| LA R2,6(,R3) -> start of name | |
| SR R1,R2 Compute length of name | |
| STCM R1,3,4(R3) Set length of name | |
| LA R3,6(R1,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1TNODE EQU * | |
| MVC 0(2,R3),INMTNODE Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 6(8,R3),DESTNODE Use destination node name | |
| LA R1,6+8(,R3) If TRT fails | |
| TRT 6(8,R3),BLANK Look for end of name | |
| LA R2,6(,R3) -> start of name | |
| SR R1,R2 Compute length of name | |
| STCM R1,3,4(R3) Set length of name | |
| LA R3,6(R1,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1TUID EQU * | |
| MVC 0(2,R3),INMTUID Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 6(8,R3),DESTUSER Use destination userid | |
| LA R1,6+8(,R3) If TRT fails | |
| TRT 6(8,R3),BLANK Look for end of name | |
| LA R2,6(,R3) -> start of name | |
| SR R1,R2 Compute length of name | |
| STCM R1,3,4(R3) Set length of name | |
| LA R3,6(R1,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1FTIME EQU * | |
| MVC 0(2,R3),INMFTIME Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(16) Set length | |
| TIME DEC Get the date and time | |
| * R1 = 0yyydddF | |
| * R0 = hhmmssth | |
| LR R2,R1 Copy the date info | |
| SRL R2,12 Put year here: 0000yyyx | |
| ST R2,DBLE Plug into work area | |
| OI DBLE+3,X'0F' Insert sign | |
| AP DBLE(4),=P'1900' Add base century | |
| UNPK 6(4,R3),DBLE(4) Unpk the year | |
| OI 9(R3),X'F0' Fix sign | |
| DP DBLE(4),=P'4' Check for leap year | |
| LA R15,LEAP Assume leap year | |
| CP DBLE+3(1),=P'0' Did it divide evenly? | |
| BE B1FTME10 Yes, it is a leap year | |
| LA R15,NONLEAP Use non leap year table | |
| * | |
| B1FTME10 EQU * | |
| N R1,=X'0000FFFF' Keep only the day and sign | |
| ST R1,DBLE Save into work area | |
| LA R2,1 Init month counter | |
| * | |
| B1FTME20 EQU * | |
| CP DBLE(4),0(2,R15) Check against days table | |
| BNH B1FTME30 Found the right month | |
| LA R15,2(,R15) -> next days entry | |
| LA R2,1(,R2) Next month number | |
| B B1FTME20 Continue | |
| * | |
| B1FTME30 EQU * | |
| C R2,=F'1' Was it found in month 1? | |
| BE B1FTME40 Yes, use day as is | |
| BCTR R15,0 Back up | |
| BCTR R15,0 to prior month's entry | |
| SP DBLE(4),0(2,R15) Compute the day number | |
| * | |
| B1FTME40 EQU * | |
| UNPK 12(2,R3),DBLE(4) unpk day number | |
| OI 13(R3),X'F0' Fix sign | |
| CVD R2,DBLE Convert month number | |
| UNPK 10(2,R3),DBLE unpk month number | |
| OI 11(R3),X'F0' Fix sign | |
| * | |
| ST R0,DBLE Save the time value | |
| UNPK TWRK(9),DBLE(5) Add zones | |
| MVC 14(8,R3),TWRK Mov the time HHMMSSTH | |
| * | |
| LA R3,22(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B1NUMF EQU * | |
| MVC 0(2,R3),INMNUMF Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(1) Set length | |
| MVI 6(R3),1 Only 1 file supported | |
| LA R3,7(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2UTIL EQU * | |
| MVC 0(2,R3),INMUTILN Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 6(8,R3),UTLNAME Use utility name | |
| LA R1,6+8(,R3) If TRT fails | |
| TRT 6(8,R3),BLANK Look for end of name | |
| LA R2,6(,R3) -> start of name | |
| SR R1,R2 Compute length of name | |
| STCM R1,3,4(R3) Set length of name | |
| LA R3,6(R1,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2FSIZE EQU * | |
| MVC 0(2,R3),INMSIZE Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| MVC 6(4,R3),FILESIZE File size in bytes | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2DIRBLK EQU * | |
| ICM R0,15,DIRBLKS Get # of dir blocks needed | |
| BZR R14 This key is not needed | |
| MVC 0(2,R3),INMDIR Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(3) Set length | |
| STCM R0,7,6(R3) Set directory blocks | |
| LA R3,9(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2LRECL EQU * | |
| MVC 0(2,R3),INMLRECL Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| MVC 6(4,R3),LRECL Set LRECL | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2DSORG EQU * | |
| MVC 0(2,R3),INMDSORG Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(2) Set length | |
| MVC 6(2,R3),DSORG Set DSORG | |
| LA R3,8(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2BLKSI EQU * | |
| ICM R0,15,BLKSIZE Get block size | |
| BZR R14 This key is not needed | |
| MVC 0(2,R3),INMBLKSZ Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| STCM R0,15,6(R3) Set blocksize | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2RECFM EQU * | |
| TM RECFM,X'40' Variable (or U) records? | |
| BZ *+8 No | |
| MVI RECFM+1,X'02' Y, indicate varying w/o RDW fmt | |
| * | |
| MVC 0(2,R3),INMRECFM Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(2) Set length | |
| MVC 6(2,R3),RECFM Set RECFM | |
| LA R3,8(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B2DSN EQU * | |
| CLI DSNAME,X'00' DSNAME field filled? | |
| BER R14 Exit if no DSNAME avail | |
| MVC 0(2,R3),INMDSNAM Set key | |
| LA R1,DSNAME+44 In case TRT fails | |
| TRT DSNAME,BLANK Find end of DSNAME | |
| LA R2,DSNAME -> start | |
| SR R1,R2 Compute DSN length | |
| LR R0,R1 Keep length in R0 | |
| LA R1,1 Set # qualifiers to start | |
| LA R4,4(,R3) -> where 1st length fld goes | |
| * | |
| B2DSN010 EQU * | |
| LA R5,2(,R4) -> DSN qualifier goes | |
| SR R6,R6 Init qualifier length | |
| * | |
| B2DSN020 EQU * | |
| CLI 0(R2),C'.' Look for qualification delim | |
| BNE B2DSN040 No, just a regular character | |
| STCM R6,3,0(R4) Fill in length field | |
| LA R4,2(R6,R4) -> next length field area | |
| LA R1,1(,R1) Bump qualifier count | |
| LA R2,1(,R2) -> next DSN character (skip '.') | |
| BCT R0,B2DSN010 Keep building | |
| ABEND106 ABEND 106,DUMP Shouldn't happen | |
| * | |
| B2DSN040 EQU * | |
| MVC 0(1,R5),0(R2) Move a DSN char | |
| LA R5,1(,R5) Next available byte in BUFF | |
| LA R6,1(,R6) Count qualifier length | |
| LA R2,1(,R2) -> next DSN character | |
| BCT R0,B2DSN020 Keep building | |
| * | |
| STCM R1,3,2(R3) Set the # field (# qualifiers) | |
| STCM R6,3,0(R4) Fill in length field | |
| LA R3,2(R6,R4) -> next length field area | |
| BR R14 Return | |
| * | |
| B3FSIZE EQU * | |
| MVC 0(2,R3),INMSIZE Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| MVC 6(4,R3),FILESIZE File size in bytes | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B3DSORG EQU * | |
| MVC 0(2,R3),INMDSORG Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(2) Set length | |
| MVC 6(2,R3),=X'4000' Set DSORG to PS in INMR03 | |
| LA R3,8(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B3LRECL EQU * | |
| MVC 0(2,R3),INMLRECL Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(4) Set length | |
| MVC 6(4,R3),=A(80) LRECL always 80 for INMR03 | |
| LA R3,10(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| B3RECFM EQU * | |
| MVC 0(2,R3),INMRECFM Set key | |
| MVC 2(2,R3),=Y(1) Set # | |
| MVC 4(2,R3),=Y(2) Set length | |
| MVC 6(2,R3),=X'0001' Shortened transmission var fmt | |
| LA R3,8(,R3) -> next available byte | |
| BR R14 Return | |
| * | |
| * | |
| *-- Request some more bytes of NETDATA formatted data | |
| * | |
| *-- Entry: R0 = # of bytes to write (1-255) | |
| *-- BUFF contains the data | |
| * | |
| *-- Exit: None | |
| * | |
| *-- Uses R0-R1,R5-R8,R14-R15; the caller's values in these | |
| *-- registers are not preserved across this call. | |
| * | |
| PUTBYTES EQU * | |
| ST R14,SV14PB Save return addr | |
| L R5,PBREM Get # bytes remaining in rec buf | |
| LA R1,BUFF Point to putbytes (PB) buffer | |
| ST R1,PBPOS Set starting position | |
| * | |
| LR R8,R0 Requested amount to R8 | |
| * | |
| * | |
| PB010 EQU * | |
| LTR R5,R5 Any bytes left in phys record? | |
| BP PB040 Yes, use them first | |
| * | |
| BAL R14,PUT000 Write the record | |
| LTR R15,R15 Any errors? | |
| BNZ XITNET08 Exit if yes | |
| * | |
| LA R5,80 Reset record to 80 remaining | |
| LA R1,REC -> physical record | |
| ST R1,PBRPS Reset start of record position | |
| * | |
| PB040 EQU * | |
| LR R7,R8 Assume requested amt avail | |
| LR R15,R8 Same | |
| * | |
| CR R5,R8 Have more than we need? | |
| BH PB050 Yes, just move requested | |
| LR R7,R5 Else move only what we have avai | |
| LR R15,R5 Same | |
| * | |
| PB050 EQU * | |
| LR R0,R7 Save copy of length to move | |
| L R14,PBPOS -> PB buffer position | |
| L R6,PBRPS -> output record curr position | |
| MVCL R6,R14 Move | |
| * | |
| ST R14,PBPOS New PB position | |
| ST R6,PBRPS New phys record curr position | |
| * | |
| SR R5,R0 Reduce bytes left in phy record | |
| SR R8,R0 Reduce requested amt | |
| BP PB010 We need more, go get it | |
| * | |
| ST R5,PBREM Remember whats left in phy rec | |
| * | |
| L R14,SV14PB Load return addr | |
| BR R14 Return from getbytes | |
| * | |
| * | |
| * | |
| *-- Exits from NJENET | |
| * | |
| XITNET00 EQU * | |
| SR R15,R15 | |
| B XITNET | |
| * | |
| XITNET08 EQU * | |
| LA R15,8 I/O writing records | |
| B XITNET | |
| * | |
| XITNET EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| ST R15,16(,R13) Set RC | |
| LM R14,R12,12(R13) Reload callers regs | |
| BR R14 Return with RC | |
| * | |
| * | |
| LTORG | |
| * | |
| NONLEAP DC PL2'31,59,90,120,151,181,212,243,273,304,334,365' | |
| LEAP DC PL2'31,60,91,121,152,182,213,244,274,305,335,366' | |
| * | |
| *-- Find INMR01 record | |
| * NET02190 | |
| * NET02190 | |
| *- Control records that we look for and process (others ignored). NET02190 | |
| INMR01 DC C'INMR01' Header Control record NET02200 | |
| INMR02 DC C'INMR02' File Utility Control record NET02210 | |
| INMR03 DC C'INMR03' Data Control record NET02210 | |
| INMR06 DC C'INMR06' Trailer Control record NET02210 | |
| * NET02220 | |
| *- Keys we are supporting NET02230 | |
| INMKEYS DS 0H | |
| INMBLKSZ DC X'0030' Block size | |
| INMDIR DC X'000C' Number of directory blocks | |
| INMDSNAM DC X'0002' Name of the file | |
| INMDSORG DC X'003C' File organization | |
| INMFNODE DC X'1011' Origin node name or node number | |
| INMFTIME DC X'1024' Origin timestamp | |
| INMFUID DC X'1012' Origin user ID | |
| INMLRECL DC X'0042' Logical record length | |
| INMRECFM DC X'0049' Record format | |
| INMSIZE DC X'102C' File size in bytes | |
| INMTNODE DC X'1001' Target node name or node number | |
| INMTUID DC X'1002' Target user ID | |
| INMUTILN DC X'1028' Name of utility program | |
| INMNUMF DC X'102F' Number of files transmitted = 1 | |
| DC X'FFFF' End of table | |
| * NET02220 | |
| *- Keys we are NOT supporting; for reference NET02230 | |
| INMCREAT EQU X'1022' Creation date | |
| INMDDNAM EQU X'0001' DDNAME for the file | |
| INMEATTR EQU X'8028' Extended attribute status | |
| INMERRCD EQU X'1027' RECEIVE command error code | |
| INMEXPDT EQU X'0022' Expiration date | |
| INMFACK EQU X'1026' Originator requested notificat'n | |
| INMFFM EQU X'102D' Filemode number | |
| INMFVERS EQU X'1023' Origin version num of the data | |
| INMLCHG EQU X'1021' Date last changed | |
| INMLREF EQU X'1020' Date last referenced | |
| INMLSIZE EQU X'8018' Data set size in megabytes. | |
| INMMEMBR EQU X'0003' Member name list | |
| INMRECCT EQU X'102A' Transmitted record count | |
| INMSECND EQU X'000B' Secondary space quantity | |
| INMTERM EQU X'0028' Data transmitted as a message | |
| INMTYPE EQU X'8012' Data set type | |
| INMTTIME EQU X'1025' Destination timestamp | |
| INMUSERP EQU X'1029' User parameter string | |
| * | |
| *-- Target fields from INMRxx control records that we issue: | |
| * | |
| * | |
| * INMR0x R=required to be sent | |
| * 1 2 3 6 X=may optionally be sent | |
| INMFIELD DSECT - - - - | |
| UTLNAME DS CL8 R Utility name NET02490 | |
| FNODE DS CL8 R Origin node NET02580 | |
| FUSER DS CL8 R Origin userid NET02580 | |
| TNODE DS CL8 R Dest node NET02580 | |
| TUSER DS CL8 R Dest userid NET02580 | |
| FILESIZE DS XL4 R R File size in bytes NET02500 | |
| DIRBLKS DS XL4 X #directory blocks NET02500 | |
| BLKSIZE DS XL4 X BLKSIZE NET02510 | |
| LRECL DS XL4 R R R LRECL NET02520 | |
| DSORG DS XL2 R R DSORG NET02540 | |
| RECFM DS XL2 R R RECFM NET02530 | |
| DSNAME DS CL44 X DSNAME NET02580 | |
| FTIME DS CL20 R Origin time stamp NET02580 | |
| DS 0F Force to halfword size | |
| INMFSZ EQU *-INMFIELD Size of DSECT | |
| * | |
| * NJE00250 | |
| ********************* | |
| * N J E P A R * NJEPAR calls IKJPARS to parse | |
| * * the TSO command line parameters. | |
| * TSO Command Line * | |
| * Parse * | |
| * * | |
| ********************* | |
| * | |
| * Entry: None. | |
| * | |
| * | |
| * Exit: R15 = IKJPARS RC | |
| * | |
| NJEPAR CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEPAR' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJEPAR,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,PARSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R2,PARSA -> my save area | |
| ST R2,8(,R13) Plug it into prior SA | |
| LR R13,R2 | |
| * | |
| * | |
| LR R7,R0 Copy entry action code | |
| LR R6,R1 Copy any passed ptr | |
| * | |
| *-- Identify and parse out the nodeid.userid if present | |
| * | |
| NOD000 EQU * | |
| L R1,CPARMS -> CPPL entry parms | |
| L R2,0(,R1) -> Command buffer | |
| LH R3,0(,R2) Get length of command buffer | |
| C R3,=F'257' Is buffer length within 256? | |
| BL NOD010 Yes | |
| LA R3,256 Set to max of 256 | |
| * | |
| NOD010 EQU * | |
| LR R4,R3 Copy final length | |
| ICM R3,8,BLANKS Set pad character | |
| LA R0,BUFF -> internal 256 byte work buffer | |
| LA R1,256 Max length | |
| MVCL R0,R2 Move CBUF to our stg area | |
| * | |
| STH R4,BUFF Set adjusted buffer length | |
| MVC REC,BLANKS Use as temporary TRT over- | |
| MVC LIST,BLANKS flow areas | |
| * | |
| NOD020 EQU * | |
| SR R1,R1 Clear | |
| LA R3,BUFF+4 -> copy of cmd buffer (past RDW) | |
| AH R3,BUFF+2 -> first parameter | |
| SH R4,BUFF+2 Reduce remaining length | |
| S R4,=F'4' Back out length of buffer RDW | |
| BZ XITPAR04 No parameters were entered | |
| * | |
| EX R4,TRTBLK Look for end of first param | |
| BZ PARS000 Something wrong, give to parse | |
| LR R5,R1 Save end of param addr | |
| SR R1,R3 Compute length we traversed | |
| LR R6,R1 Save copy of length to R6 | |
| C R1,=F'3' Length < 3? | |
| BL PARS000 Can't be node.user | |
| C R1,=F'17' Length > 17? | |
| BH PARS000 Can't be node.user | |
| * | |
| BCTR R1,0 Adjust for execute | |
| EX R1,TRTNAN Look for any non-alphanumeric | |
| BNZ PARS000 Found something, not node.user | |
| * | |
| EX R6,TRTDLM Look for '.' delimiter | |
| BZ PARS000 Didn't find it, not node.user | |
| LA R4,1(,R1) Save addr of userid start | |
| SR R1,R3 Compute length from start to dot | |
| BZ PARS000 Not valid node name | |
| C R1,=F'8' More than 8 char in node name? | |
| BH XITPAR08 Not valid node name | |
| MVC DESTNODE,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,OCNODE Save off node name and uppercase | |
| LA R1,1(,R1) Restore length | |
| SR R6,R1 Reduce length by node name size | |
| BCTR R6,0 Reduce length of '.' | |
| LTR R6,R6 is len=0? (. in last character) | |
| BZ XITPAR08 Not valid node.user combo | |
| C R6,=F'8' Userid > 8? | |
| BH XITPAR08 Not valid user name | |
| MVC DESTUSER,BLANKS Init receiving field | |
| BCTR R6,0 Adjust for execute | |
| EX R6,OCUSER Save off user name and uppercase | |
| * | |
| SR R5,R3 Compute area size of node.user | |
| BCTR R5,0 Adjust for execute | |
| EX R5,MVCREM Remove node.user from cmd buffer | |
| OI FLAGS3,F3DEST Valid node.user specified | |
| B PARS000 Turn the rest over to parser | |
| * | |
| MVCREM MVC 0(0,R3),BLANKS executed instr | |
| OCNODE OC DESTNODE(0),0(R3) executed instr | |
| OCUSER OC DESTUSER(0),0(R4) executed instr | |
| TRTBLK TRT 0(0,R3),BLANK executed instr | |
| TRTDLM TRT 0(0,R3),DOTS executed instr | |
| TRTNAN TRT 0(0,R3),NONALNUM executed instr | |
| * | |
| * | |
| PARS000 EQU * | |
| L R1,CPARMS -> CPPL entry parms | |
| LM R2,R5,0(R1) Get TSO command entry parameters | |
| * R2 -> Command buffer | |
| * R3 -> UPT | |
| * R4 -> PSCB | |
| * R5 -> ECT | |
| * | |
| LA R8,PPLSTG -> PPL | |
| USING PPL,R8 | |
| ST R3,PPLUPT Set UPT addr | |
| ST R5,PPLECT Set ECT addr | |
| LA R3,PARSECB -> parse ECB | |
| ST R3,PPLECB Set it | |
| LA R3,ANSWER -> IKJPARS "answer area" | |
| ST R3,PPLANS Set it | |
| ST R10,PPLUWA Set user work area addr | |
| * | |
| * ** Process command line | |
| LA R2,BUFF -> local copy of TSO cmd buff | |
| ST R2,PPLCBUF Set TSO command buffer addr | |
| L R3,=A(PCLDEFS) -> command parms definitions | |
| ST R3,PPLPCL Set it | |
| B PARS020 | |
| * | |
| PARS020 EQU * | |
| CALLTSSR EP=IKJPARS,MF=(E,PPLSTG) Parse command line | |
| LTR R0,R15 Any parse errors? | |
| BNZ XITPAR12 Yes | |
| DROP R8 PPL | |
| * | |
| *- Examine command line results | |
| L R4,ANSWER -> IKJPARS built PCEs | |
| USING PRDSECT,R4 | |
| * | |
| PARS030 EQU * | |
| LA R2,QTPCE -> QUIET PCE | |
| CLC 0(2,R2),=AL2(1) Was QUIET specified? | |
| BNE PARS035 No | |
| OI FLAGS3,F3QUIET Indicate QUIET | |
| * | |
| PARS035 EQU * | |
| LA R2,PDSPCE -> PDS/SEQL PCE | |
| CLC 0(2,R2),=AL2(2) Was PDS specified? | |
| BNE PARS040 No | |
| OI FLAGS3,F3PDS Indic PDS copy and not SEQL copy | |
| * | |
| PARS040 EQU * | |
| LA R2,VOLPCE -> VOLSER PCE | |
| TM 6(R2),X'80' Was VOLSER specified? | |
| BZ PARS050 No | |
| L R3,0(,R2) -> VOLSER string | |
| LH R1,4(,R2) Length of volser | |
| MVC OUTVOL,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVVOL Move the volser | |
| OI FLAGS3,F3VOLSER Indicate volser valid | |
| * | |
| PARS050 EQU * | |
| LA R2,OTDAPCE -> OUTDATASET PCE | |
| TM 6(R2),X'80' Was OUTDATASET specified? | |
| BZ PARS080 No | |
| MVC OUTPUTDS,BLANKS Init receiving field | |
| LA R5,OUTPUTDS -> where to place DSN | |
| * | |
| TM 6(R2),X'40' Was dataset name in quotes? | |
| BO PARS060 Y, don't insert prefix | |
| CLC PREFIX,BLANKS Is a prefix available? | |
| BE PARS060 All blank, dont use prefix | |
| * | |
| MVC OUTPUTDS(8),PREFIX Add the prefix | |
| TRT OUTPUTDS,BLANK Look for end of prefix | |
| MVI 0(R1),C'.' Set delim after prefix | |
| LA R5,1(,R1) -> place to put rest of dsn | |
| LA R2,OTDAPCE -> OUTDATASET PCE | |
| * | |
| PARS060 EQU * | |
| L R3,0(,R2) -> OUTDATASET string | |
| LH R1,4(,R2) Length of DSN | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVDS Move the DSN | |
| OI FLAGS3,F3OUTDS Indicate OUTDATASET valid | |
| * | |
| PARS070 EQU * | |
| TM 14(R2),X'80' Was OUTDATASET member specified? | |
| BZ PARS080 No | |
| L R3,8(,R2) -> OUTDATASET member name | |
| LH R1,12(,R2) Length of member name | |
| MVC OUTMEM,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVOUTMEM Move the member name | |
| OI FLAGS3,F3OUTMEM Indicate OUTDATASET member valid | |
| * | |
| PARS080 EQU * | |
| LA R2,FDAPCE -> DATASET PCE | |
| TM 6(R2),X'80' Was DATASET specified? | |
| BZ PARS130 No v200 | |
| MVC INPUTDS,BLANKS Init receiving field | |
| LA R5,INPUTDS -> where to place DSN | |
| * | |
| TM 6(R2),X'40' Was dataset name in quotes? | |
| BO PARS090 Y, don't insert prefix | |
| CLC PREFIX,BLANKS Is a prefix available? | |
| BE PARS090 All blank, dont use prefix | |
| * | |
| MVC INPUTDS(8),PREFIX Add the prefix | |
| TRT INPUTDS,BLANK Look for end of prefix | |
| MVI 0(R1),C'.' Set delim after prefix | |
| LA R5,1(,R1) -> place to put rest of dsn | |
| LA R2,FDAPCE -> DATASET PCE | |
| * | |
| PARS090 EQU * | |
| L R3,0(,R2) -> DATASET string | |
| LH R1,4(,R2) Length of DSN | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVDS Move the DSN | |
| OI FLAGS3,F3INDS Indicate DATASET valid | |
| * | |
| PARS100 EQU * | |
| TM 14(R2),X'80' Was DATASET member specified? | |
| BZ PARS120 No | |
| L R3,8(,R2) -> DATASET member name | |
| LH R1,12(,R2) Length of member name | |
| MVC INMEM,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVINMEM Move the member name | |
| OI FLAGS3,F3INMEM Indicate SEQL MEMBER specified | |
| B PARS130 We're done v200 | |
| * | |
| PARS120 EQU * | |
| NI FLAGS3,255-F3PDS Turn off;we'll do what DSORG say | |
| * | |
| PARS130 EQU * v200 | |
| LA R2,UNIPCE -> UNIT PCE v200 | |
| TM 6(R2),X'80' Was UNIT specified? v200 | |
| BZ PARS190 No v200 | |
| L R3,0(,R2) -> UNIT string v200 | |
| LH R1,4(,R2) Length of unit name v200 | |
| MVC OUTUNIT,BLANKS Init receiving field v200 | |
| BCTR R1,0 Adjust for execute v200 | |
| EX R1,MVUNIT Move the unit v200 | |
| OI FLAGS2,F2UNIT Indicate unit valid v200 | |
| * | |
| PARS190 EQU * | |
| B XITPAR00 All done | |
| DROP R4 PRDSECT | |
| * | |
| MVVOL MVC OUTVOL(0),0(R3) executed instr | |
| MVDS MVC 0(0,R5),0(R3) executed instr | |
| MVINMEM MVC INMEM(0),0(R3) executed instr | |
| MVOUTMEM MVC OUTMEM(0),0(R3) executed instr | |
| MVUNIT MVC OUTUNIT(0),0(R3) executed instr v200 | |
| * | |
| * | |
| *-- Exit | |
| * | |
| XITPAR00 EQU * | |
| LA R1,ANSWER -> IKJPARS "answer place" | |
| IKJRLSA (1) Release parsing storage | |
| * | |
| SR R0,R0 Set secondary RC=0 | |
| SR R15,R15 Set RC=0; | |
| B XITPAR | |
| * | |
| XITPAR04 EQU * | |
| SR R0,R0 Set secondary RC=0 | |
| LA R15,4 Set RC=4; no parameters entered | |
| B XITPAR | |
| * | |
| XITPAR08 EQU * | |
| SR R0,R0 Set secondary RC=0 | |
| LA R15,8 Set RC=8; invalid node.user combo | |
| B XITPAR | |
| * | |
| XITPAR12 EQU * | |
| LA R15,12 Set RC=12; R0 already set by IKJPARS | |
| B XITPAR | |
| * | |
| XITPAR EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| L R14,12(,R13) Load r14 | |
| LM R1,R12,24(R13) Reload callers regs | |
| BR R14 Return with RCs in R0/R15 | |
| * | |
| LTORG | |
| * | |
| *-- IKJPARS Description Macros | |
| * | |
| *-- TRANSMIT command parms: | |
| * | |
| * TRANSMIT node.userid DATASET(ddd) OUTDATASET(ooo) VOLSER(vvvvv) | |
| * PDS | SEQUENTIAL | |
| * QUIET | |
| * | |
| * Where: | |
| * | |
| * node.user is the node and userid destination for the file. | |
| * ddd is the dataset(+member) to be transmitted. | |
| * ooo is the optional output dataset to write the NETDATA encoded | |
| * transmission into in lieu of actually sending it. | |
| * vvv is an optional VOLSER of where to allocate the OUTDATASET. | |
| * | |
| * | |
| PCLDEFS IKJPARM DSECT=PRDSECT | |
| * | |
| * | |
| QTPCE IKJKEYWD | |
| IKJNAME QUIET PCE value = 1 | |
| * | |
| PDSPCE IKJKEYWD DEFAULT='SEQUENTIAL' | |
| IKJNAME SEQUENTIAL PCE value = 1 | |
| IKJNAME PDS PCE value = 2 | |
| * | |
| OTDSPCE IKJKEYWD | |
| IKJNAME 'OUTDATASET',SUBFLD=OTDSFLD,ALIAS='OUTDSNAME' | |
| * | |
| FDSPCE IKJKEYWD | |
| IKJNAME 'DATASET',SUBFLD=FDSFLD,ALIAS='DSNAME' | |
| * | |
| VSRPCE IKJKEYWD | |
| IKJNAME 'VOLSER',SUBFLD=VOLSFLD,ALIAS='VOLUME' | |
| * | |
| USRPCE IKJKEYWD , v200 | |
| IKJNAME 'UNIT',SUBFLD=UNISFLD,ALIAS=('U') v200 | |
| * | |
| OTDSFLD IKJSUBF | |
| OTDAPCE IKJPOSIT DSNAME, x | |
| PROMPT='THE NAME OF THE DATA SET YOU WANT TO CONTAIN THEx | |
| ENCODED FILE' | |
| * | |
| FDSFLD IKJSUBF | |
| FDAPCE IKJPOSIT DSNAME, x | |
| PROMPT='THE NAME OF THE DATA SET YOU WANT TO TRANSMIT' | |
| * | |
| VOLSFLD IKJSUBF | |
| VOLPCE IKJPOSIT DSTHING,VOLSER, x | |
| PROMPT='THE VOLUME SERIAL OF THE VOLUME WHERE YOU WANT Tx | |
| HE OUTDATASET ALLOCATED' | |
| * | |
| UNISFLD IKJSUBF , v200 | |
| UNIPCE IKJIDENT 'UNIT NAME',MAXLNTH=8,FIRST=ALPHANUM, v200x | |
| OTHER=ALPHANUM v200 | |
| * | |
| IKJENDP | |
| * | |
| * | |
| * | |
| IKJPPL | |
| IKJPPLSZ EQU (*-PPL)/4 # words in PPL | |
| * | |
| LTORG | |
| * | |
| * * | |
| *********************************************************************** | |
| ** ** | |
| ** TASK ESTAE EXIT ** | |
| ** ** | |
| ** This csect handles all abends trapped by ESTAE during the normal ** | |
| ** execution of the subtask. This exit does not attempt ** | |
| ** any recovery other than to terminate processing. ** | |
| ** An SVC dump is taken on abends. ** | |
| ** ** | |
| ** On entry: R0=ESTAE provide entry code ** | |
| ** R1=SDWA address ** | |
| ** R2=parameter passed on ESTAE macro ** | |
| ** ** | |
| ** ** | |
| ** On exit: If SDWACLUP is 1, then no retry is allowed and this ** | |
| ** exit will allow percolation back to system routines ** | |
| ** to terminate the task. ** | |
| ** ** | |
| ** If SDWACLUP is 0, then retry is allowed. ** | |
| ** ** | |
| ** Security: N/A. ** | |
| ** ** | |
| ** Register usage: ** | |
| ** ** | |
| ** R1 = SDWA address ** | |
| ** R3 = SDWA address ** | |
| ** R10 = Dynamic storage area base ** | |
| ** R12 = This program base ** | |
| ** ** | |
| ** ** | |
| ** ** | |
| *********************************************************************** | |
| * | |
| NJEDMP CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDMP' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| LR R12,R15 SET UP BASE REG | |
| USING NJEDMP,R12 ESTABLISH ADDRESSABILITY | |
| LR R8,R14 SAVE RETURN ADDRESS TO SYSTEM | |
| * | |
| L R10,0(,R1) GET VALUE PASSED TO US (WORKA) | |
| USING NJEWK,R10 | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| * | |
| LR R3,R1 SAVE R1 ENTRY CONTENTS | |
| USING SDWA,R3 | |
| LR R5,R0 Save R0 entry code | |
| * | |
| LTR R3,R3 Do we have an SDWA? | |
| BZ NOSDWA Exit if no SDWA | |
| LA R13,MVSSAVE Save area | |
| ESTAE 0 | |
| * | |
| MODESET MODE=SUP, Run this ESTAI exit privileged x | |
| KEY=ZERO to access PSW -> storage | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| L R6,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R6) -> TIOT | |
| MVC MACLIST+9(8),0(R5) Plug in job name | |
| MVC MACLIST+4(4),=C'USER' | |
| MVC MACLIST+19(8),=C'TRANSMIT' Plug in command name | |
| * | |
| * | |
| LNK020 EQU * | |
| MVC MACLIST+29(5),=C'ABEND' | |
| L R5,SDWAABCC GET ABEND CODE INFO WORD | |
| N R5,=X'00FFF000' KEEP ONLY THE SYSTEM CODE | |
| BZ USERCDE NONE THERE, MUST BE A USER CODE | |
| SRL R5,12 Put sys code in low order v201 | |
| C R5,=X'00000222' Operator cancel, no dump? v201 | |
| BE SDUMP040 Yes, suppress dump | |
| CLM R5,1,=X'3E' Was it an x3E (DETACH) ? v201 | |
| BE SDUMP040 Yes, suppress dump v201 | |
| C R5,=X'00000013' Open 013 abend? v201 | |
| BNE ACCPT no, do the dump v200 | |
| CLC SDWAGR15,=X'00000018' Was it 013-18? v200 | |
| BE SDUMP060 Yes, suppress dump v200 | |
| * | |
| ACCPT EQU * v200 | |
| MVI MACLIST+35,C'S' INDICATE SYSTEM CODE | |
| UNPK FWORK(5),SDWACMPC(3) GET SYSTEM CMP CODE | |
| TR FWORK(3),HEXTRAN-240 | |
| MVC FWORK+3(5),=CL5' ' CLEAR REST OF ABEND CODE | |
| B NOREAS | |
| * | |
| USERCDE EQU * | |
| MVI MACLIST+35,C'U' INDICATE USER ABEND CODE | |
| L R5,SDWAABCC GET ABEND CODE | |
| N R5,=X'00000FFF' KEEP USER ABEND CODE | |
| CVD R5,FSAVE CONVERT CODE TO DECIMAL | |
| UNPK FWORK(4),FSAVE UNPK THE CODE | |
| OI FWORK+3,X'F0' FIX SIGN | |
| MVC FWORK+4(2),=CL2' ' BLANKS AT END OF ABEND CODE | |
| * | |
| NOREAS EQU * | |
| MVC MACLIST+36(6),FWORK MOVE ABEND-REASON TO LINE | |
| MVC ABCODE,MACLIST+36 Save a copy of formatted abcode | |
| * | |
| WTO ,MF=(E,MACLIST) Write to console | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(3),=C'PSW' | |
| UNPK FSAVE(9),SDWAEC1(5) Add zones to PSW word 1 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+10(8),FSAVE | |
| UNPK FSAVE(9),SDWAEC1+4(5) Add zones to PSW word 2 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+19(8),FSAVE | |
| * | |
| SR R5,R5 CLEAR FOR IC | |
| IC R5,SDWAILC1 GET THE ILC | |
| CVD R5,FWORK MAKE DECIMAL | |
| MVC MACLIST+29(3),=C'ILC' | |
| UNPK MACLIST+33(2),FWORK UNPK | |
| OI MACLIST+34,X'F0' FIX THE SIGN | |
| * | |
| MVC MACLIST+37(4),=C'INTC' | |
| UNPK FWORK(5),SDWAINC1(3) MAKE INTC DISPLAYABLE | |
| TR FWORK(4),HEXTRAN-240 | |
| MVC MACLIST+42(4),FWORK MOVE INTC TO LINE | |
| * | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(13),=C'DATA NEAR PSW' | |
| MVC MACLIST+19(8),=CL8'UNAVAIL' ASSUME WE CANT GET DATA | |
| L R4,SDWAEC1+4 Get PSW IA | |
| LA R4,0(,R4) Clear high bit | |
| C R4,=F'8' 1st 8 bytes of storage? | |
| BH LOC010 No, its higher than that | |
| SR R4,R4 Yes, just use 0 | |
| B LOC020 | |
| * | |
| LOC010 EQU * | |
| S R4,=F'8' BACK UP BEFORE INTERRUPT ADDR | |
| * | |
| LOC020 EQU * | |
| LRA R0,0(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| LRA R0,14(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| * | |
| ST R4,FWORK SAVE FOR CONVERSION | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES TO ADDRESS | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+19(8),FSAVE MOVE DISPLAYABLE | |
| * | |
| MVC FWORK(4),0(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+29(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),4(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+38(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),8(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+47(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),12(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+56(8),FSAVE MOVE TO LINE | |
| * | |
| UNAVAIL EQU * | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| *---- | |
| LA R4,4 4 ROWS OF REGISTERS | |
| LA R5,SDWAGR00 POINT TO ABEND REGS | |
| LA R6,REGLIST POINT TO REGISTER ID LITERALS | |
| * | |
| REG000 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(8),0(R6) MOVE REGISTERS ID | |
| LA R15,MACLIST+13 WHERE 1ST REG GOES ON LINE | |
| LA R14,4 4 REGS PER LINE | |
| * | |
| REG010 EQU * | |
| UNPK FSAVE(9),0(5,R5) UNPK A REGISTER | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC 0(8,R15),FSAVE MOVE TO THE LINE | |
| LA R15,10(,R15) NEXT SPOT ON PRINT LINE | |
| LA R5,4(,R5) NEXT REGISTER | |
| BCT R14,REG010 KEEP DOING REGS | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| LA R6,8(,R6) NEXT REGISTER ID | |
| BCT R4,REG000 GO DISPLAY THE NEXT ROW | |
| * | |
| * | |
| SDUMP000 EQU * | |
| L R5,SDWAABCC Get abend code info word | |
| N R5,=X'00FFF000' Keep only the system code | |
| SRL R5,12 Right justify the code | |
| C R5,=X'00000222' Operator cancel, no dump? | |
| BE SDUMP040 Yes, skip dump | |
| CLM R5,1,=X'37' x37 abend code? | |
| BE SDUMP040 Skip the dump | |
| * | |
| MVI DHDR,C' ' | |
| MVC DHDR+1(29),DHDR | |
| MVI DHDR,29 IBM length of header | |
| L R5,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R5) -> TIOT | |
| MVC DHDR+1(8),0(R5) Use jobname in description | |
| MVC DHDR+11(8),=C'TRANSMIT' Use command name | |
| MVC DHDR+21(7),ABCODE | |
| * | |
| MVC MACLIST(SDUMPL),SDUMP MOVE SDUMP LIST TO WORK | |
| LA R1,MACLIST | |
| SDUMP HDRAD=DHDR, ISSUE SDUMP TO RECORD STATUS x | |
| BUFFER=NO, x | |
| QUIESCE=NO, x | |
| SDATA=(RGN,CSA,LPA,SUM), x | |
| MF=(E,(1)) | |
| * | |
| * | |
| SDUMP040 EQU * | |
| LR R1,R3 SDWA BACK TO R1 | |
| L R15,=A(NJETRN) Main csect addr | |
| ST R15,SDWASRSV+4*R12 Plug it to R12 | |
| L R15,=A(EXIT08) -> TRANSMIT exit point | |
| B SDUMP090 v200 | |
| * | |
| SDUMP060 EQU * ** Here for S013-18 abend only v200 | |
| LR R1,R3 SDWA BACK TO R1 v200 | |
| L R15,=A(NJETRN) Main csect addr v200 | |
| ST R15,SDWASRSV+4*R12 Plug it to R12 v200 | |
| L R15,=A(ERR015) -> TRANSMIT ERRMSG v200 | |
| * | |
| SDUMP090 EQU * | |
| SETRP RC=4, Retry - try to shut down TRANSMITx | |
| DUMP=NO, Suppress any further dumps x | |
| FRESDWA=YES, Free the SDWA x | |
| RETREGS=YES, Restore original regs x | |
| RETADDR=(15) Return to Transmit exit point | |
| * | |
| NOSDWA EQU * ** NO RETRY AVAILABLE (OR DESIRED) | |
| SR R15,R15 REQUEST PERCOLATION | |
| LR R14,R8 RESTORE RETURN ADDRESS | |
| BR R14 RETURN TO SYSTEM | |
| * | |
| LTORG | |
| * | |
| SDUMP SDUMP MF=L | |
| SDUMPL EQU *-SDUMP | |
| * | |
| REGLIST DC CL8'GR 0-3' | |
| DC CL8'GR 4-7' | |
| DC CL8'GR 8-11' | |
| DC CL8'GR 12-15' | |
| * | |
| WTOMSG WTO ' x | |
| ',MF=L | |
| WTOMSGL EQU *-WTOMSG | |
| * | |
| LTORG | |
| * | |
| * | |
| **** Main work area common NJE00290 | |
| **** to all NJExxx CSECTs. NJE00290 | |
| * NJE00290 | |
| NJEWK DSECT | |
| NJEEYE DS CL4'NJET' Eyecatcher | |
| NJEWKLEN DS F Getmain size of this area | |
| * | |
| DBLE DS D Work area NJE00310 | |
| TWRK DS 2D Work area | |
| LCLNODE DS CL8 Local node id | |
| DEFUSER DS CL8 Default 'no security' userid | |
| USERID DS CL8 TSO Userid | |
| PREFIX DS CL8 TSO PREFIX | |
| DESTNODE DS CL8 Destination node | |
| DESTUSER DS CL8 Destination userid | |
| SPLDSN DS CL44 NETSPOOL dataset name | |
| * | |
| * | |
| MACLIST DS CL96 Macro expansion area | |
| STAXLIST DS CL20 STAX parameter list | |
| * NET02360 | |
| CPARMS DS A -> input CPPL (entry parms) | |
| PUTECB DS F ECB for PUTLINE | |
| IOPLAREA DS 4A IOPL for PUTLINE | |
| SV14PUT DS A R14 save area | |
| SV14LN DS A R14 save area NET02370 | |
| SV14PB DS A R14 save area NET02370 | |
| SV14SI DS A R14 save area NET02370 | |
| * | |
| PBREM DS F # bytes remaining in phys rec | |
| PBPOS DS A -> current position in BUFF | |
| PBRPS DS A -> current position in phys rec | |
| OUTRECS DS F Count of output records written | |
| * | |
| BLOCKLEN DS F Length of block buffer | |
| BLOCK DS A -> Block of physical records | |
| * | |
| DEVINFO DS 0XL20 5 WORDS OF DEVTYPE INFO | |
| DEVUCBTY DS F DEV TYPE: VALUE OF UCBTYP FIELD | |
| DEVMAXBK DS F MAXIMUM BLKSIZE ON DEVICE | |
| DEVCYLS DS XL2 NUMBER OF CYLINDERS ON DEVICE | |
| DEVTRKS DS XL2 NUMBER OF HEADS ON DEVICE | |
| DEVNUSED DS 0XL8 2 WORDS NOT USED HERE | |
| * | |
| OLD DS F For PUTGET, # segments | |
| OLDMSGAD DS A -> msg len/text | |
| * | |
| PARSECB DS F IKJPARS ECB | |
| ANSWER DS F IKJPARS Answer area | |
| PPLSTG DS (IKJPPLSZ)A Space for PPL | |
| OUTVOL DS CL6 User specified output volser | |
| OUTPUTDS DS CL44 User specified OUTDATASET DSN | |
| OUTMEM DS CL8 User specified OUTDATASET member | |
| OUTUNIT DS CL8 User specified UNIT name v200 | |
| INPUTDS DS CL44 Input dataset name | |
| INMEM DS CL8 User specified input member | |
| * | |
| * | |
| FLAGS1 DS X Flag bits | |
| F1INPDS EQU X'80' 1... .... Input dataset is a PDS, 0=SEQL | |
| F1ATTN EQU X'40' .1.. .... User pressed ATTN key v201 | |
| F1BATCH EQU X'08' .... 1... Running in BATCH TSO | |
| F1ACEE EQU X'04' .... .1.. Security is available on system | |
| F1AUSR EQU X'02' .... ..1. Special user | |
| F1APF EQU X'01' .... ...1 Authorized at invocation | |
| * ..xx .... available bits | |
| * | |
| FLAGS2 DS X Flag bits | |
| F2INOPN EQU X'80' 1... .... INDS DCB open | |
| F2NCBOPN EQU X'40' .1.. .... NETSPOOL NCB open | |
| F2OUTOPN EQU X'20' ..1. .... OUTDS DCB open | |
| F2NJE38 EQU X'10' ...1 .... NJE38 is active (LCLNODE valid) | |
| F2SYSOPN EQU X'08' .... 1... SYSINDS DCB open | |
| F2EXIST EQU X'04' .... .1.. OUTDATASET previously existed | |
| F2UNIT EQU X'02' .... ..1. UNIT specified v200 | |
| * .... ...x available bits | |
| * | |
| FLAGS3 DS X Flag bits from CMD line parse | |
| F3DEST EQU X'80' 1... .... Valid node.user destination spec | |
| F3PDS EQU X'40' .1.. .... 1=PDS,0=SEQL specified | |
| F3VOLSER EQU X'20' ..1. .... VOLSER specified | |
| F3OUTDS EQU X'10' ...1 .... OUTDATASET specified | |
| F3OUTMEM EQU X'08' .... 1... OUTDATASET MEMBER specified | |
| F3INDS EQU X'04' .... .1.. DATASET specified | |
| F3INMEM EQU X'02' .... ..1. DATASET member specified | |
| F3QUIET EQU X'01' .... ...1 1=QUIET suppress info msgs | |
| * | |
| FLAGS4 DS X Flag bits | |
| * xxxx xxxx available bits | |
| * NET02470 | |
| DS 0F | |
| INMF01 DS (INMFSZ)X Fields for INMR01 record | |
| INMF02A DS (INMFSZ)X Fields for 1st INMR02 record | |
| INMF02B DS (INMFSZ)X Fields for 2nd INMR02 record | |
| INMF03 DS (INMFSZ)X Fields for INMR03 record | |
| * NET02590 | |
| DS 0F | |
| CAMWORK DS 0XL140 CAMLST work area | |
| BUFF DS CL256 GB buffer containing request data NET02600 | |
| LIST DS CL80 Print line | |
| REC DS CL133 Physical record from spool | |
| * | |
| *---- | |
| LS99PTR DS A PTR TO S99RB | |
| LS99RB DS XL20 SPACE FOR S99RB | |
| * | |
| TXTPTRS DS 15A -> Text unit ptr list | |
| * | |
| DS 0H | |
| UTXT DS 0XL06,Y,AL2,AL2 DDNAME Unallocation | |
| UDDNAME DS CL8 DDNAME | |
| * | |
| DS 0H | |
| TXT01 DS 0XL06,Y,AL2,AL2 Return DDNAME | |
| TDDNAME DS CL8 DDNAME | |
| * | |
| DS 0H | |
| TXT02 DS 0XL06,Y,AL2,AL2 DSN= | |
| TDSNAME DS CL44 DSNAME | |
| * | |
| DS 0H | |
| TXT03 DS 0XL07,Y,AL2,AL2,X DISP=(NEW, | |
| * | |
| DS 0H | |
| TXT04 DS 0XL07,Y,AL2,AL2,X DISP=(,CATLG) | |
| * | |
| DS 0H | |
| TXT05 DS 0XL06,Y,AL2,AL2 SPACE BLOCK LEN | |
| TBLKLEN DS XL3 BLKLEN | |
| * | |
| DS 0H | |
| TXT06 DS 0XL06,Y,AL2,AL2 SPACE PRIMARY | |
| TPRIME DS XL3 Primary | |
| * | |
| DS 0H | |
| TXT07 DS 0XL06,Y,AL2,AL2 SPACE SECONDARY | |
| TSECND DS XL3 Secondary | |
| * | |
| DS 0H | |
| TXT08 DS 0XL06,Y,AL2,AL2 SPACE DIRECTORY BLOCKS | |
| TDIRBLKS DS XL3 DIR BLKS | |
| * | |
| DS 0H | |
| TXT09 DS 0XL06,Y,AL2,AL2 VOLUME | |
| TVOLSER DS CL6 VOLSER | |
| * | |
| DS 0H | |
| TXT10 DS 0XL14,Y,AL2,AL2 UNIT v200 | |
| TUNIT DS CL8 UNITNAME v200 | |
| * | |
| DS 0H | |
| TXT11 DS 0XL06,Y,AL2,AL2 EXPDT | |
| TEXPDT DS CL5 EXPDT=yyddd | |
| * | |
| DS 0H | |
| TXT12 DS 0XL06,Y,AL2,AL2 BLKSIZE | |
| TBLKSIZE DS XL2 BLKSIZE | |
| * | |
| DS 0H | |
| TXT13 DS 0XL06,Y,AL2,AL2 DSORG | |
| TDSORG DS XL2 DSORG | |
| * | |
| DS 0H | |
| TXT14 DS 0XL06,Y,AL2,AL2 LRECL | |
| TLRECL DS XL2 LRECL | |
| * | |
| DS 0H | |
| TXT15 DS 0XL06,Y,AL2,AL2 RECFM | |
| TRECFM DS XL1 RECFM | |
| * | |
| DS 0H | |
| TXT16 DS 0XL04,Y,AL2 DUMMY | |
| * | |
| DS 0H | |
| TXT17 DS 0XL04,Y,AL2 SYSOUT | |
| * | |
| DS 0H | |
| TXT18 DS 0XL04,Y,AL2 TERM | |
| * | |
| DS 0H | |
| TXT19 DS 0XL04,Y,AL2 CYLINDER | |
| * | |
| DS 0H | |
| TXT20 DS 0XL04,Y,AL2 FREE=CLOSE | |
| * | |
| DS 0H | |
| TXT21 DS 0XL06,Y,AL2,AL2 MEMBER | |
| TMEMBER DS CL8 | |
| *--- | |
| * | |
| CTL DS X Segment descriptor byte | |
| * | |
| * | |
| DS 0F | |
| TAGDATA DS XL108 TAG data area | |
| TYPPRT EQU X'40' PRT dev | |
| TYPPUN EQU X'80' PUN dev | |
| * | |
| NCB1 DS XL48 NCB for Spool Access | |
| SYSINDS DS 0X SYSIN DCB for IEBCOPY ctl cards | |
| INDS DS (DMYINDSL)X Input dataset DCB | |
| OUTDS DS (DMYOUTDL)X OUTDATASET DCB | |
| CAMLST DS (DMYLSTL)X Space to hold a CAMLST | |
| * | |
| CPYPLIST DS XL(COPYPRML) IEBCOPY PARM FIELD | |
| * | |
| DS 0H | |
| DDLISTL DS AL2(DDLISTSZ) DDNAME LIST LENGTH | |
| DDLIST DS 4XL8'00' FOUR DDNAMES UNDEFINED | |
| DDSYSIN DS CL8 DDNAME representing IEBCOPY's SYSIN | |
| DDSYSPR DS CL8 DDNAME representing IEBCOPY's SYSPRINT | |
| DS XL8'00' UNDEFINED DD | |
| DDSYSUT1 DS CL8 DDNAME of the dataset to be transmitted (SYSUT1) | |
| DDSYSUT2 DS CL8 DDNAME representing IEBCOPY's SYSUT2 | |
| DS XL8'00' SYSUT3 unused | |
| DDSYSUT4 DS CL8 DDNAME representing IEBCOPY's SYSUT4 | |
| DDLISTSZ EQU *-DDLIST LENGTH OF DDLIST for IEBCOPY | |
| DDOUTDS DS XL8'00' OUTDATASET DDNAME | |
| DDNETSPL DS XL8'00' NETSPOOL DDNAME | |
| UNLISTSZ EQU *-DDLIST TOTAL of all DDs in list | |
| * | |
| *-- ESTAE exit used areas | |
| * | |
| FSAVE DS 2D | |
| FWORK DS D | |
| DHDR DS CL30 | |
| ABCODE DS CL7 | |
| MVSSAVE DS 18F ESTAE exit OS save | |
| *-- End of ESTAE area | |
| * | |
| * | |
| NJESA DS 18F NJERCV OS save area NJE00300 | |
| DYNSA DS 18F NJEDYN OS save area NJE00300 | |
| NETSA DS 18F NJENET OS save area NJE00300 | |
| PARSA DS 18F NJEPAR OS save area NJE00300 | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEWK | |
| * NJE00930 | |
| * | |
| *-- System DSECTs | |
| * | |
| CVT DSECT=YES,PREFIX=NO | |
| IEFZB4D0 | |
| IEFZB4D2 | |
| DCBD DSORG=PS,DEVD=DA | |
| * | |
| IEFUCBOB DSECT | |
| IEFUCBOB LIST=YES | |
| IHAPSA | |
| IEESMCA | |
| IKJTCB | |
| IHASDWA | |
| IEFTIOT DSECT | |
| IEFTIOT1 | |
| IHAASCB | |
| IHAASXB | |
| IKJUPT | |
| IKJCPPL | |
| IKJPGPB | |
| IKJIOPL | |
| DSCBF1 DSECT | |
| IECSDSL1 (1) | |
| * | |
| VOLLIST DSECT Volume list returned by LOCATE | |
| VOLCOUNT DS H Volume count | |
| VOLDEV DS CL4 UCB dev type | |
| VOLSER DS CL6 Volser | |
| VOLSTAT DS H Status bytes | |
| * | |
| ACEE DSECT Maps a portion of ACEE in MVS3.8 | |
| ACEEEYE DS CL4'ACEE' | |
| DS 16X | |
| ACEEUSRL DS X Length of userid | |
| ACEEUSR DS CL8 Userid | |
| * | |
| COPY NETSPOOL NJE00940 | |
| COPY TAG | |
| * | |
| *-- NJE38 DSECTs | |
| * | |
| NJEWRE v220 | |
| * | |
| END NJETRN NJE01000 | |
| ./ ADD NAME=NJERCV | |
| * | |
| *-- NJE38 - TSO RECEIVE | |
| * | |
| * Command line format (all parameters are optional): | |
| * | |
| * RECEIVE filenum | |
| * DATASET( ) | |
| * VOLSER( ) | |
| * UNIT( ) | |
| * DIR( ) | |
| * INDATASET( ) | |
| * PURGE | NOPURGE | |
| * PROMPT | NOPROMPT | |
| * QUIET | |
| * | |
| * where: | |
| * | |
| * filenum - specifies a specific NJE38 spool file number | |
| * to be received. If not specified, the next | |
| * available spool file is received. Ignored if | |
| * INDATASET is specified. | |
| * | |
| * DATASET( ) - specifies the dsname of the dataset to be | |
| * created; the received data will be placed within. | |
| * If not specified, the dataset name will be | |
| * derived from the incoming dataset name, with | |
| * the first qualifer being replaced by the | |
| * receiver's TSO userid. | |
| * | |
| * VOLSER( ) - specifies a volume where DATASET should be | |
| * created. If not specified, a PUBLIC volume will | |
| * be chosen based on the receiving dataset's | |
| * attributes. | |
| * | |
| * UNIT( ) - specifies a unit name where DATASET should be | |
| * created. If not specified, SYSDA is the default | |
| * unit name. | |
| * | |
| * DIR( ) - specifies a number of directory blocks if | |
| * incoming file was a PDSE. | |
| * | |
| * INDATASET( ) - optional. Specifies that the encoded named | |
| * dataset is to be received. The encoded dataset | |
| * was previously created by TRANSMIT using | |
| * OUTDATASET. May optionally specify a membername. | |
| * | |
| * PURGE - DEFAULT. Indicates that RECEIVE is to purge | |
| * the spool file after successful retrieval. Has | |
| * no meaning if INDATASET is specified. | |
| * | |
| * NOPURGE - Indicates that RECEIVE is to retain the spool | |
| * file. The file can be received again or must be | |
| * removed from the spool by other means. Has | |
| * no meaning if INDATASET is specified. | |
| * | |
| * PROMPT - DEFAULT. Indicates that RECEIVE is to prompt | |
| * the TSO user to respecify DATASET or VOLSER | |
| * after learning the incoming dataset name. The | |
| * user can then choose to change the name or | |
| * volume. | |
| * | |
| * NOPROMPT - Indicates that no prompts are to be issued. If | |
| * errors are encountered, such as the incoming | |
| * dataset name already existing, then RECEIVE is | |
| * terminated without any opportunity to change | |
| * the parameters. | |
| * | |
| * QUIET - If specified, indicates that all informational | |
| * messages from RECEIVE are suppressed. Error | |
| * messages will always be displayed. QUIET also | |
| * forces on NOPROMPT. | |
| * | |
| * | |
| * Change log: | |
| * | |
| * | |
| * 21 Oct 21 - Temp dataset on IEBCOPY type receive not using vol v230 | |
| * identified by GETVOL (instead uses hi-cuu PUBLIC) v230 | |
| * 22 Jul 21 - Typo could cause alloc error with user coded volume v230 | |
| * 24 Apr 21 - Use TSO userid as default user if no security and v222 | |
| * NJE38 is not active. v222 | |
| * 15 Feb 21 - Not picking up jobname when run as an STC. v221 | |
| * 01 Oct 20 - Put ENQ existence check in common module v210 | |
| * 09 Aug 20 - Improve TSO attention key handling v201 | |
| * 13 Jul 20 - Flat file with JCL sneaks by NETDATA checks, causing v200 | |
| * loss of first record in result. v200 | |
| * 12 Jul 20 - Add support for DIR( ) command line parameter v200 | |
| * 10 Jul 20 - Add support for UNIT( ) command line parameter v200 | |
| * 08 Jul 20 - IEBCOPY failures if netdata records shorter than 80 v200 | |
| * 15 May 20 - Initial creation | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJERCV CSECT NJE00020 | |
| NJEVER | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJERCV,R12 NJE00070 | |
| LR R8,R1 Copy input parm addr | |
| * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJER' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| ST R8,CPARMS Save ptr to input parms | |
| MVC OLD,=F'1' Set number of PUTGET segments | |
| OI FLAGS3,F3PURGE Set default: PURGE | |
| * | |
| INIT000 EQU * | |
| MVC MACLIST(ESTAEL),ESTAE Move ESTAE parm list | |
| L R6,=A(NJEDMP) Point to local ESTAE rtn | |
| ESTAE (R6), Issue ESTAE X | |
| CT, X | |
| TERM=YES, X | |
| PARAM=(R10), PARAM is work area address X | |
| MF=(E,MACLIST) | |
| * | |
| *-- Establish TSO userid issuing this command | |
| * | |
| TESTAUTH FCTN=1 Are we authorized on entry? | |
| LTR R15,R15 Check result | |
| BNZ INIT010 Branch if not authorized | |
| OI FLAGS1,F1APF Indicate authorized on entry | |
| * | |
| INIT010 EQU * | |
| L R2,PSATOLD-PSA(0) -> my TCB | |
| L R2,TCBTIO-TCB(R2) -> my TIOT | |
| LA R4,TIOCNJOB-IEFTIOT(R2) -> TIOT jobname v221 | |
| LR R3,R4 Assume will use jobname v222 | |
| * | |
| L R2,PSAAOLD-PSA(0) -> my ASCB | |
| L R6,ASCBTSB-ASCB(,R2) -> TSB (or 0) | |
| L R2,ASCBASXB-ASCB(,R2) -> my ASXB | |
| ICM R2,15,ASXBSENV-ASXB(R2) -> my ACEE | |
| BZ INIT015 Exit if no ACEE | |
| * | |
| USING ACEE,R2 | |
| CLI ACEEUSRL,X'00' No userid available? | |
| BE INIT015 Exit if unavail | |
| CLI ACEEUSR,X'00' Userid not formed correctly? | |
| BE INIT015 Exit if unavail | |
| LA R3,ACEEUSR -> Userid | |
| OI FLAGS1,F1ACEE Valid ACEE found | |
| CLC ACEEUSR,=CL8'STC' Is this a started task? v221 | |
| BNE INIT015 No, use ACEEUSR id v221 | |
| LR R3,R4 Make the TIOT jobname the idv221 | |
| DROP R2 ACEE | |
| * | |
| INIT015 EQU * | |
| MVC USERID,0(R3) Set the userid | |
| TM FLAGS1,F1APF Authorized at entry? | |
| BO INIT040 yes. | |
| CLC USERID,=CL8'HERC01' Special access id? | |
| BE INIT020 Yes | |
| CLC USERID,=CL8'HERC02' Special access id? | |
| BNE INIT030 No | |
| * | |
| INIT020 EQU * | |
| OI FLAGS1,F1AUSR Indicate special authorized user | |
| SR 0,0 Use authorization SVC | |
| LA 1,1 For TK4- HERC01/HERC02 only | |
| SVC 244 Get authorized | |
| B INIT040 | |
| * | |
| INIT030 EQU * | |
| TM FLAGS1,F1APF Authorized at entry? | |
| BZ ERR006 No, issue error | |
| * | |
| INIT040 EQU * | |
| LA R6,0(,R6) Clear high order byte | |
| LTR R6,R6 Was there a TSB address | |
| BNZ INIT045 There was. Running in TSO userid | |
| OI FLAGS1,F1BATCH Indicate batch TSO | |
| TM FLAGS1,F1ACEE Valid ACEE found? | |
| BO INIT045 Yes, go with ACEE userid | |
| BAL R2,CHK000 See if NJE38 is active v210 | |
| BNZ INIT045 NJE38 not active; use jobnamv222 | |
| MVC USERID,DEFUSER Use default userid | |
| * | |
| INIT045 EQU * | |
| L R2,4(,R8) -> UPT from input parms | |
| USING UPT,R2 | |
| MVC PREFIX,BLANKS Init receiving field | |
| SR R1,R1 Clear for IC | |
| ICM R1,1,UPTPREFL Get prefix length | |
| BZ INIT050 No prefix value in use | |
| BCT R1,*+10 Adjust for execute | |
| MVC PREFIX(0),UPTPREFX executed instr | |
| EX R1,*-6 Copy the prefix value | |
| DROP R2 UPT | |
| * | |
| INIT050 EQU * | |
| MVC STAXLIST(STAXL),STAX Move STAX parm list | |
| LA R5,LIST -> input buffer from attn | |
| LA R6,STAXXIT Point to local exit | |
| STAX (R6), Set exit for attention X | |
| OBUF=(ATTNMSG,L'ATTNMSG), x | |
| IBUF=((5),80), x | |
| USADDR=(10), Parameter is our work area x | |
| MF=(E,MACLIST) | |
| * | |
| *-- Parse command line | |
| * | |
| SR R0,R0 Code 0: parse command line | |
| L R15,=A(NJEPAR) -> parse routine | |
| BALR R14,R15 | |
| * | |
| TM FLAGS4,F4ATTN Was ATTN pressed? v201 | |
| BO EXIT08 Y, immediate exit v201 | |
| LTR R15,R15 Any errors? | |
| BNZ ERR001 Display IJKPARS RC | |
| * | |
| *-- Issue hello msgs | |
| * | |
| INIT060 EQU * | |
| LA R2,MSG000 Issue hello msg | |
| BAL R14,PUTLINE | |
| LA R2,MSGBLNK Issue blank line | |
| BAL R14,PUTLINE | |
| * | |
| *-- Are we reading from the NJE38 spool or an INDATASET? | |
| * | |
| TM FLAGS3,F3INDS INDATASET specified? | |
| BZ OPN000 No, use NETSPOOL | |
| * | |
| *-- Set up INDATASET | |
| * | |
| INIT080 EQU * | |
| MVC TDSNAME,USRINDS Set DSNAME of INDATASET | |
| * | |
| LA R0,DYNINDS 24 allocate INDATASET | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 Any errors? | |
| BNZ EXIT08 Exit if allocation error | |
| * | |
| MVC NETDATA(DMYNPOL),DMYNPO Set up DCB for PDS | |
| CLI TDSORG,X'02' Was DSORG=PO ? | |
| BE *+10 Yes | |
| MVC NETDATA(DMYNPSL),DMYNPS Set up DCB for SEQL | |
| * | |
| MVC DDNETDAT,TDDNAME Save off the DDNAME returned | |
| MVC DECB(READL),READ Set up DECB | |
| LA R6,NETDATA -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBDDNAM,DDNETDAT Set DCB DDNAME | |
| * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (NETDATA,INPUT), Open the NETDATA dataset X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2NETOPN Indicate DCB is open | |
| * | |
| CLC DCBLRECL,=Y(80) Is LRECL 80? | |
| BNE ERR009 No, cant be netdata file | |
| TM DCBRECFM,DCBRECF Fixed length records? | |
| BZ ERR009 No, cant be netdata file | |
| * | |
| LH R0,DCBBLKSI Get physical blksize | |
| ST R0,BLOCKLEN Save it | |
| GETMAIN RU,LV=(0) Get buffer to read blocks | |
| ST R1,BLOCK Save buffer addr | |
| DROP R6 | |
| * | |
| CLI TDSORG,X'40' Was DSORG=PS ? | |
| BE INIT100 Yes, don't do the FIND | |
| * | |
| FIND NETDATA,USRMEM,D Point to the member | |
| LTR R15,R15 Any errors? | |
| BNZ ERR004 Exit if member not found | |
| * | |
| *-- Process the initial NETDATA control records from INDATASET | |
| * | |
| INIT100 EQU * | |
| SR R0,R0 Code 0, process initial NETDATA | |
| L R15,=A(NJENET) -> NETDATA parsing routines | |
| BALR R14,R15 Process the control records | |
| * | |
| B INIT110(R15) Branch based on error | |
| INIT110 B USR000 00 Normal, proceed. | |
| B ERR008 04 File is not NETDATA | |
| B EXIT08 08 Invalid NETDATA encountered | |
| B ERR005 0C Unexpected EOF on INDATASET | |
| B ERR007 10 READ i/o error on INDATASET | |
| B ERR030 14 INMTEXT detected, not supported | |
| B ERR038 18 Record segments exceed LRECLv222 | |
| * | |
| *-- Open NETSPOOL | |
| * | |
| OPN000 EQU * | |
| BAL R2,CHK000 Get NJE38 Spool DSN v210 | |
| BNZ ERR013 NJE38 is not active v210 | |
| * | |
| MVC DDNETSPL,=CL8'NETSPOOL' Set NETSPOOL DDN (for unalloc) | |
| MVC TDDNAME,DDNETSPL NETSPOOL DD | |
| LA R0,DYNETSPL 28 allocate NETSPOOL | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| * | |
| LA R8,NCB1 -> NCB | |
| USING NCB,R8 | |
| * | |
| LA R6,TAGDATA -> area to hold tag data | |
| USING TAG,R6 | |
| * | |
| NSIO TYPE=OPEN, x | |
| NCB=(R8), x | |
| TAG=(R6), -> Where tag data will be x | |
| EODAD=EOD000 | |
| C R15,=F'4' NETSPOOL needs verify? | |
| BE ERR025 Yes | |
| BL OPN010 Everything is good | |
| BAL R14,FMT000 Display Open error | |
| CLC NCBRTNCD(2),=AL1(8,152) X'0898' security denied access? | |
| BE ERR032 Yes, special msg | |
| B EXIT08 Exit on VSAM error | |
| * | |
| OPN010 EQU * | |
| OI FLAGS2,F2NCBOPN Indicate NETSPOOL is open | |
| TM FLAGS3,F3FILEID Specific file # specified? | |
| BO OPN020 Yes | |
| * | |
| *-- Here for 'next' available spool file | |
| * | |
| NSIO TYPE=CONTENTS, Get list of files x | |
| NCB=(R8) | |
| LTR R15,R15 Any errors? | |
| BZ OPN030 No | |
| CLC NCBRTNCD(2),=AL1(12,6) No files in directory? | |
| BE ERR010 Close up and indicate no files | |
| BAL R14,FMT000 Display error | |
| B EXIT08 Exit on VSAM error | |
| * | |
| *-- Here for 'specific' spool file number | |
| * | |
| OPN020 EQU * | |
| MVC TAGID,FILEID+2 Set file # to find | |
| * | |
| NSIO TYPE=FIND, get directory entry x | |
| NCB=(R8), x | |
| TAG=(R6) Where to place tag data | |
| LTR R15,R15 Any errors? | |
| BZ OPN200 No, process file | |
| CLC NCBRTNCD(2),=AL1(12,4) Was file id not found? | |
| BE ERR011 Yes | |
| BAL R14,FMT000 Otherwise, display error | |
| B EXIT08 Exit on VSAM error | |
| * | |
| *-- Look for next available in contents directory | |
| * | |
| OPN030 EQU * | |
| L R2,NCBAREA Get a list of spool content | |
| USING NSDIR,R2 | |
| SR R5,R5 | |
| ICM R5,3,NCBRECCT # of returned entries | |
| SR R6,R6 Indicate nothing found yet | |
| * | |
| OPN040 EQU * | |
| CLC LCLNODE,NSTOLOC Is this file for this link? | |
| BNE OPN160 no, skip this file | |
| TM FLAGS1,F1ACEE Was security available? | |
| BZ OPN150 No; do not enforce selection | |
| CLC USERID,NSTOVM Is this file for this userid? | |
| BNE OPN160 no, skip this file | |
| * | |
| OPN150 EQU * | |
| LA R6,TAGDATA -> tag data area for file | |
| USING TAG,R6 | |
| XC TAGDATA(TAGLEN),TAGDATA | |
| MVC TAGINLOC(TAGUSELN),NSINLOC Copy tag datq | |
| B OPN170 Go process the file | |
| * | |
| OPN160 EQU * | |
| LA R2,NSDIRLN(,R2) Next NETSPOOL dir entry | |
| BCT R5,OPN040 Continue thru the contents | |
| DROP R2 NSDIR | |
| * | |
| * | |
| OPN170 EQU * | |
| LM R0,R1,NCBAREAL Get list length and address | |
| XC NCBAREA,NCBAREA Clear obsolete ptr | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| LTR R6,R6 Did we obtain tag data? | |
| BZ ERR010 No, no files available | |
| B OPN300 | |
| * | |
| *-- validate specific file owner | |
| * | |
| OPN200 EQU * | |
| CLC LCLNODE,TAGTOLOC Is this file for this link? | |
| BNE ERR016 no, skip this file | |
| TM FLAGS1,F1ACEE Was security available? | |
| BZ OPN300 No; do not enforce selection | |
| CLC USERID,TAGTOVM Is file for this userid? | |
| BNE ERR016 no, skip this file | |
| DROP R6 TAG | |
| DROP R8 NCB | |
| * | |
| *-- Process the initial NETDATA control records from NETSPOOL | |
| * | |
| OPN300 EQU * | |
| SR R0,R0 Code 0, process initial NETDATA | |
| L R15,=A(NJENET) -> NETDATA parsing routines | |
| BALR R14,R15 Process the control records | |
| * | |
| B OPN310(R15) Branch based on error | |
| OPN310 B USR000 00 Normal, proceed. | |
| B OPN400 04 File is not NETDATA | |
| B EXIT08 08 Invalid NETDATA encountered | |
| B ERR005 0C Unexpected EOF on NETSPOOL | |
| B ERR007 10 READ i/o error on NETSPOOL | |
| B ERR030 14 INMTEXT detected, not supported | |
| B ERR038 18 Record segments exceed LRECLv222 | |
| * | |
| OPN400 EQU * | |
| OI FLAGS2,F2FLAT Indicate file is a flat file | |
| * | |
| *-- Notify user of dataset and prompt for changes | |
| * | |
| *-- This routine will: | |
| * 1. Obtain or make the dataset name that came from the Tag/NETDATA | |
| * 2. Tell user that name and prompt for changes | |
| * 3. Parse the changes | |
| * | |
| USR000 EQU * | |
| LA R7,INMF02A -> 1st INMR02 record v200 | |
| USING INMFIELD,R7 v200 | |
| NC DSTYPE(2),DSTYPE Was a DSTYPE key detected? v200 | |
| BZ USR020 No, we're good v200 | |
| CLI DSTYPE+2,X'40' PDSE program library? v200 | |
| BE ERR035 Can't support it v200 | |
| DROP R7 INMFIELD v200 | |
| * | |
| USR020 EQU * v200 | |
| MVI FLAGS4,X'00' Reinit parse results flags | |
| L R15,=A(NJENOT) -> Notify user and parse rtn | |
| BALR R14,R15 | |
| * | |
| LR R1,R15 RC to R1 | |
| LR R15,R0 Any secondary RC to R15 | |
| B USR080(R1) Branch based on error in R1 | |
| USR080 B USR100 00 Normal, proceed. | |
| B RCV920 04 User specified "END" | |
| B RCV910 08 User specified "PURGE" | |
| B ERR001 0C IKJPARS err, RC in R15 | |
| B ERR026 10 PUTGET errr, RC in R15 | |
| * | |
| *-- Did user enter a dataset name -and- member name on the prompt? | |
| *-- If so, warn him that we are ignoring the member name. | |
| * | |
| USR100 EQU * | |
| TM FLAGS4,F4MEMINV Was a member name specified? | |
| BZ USR110 No | |
| * | |
| LA R2,MSG021 msg: member name ignored | |
| BAL R14,PUTLINE Inform user | |
| * | |
| USR110 EQU * | |
| TM FLAGS2,F2FLAT Flat non-NETDATA type file? | |
| BZ RCV000 No, process NETDATA | |
| * | |
| *-- Prepare attributes for a flat file | |
| * | |
| FLT000 EQU * | |
| LA R7,INMF02A -> 1st INMR02 record | |
| USING INMFIELD,R7 | |
| MVC TDSNAME,FINALDS Set up DSNAME to build | |
| MVI DSNAME+1,44 Set DSNAME length for dynalloc | |
| MVC DSORG+2(2),=X'4000' Set DSORG=PS | |
| MVC BLKSIZE+6(4),=F'0' Set BLKSIZE to 0 to be computed | |
| MVI RECFM+2,DCBRECF+DCBRECBR Indicate RECFM=FB | |
| LA R6,TAGDATA -> TAG data | |
| USING TAG,R6 | |
| LA R1,80 Assume punch data length | |
| TM TAGINDEV,TYPPUN Is this punch data? | |
| BO FLT010 Yes | |
| LA R1,133 Assign print data length | |
| OI RECFM+2,DCBRECCA Use ASA ctl char | |
| * | |
| FLT010 EQU * | |
| STCM R1,15,LRECL+6 Set LRECL | |
| SR R0,R0 Clear for multiply | |
| M R0,TAGRECNM Compute size of file | |
| ST R1,FILESIZE+6 Set size in bytes for space calc | |
| DROP R6,R7 TAG,INMFIELD | |
| * | |
| *-- Prepare to receive the data | |
| * | |
| RCV000 EQU * | |
| LA R7,INMF02A -> 1st INMR02 record | |
| USING INMFIELD,R7 v222 | |
| ICM R0,15,BLKSIZE+6 Get blocksize to use in srchv222 | |
| C R0,=F'32760' BLKSIZE > 32760 MVS limit? v222 | |
| BH ERR023 Exit if invalid blksize v222 | |
| CLC LRECL+6(4),=F'32760' LRECL > 32760 MVS limit? v222 | |
| BH ERR023 Exit if invalid LRECL v222 | |
| * | |
| TM FLAGS1,F1INMR2B Was there a second INMR02? | |
| BZ RCV030 No | |
| LA R7,INMF02B -> 2nd INMR02 record | |
| * | |
| *-- Locate a suitable volume to hold the new dataset | |
| * | |
| RCV030 EQU * | |
| MVC TVOLSER,USRVOL Assume user specified volser | |
| TM FLAGS3,F3VOLSER Did user specify a volser? | |
| BO RCV040 Yes, we'll use that | |
| TM FLAGS4,F4VOLSER user specify a volser at prompt? | |
| BO RCV040 Yes, we'll use that | |
| TM FLAGS2,F2UNIT user specify a unit? v200 | |
| BO RCV040 Y, dont select a volume v200 | |
| * | |
| * R0 must contain BLKSIZE or 0 | |
| BAL R14,GETVOL Find a volume for allocation | |
| BZ ERR022 No volume found | |
| * | |
| *-- Start computing values and filling dynamic allocation text units | |
| * | |
| RCV040 EQU * | |
| LA R1,TVOLSER -> selected volser v200 | |
| BAL R14,FNDVOL Get track sz of selected volv200 | |
| BZ ERR036 Volume not online v200 | |
| LA R1,INMF02A -> 1st INMR02 record v200 | |
| L R1,BLKSIZE+6-INMFIELD(,R1) Get target DSN blksize v200 | |
| CR R1,R15 Will block fit on track? v200 | |
| BH ERR037 No; were done here v200 | |
| * | |
| BAL R14,GETBSZ Obtain final sizes, format | |
| STH R1,TBLKSIZE Set dynalloc block size | |
| STCM R1,7,TBLKLEN Set dynalloc space blk len | |
| STH R2,TLRECL Set dynalloc lrecl | |
| STC R3,TRECFM Set dynalloc recfm | |
| * | |
| BAL R14,GETSPACE Compute space parameters | |
| STCM R1,7,TPRIME Set primary space in blocks | |
| STCM R2,7,TSECND Set secondary space in blocks | |
| * | |
| MVC TDSORG,DSORG+2 NETDATA DSORG to text unit | |
| MVC TDSNAME,FINALDS Set DSNAME to allocate | |
| * | |
| * | |
| * | |
| *-- Call NJEDYN to allocate the dataset | |
| * | |
| LA R0,DYNINMCP 04 allocate dataset for SEQL file | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| * | |
| B RCV060(R15) Branch on RC | |
| RCV060 B RCV200 00 Normal, proceed | |
| B USR000 04 Dataset exists, reprompt | |
| B EXIT08 08 All other errors | |
| * | |
| * | |
| *-- Open the dataset | |
| * | |
| RCV200 EQU * | |
| MVC DDSYSUT1,TDDNAME Save off the DDNAME returned | |
| MVC NEWDS(DMYSEQL),DMYSEQ Set up DCB | |
| LA R6,NEWDS -> DCB | |
| USING IHADCB,R6 | |
| MVC DCBBLKSI,TBLKSIZE Set block size | |
| MVC DCBLRECL,TLRECL Set length | |
| MVC DCBRECFM,TRECFM Set format | |
| MVC DCBDDNAM,DDSYSUT1 Set Dynamic DD name | |
| TM DCBRECFM,DCBRECU Using undefined records? | |
| BNO RCV210 No | |
| * | |
| LH R0,DCBBLKSI Get dataset block size | |
| GETMAIN RU,LV=(0) Get recd build buffer for RECFMU | |
| STM R0,R1,NEWLEN Save length and addr | |
| DROP R6 IHADCB | |
| * | |
| RCV210 EQU * | |
| MVC MACLIST(OPENL),OPEN Move OPEN list | |
| OPEN (NEWDS,OUTPUT), Open the NEWDS dataset X | |
| MF=(E,MACLIST) | |
| OI FLAGS2,F2NEWOPN Indicate DCB is open | |
| * | |
| LA R0,4 Code 4, process NETDATA | |
| TM FLAGS2,F2FLAT Flat non-NETDATA type file? | |
| BZ RCV220 No, proceed with NETDATA | |
| LA R0,8 Code 8, process PRT/PUN file | |
| * | |
| RCV220 EQU * | |
| L R15,=A(NJENET) -> data retreival routines | |
| BALR R14,R15 Process the records | |
| * | |
| B RCV230(R15) Branch based on result RC | |
| RCV230 B RCV240 00 Normal, proceed. | |
| DC AL4(0) 04 Not used | |
| B EXIT08 08 Invalid NETDATA encountered | |
| B ERR005 0C Unexpected EOF on INDATASET | |
| B ERR007 10 READ i/o error on INDATASET | |
| B ERR030 14 INMTEXT detected, not supported | |
| B ERR038 18 Record segments exceed LRECLv222 | |
| * | |
| RCV240 EQU * | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (NEWDS), Close it X | |
| MF=(E,MACLIST) | |
| NI FLAGS2,255-F2NEWOPN Indicate file closed | |
| * | |
| TM FLAGS3,F3INDS INDATASET specified? | |
| BZ RCV250 No, skip close | |
| * | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (NETDATA), Close it X | |
| MF=(E,MACLIST) | |
| NI FLAGS2,255-F2NETOPN Indicate NETDATA file closed | |
| * | |
| * | |
| * | |
| *-- If two INMR02 control records were found, then we need to run | |
| *-- IEBCOPY to load a PDS from the unloaded file just processed above. | |
| * | |
| RCV250 EQU * | |
| TM FLAGS1,F1INMR2B Was there a second INMR02? | |
| BZ RCV950 No. We're done | |
| * | |
| LA R7,INMF02A -> 1st INMR02 record | |
| USING INMFIELD,R7 | |
| * | |
| *-- Filling dynamic allocation text units for final dataset | |
| * | |
| ICM R1,15,BLKSIZE+6 Get the NETDATA blksize | |
| STH R1,TBLKSIZE Set dynalloc block size | |
| STCM R1,7,TBLKLEN Set dynalloc space blk len | |
| MVC TLRECL,LRECL+8 Set dynalloc lrecl | |
| MVC TRECFM,RECFM+2 Set dynalloc recfm | |
| * | |
| BAL R14,GETSPACE Compute space parameters | |
| STCM R1,7,TPRIME Set primary space in blocks | |
| STCM R2,7,TSECND Set secondary space in blocks | |
| * | |
| MVC TDIRBLKS,DIRBLKS+7 Set directory blocks required | |
| TM FLAGS2,F2DIR Did user override with DIR? v200 | |
| BZ RCV255 No v200 | |
| MVC TDIRBLKS,USRDIR+1 Set directory blocks req'd v200 | |
| * | |
| RCV255 EQU * v200 | |
| MVC TDSORG,DSORG+2 NETDATA DSORG to text unit | |
| MVC TDSNAME,FINALDS Set DSNAME to allocate | |
| * | |
| * | |
| *-- Call NJEDYN to allocate the final output dataset as "SYSUT2" | |
| * | |
| LA R0,DYNFINAL 10 allocate final dataset | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| * | |
| B RCV260(R15) Branch on RC | |
| RCV260 B RCV400 00 Normal, proceed | |
| B RCV300 04 Dataset exists, reprompt | |
| B EXIT08 08 All other errors | |
| * | |
| *-- Notify user of existing dataset and prompt for changes | |
| * | |
| *-- This routine will: | |
| * 1. Obtain or make the dataset name that came from the Tag/NETDATA | |
| * 2. Tell user that name and prompt for changes | |
| * 3. Parse the changes | |
| * | |
| RCV300 EQU * | |
| MVI FLAGS4,X'00' Reinit parse results flags | |
| L R15,=A(NJENOT) -> Notify user and parse rtn | |
| BALR R14,R15 | |
| * | |
| LR R1,R15 RC to R1 | |
| LR R15,R0 Any secondary RC to R15 | |
| B RCV310(R1) Branch based on error in R1 | |
| RCV310 B RCV320 00 Normal, proceed. | |
| B RCV920 04 User specified "END" | |
| B RCV910 08 User specified "PURGE" | |
| B ERR001 12 IKJPARS err, RC in R15 | |
| B ERR026 16 PUTGET errr, RC in R15 | |
| * | |
| *-- Did user enter a dataset name -and- and member name on the prompt? | |
| *-- If so, warn him that we are ignoring the member name. | |
| * | |
| RCV320 EQU * | |
| TM FLAGS4,F4VOLSER Was a new volser specified? | |
| BZ RCV330 No | |
| MVC TVOLSER,USRVOL Grab new volser | |
| * | |
| RCV330 EQU * | |
| TM FLAGS4,F4MEMINV Was a member name specified? | |
| BZ RCV250 No, try to allocate again | |
| * | |
| LA R2,MSG021 msg: member name ignored | |
| BAL R14,PUTLINE Inform user | |
| B RCV250 Try to allocate again | |
| * | |
| * | |
| * | |
| *-- Prepare to launch IEBCOPY | |
| * | |
| RCV400 EQU * | |
| MVC DDSYSUT2,TDDNAME Set replacement SYSUT2 DD | |
| * | |
| *-- Call NJEDYN to allocate the SYSIN dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSIN 08 allocate SYSIN for IEBCOPY | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSIN,TDDNAME Save generated DDNAME | |
| * | |
| *-- Call NJEDYN to allocate the SYSPRINT dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSPR 12 allocate SYSPRINT for IEBCOPY | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSPR,TDDNAME Save generated DDNAME | |
| * | |
| *-- Call NJEDYN to allocate the SYSUT3 dataset needed by IEBCOPY | |
| * | |
| LA R0,DYNSYSU3 14 allocate SYSUT3 temporary | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ EXIT08 Exit with dynalloc error | |
| MVC DDSYSUT3,TDDNAME Set replacement SYSUT3 DD | |
| * | |
| *-- Invoke IEBCOPY | |
| * | |
| MVC CPYPLIST,COPYPARM Move IEBCOPY parms to 24-bit stg | |
| MVC DDLISTL,=AL2(DDLISTSZ) Set IEBCOPY DD list length | |
| LA R2,CPYPLIST | |
| LA R3,DDLISTL | |
| MVC MACLIST(LINKL),LINK Move macro model | |
| LINK EP=IEBCOPY, x | |
| PARAM=((R2),(R3)), x | |
| VL=1, x | |
| MF=(E,MACLIST) | |
| LTR R5,R15 Copy RC to R5 | |
| BZ RCV950 Exit on success | |
| * | |
| *-- RECEIVE ended because IEBCOPY failed | |
| * | |
| RCV900 EQU * | |
| LA R2,MSGBLNK -> blank line msg | |
| BAL R14,PUTLINE | |
| * | |
| MVC LIST(4+L'MSG018T),MSG018 IEBCOPY fail msg | |
| CVD R5,DBLE Convert IEBCOPY RC | |
| UNPK LIST+37(2),DBLE | |
| OI LIST+38,X'F0' Fix sign | |
| * | |
| LA R2,LIST -> start of msg | |
| BAL R14,PUTLINE Display failure | |
| B EXIT08 | |
| * | |
| *-- User chose PURGE on the action prompt; purge the spool file | |
| *-- (if not using INDATASET) and then exit. | |
| * | |
| RCV910 EQU * | |
| TM FLAGS3,F3INDS Was INDATASET specified? | |
| BO RCV920 Y, exit with no action | |
| BAL R14,PUR000 Purge spool file as requested | |
| LA R2,MSGBLNK -> blank line msg | |
| BAL R14,PUTLINE | |
| LA R2,MSG029 -> ended with nothing recv'd | |
| BAL R14,PUTLINE | |
| B EXIT00 And we're done | |
| * | |
| *-- RECEIVE ended with no action taken | |
| * | |
| *-- Here if 'END' specified or attention received | |
| * | |
| RCV920 EQU * | |
| LA R2,MSGBLNK -> blank line msg | |
| BAL R14,PUTLINE | |
| LA R2,MSG019 -> ended with no action | |
| BAL R14,PUTLINE | |
| TM FLAGS2,F2FEND Was END forced in BATCH mode? | |
| BO EXIT08 Yes, force RC=8 | |
| B EXIT00 | |
| * | |
| *-- RECEIVE ended successfully with dataset created and filled | |
| * | |
| *-- If the user at any time specified the PURGE option, remove | |
| *-- the spool file that was received. | |
| * | |
| RCV950 EQU * | |
| * | |
| RCV990 EQU * | |
| LA R2,MSGBLNK -> blank line msg | |
| BAL R14,PUTLINE | |
| MVC LIST,BLANKS | |
| MVC LIST(4+L'MSG017T),MSG017 Success msg | |
| LA R1,LIST+4+L'MSG017T -> next available byte | |
| MVI 0(R1),C'''' Move apost | |
| MVC 1(44,R1),FINALDS Move final DSN | |
| TRT 1(45,R1),BLANK Look for end of DSN | |
| MVI 0(R1),C'''' Move apost | |
| LA R1,2(,R1) -> skip over apost + 1 blank | |
| MVC 0(10,R1),=C'successful' | |
| LA R1,10(,R1) -> skip to end | |
| LA R2,LIST -> start of msg | |
| SR R1,R2 Compute msg length | |
| STH R1,LIST Set RDW | |
| BAL R14,PUTLINE Display success | |
| * | |
| BAL R14,PUR000 Purge the spool file if needed | |
| B EXIT00 | |
| * | |
| * | |
| *-- Return the BLKSIZE value from the NETDATA, and adjust the | |
| *-- RECFM and LRECL based on the NETDATA-unique variable formats when | |
| *-- applicable. | |
| * | |
| *-- General guidelines and manipulations by this routine: | |
| * | |
| *-- 1. If the NETDATA LRECL is zero, this is unusual but don't alter | |
| *-- any other DCB parameters; this covers the RECFM=U case. | |
| * | |
| *-- 2. If the NETDATA RECFM specifies the variable spanned records, | |
| *-- leave all other parameters as is. This file came from MVS. | |
| * | |
| *-- 3. If the NETDATA RECFM specifies the shortened variable format, | |
| *-- e.g., RECFM=xx01 or xx02, then the LRECL must be increased | |
| *-- by 4 bytes to account for a RDW to be inserted. | |
| * | |
| *-- 4. If the NETDATA RECFM specifies the shortened variable format, | |
| *-- e.g., RECFM=xx01 or xx02, then the RECFM value used for | |
| *-- dynamic allocation of the dataset must be modified to specify | |
| *-- variable length records, as the variable X'40' bit may not | |
| *-- be set in the NETDATA RECFM. | |
| * | |
| *-- 5. If the BLKSIZE is 0, the file probably came from VM; then | |
| *-- do the following: | |
| *-- a. Manufacture a suitable blksize as close to 4K as possible. | |
| *-- b. If the LRECL > 4K, then make BLKSIZE=LRECL. | |
| *-- c. For Fixed length records, force the RECFM X'10' bit to | |
| *-- indicate blocked records, if BLKSIZE is not equal to LRECL. | |
| * | |
| *-- Entry: Fields BLKSIZE, LRECL, RECFM as decoded from NETDATA | |
| *-- Exit: R1 = BLKSIZE for use in dynamic allocation and DCB | |
| *-- R2 = LRECL for use in dynamic allocation and DCB | |
| *-- R3 = RECFM for use in dynamic allocation and DCB | |
| * | |
| GETBSZ EQU * | |
| ICM R1,15,BLKSIZE+6 Get blocksize | |
| IC R3,RECFM+2 Get DCB portion of NETDATA RECFM | |
| ICM R2,15,LRECL+6 Get lrecl | |
| BZR R14 No LRECL? leave everything be | |
| TM RECFM+2,X'48' Spanned variable records? | |
| BOR R14 Yes, use as specified | |
| TM RECFM+3,X'03' Shortened variable format? | |
| BZ GETB010 No | |
| LA R2,4(,R2) Add length to LRECL for RDW | |
| O R3,=A(DCBRECV+DCBRECBR) Ensure DCB RECFM is VB | |
| * | |
| GETB010 EQU * | |
| LTR R1,R1 Was there a blksize? | |
| BNZR R14 Use it if we have it | |
| TM RECFM+2,X'40' Variable format data? | |
| BO GETB030 Yes | |
| TM RECFM+3,X'03' Compressed variable format? | |
| BNZ GETB030 Yes, treat as variable | |
| *fixed | |
| L R1,=F'4096' Get possible block size | |
| DR R0,R2 Compute # recs in 4096 block | |
| LTR R1,R1 Do any recs fit? | |
| BZ GETB020 No, so make blksize=lrecl | |
| SR R0,R0 Dispose of remainder | |
| MR R0,R2 Compute nearest block size | |
| O R3,=A(DCBRECF+DCBRECBR) Set RECFM to FB | |
| BR R14 Return with BLKSIZE in R1 | |
| * | |
| GETB020 EQU * | |
| LR R1,R2 Make BLKSIZE=LRECL if LRECL>4096 | |
| N R3,=A(-1-DCBRECBR) Turn off blocking | |
| BR R14 Return with BLKSIZE in R1 | |
| * | |
| *variable | |
| GETB030 EQU * | |
| L R1,=F'4096' Get possible block size | |
| LA R0,4092 Possible size - 4 (for RDW) | |
| CR R2,R0 Will LRECL fit in possible size? | |
| BNHR R14 Yes, use the 4K blksize | |
| * | |
| GETB040 EQU * | |
| LA R1,4(,R2) Mk BLKSIZE=LRECL+4 if LRECL>4092 | |
| N R3,=A(-1-DCBRECBR) Turn off blocking | |
| BR R14 Return with BLKSIZE in R1 | |
| * | |
| *-- Compute primary and secondary space values in # blocks | |
| * | |
| *-- Entry: R1 = blksize | |
| *-- Field FILESIZE contains NETDATA estimated file size in bytes | |
| * | |
| *-- Exit: R1 = # of primary blocks | |
| *-- R2 = # of secondary blocks (always 10% of primary) | |
| * | |
| GETSPACE EQU * | |
| ICM R3,15,FILESIZE+6 Get approx size of file | |
| SR R2,R2 Clear for divide | |
| DR R2,R1 Compute # blocks needed | |
| LA R3,1(,R3) Always round up | |
| LR R1,R3 Return primary blocks in R1 | |
| SR R2,R2 Clear for divide | |
| D R2,=F'10' Compute 1/10th of needed amt | |
| LA R2,1(,R3) Round up = secondary blks needed | |
| BR R14 Return with R1 & R2 values | |
| DROP R7 | |
| * | |
| *-- PURGE the spool file | |
| * | |
| *-- Conditions: | |
| *-- 1. If INDATASET was specified then there is no spool file to purge | |
| *-- 2. If PURGE was specified when the user was prompted for | |
| *-- additional parameters, then purge the spool file and exit | |
| *-- without receiving the file. | |
| *-- 3. If NOPURGE was specified on the command line (if not overridden | |
| *-- by (2) above), then receive the file but do not purge it from | |
| *-- the spool. | |
| *-- 4. Otherwise, PURGE is defaulted or explicity specified on the | |
| *-- command line, receive the file and then purge it from spool. | |
| * | |
| PUR000 EQU * | |
| TM FLAGS3,F3INDS INDATASET specified? | |
| BOR R14 Yes, PURGE has no meaning | |
| TM FLAGS4,F4PURGE PURGE specified on prompt? | |
| BO PUR010 Yes, do it | |
| TM FLAGS3,F3PURGE PURGE specified or defaulted? | |
| BZR R14 No; do not purge spool file | |
| * | |
| PUR010 EQU * | |
| ST R14,SV14PUR Save return addr | |
| LA R6,TAGDATA -> area containing tag data | |
| USING TAG,R6 | |
| LA R8,NCB1 -> NCB | |
| NSIO TYPE=PURGE, Purge the file x | |
| NCB=(R8), x | |
| TAG=(R6) -> Where tag data is | |
| LTR R15,R15 Any errors? | |
| BZ PUR040 No | |
| BAL R14,FMT000 Display error | |
| B EXIT08 Exit on VSAM error | |
| * | |
| PUR030 EQU * | |
| NSIO TYPE=CLOSE, Close the spool x | |
| NCB=(R8) | |
| NI FLAGS2,255-F2NCBOPN Indicate NETSPOOL closed | |
| * | |
| PUR040 EQU * | |
| MVC LIST(4+L'MSG028T),MSG028 Move file purged msg | |
| LH R1,TAGID Get the file ID | |
| DROP R6 TAG | |
| CVD R1,DBLE | |
| UNPK LIST+9(4),DBLE | |
| OI LIST+12,X'F0' Fix sign | |
| LA R2,LIST -> msg text | |
| BAL R14,PUTLINE Inform user | |
| L R14,SV14PUR Reload return addr | |
| BR R14 Return | |
| * | |
| * | |
| ERR001 EQU * | |
| MVC LIST(4+L'MSG001T),MSG001 Move msg to work area | |
| CVD R15,DBLE unpk IKJPARS RC | |
| UNPK LIST+57(2),DBLE | |
| OI LIST+58,X'F0' Fix sign | |
| LA R2,LIST -> msg | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR004 EQU * | |
| MVC LIST(4+L'MSG004T),MSG004 Move msg to work area | |
| MVC LIST+11(8),USRMEM Plug in member name | |
| LA R2,LIST -> msg | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR005 EQU * | |
| MVC LIST(4+L'MSG005T),MSG005 Move msg text | |
| LA R1,=CL9'INDATASET' Assume reading from INDATASET | |
| TM FLAGS3,F3INDS Using INDATASET? | |
| BO *+8 We are | |
| LA R1,=CL9'NETSPOOL' NO, its NETSPOOL | |
| MVC LIST+4+L'MSG005T(9),0(R1) Move source of error | |
| LH R1,LIST Get current msg length | |
| LA R1,9(,R1) Add on the source length | |
| STH R1,LIST Put back | |
| LA R2,LIST Unexpected EOF on xxxxxxxxx | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR006 EQU * | |
| LA R2,MSG006 Not APF authorized | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR007 EQU * | |
| MVC LIST(4+L'MSG007T),MSG007 Move msg text | |
| LA R1,=CL9'INDATASET' Assume reading from INDATASET | |
| TM FLAGS3,F3INDS Using INDATASET? | |
| BO *+8 We are | |
| LA R1,=CL9'NETSPOOL' NO, its NETSPOOL | |
| MVC LIST+4+L'MSG007T(9),0(R1) Move source of error | |
| LH R1,LIST Get current msg length | |
| LA R1,9(,R1) Add on the source length | |
| STH R1,LIST Put back | |
| LA R2,LIST Read i/o error on INDATASET | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR008 EQU * | |
| LA R2,MSG008 INDATASET is not NETDATA fmt | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR009 EQU * | |
| LA R2,MSG009 INDATASET is not 80/F | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR010 EQU * | |
| LA R2,MSG010 No files available to receive | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR011 EQU * | |
| LA R2,MSG011 Specific file number not exis | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR013 EQU * | |
| LA R2,MSG013 NJE38 is not active | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR016 EQU * | |
| LA R2,MSG016 Cant receive another users file | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR022 EQU * | |
| LA R2,MSG022 No suitable PUBLIC volume | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR023 EQU * | |
| LA R2,MSG023 BLKSIZE/LRECL to large | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR025 EQU * | |
| LA R2,MSG025 Need to run VERIFY | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR026 EQU * | |
| MVC LIST(4+L'MSG026T),MSG026 Move msg to work area | |
| CVD R15,DBLE unpk PUTGET RC | |
| UNPK LIST+49(2),DBLE | |
| OI LIST+50,X'F0' Fix sign | |
| LA R2,LIST -> msg PUTGET failed | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR030 EQU * | |
| LA R2,MSG030 INMTEXT detected not supported | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR032 EQU * | |
| LA R2,MSG032 Security denied access NETSPOOL | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR035 EQU * v200 | |
| LA R2,MSG035 Incoming is a PDSE Prog Lib v200 | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR036 EQU * v200 | |
| LA R2,MSG036 Volume not online v200 | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR037 EQU * v200 | |
| LA R2,MSG037 BLKSIZE to large for volume v200 | |
| B ERRPUT Write msg v200 | |
| * | |
| ERR038 EQU * v222 | |
| LA R2,MSG038 Input file recs exceed LRECLv222 | |
| B ERRPUT Write msg v222 | |
| * | |
| ERRPUT EQU * v200 | |
| BAL R14,PUTLINE Write error msg in R2 v200 | |
| B EXIT08 Exit w RC=08 v200 | |
| * | |
| EXIT00 EQU * | |
| SR R15,R15 Set RC=0 | |
| B XIT000 Clean up and exit | |
| * | |
| EXIT08 EQU * | |
| LA R15,8 Set RC=8 | |
| B XIT000 Clean up and exit | |
| * | |
| XIT000 EQU * | |
| LA R13,NJESA Ensure using proper SA in case | |
| * we've come here due to ESTAE | |
| LR R5,R15 Save RC across shutdown | |
| ESTAE 0 Disable ESTAE | |
| * | |
| TM FLAGS2,F2NETOPN Is NETDATA open? | |
| BZ XIT010 No | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (NETDATA), Close it X | |
| MF=(E,MACLIST) | |
| * | |
| XIT010 EQU * | |
| TM FLAGS2,F2NEWOPN Is NEWDS open? | |
| BZ XIT020 No | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE (NEWDS), Close it X | |
| MF=(E,MACLIST) | |
| * | |
| XIT020 EQU * | |
| TM FLAGS2,F2NCBOPN Is NETSPOOL open? | |
| BZ XIT030 No | |
| SR R6,R6 Ensure no tag data | |
| LA R8,NCB1 -> NCB | |
| NSIO TYPE=CLOSE, Close the spool x | |
| NCB=(R8) | |
| * | |
| XIT030 EQU * | |
| L R0,BLOCKLEN Size of stg area | |
| ICM R1,15,BLOCK -> stg area | |
| BZ XIT040 Skip if never allocated | |
| FREEMAIN RU,LV=(0),A=(1) Release it | |
| * | |
| XIT040 EQU * | |
| L R0,NEWLEN Size of stg area | |
| ICM R1,15,NEWBLK -> stg area | |
| BZ XIT050 Skip if never allocated | |
| FREEMAIN RU,LV=(0),A=(1) Release it | |
| * NJE00200 | |
| XIT050 EQU * NJE00210 | |
| LA R3,DDLIST -> list of DD's we allocated | |
| LA R4,UNLISTSZ/8 # of DD list entries | |
| * | |
| XIT060 EQU * | |
| CLC =XL8'00',0(R3) Unassigned DD? | |
| BE XIT070 Skip to next | |
| * | |
| MVC UDDNAME,0(R3) | |
| LA R0,UNDYN 00 unalloc | |
| L R15,=A(NJEDYN) -> dynamic allocation rtns | |
| BALR R14,R15 | |
| * | |
| XIT070 EQU * NJE00210 | |
| LA R3,8(,R3) -> next DD entry | |
| BCT R4,XIT060 Continue unallocation scan | |
| * | |
| XIT080 EQU * NJE00210 | |
| TM FLAGS1,F1AUSR Special authorized user? | |
| BZ QUIT Y, Don't need Auth SVC | |
| SR 0,0 Use authorization SVC | |
| SR 1,1 For HERC01/HERC02 only | |
| SVC 244 Get un-authorized | |
| * | |
| QUIT EQU * NJE00210 | |
| LR R1,R10 -> NJEWK main work area page | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| ST R5,16(,R13) Set exit RC | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| LM R14,R12,12(R13) Reload system's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| DROP R12 | |
| * | |
| *-- STAX attention exit | |
| * | |
| *-- Just post the PUTGET ECB and return. PUTGET will fail with RC=8. | |
| * | |
| STAXXIT EQU * | |
| STM R14,R12,12(R13) Save | |
| LR R12,R15 Get base | |
| USING STAXXIT,R12 | |
| L R10,8(,R1) -> NJEWK area | |
| USING NJEWK,R10 | |
| POST PUTECB,16 Post the PUTGET ECB | |
| OI FLAGS4,F4ATTN Indicate ATTN pressed v201 | |
| LM R14,R12,12(R13) Load | |
| DROP R12 | |
| BR R14 Return | |
| * | |
| LTORG , | |
| * | |
| DMYNPO DCB DDNAME=NETDATA, X | |
| MACRF=(R), X | |
| DSORG=PO, X | |
| EODAD=EOD000 | |
| DMYNPOL EQU *-DMYNPO | |
| * | |
| DMYNPS DCB DDNAME=NETDATA, X | |
| MACRF=(R), X | |
| DSORG=PS, X | |
| EODAD=EOD000 | |
| DMYNPSL EQU *-DMYNPS | |
| * | |
| * | |
| DMYSEQ DCB DDNAME=0, X | |
| MACRF=(PL), X | |
| DSORG=PS, X | |
| BFTEK=A | |
| DMYSEQL EQU *-DMYSEQ | |
| * | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| LINK LINK EP=0,SF=L | |
| LINKL EQU *-LINK | |
| READ READ DMYDECB,SF,DMYNPO,MF=L | |
| READL EQU *-READ | |
| ESTAE ESTAE 0,MF=L | |
| ESTAEL EQU *-ESTAE | |
| STAX STAX 0,OBUF=(0,0),IBUF=(0,0),USADDR=0,MF=L | |
| STAXL EQU *-STAX | |
| * | |
| COPYPARM DC AL2(L'COPYOPT) | |
| COPYOPT DC C'WORK=0512K' | |
| COPYPRML EQU *-COPYPARM TOTAL LENGTH OF PARM OPTION | |
| * | |
| ATTNMSG DC C'COMMAND TERMINATED DUE TO ATTENTION; PRESS ENTER TWICE' | |
| * v201 | |
| ********************* | |
| * N J E C O M * NJECOM hosts small routines and | |
| * * frequently used constants that | |
| * Common routines * are available to all NJERxx csects | |
| * and constants * via base register 11 | |
| * * | |
| ********************* | |
| * | |
| NJECOM CSECT | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECOM' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECOM,R11 | |
| * | |
| *-- GET000 is used to read a block from the INDATASET or to read | |
| *-- a record from NETSPOOL. | |
| * | |
| *-- Entry: INDATASET or NETSPOOL must be OPEN. | |
| *-- Exit: R0 = length of data read | |
| *-- R1 -> data read | |
| *-- R15= RC. 0=OK | |
| *-- 4=Unexpected end of file | |
| *-- 8=Read i/o error | |
| * | |
| GET000 EQU * | |
| ST R14,SV14GET | |
| TM FLAGS3,F3INDS INDATASET specified? | |
| BZ GET030 No, use NETSPOOL | |
| * | |
| LA R2,NETDATA -> DCB | |
| L R0,BLOCK -> read buffer | |
| * | |
| READ DECB,SF,(R2),(R0),'S',MF=E Read block | |
| CHECK DECB | |
| * | |
| CLI DECB,X'7F' Was read successful? | |
| BNE GET090 No, read failed | |
| * | |
| L R0,BLOCKLEN Get current block size | |
| L R15,DECB+16 -> IOB addr | |
| SH R0,14(,R15) Compute size of block read | |
| L R1,BLOCK Return buffer addr | |
| SR R15,R15 Set RC=0 | |
| L R14,SV14GET | |
| BR R14 Return w/len & addr in R0,R1 | |
| * | |
| GET030 EQU * | |
| LA R1,NCB1 -> NCB | |
| NSIO TYPE=GET, TAG data contains file # x | |
| NCB=(1), x | |
| AREA=LIST v200 | |
| LTR R15,R15 Any errors? | |
| BZ GET040 No | |
| BAL R14,FMT000 Display error | |
| B GET090 | |
| * | |
| GET040 EQU * | |
| MVC REC(133),BLANKS Init receiving field v200 | |
| LH R2,NCBRECLN-NCB(,R1) Get the record length v200 | |
| BCTR R2,0 Adjust for execute v200 | |
| EX R2,MVSPL Mv spool record to phy rec areav200 | |
| LA R1,REC -> record | |
| LA R0,80 Always 80 | |
| SR R15,R15 Set RC=0 | |
| L R14,SV14GET | |
| BR R14 Return w/len & addr in R0,R1 | |
| * | |
| MVSPL MVC REC(0),LIST executed instr v200 | |
| * | |
| GET090 EQU * | |
| LA R15,8 Set RC=8 = Read error | |
| L R14,SV14GET | |
| BR R14 Return | |
| * | |
| EOD000 EQU * | |
| LA R15,4 Set RC=4 = unexpected EOF | |
| L R14,SV14GET | |
| BR R14 Return w/len & addr in R0,R1 | |
| * | |
| *-- Find a PUBLIC volume for use in allocations | |
| * | |
| *-- Entry: R0 = blksize of dataset to be allocated | |
| *-- Exit: CC=0 if no volume selected | |
| *-- CC<>0 if volume selected, and, | |
| *-- TVOLSER,DEVINFO fields are filled in. | |
| * | |
| *-- Uses R15-R3 | |
| * | |
| GETVOL EQU * | |
| LA R1,DISKS -> dasd characteristics table | |
| USING DASDTAB,R1 | |
| * | |
| GETV010 EQU * | |
| SR R3,R3 Clear for ICM | |
| L R2,16 -> CVT | |
| USING CVT,R2 | |
| L R2,CVTILK2 -> UCB Lookup table | |
| * | |
| GETV020 EQU * | |
| LA R2,2(,R2) -> first table entry | |
| * | |
| CLC 0(2,R2),=X'FFFF' End of UCBs? | |
| BE GETV030 Y | |
| ICM R3,3,0(R2) -> UCB | |
| BZ GETV020 Skip empty table slot | |
| USING IEFUCBOB,R3 | |
| TM UCBSTAT,UCBONLI Is device online? | |
| BZ GETV020 N, next UCB | |
| TM UCBTBYT3,UCB3DACC Direct access device? | |
| BZ GETV020 N, next UCB | |
| CLC UCBTBYT4,DASDTYPE Preferred device type? | |
| BNE GETV020 N, next UCB | |
| TM UCBSTAB,UCBBPUB PUBLIC volume? | |
| BZ GETV020 N | |
| LA R15,DASDSIZE -> full track size for device | |
| CLC DASDHTRK,=AL2(0) Is a half-track blksize avail? | |
| BE *+8 No | |
| LA R15,DASDHTRK Yes, use 1/2 track for device | |
| CLM R0,3,0(R15) Will file blksize fit? | |
| BH GETV030 Too large, get another dasd type | |
| * | |
| ST R1,DEVINFO Save ptr to selected dev type | |
| * UCBNAME contains C'cuu' | |
| MVC TVOLSER,UCBVOLI Save selected volser to text unit | |
| CLI *,1 Set CC to non zero | |
| BR R14 | |
| * | |
| GETV030 EQU * | |
| LA R1,DASDLEN(,R1) Next DASD device preference | |
| CLI 0(R1),X'FF' End of DASD table? | |
| BER R14 Y, no suitable unit found, cc=0 | |
| B GETV010 Search again | |
| DROP R3 IEFUCBOB | |
| DROP R2 CVT v200 | |
| DROP R1 DASDTAB | |
| * | |
| *-- Find a volser in the UCBs so we can get its devtype (cant use v200 | |
| *-- DEVTYPE because it is not allocated yet) and determine its v200 | |
| *-- maximum track size. v200 | |
| * | |
| *-- Entry: R1 -> CL'volser' to be located v200 | |
| *-- Exit: CC=0 if the volser was not found v200 | |
| *-- CC<>0 if volume found; and R15 = track size in bytes v200 | |
| * | |
| *-- Uses R15-R3 v200 | |
| * | |
| FNDVOL EQU * v200 | |
| SR R3,R3 Clear for ICM v200 | |
| L R2,16 -> CVT v200 | |
| USING CVT,R2 v200 | |
| L R2,CVTILK2 -> UCB Lookup table v200 | |
| DROP R2 CVT v200 | |
| * | |
| FNDV020 EQU * v200 | |
| LA R2,2(,R2) -> first table entry v200 | |
| * v200 | |
| CLC 0(2,R2),=X'FFFF' End of UCBs? v200 | |
| BE FNDV090 Y v200 | |
| ICM R3,3,0(R2) -> UCB v200 | |
| BZ FNDV020 Skip empty table slot v200 | |
| USING IEFUCBOB,R3 v200 | |
| TM UCBSTAT,UCBONLI Is device online? v200 | |
| BZ FNDV020 N, next UCB v200 | |
| TM UCBTBYT3,UCB3DACC Direct access device? v200 | |
| BZ FNDV020 N, next UCB v200 | |
| CLC UCBVOLI,0(R1) Selected volser? v200 | |
| BNE FNDV020 No, next UCB v200 | |
| * | |
| LA R1,DISKS -> dasd characteristics table v200 | |
| USING DASDTAB,R1 v200 | |
| * | |
| FNDV030 EQU * v200 | |
| CLI 0(R1),X'FF' End of DASD types? v200 | |
| BE FNDV090 Cant match volser vs devtype v200 | |
| * | |
| CLC UCBTBYT4,DASDTYPE Match the device type? v200 | |
| BE FNDV080 Yes v200 | |
| LA R1,DASDLEN(,R1) Next DASD device in table v200 | |
| B FNDV030 Look again v200 | |
| * | |
| FNDV080 EQU * v200 | |
| SR R15,R15 Clear for IC v200 | |
| ICM R15,3,DASDSIZE Get full track size for device v200 | |
| CLI *,1 Set CC to non zero v200 | |
| * | |
| FNDV090 EQU * v200 | |
| BR R14 Return w CC=0 or CC<>0 v200 | |
| DROP R3 IEFUCBOB v200 | |
| DROP R1 DASDTAB v200 | |
| * | |
| * | |
| *-- Format VSAM NETSPOOL errors | |
| * | |
| * | |
| FMT000 EQU * | |
| STM R14,R2,PARSA+12 Borrow NJEPAR save area | |
| LA R15,0(,R14) Clear high, Get addr of call to this rtn | |
| L R2,NJESA+4 -> system provided FSA | |
| L R2,16(,R2) Get R15's entry point addr | |
| LA R2,0(,R2) Ensure high byte clear | |
| SR R15,R2 Compute offset of call | |
| MVC LIST+0(4+L'MSG024T),MSG024 Move msg text | |
| MVC LIST+55(8),5(R2) Move csect name | |
| TRT LIST+55(9),BLANK Look for end of csect name | |
| MVI 0(R1),C'+' | |
| * | |
| ST R15,DBLE Save call offset to work area | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC 1(4,R1),TWRK Move call offset to msg | |
| * | |
| LA R15,NCB1 | |
| UNPK TWRK(5),NCBRTNCD-NCB(3,R15) Add zones | |
| TR TWRK(4),HEXTRAN-240 | |
| MVC LIST+35(4),TWRK Move rtncd/errcd | |
| * | |
| UNPK TWRK(3),NCBREQ-NCB(2,R15) Add zones | |
| TR TWRK(2),HEXTRAN-240 | |
| MVC LIST+45(2),TWRK Move req code | |
| * | |
| L R1,NCBMACAD-NCB(,R15) Get failing VSAM macro addr | |
| LA R1,0(,R1) Clear high byte | |
| S R1,=V(NJESPOOL) Compute offset into NJESPOOL rtn | |
| ST R1,DBLE | |
| UNPK TWRK(5),DBLE+2(3) Add zones | |
| TR TWRK(4),HEXTRAN-240 Display hex | |
| MVC LIST+50(4),TWRK Move NJESPOOL offset to msg | |
| * | |
| LA R2,LIST | |
| BAL R14,PUTLINE | |
| * | |
| FMT090 EQU * | |
| LM R14,R2,PARSA+12 Restore caller regs | |
| BR R14 Return | |
| * | |
| *-- Write a single line to terminal | |
| * | |
| *-- Entry: R2 -> output msg (RDW+msg text) | |
| *-- Exit: R15 = RC from PUTLINE | |
| * | |
| PUTLINE EQU * | |
| TM FLAGS3,F3QUIET QUIET mode enabled? | |
| BZ PUT010 No, proceed | |
| CLI 3(R2),1 Suppress this msg in QUIET mode? | |
| BER R14 Yes | |
| * | |
| PUT010 EQU * | |
| ST R14,SV14LN Save return | |
| XC PUTECB,PUTECB Clear PUTLINE ECB | |
| L R15,CPARMS -> command input CPPL | |
| USING CPPL,R15 | |
| LA R1,IOPLAREA -> IOPL | |
| USING IOPL,R1 | |
| MVC IOPLUPT,CPPLUPT Set UPT ptr | |
| MVC IOPLECT,CPPLECT Set ECT ptr | |
| DROP R15 CPPL | |
| * | |
| MVC TWRK(PBL),PB Move macro model | |
| PUTLINE PARM=TWRK, Write a line x | |
| ECB=PUTECB, x | |
| OUTPUT=((R2),TERM,SINGLE,DATA), x | |
| MF=(E,(1)) | |
| DROP R1 IOPL | |
| L R14,SV14LN Load return | |
| BR R14 | |
| * | |
| * | |
| *-- Write a single line to terminal and prompt for response | |
| * | |
| *-- Entry: OLDMSGAD points to output message | |
| *-- Exit: R15 = RC from PUTGET | |
| *-- PGPBIBUF -> input data (if any) | |
| * | |
| PUTGET EQU * | |
| ST R14,SV14LN Save return | |
| XC PUTECB,PUTECB | |
| L R15,CPARMS -> command input CPPL | |
| USING CPPL,R15 | |
| LA R1,IOPLAREA -> IOPL | |
| USING IOPL,R1 | |
| MVC IOPLUPT,CPPLUPT Set UPT ptr | |
| MVC IOPLECT,CPPLECT Set ECT ptr | |
| DROP R15 CPPL | |
| * | |
| MVC MACLIST(PGTL),PGT move macro model | |
| PUTGET PARM=MACLIST, x | |
| ECB=PUTECB, x | |
| OUTPUT=(OLD,SINGLE,PROMPT), x | |
| TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK), x | |
| TERMGET=(EDIT,WAIT), x | |
| MF=(E,(1)) | |
| DROP R1 IOPL | |
| * | |
| LA R5,MACLIST | |
| USING PGPB,R5 | |
| L R1,PGPBIBUF -> input buffer acquired | |
| DROP R5 | |
| L R14,SV14LN Load return | |
| BR R14 | |
| * | |
| *-- Get status of NJE38 | |
| * | |
| *-- Entry: R1=0 (no spool dsn needed), or, R1-> 44-char spool DSN area | |
| *-- Exit: RC=0 NJE38 is active; R1-> NJE38 CSA block | |
| *-- RC<>0 NJE is not active. | |
| * | |
| CHK000 EQU * | |
| LA R1,TDSNAME => where to place spool DSN v210 | |
| L R15,=V(NJESYS) -> ENQ finder v210 | |
| BALR R14,R15 Check if NJE38 already act v210 | |
| LTR R15,R15 Set CC (RC=0 NJE38 active) v210 | |
| BNZR R2 Return if NJE38 inactive v210 | |
| MVC LCLNODE,NJ38NODE-NJ38CSA(R1) Save off lcl node namev210 | |
| MVC DEFUSER,NJ38DUSR-NJ38CSA(R1) Save off default user v210 | |
| BR R2 Return; NJE38 active v210 | |
| * | |
| LTORG | |
| * | |
| PB PUTLINE MF=L | |
| PBL EQU *-PB | |
| PGT PUTGET MF=L | |
| PGTL EQU *-PGT | |
| * | |
| NJE38Q DC CL8'NJE38' QNAME | |
| NJERCON DC CL8'NJEINIT' RNAME (first 8 bytes) | |
| * | |
| * | |
| * | |
| BLANKS DC CL136' ' v200 | |
| NONBLANK DC 64X'FF',X'00',191X'FF' TR Table to locate nonblank | |
| BLANK DC 64X'00',X'FF',191X'00' TR Table to locate blanks | |
| DOTS DC 75X'00',X'FF',180X'00' TR Table to locate '.' char | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * | |
| *-- RECEIVE messages | |
| * | |
| *-- Note: a '1' after the length indicates suppress this msg if QUIET | |
| * | |
| MSGBLNK DC Y(4+L'MSGBLNKT,1) | |
| MSGBLNKT DC C' ' | |
| * | |
| MSG000 DC Y(4+L'MSG000T,1) | |
| MSG000T DC C'NJE38 RECEIVE &VERS' | |
| * | |
| MSG001 DC Y(4+L'MSG001T,0) | |
| MSG001T DC C'Error parsing RECEIVE command parameters. IKJPARS RC=yx | |
| y (dec)' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| MSG002 DC Y(4+L'MSG002T,0) | |
| MSG002T DC C' ' UNUSED - AVAILABLE | |
| * | |
| MSG003 DC Y(4+L'MSG003T,0) | |
| MSG003T DC C'Invalid or unsupported NETDATA detected; error code x,* | |
| record ' | |
| * | |
| MSG004 DC Y(4+L'MSG004T,0) | |
| MSG004T DC C'Member xxxxxxxx was not found' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| * | |
| MSG005 DC Y(4+L'MSG005T,0) | |
| MSG005T DC C'Unexpected end of file encountered reading ' | |
| * | |
| MSG006 DC Y(4+L'MSG006T,0) | |
| MSG006T DC C'The RECEIVE command is not APF-authorized' | |
| * | |
| MSG007 DC Y(4+L'MSG007T,0) | |
| MSG007T DC C'I/O error reading ' | |
| * | |
| MSG008 DC Y(4+L'MSG008T,0) | |
| MSG008T DC C'Specified INDATASET does not contain NETDATA formattedx | |
| records' | |
| * | |
| MSG009 DC Y(4+L'MSG009T,0) | |
| MSG009T DC C'Specified INDATASET must be LRECL=80, RECFM=F or FB' | |
| * | |
| MSG010 DC Y(4+L'MSG010T,0) | |
| MSG010T DC C'No files are available to receive' | |
| * | |
| MSG011 DC Y(4+L'MSG011T,0) | |
| MSG011T DC C'Specified file number does not exist' | |
| * | |
| MSG012 DC Y(4+44+L'MSG012T,0) | |
| MSG012T DC C'Allocation error xxxxxxxx, DSN=' | |
| * | |
| MSG013 DC Y(4+L'MSG013T,0) | |
| MSG013T DC C'NJE38 is not active' | |
| * | |
| MSG014 DC Y(4+L'MSG014T,1) | |
| MSG014T DC C'Receiving ' | |
| * | |
| MSG015 DC Y(4+L'MSG015T,1) | |
| MSG015T DC C' Enter receive parameters or ''PURGE'' or ''END'' +' | |
| * | |
| MSG016 DC Y(4+L'MSG016T,0) | |
| MSG016T DC C'Cannot receive file destined for another user' | |
| * | |
| MSG017 DC Y(4+L'MSG017T,1) | |
| MSG017T DC C'Receive into ' | |
| * | |
| MSG018 DC Y(4+L'MSG018T,0) | |
| MSG018T DC C'Receive failed due to IEBCOPY RC=xx' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| * | |
| MSG019 DC Y(4+L'MSG019T,0) | |
| MSG019T DC C'RECEIVE ended with no action taken' | |
| * | |
| MSG020 DC Y(4+L'MSG020T,1) | |
| MSG020T DC C' Enter receive parameters or ''END'' +' | |
| * | |
| MSG021 DC Y(4+L'MSG021T,0) | |
| MSG021T DC C'Member name ignored' | |
| * | |
| MSG022 DC Y(4+L'MSG022T,0) | |
| MSG022T DC C'No suitable PUBLIC volume found that can contain this x | |
| dataset' | |
| * | |
| MSG023 DC Y(4+L'MSG023T,0) | |
| MSG023T DC C'The BLKSIZE or LRECL of the received file exceeds the x | |
| 32760-byte MVS limit' | |
| * | |
| MSG024 DC Y(4+L'MSG024T,0) | |
| MSG024T DC C'ERROR: NETSPOOL RTNCD/ERRCD=X''0000'',REQ=01,O=1234,Mx | |
| MMMMMMM ' | |
| * | |
| MSG025 DC Y(4+L'MSG025T,0) | |
| MSG025T DC C'Unable to open NETSPOOL. Run IDCAMS VERIFY against thex | |
| NETSPOOL dataset' | |
| * | |
| MSG026 DC Y(4+L'MSG026T,0) | |
| MSG026T DC C'Error in terminal prompt message. PUTGET RC=yy (dec)' | |
| * 456789012345678901234567890123456789012345678901234567 | |
| * | |
| MSG027 DC Y(4+L'MSG027T,0) | |
| MSG027T DC C' exists' | |
| * | |
| MSG028 DC Y(4+L'MSG028T,1) | |
| MSG028T DC C'File(xxxx) purged from NJE38 spool' | |
| * | |
| MSG029 DC Y(4+L'MSG029T,0) | |
| MSG029T DC C'RECEIVE ended without receiving anything' | |
| * | |
| MSG030 DC Y(4+L'MSG030T,0) | |
| MSG030T DC C'RECEIVE halted; unsupported message text (INMTEXT) detx | |
| ected' | |
| * | |
| MSG031 DC Y(4+L'MSG031T,0) | |
| MSG031T DC C' does not exist' | |
| * | |
| MSG032 DC Y(4+L'MSG032T,0) | |
| MSG032T DC C'Access to the NETSPOOL dataset denied due to security x | |
| settings' | |
| * | |
| MSG033 DC Y(4+L'MSG033T,0) v200 | |
| MSG033T DC C'Volume unavailable or conflicting with specified UNIT x | |
| name' v200 | |
| * | |
| MSG034 DC Y(4+L'MSG034T,0) v200 | |
| MSG034T DC C'The specified UNIT name is not defined in the system' x | |
| v200 | |
| * | |
| MSG035 DC Y(4+L'MSG035T,0) v200 | |
| MSG035T DC C'Incoming file is a PDSE Program Library which cannot bx | |
| e supported' v200 | |
| * | |
| MSG036 DC Y(4+L'MSG036T,0) v200 | |
| MSG036T DC C'The selected volume is not online' v200 | |
| * | |
| MSG037 DC Y(4+L'MSG037T,0) v200 | |
| MSG037T DC C'The incoming file block size is too large to fit on thx | |
| e selected volume' v200 | |
| * | |
| MSG038 DC Y(4+L'MSG038T,0) v222 | |
| MSG038T DC C'The incoming file contains logical records that exceedx | |
| the LRECL of the dataset' v222 | |
| * NJE00250 | |
| * NJE00250 | |
| * DASD Characteristics in order of selection preference NJE00250 | |
| * NJE00250 | |
| * NOTE: 3380 DASD exist in this table twice. The reason for NJE00250 | |
| * this is to allow a better identification of the DASD NJE00250 | |
| * type required by "GETVOL" based on the received file's NJE00250 | |
| * BLKSIZE. The file could be half-track blocked, so we NJE00250 | |
| * need to account for that in selecting a device type. NJE00250 | |
| * However, the file could be using a BLKSIZE that is NJE00250 | |
| * larger than the half track size despite the inefficiency. NJE00250 | |
| * For these cases, the last 3380 entry does not have NJE00250 | |
| * a half-track size value, allowing the GETVOL search to | |
| * succeed using the full track size which would accomodate | |
| * any MVS BLKSIZE that could be received. | |
| * | |
| * NJE00250 | |
| DISKS EQU * TYP CYLS TRKS BYTES 1/2-TRK | |
| DC X'0E',AL2(885),AL1(15),AL2(47476),AL2(23476) 3380 A/D/J | |
| DC X'0B',AL2(555),AL1(30),AL2(19069),AL2(0) 3350 | |
| DC X'0C',AL2(959),AL1(12),AL2(35616),AL2(17600) 3375 | |
| DC X'0F',AL2(1113),AL1(15),AL2(56664),AL2(27998) 3390-1 | |
| DC X'0D',AL2(808),AL1(19),AL2(13030),AL2(0) 3330-11 | |
| DC X'09',AL2(404),AL1(19),AL2(13030),AL2(0) 3330-1 | |
| DC X'0A',AL2(696),AL1(12),AL2(8368),AL2(0) 3340-70 | |
| DC X'08',AL2(200),AL1(20),AL2(7294),AL2(0) 2314 | |
| DC X'0E',AL2(885),AL1(15),AL2(47476),AL2(0) 3380 A/D/J | |
| DC X'FF' End of table | |
| * NJE00250 | |
| DASDTAB DSECT | |
| DASDTYPE DS X Dasd UCB device type code | |
| DASDCYLS DS AL2 Number of cylinders | |
| DASDTRKS DS AL1 Number of tracks | |
| DASDSIZE DS AL2 Bytes per track | |
| DASDHTRK DS AL2 Bytes per half-track block or 0 | |
| DASDLEN EQU *-DASDTAB Size of one DASDTAB entry | |
| * | |
| * NJE00250 | |
| ********************* | |
| * N J E N O T * NJENOT tells the user the chosen | |
| * * DSN of the file and prompts for | |
| * User notify and * changes | |
| * prompt * | |
| * * | |
| ********************* | |
| * | |
| * | |
| NJENOT CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJENOT' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJENOT,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,NOTSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R2,NOTSA -> my save area | |
| ST R2,8(,R13) Plug it into prior SA | |
| LR R13,R2 | |
| * | |
| NOT000 EQU * | |
| BAL R14,BDS000 Build final dataset name | |
| BAL R14,NTF000 Build notification msg | |
| * | |
| TM FLAGS2,F2FEND END forced previously? | |
| BO XITNOT04 Force 'END' again | |
| * | |
| LA R2,LIST -> MSG014 receiving dataset... | |
| BAL R14,PUTLINE Notify user | |
| * | |
| TM FLAGS1,F1BATCH Are we in BATCH mode? | |
| BO NOT090 Yes, special handling | |
| TM FLAGS3,F3NPRMPT Are we in NOPROMPT mode? | |
| BO NOT090 Yes, special handling | |
| * | |
| LA R1,MSG015 -> enter parameters prompt | |
| TM FLAGS3,F3INDS Was INDATASET specified? | |
| BZ NOT010 No | |
| LA R1,MSG020 Use MSG020 if INDS in use | |
| * | |
| NOT010 EQU * | |
| ST R1,OLDMSGAD Set it in the OLD | |
| BAL R14,PUTGET Prompt the user | |
| C R15,=F'8' PUTGET ECB posted (attn recv'd)? | |
| BE XITNOT04 Yes, treat as 'END' specified | |
| LTR R0,R15 PUTGET RC to R0 | |
| BNZ XITNOT16 Exit if putget error | |
| * | |
| ST R1,OLDMSGAD Temp save of PUTGET input ptr | |
| LA R0,4 Code 4: use prompt parameters | |
| * R1 -> PUTGET input buffer | |
| L R15,=A(NJEPAR) -> parse routine | |
| BALR R14,R15 | |
| LR R5,R15 Any errors to R5 | |
| * | |
| TM FLAGS4,F4ATTN Was ATTN pressed? v201 | |
| BO XITNOT04 Y, immediate exit v201 | |
| * | |
| L R1,OLDMSGAD -> PUTGET input buffer | |
| LH R0,0(,R1) Get length of area | |
| O R0,=X'01000000' Set SP=1 | |
| FREEMAIN R,LV=(0),A=(1) Free the PUTGET msg buffer | |
| * | |
| LTR R0,R5 Now put IKJPARS RC in R0 | |
| BNZ XITNOT12 Display IJKPARS RC | |
| TM FLAGS4,F4END Was END specified? | |
| BO XITNOT04 Exit if END | |
| TM FLAGS4,F4PURGE Was PURGE specified? | |
| BO XITNOT08 Exit if PURGE | |
| B XITNOT00 | |
| * | |
| *-- If running BATCH, allow one trip through here to exit cleanly | |
| *-- to simulate pressing "enter" with no parameters. On all | |
| *-- subsquent calls to NJENOT, F2END will be set (if BATCH) so | |
| *-- we can force END in order to prevent looping in batch. | |
| * | |
| NOT090 EQU * | |
| OI FLAGS2,F2FEND Indic force END from now on | |
| B XITNOT00 Allow null prompt this time | |
| * | |
| *-- Build DSN | |
| * | |
| *-- DSN Strategy: The DSN from the NETDATA will be extracted and | |
| *-- the first qualifer eliminated, unless the DSN is only one | |
| *-- qualifier. Then, the remaining part of that DSN will be appended | |
| *-- to the receiving user's userid (the userid will be the new | |
| *-- first qualifier. | |
| * | |
| *-- If the incoming file is a flat file (not NETDATA) the DSNAME is | |
| *-- manufactured from the filename and filetype fields of the TAG data. | |
| * | |
| *-- If DATASET was specified on the command line (F3DS=1) then we | |
| *-- will attempt to use that as is and exit the build DS routine. | |
| * | |
| BDS000 EQU * | |
| TM FLAGS3,F3DS Is final dataset already set? | |
| BOR R14 Exit if we already have it | |
| MVC FINALDS,BLANKS Init | |
| MVC FINALDS(8),USERID Move userid | |
| TM FLAGS2,F2FLAT Is incoming file a flat file? | |
| BO BDS020 Yes, use tag data | |
| * | |
| LA R7,INMF02A -> first INMR02 results | |
| USING INMFIELD,R7 | |
| * | |
| SR R4,R4 Clear for IC | |
| ICM R4,3,DSNAME Get NETDATA DSN length | |
| LA R1,DSNAME+2 Assume DSN has 1 qualifier | |
| TRT DSNAME+2(10),DOTS Look for end of 1st qualifier | |
| BZ BDS010 Branch if only 1 qualifier | |
| LA R1,1(,R1) Skip the delim after 1st qualifr | |
| LR R0,R1 Copy position | |
| LA R2,DSNAME+2 Start of DSN | |
| SR R0,R2 Compute length we are skipping | |
| SR R4,R0 Reduce remaining DSN length | |
| * | |
| BDS010 EQU * | |
| LR R3,R1 Save start of NETDATA DSN | |
| TRT FINALDS(9),BLANK Look for end of userid | |
| MVI 0(R1),C'.' Add delimiter | |
| LA R1,1(,R1) -> next available byte | |
| LA R2,FINALDS -> start of userid | |
| LR R0,R1 Copy next available byte addr | |
| SR R0,R2 Compute userid. length | |
| LA R15,43 Total DSN length -1 for execute | |
| SR R15,R0 Compute remaining available | |
| CR R15,R4 Use lesser remaining length | |
| BL *+6 Br if TDSNAME length is less | |
| LR R15,R4 No, NETDATA DSN len is less | |
| EX R15,MVCDSN Move the rest of it | |
| *MVCDSN MVC 0(0,R1),0(R3) | |
| CLI FINALDS+43,C'.' Last char of DSN is a delim? | |
| BNER R14 No | |
| MVI FINALDS+43,C' ' Blank it out | |
| DROP R7 INMFIELD | |
| BR R14 Return | |
| * | |
| BDS020 EQU * | |
| LA R4,TAGDATA -> Spool file's tag data | |
| USING TAG,R4 | |
| * | |
| LA R1,FINALDS -> final dsname area | |
| TRT 0(9,R1),BLANK Look for end of userid | |
| MVI 0(R1),C'.' Add delimiter | |
| LA R1,1(,R1) -> next available byte | |
| MVC 0(8,R1),TAGNAME Insert tag's file name | |
| TRT 0(9,R1),BLANK Find the end of it | |
| MVI 0(R1),C'.' Add delimiter | |
| LA R1,1(,R1) -> next available byte | |
| MVC 0(8,R1),TAGTYPE Insert tag's file name | |
| DROP R4 TAG | |
| BR R14 Return | |
| * | |
| * | |
| MVCDSN MVC 0(0,R1),0(R3) executed instr | |
| * | |
| * | |
| *-- Build msg containing incoming dataset name from the netdata | |
| * | |
| NTF000 EQU * | |
| MVC LIST,BLANKS | |
| MVC LIST(4+L'MSG014T),MSG014 'Receiving ...' | |
| LA R1,LIST+4+L'MSG014T -> next available byte | |
| MVI 0(R1),C'''' Move apost | |
| LA R1,1(,R1) Next byte | |
| * | |
| TM FLAGS2,F2FLAT Is incoming file a flat file? | |
| BO NTF020 Yes, use tag data | |
| * | |
| LA R7,INMF02A -> First INMR02 data | |
| USING INMFIELD,R7 | |
| MVC 0(44,R1),DSNAME+2 Move incoming DSN | |
| TRT 0(45,R1),BLANK Look for end of DSN | |
| MVI 0(R1),C'''' Move apost | |
| LA R1,2(,R1) -> skip over apost + 1 blank | |
| MVC 0(4,R1),=C'from' | |
| LA R1,5(,R1) -> where to put node id | |
| LA R7,INMF01 -> INMR01 data | |
| USING INMFIELD,R7 | |
| MVC 0(8,R1),FNODE+2 Move from node name | |
| TRT 0(9,R1),BLANK Look for end of nodeid | |
| MVI 0(R1),C'(' Insert ( | |
| MVC 1(8,R1),FUSER+2 Move from user name | |
| DROP R7 INMFIELD | |
| TRT 1(9,R1),BLANK Look for end of userid | |
| MVI 0(R1),C')' Insert ) | |
| LA R1,1(,R1) -> end of msg | |
| LA R0,LIST -> start of msg | |
| ST R0,OLDMSGAD Set msg ptr | |
| SR R1,R0 Compute length of msg | |
| STH R1,LIST Set length of msg for PUTGET | |
| BR R14 Return | |
| * | |
| *-- Build msg containing incoming dataset name from the tag data | |
| * | |
| NTF020 EQU * | |
| LA R4,TAGDATA -> Spool file's tag data | |
| USING TAG,R4 | |
| * | |
| MVC 0(8,R1),TAGNAME Insert tag's file name | |
| TRT 0(9,R1),BLANK Find the end of it | |
| LA R1,1(,R1) -> next available byte | |
| MVC 0(8,R1),TAGTYPE Insert tag's file name | |
| TRT 0(9,R1),BLANK Find the end of it | |
| MVI 0(R1),C'''' Move apost | |
| LA R1,2(,R1) -> skip over apost + 1 blank | |
| MVC 0(4,R1),=C'from' | |
| LA R1,5(,R1) -> where to put node id | |
| MVC 0(8,R1),TAGINLOC Move from node name | |
| TRT 0(9,R1),BLANK Look for end of nodeid | |
| MVI 0(R1),C'(' Insert ( | |
| MVC 1(8,R1),TAGINVM Move from user name | |
| DROP R4 TAG | |
| TRT 1(9,R1),BLANK Look for end of userid | |
| MVI 0(R1),C')' Insert ) | |
| LA R1,1(,R1) -> end of msg | |
| LA R0,LIST -> start of msg | |
| ST R0,OLDMSGAD Set msg ptr | |
| SR R1,R0 Compute length of msg | |
| STH R1,LIST Set length of msg for PUTGET | |
| BR R14 Return | |
| * | |
| *-- Exit | |
| * | |
| XITNOT00 EQU * | |
| SR R0,R0 Set secondary RC=0; | |
| SR R15,R15 Set RC=0; normal | |
| B XITNOT | |
| * | |
| XITNOT04 EQU * | |
| SR R0,R0 Set secondary RC=0; | |
| LA R15,4 Set RC=4; END specified | |
| B XITNOT | |
| * | |
| XITNOT08 EQU * | |
| SR R0,R0 Set secondary RC=0; | |
| LA R15,8 Set RC=8; PURGE specified | |
| B XITNOT | |
| * | |
| XITNOT12 EQU * | |
| LA R15,12 Set RC=12; secondary is IKJPARS RC | |
| B XITNOT | |
| * | |
| XITNOT16 EQU * | |
| LA R15,16 Set RC=16; secondary is PUTGET RC | |
| * | |
| XITNOT EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| L R14,12(,R13) Load r14 | |
| LM R1,R12,24(R13) Reload callers regs | |
| BR R14 Return with RCs in R0/R15 | |
| * | |
| LTORG | |
| * NJE00250 | |
| * NJE00250 | |
| ********************* | |
| * N J E D Y N * NJEDYN handles the various | |
| * * dynamic allocations required | |
| * Handle DYNALLOC * and their unallocations as well. | |
| * * | |
| ********************* | |
| * | |
| USING INMFIELD,R7 -> R7 at entry | |
| * | |
| NJEDYN CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDYN' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJEDYN,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,DYNSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,DYNSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC LS99RB,CPS99RB init THE S99RB | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| ST R1,LS99PTR Set parameter word | |
| OI LS99PTR,X'80' Set VL | |
| LA R6,TXTPTRS -> start of text unit list | |
| ST R6,S99TXTPP Put in S99RB | |
| DROP R1 S99RB | |
| * | |
| UNDYN EQU 0 00 unallocate DDNAME | |
| DYNINMCP EQU 4 04 Allocate INMCOPY dataset | |
| DYNSYSIN EQU 8 08 Allocate SYSIN for IEBCOPY | |
| DYNSYSPR EQU 12 0C Allocate SYSPRINT for IEBCOPY | |
| DYNFINAL EQU 16 10 Allocate final dataset IEBCOPY | |
| DYNSYSU3 EQU 20 14 Allocate SYSUT3 IEBCOPY | |
| DYNINDS EQU 24 18 Allocate INDATASET | |
| DYNETSPL EQU 28 1C Allocate NETSPOOL | |
| * | |
| LR R5,R0 Copy action code | |
| B DYN000(R5) Branch into table | |
| * | |
| DYN000 B DYN010 00 Perform DDNAME Unallocation | |
| B DYN100 04 Allocate INMCOPY dataset | |
| B DYN200 08 Allocate SYSIN for IEBCOPY | |
| B DYN300 0C Allocate SYSPRINT for IEBCOPY | |
| B DYN400 10 Allocate final dataset IEBCOPY | |
| B DYN500 14 Allocate SYSUT3 IEBCOPY | |
| B DYN600 18 Allocate INDATASET | |
| B DYN700 1C Allocate NETSPOOL | |
| * | |
| DYN010 EQU * | |
| MVC UTXT,UTXTD Init text unit | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| MVI S99VERB,S99VRBUN Set verb code to unallocation | |
| DROP R1 S99RB | |
| * | |
| LA R0,UTXT -> UNALLOC DD text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Deallocate the DD | |
| * | |
| *-- Dataset created for INMCOPY INMR02 control record | |
| * | |
| *-- If there is no DSN, this is a temporary 'unloaded pds' dataset and | |
| *-- no volser is used and can be allocated on a storage volume. | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,DELETE),UNIT=SYSDA, | |
| * // SPACE=(blk,(pri,sec)), | |
| * // DCB=(BLKSIZE=blk,LRECL=l,RECFM=f,DSORG=PS) | |
| * | |
| *-- If there is a DSN, then this is a final dataset, so use the | |
| *-- dsname text unit and place it on the volser of choise. | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,CATLG),UNIT=SYSDA, | |
| * // SPACE=(blk,(pri,sec)), | |
| * // DCB=(BLKSIZE=blk,LRECL=l,RECFM=f,DSORG=PS), | |
| * // DSN=dsname,VOL=SER=volser | |
| * | |
| DYN100 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT04,TXT04D | |
| MVC TXT05,TXT05D | |
| MVC TXT06,TXT06D | |
| MVC TXT07,TXT07D | |
| MVC TXT09,TXT09D | |
| MVC TXT10,TXT10D | |
| MVC TXT12,TXT12D | |
| MVC TXT13,TXT13D | |
| MVC TXT14,TXT14D | |
| MVC TXT15,TXT15D | |
| * | |
| LA R0,TXT01 -> Return DDNAME text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP text unit 1 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP text unit 2 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT12 -> BLKSIZE text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT05 -> BLKLEN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT14 -> LRECL text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT15 -> RECFM text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> PRIMARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT07 -> SECONDARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> DSORG text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| CLC DSNAME(2),=AL2(0) Was there a DSN? | |
| BNE DYN120 Yes, plug DSN & VOL text unit | |
| MVI TXT04+6,X'04' No, its a temp; set DISP=,DELETE | |
| *v223 B DYN190 Then skip DSN text unit v200 | |
| B DYN130 Process remaining txt units v223 | |
| * | |
| DYN120 EQU * | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN130 EQU * v223 | |
| TM FLAGS2,F2UNIT Was UNIT specified? v200 | |
| BZ DYN170 No, leave default v200 | |
| MVC TUNIT,USRUNIT Set user's unit name v200 | |
| TM FLAGS3,F3VOLSER Did user specify VOLSER? v200 | |
| BO DYN170 Yes, use what he coded v200 | |
| TM FLAGS4,F4VOLSER Did user specify VOLSER? v200 | |
| BO DYN170 Yes, use what he coded v200 | |
| B DYN190 UNIT without VOLSER specif'dv200 | |
| * | |
| DYN170 EQU * Use specified VOL or GETVOL v200 | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT09 -> VOLSER text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN190 EQU * v200 | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- SYSIN for IEBCOPY | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DUMMY | |
| * | |
| * | |
| DYN200 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT16,TXT16D | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT16 -> DUMMY | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- SYSPRINT for IEBCOPY | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD SYSOUT=*,TERM=TS | |
| * | |
| DYN300 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT16,TXT16D | |
| MVC TXT17,TXT17D | |
| MVC TXT18,TXT18D | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| TM FLAGS3,F3QUIET QUIET mode enabled? | |
| BO DYN310 Yes, use DUMMY | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT17 -> SYSOUT=* | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT18 -> TERM=TS | |
| ST R0,0(,R6) Plug into ptr list | |
| B DYN320 | |
| * | |
| DYN310 EQU * | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT16 -> DUMMY | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN320 EQU * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Final dataset that IEBCOPY will load | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,CATLG),UNIT=SYSDA, | |
| * // SPACE=(blk,(pri,sec)), | |
| * // DCB=(BLKSIZE=blk,LRECL=l,RECFM=f,DSORG=PO), | |
| * // DSN=dsname,VOL=SER=volser | |
| * | |
| DYN400 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT04,TXT04D | |
| MVC TXT05,TXT05D | |
| MVC TXT06,TXT06D | |
| MVC TXT07,TXT07D | |
| MVC TXT08,TXT08D | |
| MVC TXT09,TXT09D | |
| MVC TXT10,TXT10D | |
| MVC TXT12,TXT12D | |
| MVC TXT13,TXT13D | |
| MVC TXT14,TXT14D | |
| MVC TXT15,TXT15D | |
| * | |
| LA R0,TXT01 -> Return DDNAME text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP text unit 1 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP text unit 2 | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT12 -> BLKSIZE text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT05 -> BLKLEN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT14 -> LRECL text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT15 -> RECFM text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> PRIMARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT07 -> SECONDARY text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT08 -> DIRECTORY BLOCKS text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> DSORG text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSN text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot v200 | |
| LA R0,TXT10 -> UNIT text unit v200 | |
| ST R0,0(,R6) Plug into ptr list v200 | |
| * | |
| TM FLAGS2,F2UNIT Was UNIT specified? v200 | |
| BZ DYN470 No, leave default v200 | |
| MVC TUNIT,USRUNIT Set user's unit name v200 | |
| TM FLAGS3,F3VOLSER Did user specify VOLSER? v200 | |
| BO DYN470 Yes, use what he coded v200 | |
| TM FLAGS4,F4VOLSER Did user specify VOLSER? v200 | |
| BO DYN470 Yes, use what he coded v223 | |
| B DYN490 UNIT without VOLSER specif'dv200 | |
| * | |
| DYN470 EQU * Use specified VOL or GETVOL v200 | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT09 -> VOLSER text unit | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN490 EQU * v200 | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- SYSUT3 for IEBCOPY | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=(NEW,DELETE),UNIT=SYSDA, | |
| * // SPACE=(CYL,5) | |
| * | |
| DYN500 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT03,TXT03D DISP 1 | |
| MVC TXT04,TXT04D DISP 2 | |
| MVC TXT06,TXT06D PRIME | |
| MVC TXT10,TXT10D UNIT | |
| MVC TXT19,TXT19D CYL | |
| * | |
| MVI TXT04+6,X'04' Adjust to DISP=,DELETE | |
| MVC TXT06+6(3),=XL3'05' 5 cylinders | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=NEW | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT04 -> DISP=,DELETE | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT06 -> Primary space | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT10 -> UNIT | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT19 -> SPACE CYL | |
| ST R0,0(,R6) Plug into ptr list | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Dataset INDATASET | |
| * | |
| * Equivalent JCL: | |
| * //SYS00000 DD DISP=SHR,DSNAME=indataset | |
| * | |
| DYN600 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| MVC TXT13,TXT13D | |
| * | |
| MVI TXT03+6,X'08' set DISP=SHR | |
| MVC TXT13(2),=Y(DALRTORG) set RETURN DSORG | |
| * | |
| LA R0,TXT01 -> return DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=SHR | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT13 -> DSORG | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| DYN610 EQU * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Dataset NETSPOOL | |
| * | |
| * Equivalent JCL: | |
| * //NETSPOOL DD DISP=SHR,DSNAME=NJE38.NETSPOOL | |
| * | |
| * | |
| DYN700 EQU * | |
| MVC TXT01,TXT01D Init from the models | |
| MVC TXT02,TXT02D | |
| MVC TXT03,TXT03D | |
| * | |
| MVC TXT01(2),=Y(DALDDNAM) Use fixed DD | |
| MVI TXT03+6,X'08' set DISP=SHR | |
| * | |
| LA R0,TXT01 -> DDNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT03 -> DISP=SHR | |
| ST R0,0(,R6) Plug into ptr list | |
| LA R6,4(,R6) -> next ptr list slot | |
| LA R0,TXT02 -> DSNAME | |
| ST R0,0(,R6) Plug into ptr list | |
| * | |
| OI 0(R6),X'80' End the parameter list | |
| B DYN900 Go allocate | |
| * | |
| *-- Allocate the dataset | |
| * | |
| DYN900 EQU * | |
| LA R1,LS99RB -> S99RB | |
| USING S99RB,R1 | |
| OI S99FLAG1,S99NOCNV FORCE NEW ALLOCATION | |
| DROP R1 | |
| LA R1,LS99PTR POINTER TO S99 PTR | |
| SVC 99 ISSUE DYNALLOC | |
| LTR R15,R15 Any errors? | |
| BZ XITDYN00 No | |
| * | |
| LA R1,LS99RB | |
| USING S99RB,R1 | |
| UNPK TWRK(9),S99ERROR(5) Add zones to error code | |
| L R4,S99ERROR Error code in R4 for later v200 | |
| DROP R1 | |
| TR TWRK(8),HEXTRAN-240 | |
| CLI TWRK+1,C'7' Class 7 error code? | |
| BNE ERR012 No | |
| LA R1,DYNINMCP Code for the INMCOPY dataset? | |
| CR R1,R5 Was alloc for DYNINMCP? | |
| BE ERR027 Yes, dataset exists | |
| LA R1,DYNFINAL Code for the final dataset? | |
| CR R1,R5 Was alloc for DYNFINAL? | |
| BE ERR027 Yes, dataset exists | |
| LA R1,DYNINDS Code for the INDATASET? | |
| CR R1,R5 Was alloc for DYNINDS? | |
| BE ERR031 Yes, dataset does not exist | |
| * | |
| ERR012 EQU * | |
| MVC LIST(4+L'MSG012T),MSG012 Dyn alloc failure msg | |
| MVC LIST+21(8),TWRK Error codes to line | |
| MVC LIST+35(44),TDSNAME Move DSNAME | |
| LA R2,LIST -> msg | |
| BAL R14,PUTLINE Display it | |
| CLM R4,12,=X'0218' volume conflict/invalid? v200 | |
| BE ERR033 Yes v200 | |
| CLM R4,12,=X'021C' Unit undefined? v200 | |
| BE ERR034 Yes v200 | |
| B XITDYN08 General allocation failure | |
| * | |
| ERR027 EQU * | |
| MVC LIST,BLANKS | |
| MVC LIST+4(9),=C'Dataset ''' | |
| MVC LIST+13(44),TDSNAME Move name | |
| TRT LIST+13(45),BLANK Look for end of name | |
| MVI 0(R1),C'''' Close apost | |
| LA R1,1(,R1) Skip apost | |
| MVC 0(L'MSG027T,R1),MSG027T Move rest of msg | |
| LA R1,L'MSG027T(,R1) point to end | |
| XC LIST(4),LIST Clear RDW area | |
| LA R2,LIST -> start of RDW+msg | |
| SR R1,R2 Compute total length | |
| STH R1,LIST Plug RDW | |
| BAL R14,PUTLINE Inform user | |
| B XITDYN04 And exit with dataset exists | |
| * | |
| ERR031 EQU * | |
| MVC LIST,BLANKS | |
| MVC LIST+4(9),=C'Dataset ''' | |
| MVC LIST+13(44),TDSNAME Move name | |
| TRT LIST+13(45),BLANK Look for end of name | |
| MVI 0(R1),C'''' Close apost | |
| LA R1,1(,R1) Skip apost | |
| MVC 0(L'MSG031T,R1),MSG031T Move rest of msg | |
| LA R1,L'MSG031T(,R1) point to end | |
| XC LIST(4),LIST Clear RDW area | |
| LA R2,LIST -> start of RDW+msg | |
| SR R1,R2 Compute total length | |
| STH R1,LIST Plug RDW | |
| BAL R14,PUTLINE Inform user | |
| B XITDYN04 And exit with dataset doesnt exist | |
| * | |
| ERR033 EQU * v200 | |
| LA R2,MSG033 -> msg (inv unit/volser combo) v200 | |
| BAL R14,PUTLINE Display it v200 | |
| B XITDYN08 v200 | |
| * | |
| ERR034 EQU * v200 | |
| LA R2,MSG034 -> msg (undefined unit) v200 | |
| BAL R14,PUTLINE Display it v200 | |
| B XITDYN08 v200 | |
| * | |
| * | |
| *-- Exit | |
| * | |
| XITDYN00 EQU * | |
| SR R15,R15 Set RC=0; alloc/dealloc ok | |
| B XITDYN | |
| * | |
| XITDYN04 EQU * | |
| LA R15,4 Set RC=4; Exit for special action | |
| B XITDYN | |
| * | |
| XITDYN08 EQU * | |
| LA R15,8 Set RC=8; allocation error | |
| * | |
| XITDYN EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| ST R15,16(,R13) Set RC | |
| LM R14,R12,12(R13) Reload callers regs | |
| BR R14 Return with RC | |
| * | |
| LTORG | |
| DROP R7 INMFIELD | |
| * | |
| * | |
| * | |
| *-- Text unit skeletons | |
| * | |
| *-- Note: EXPDT is included for completeness but is not used. | |
| * | |
| * | |
| * | |
| TXT01D DC Y(DALRTDDN),AL2(1),AL2(8) RETURN DDNAME | |
| TXT02D DC Y(DALDSNAM),AL2(1),AL2(44) DSNAME | |
| TXT03D DC Y(DALSTATS),AL2(1),AL2(1),X'04' DISP=(NEW,) | |
| TXT04D DC Y(DALNDISP),AL2(1),AL2(1),X'02' DISP=(,CATLG) | |
| TXT05D DC Y(DALBLKLN),AL2(1),AL2(3) BLK TEXT KEY, BLKLEN | |
| TXT06D DC Y(DALPRIME),AL2(1),AL2(3) PRIMARY SPACE UNITS | |
| TXT07D DC Y(DALSECND),AL2(1),AL2(3) SECONDARY SPACE UNITS | |
| TXT08D DC Y(DALDIR),AL2(1),AL2(3) DIRECTORY BLOCKS | |
| TXT09D DC Y(DALVLSER),AL2(1),AL2(6) VOLSER | |
| TXT10D DC Y(DALUNIT),AL2(1),AL2(8),CL8'SYSDA' UNIT default v200 | |
| TXT11D DC Y(DALEXPDT),AL2(1),AL2(5) EXPDT C'YYDDD' | |
| TXT12D DC Y(DALBLKSZ),AL2(1),AL2(2) BLKSIZE | |
| TXT13D DC Y(DALDSORG),AL2(1),AL2(2) DSORG | |
| TXT14D DC Y(DALLRECL),AL2(1),AL2(2) LRECL | |
| TXT15D DC Y(DALRECFM),AL2(1),AL2(1) RECFM | |
| TXT16D DC Y(DALDUMMY),AL2(0) DUMMY | |
| TXT17D DC Y(DALSYSOU),AL2(0) SYSOUT | |
| TXT18D DC Y(DALTERM),AL2(0) TERM | |
| TXT19D DC Y(DALCYL),AL2(0) CYLINDER | |
| TXT20D DC Y(DALCLOSE),AL2(0) FREE=CLOSE | |
| * | |
| UTXTD DC Y(DUNDDNAM),AL2(1),AL2(8) DD for deallocation | |
| * | |
| DS 0F | |
| CPS99RB DS 0XL20 DEFINE INITIAL S99RB | |
| DC AL1(20) LENGTH OF REQ BLOCK | |
| DC AL1(1) VERB CODE: ALLOCATION | |
| DC X'20' FLAGS: NO MOUNTS,OFFLINE VOLS | |
| DC X'00' FLAGS | |
| DC AL2(0) ERROR REASON CODE | |
| DC AL2(0) INFO REASON CODE | |
| DC A(0) ADDR OF TEXT PTRS | |
| DC A(0) ADDR OF RBX | |
| DC AL4(0) MORE FLAGS | |
| * NJE00250 | |
| * NJE00250 | |
| ********************* | |
| * N J E N E T * NJENET determines if NETDATA | |
| * * exists in a spool file and | |
| * Examine NETDATA * examines the INMR02 control | |
| * * record for attributes | |
| ********************* | |
| * | |
| NJENET CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJENET' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJENET,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,NETSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NETSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| LR R15,R0 Copy action code | |
| B FUNC000(R15) Branch into table | |
| * | |
| FUNC000 B PINIT000 00 Process initial ctl records | |
| B PDATA000 04 Process netdata records | |
| B PFLAT000 08 Process flat records | |
| * | |
| *-- Find INMR01 record NET00060 | |
| * NET00060 | |
| PINIT000 EQU * | |
| LA R0,2 # of bytes to get NET00070 | |
| BAL R14,GETBYTES Get length and desc of segment NET00080 | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| * NET00090 | |
| CLI CTL,X'E0' Valid 1st control rec indic?v200 NET00100 | |
| BE PINIT010 Could be ok v200 NET00110 | |
| CLI CTL,X'A0' Valid 1st control rec indic?v200 NET00100 | |
| BNE XITNET04 No, its not NETDATA v200 NET00110 | |
| * NET00120 | |
| PINIT010 EQU * v200 | |
| L R2,GBRPS -> phys record position v200 | |
| CLC 0(6,R2),INMR01 Peek ahead. INMR01? v200 | |
| BNE XITNET04 No, its not NETDATA v200 | |
| * | |
| SR R0,R0 NET00130 | |
| IC R0,0(,R1) Get segment length byte NET00140 | |
| S R0,=F'2' Less 2 we already retrieved NET00150 | |
| LR R3,R0 Copy length of control record NET00300 | |
| BAL R14,GETBYTES Get control record NET00160 | |
| * NET00170 | |
| CLC 0(6,R1),INMR01 NETDATA? NET00180 | |
| BNE XITNET04 Not NETDATA NET00190 | |
| * | |
| LA R15,6 Len of "INMR01" NET00360 | |
| AR R1,R15 Skip over that field NET00370 | |
| LA R9,INMF01 -> area to hold INMR01 fields | |
| USING INMFIELD,R9 | |
| BAL R14,CTL000 Go parse control record | |
| OI FLAGS1,F1INMR01 Indicate fields processed | |
| * | |
| *-- Find INMR02 record NET00060 | |
| * NET00200 | |
| FINMR02 EQU * | |
| LA R0,2 # of bytes to get NET00210 | |
| BAL R14,GETBYTES Get length and desc of segment NET00220 | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| * NET00090 | |
| LA R0,CODE1 Control record not indicated | |
| TM CTL,X'20' Is this a control record? NET00100 | |
| BZ XITNET08 No, invalid NETDATA NET00110 | |
| * NET00260 | |
| SR R0,R0 NET00270 | |
| IC R0,0(,R1) Get segment length byte NET00280 | |
| S R0,=F'2' Less 2 we already retrieved NET00290 | |
| LR R3,R0 Copy length of control record NET00300 | |
| BAL R14,GETBYTES Get control record NET00310 | |
| * NET00320 | |
| LA R0,CODE2 INMR02 record not detected | |
| CLC 0(6,R1),INMR02 NETDATA? NET00330 | |
| BNE XITNET08 invalid NETDATA NET00190 | |
| * NET00350 | |
| LA R15,10 Len of "INMR02"+file number word NET00360 | |
| AR R1,R15 Skip over those fields NET00370 | |
| LA R9,INMF02A -> area to hold INMR02 fields | |
| BAL R14,CTL000 Go parse control record | |
| TM FLAGS2,F2TERM Was a TERM text unit key found? | |
| BO XITNET20 Y, unsupported | |
| OI FLAGS1,F1INMR2A Indicate fields processed | |
| * | |
| *-- Find INMR02 or INMR03 record NET00060 | |
| * NET00200 | |
| LA R0,2 # of bytes to get NET00210 | |
| BAL R14,GETBYTES Get length and desc of segment NET00220 | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| * NET00090 | |
| LA R0,CODE3 Control record not indicated | |
| TM CTL,X'20' Is this a control record? NET00100 | |
| BZ XITNET08 No, invalid NETDATA NET00110 | |
| * NET00260 | |
| SR R0,R0 NET00270 | |
| IC R0,0(,R1) Get segment length byte NET00280 | |
| S R0,=F'2' Less 2 we already retrieved NET00290 | |
| LR R3,R0 Copy length of control record NET00300 | |
| BAL R14,GETBYTES Get control record NET00310 | |
| * NET00320 | |
| CLC 0(6,R1),INMR03 Is it INMR03? NET00330 | |
| BE IR03 Yes, go there NET00190 | |
| LA R0,CODE4 INMR02 record not detected | |
| CLC 0(6,R1),INMR02 Is it INMR02? NET00330 | |
| BNE XITNET08 Something wrong; inval NETDATA NET00190 | |
| * NET00350 | |
| LA R15,10 Len of "INMR02"+file number word NET00360 | |
| AR R1,R15 Skip over those fields NET00370 | |
| LA R9,INMF02B -> area to hold INMR02 fields | |
| BAL R14,CTL000 Go parse control record | |
| TM FLAGS2,F2TERM Was a TERM text unit key found? | |
| BO XITNET20 Y, unsupported | |
| OI FLAGS1,F1INMR2B Indicate fields processed | |
| * | |
| *-- Find INMR03 record NET00060 | |
| * NET00200 | |
| FINMR03 EQU * | |
| LA R0,2 # of bytes to get NET00210 | |
| BAL R14,GETBYTES Get length and desc of segment NET00220 | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| * NET00090 | |
| LA R0,CODE5 INMR03 ctl rec not indicated | |
| TM CTL,X'20' Is this a control record? NET00100 | |
| BZ XITNET08 No, invalid NETDATA NET00110 | |
| * NET00260 | |
| SR R0,R0 NET00270 | |
| IC R0,0(,R1) Get segment length byte NET00280 | |
| S R0,=F'2' Less 2 we already retrieved NET00290 | |
| LR R3,R0 Copy length of control record NET00300 | |
| BAL R14,GETBYTES Get control record NET00310 | |
| * NET00320 | |
| LA R0,CODE6 INMR03 record not detected | |
| CLC 0(6,R1),INMR03 Is it INMR03? NET00330 | |
| BNE XITNET08 Something wrong; invalid NETDATA NET00190 | |
| * NET00350 | |
| IR03 EQU * | |
| LA R15,6 Len of "INMR03" NET00360 | |
| AR R1,R15 Skip over those fields NET00370 | |
| LA R9,INMF03 -> area to hold INMR02 fields | |
| BAL R14,CTL000 Go parse control record | |
| OI FLAGS1,F1INMR03 Indicate fields processed | |
| B XITNET00 Done | |
| * NET00380 | |
| *-- Parse the text unit keys from a control record NET00380 | |
| * NET00380 | |
| *-- Entry: R3 = length of entire control record NET00380 | |
| *-- R15= length of INMRxx header fields to skip over | |
| *-- Exit: Keys identified are parsed an in their respective fields NET00380 | |
| * NET00380 | |
| CTL000 EQU * NET00390 | |
| ST R14,SV14CTL Save return addr | |
| * | |
| CTL010 EQU * NET00390 | |
| LA R4,CTL010 Where to return with new segmnt | |
| SR R3,R15 Reduce remaining length NET00400 | |
| BNP CTL070 Done with control record segmnt NET00410 | |
| LA R7,INMKEYS -> text unit keys table | |
| * NET00420 | |
| *-- Look for supported keys NET00430 | |
| * NET00440 | |
| CTL020 EQU * NET00390 | |
| LA R0,CODE7 Inv/unrecognized NETDATA key | |
| CLI 0(R7),X'FF' End of table? | |
| BE XITNET08 Invalid NETDATA key | |
| * | |
| CLC 0(2,R1),0(R7) Look for matching key NET00450 | |
| BE CTL030 Got one NET00460 | |
| LA R7,KEYLEN(,R7) Bump to next in table | |
| B CTL020 Keep searching | |
| * | |
| CTL030 EQU * NET00390 | |
| ICM R15,15,2(R7) -> supporting rtn for key | |
| BNZR R15 Go there if rtn available | |
| * NET00610 | |
| *-- Skip over and ignore unsupported/unrecognized keys NET00620 | |
| * NET00630 | |
| CTL050 EQU * | |
| LA R1,2(,R1) Skip over unrecognized key NET00640 | |
| LA R15,2 Remaining length adjust NET00650 | |
| SR R0,R0 Clear for IC NET00660 | |
| ICM R0,3,0(R1) Get # value NET00670 | |
| LA R1,2(,R1) Skip over # value NET00680 | |
| LA R15,2(,R15) Remaining length adjust NET00690 | |
| BZ CTL010 # was 0; no lengths NET00700 | |
| * | |
| LA R4,CTL060 Where to return with new segmnt | |
| SR R3,R15 Reduce remaining length NET00400 | |
| BNP CTL070 Done with control record segmnt NET00410 | |
| * NET00720 | |
| CTL060 EQU * NET00730 | |
| SR R14,R14 Clear for ICM NET00710 | |
| ICM R14,3,0(R1) Get length field NET00740 | |
| LA R1,2(R14,R1) Skip over length and data NET00750 | |
| LA R15,2(R14,R15) Remaining length adjust NET00760 | |
| BCT R0,CTL060 Do next len/data field pair NET00770 | |
| B CTL010 Resume NET00780 | |
| * NET00720 | |
| *-- Here at end of segment or entire control record. NET00720 | |
| *-- We could also be here in the middle of a key (like INMMEMBR) and NET00720 | |
| *-- we need to return to the right place after getting the next | |
| *-- segment to continue on. | |
| * NET00720 | |
| CTL070 EQU * NET00730 | |
| TM CTL,X'40' Was that the final segment? | |
| BO CTL090 Yes, done with control record | |
| * | |
| *-- We need another control record segment | |
| * | |
| ST R0,SVR0CTL Save # value for keys in progres | |
| LA R0,2 # of bytes to get NET00070 | |
| BAL R14,GETBYTES Get length and desc of segment NET00080 | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| * NET00090 | |
| LA R0,CODE8 Ctl rec segment not detected | |
| TM CTL,X'20' Is this a control record? NET00100 | |
| BZ XITNET08 Bad...something wrong NET00110 | |
| * NET00120 | |
| SR R0,R0 NET00130 | |
| IC R0,0(,R1) Get segment length byte NET00140 | |
| S R0,=F'2' Less 2 we already retrieved NET00150 | |
| LR R3,R0 Copy length of ctl segment NET00300 | |
| BAL R14,GETBYTES Get control record segment NET00160 | |
| L R0,SVR0CTL Restore # value of the key | |
| SR R15,R15 Clear length adjustment | |
| BR R4 Return to CTL010 or CTL060 | |
| * NET00720 | |
| CTL090 EQU * NET00730 | |
| L R14,SV14CTL Load return addr | |
| BR R14 Done with control record | |
| * NET00790 | |
| *-- Handle keys we dont support. NET00800 | |
| *-- We look for INMTERM in order to bail out if present. | |
| *-- This is generated by modern TRANSMIT with MSG. | |
| * | |
| TRM000 EQU * | |
| OI FLAGS2,F2TERM Indicate INMTERM discovered | |
| B CTL050 Ignore the text unit key | |
| * | |
| *-- Handle keys we support, as well as those that we will capture NET00800 | |
| *-- a value for but not do anything with it (example: creation date). | |
| * NET00810 | |
| *- Utility name NET00820 | |
| UTL000 EQU * Get utility name NET00830 | |
| MVC UTLNAME+2,BLANKS Init receiving field NET00840 | |
| LA R6,UTLNAME -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- File size NET00880 | |
| FSZ000 EQU * File size NET00890 | |
| LA R6,FILESIZE -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET00920 | |
| *- DSORG NET00930 | |
| DSG000 EQU * DSORG NET00940 | |
| LA R6,DSORG -> receiving field NET00950 | |
| BAL R14,KEY000 Go handle the key NET00960 | |
| B CTL010 Scan for next key | |
| *- BLKSIZE NET00970 | |
| BLK000 EQU * BLKSIZE NET00980 | |
| LA R6,BLKSIZE -> receiving field NET00990 | |
| BAL R14,KEY000 Go handle the key NET01000 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET01010 | |
| *- LRECL NET01020 | |
| LRL000 EQU * LRECL NET01030 | |
| LA R6,LRECL -> receiving field NET01040 | |
| BAL R14,KEY000 Go handle the key NET01050 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET01060 | |
| *- RECFM NET01070 | |
| RFM000 EQU * RECFM NET01080 | |
| LA R6,RECFM -> receiving field NET01090 | |
| BAL R14,KEY000 Go handle the key NET01100 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- # directory blocks NET00880 | |
| DIR000 EQU * File size NET00890 | |
| LA R6,DIRBLKS -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET01110 | |
| *- FFM NET01120 | |
| FFM000 EQU * File mode number NET01130 | |
| LA R6,FFM -> receiving field NET01140 | |
| BAL R14,KEY000 Go handle the key NET01150 | |
| B CTL010 Scan for next key | |
| * | |
| *- Origin timestamp NET00820 | |
| FTM000 EQU * NET00830 | |
| MVC FTIME+2,BLANKS Init receiving field NET00840 | |
| LA R6,FTIME -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Origin node NET00820 | |
| FND000 EQU * Get origin node NET00830 | |
| MVC FNODE+2,BLANKS Init receiving field NET00840 | |
| LA R6,FNODE -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Origin userid NET00820 | |
| FUS000 EQU * Get origin userid NET00830 | |
| MVC FUSER+2,BLANKS Init receiving field NET00840 | |
| LA R6,FUSER -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- To node NET00820 | |
| TND000 EQU * Get destination node NET00830 | |
| MVC TNODE+2,BLANKS Init receiving field NET00840 | |
| LA R6,TNODE -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- To userid NET00820 | |
| TUS000 EQU * Get destination userid NET00830 | |
| MVC TUSER+2,BLANKS Init receiving field NET00840 | |
| LA R6,TUSER -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Version NET00820 | |
| VER000 EQU * Get Version info NET00830 | |
| MVC FVERS+2,BLANKS Init receiving field NET00840 | |
| LA R6,FVERS -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * | |
| *- Creation date NET00820 | |
| CRE000 EQU * NET00830 | |
| MVC CREATE+2,BLANKS Init receiving field NET00840 | |
| LA R6,CREATE -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- DDNAME NET00820 | |
| DDN000 EQU * NET00830 | |
| MVC DDNAME+2,BLANKS Init receiving field NET00840 | |
| LA R6,DDNAME -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Extended attribute NET00820 | |
| ATR000 EQU * NET00830 | |
| LA R6,EATTR -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- RECEIVE error code NET00820 | |
| ECD000 EQU * NET00830 | |
| LA R6,ERRCD -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Expiration date NET00820 | |
| EXP000 EQU * NET00830 | |
| MVC EXPDT+2,BLANKS Init receiving field NET00840 | |
| LA R6,EXPDT -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Last changed date NET00820 | |
| LCH000 EQU * NET00830 | |
| MVC LCHG+2,BLANKS Init receiving field NET00840 | |
| LA R6,LCHG -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * | |
| *- Last referenced date NET00820 | |
| LRF000 EQU * NET00830 | |
| MVC LREF+2,BLANKS Init receiving field NET00840 | |
| LA R6,LREF -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- Size in megabytes NET00880 | |
| LSZ000 EQU * File size in MB NET00890 | |
| LA R6,LSIZE -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- Number of files NET00880 | |
| NMF000 EQU * File size in MB NET00890 | |
| LA R6,NUMF -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- Record count NET00880 | |
| RCT000 EQU * NET00890 | |
| LA R6,RECCT -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| BAL R14,ADJ000 Right justify the value NET00910 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- Secondary space NET00880 | |
| SEC000 EQU * NET00890 | |
| LA R6,SECND -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| B CTL010 Scan for next key | |
| * | |
| *- Destination timestamp NET00820 | |
| TTM000 EQU * NET00830 | |
| MVC TTIME+2,BLANKS Init receiving field NET00840 | |
| LA R6,TTIME -> receiving field NET00850 | |
| BAL R14,KEY000 Go handle the key NET00860 | |
| B CTL010 Scan for next key | |
| * NET00870 | |
| *- Dataset Type NET00880 | |
| TYP000 EQU * Data set type NET00890 | |
| LA R6,DSTYPE -> receiving field NET00900 | |
| BAL R14,KEY000 Go handle the key NET00910 | |
| B CTL010 Scan for next key | |
| * NET01160 | |
| * NET01160 | |
| *- DSNAME NET01170 | |
| DSN000 EQU * DSNAME NET01180 | |
| MVC DSNAME+2,BLANKS Init receiving field NET01190 | |
| LA R6,DSNAME+2 -> receiving field NET01200 | |
| LA R1,2(,R1) Skip over key NET01210 | |
| LA R15,2 Remaining length adjust NET01220 | |
| SR R0,R0 Clear for IC NET01230 | |
| ICM R0,3,0(R1) Get # value NET01240 | |
| LA R1,2(,R1) Skip over # value NET01250 | |
| LA R15,2(,R15) Remaining length adjust NET01260 | |
| BZ CTL010 # was 0; no lengths NET01270 | |
| SR R14,R14 Clear for ICM NET01280 | |
| * NET01290 | |
| DSN020 EQU * NET01300 | |
| ICM R14,3,0(R1) Get length field NET01310 | |
| BCT R14,DSN030 Adjust for execute NET01320 | |
| MVC 0(0,R6),2(R1) executed instr NET01330 | |
| DSN030 EX R14,*-6 Move name to receiving field NET01340 | |
| LA R1,3(R14,R1) Skip over length and data NET01350 | |
| LA R15,3(R14,R15) Remaining length adjust NET01360 | |
| LA R6,1(R14,R6) Bump to next qualifier area NET01370 | |
| MVI 0(R6),C'.' Add qualifier dot | |
| LA R6,1(,R6) -> next qualifier area | |
| BCT R0,DSN020 Do next len/data field pair NET01380 | |
| BCTR R6,0 -> last byte of DSNAME NET01390 | |
| MVI 0(R6),C' ' Remove trailing dot | |
| BCTR R6,0 -> prior to trailing '.' NET01390 | |
| LA R0,DSNAME+2 -> start of DSNAME NET01400 | |
| SR R6,R0 Compute final DSN length NET01410 | |
| STCM R6,3,DSNAME Save it NET01420 | |
| B CTL010 get next key NET01430 | |
| * NET01440 | |
| *-- Common routine to break part key/#/len/data elements that have #=1 NET01450 | |
| * NET01460 | |
| KEY000 EQU * NET01470 | |
| LA R1,4(,R1) Skip over key, # NET01480 | |
| LA R15,4 Remaining length accum NET01490 | |
| SR R5,R5 Clear for IC NET01500 | |
| ICM R5,3,0(R1) Get length of name NET01510 | |
| STCM R5,3,0(R6) Store actual len in result fld | |
| BZR R14 If no length, done with key | |
| BCT R5,KEY010 Adjust for execute NET01520 | |
| MVC 2(0,R6),2(R1) executed instr NET01530 | |
| KEY010 EX R5,*-6 Move name to receiving field NET01540 | |
| LA R1,3(R5,R1) -> next text unit key NET01550 | |
| LA R15,3(R5,R15) Accum length adjustment NET01560 | |
| BR R14 Return NET01570 | |
| * | |
| *-- Common routine right justify numeric fields of numeric text units NET01450 | |
| * NET01460 | |
| ADJ000 EQU * | |
| LA R8,8 Max length of value | |
| LH R0,0(,R6) Get length from NETDATA key | |
| SR R8,R0 Compute # bytes of shift | |
| BZR R14 No justification required | |
| SLA R8,3 Turn # bytes into # bits | |
| LM R4,R5,2(R6) Get numeric field | |
| SRDL R4,0(R8) Right justify the number | |
| STM R4,R5,2(R6) Put back justified numeric value | |
| BR R14 | |
| * | |
| DROP R9 INMFIELD | |
| * | |
| * | |
| *-- Process data records | |
| * | |
| *-- NOTE! We are using PUT LOCATE mode here, which offers the | |
| *-- flexibility to accomodate RECFM=VS and VBS records when | |
| *-- combined with DCB=BFTEK=A. This can be confusing looking | |
| *-- as it seems the PUT is issued and then the record is built. | |
| *-- However, the PUT is actually writing the previous record | |
| *-- and the last record is written by CLOSE, all per the IBM | |
| *-- data management specification. | |
| * | |
| *-- NOTE! RECFM=U processing requires the length of the record | |
| *-- be stored in DCBLRECL prior to the PUT LOCATE being issued. | |
| *-- But we don't know the length of the record yet, because it | |
| *-- is coming in from the NETDATA in segments. So, we have to | |
| *-- unfortunately use a separate buffer to accumulate the | |
| *-- segments and when complete obtain the total length to | |
| *-- store into DCBLRECL. Then we can issue the PUT. Then | |
| *-- we have to move the data from our segment accumulation | |
| *-- buffer into the PUT LOCATE buffer. Note though, that | |
| *-- if we used PUT MOVE for RECFM=U, the system would | |
| *-- move our data out of the segment buffer; so either way | |
| *-- the data is moved an extra time. | |
| * | |
| PDATA000 EQU * | |
| LA R0,2 # of bytes to get NET00210 | |
| BAL R14,GETBYTES Get length and desc of segment NET00220 | |
| * NET00230 | |
| TM 1(R1),X'20' Is this a control record? NET00240 | |
| BO PDATA100 Yes NET00110 | |
| * | |
| MVC CTL,1(R1) Save copy of descriptor byte | |
| SR R0,R0 NET00130 | |
| IC R0,0(,R1) Get segment length byte NET00140 | |
| S R0,=F'2' Less 2 we already retrieved NET00150 | |
| LR R3,R0 Copy length of segment NET00300 | |
| BAL R14,GETBYTES Get a segment NET00160 | |
| LR R4,R1 Copy segment ptr | |
| * | |
| *-- Determine type of record segment | |
| * | |
| TM CTL,X'C0' C0 Complete record? | |
| BO CMP000 Yes | |
| TM CTL,X'80' 80 1st record of segment? | |
| BO FST000 Yes | |
| TM CTL,X'40' 40 last record of segment? | |
| BO LST000 Yes | |
| * | |
| *-- Middle segment | |
| * | |
| MID000 EQU * 00 Handle middle segment | |
| L R1,RBPOS -> next available buffer byte | |
| LR R0,R1 Copy next available ptr v222 | |
| S R0,RBUFF Compute len used so far v222 | |
| AR R0,R3 Add len of next segment v222 | |
| CH R0,NEWDS+(DCBLRECL-IHADCB) will segment fit in buff?v222 | |
| BH XITNET24 No. record too large v222 | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segement data | |
| LA R1,1(R3,R1) -> next available byte | |
| ST R1,RBPOS Save record position | |
| B PDATA000 Go get some more | |
| * | |
| *-- Complete segment (an entire record) | |
| * | |
| CMP000 EQU * | |
| TM TRECFM,X'C0' Using undefined format? | |
| BO CMPU100 Yes | |
| * | |
| PUT NEWDS Write R1 buffer and get new one | |
| * | |
| TM TRECFM,X'40' Using variable format? | |
| BO CMP010 Yes | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| B PDATA000 Go get some more | |
| * | |
| CMP010 EQU * | |
| LA R0,4(,R3) Copy record length + 4 | |
| SLL R0,16 Make RDW = LLZZ | |
| STCM R0,15,0(R1) Plug in RDW | |
| LA R1,4(,R1) Skip over RDW | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| B PDATA000 Go get some more | |
| * | |
| CMPU100 EQU * ** Here if RECFM=U only | |
| STH R3,NEWDS+(DCBLRECL-IHADCB) Set len of output recrd | |
| PUT NEWDS Write R1 buffer and get new one | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| B PDATA000 Go get some more | |
| * | |
| MVCSEG MVC 0(0,R1),0(R4) executed instr | |
| * | |
| *-- First segment of a record | |
| * | |
| FST000 EQU * Handle first segment | |
| TM TRECFM,X'C0' Using undefined format? | |
| BO FSTU100 Yes | |
| * | |
| PUT NEWDS Write R1 buffer and get new one | |
| ST R1,RBUFF Save start addr of buffer | |
| * | |
| TM TRECFM,X'40' Variable records? | |
| BZ FST010 No | |
| LA R1,4(,R1) Leave space for RDW | |
| * | |
| FST010 EQU * | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| LA R1,1(R3,R1) -> next available byte | |
| ST R1,RBPOS Save record position | |
| B PDATA000 Go get some more | |
| * | |
| FSTU100 EQU * ** Here if RECFM=U only | |
| L R1,NEWBLK -> RECFM=U build buffer | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| LA R1,1(R3,R1) -> next available byte | |
| ST R1,RBPOS Save record position | |
| B PDATA000 Go get some more | |
| * | |
| *-- Last segment of a record | |
| * | |
| LST000 EQU * Handle last segment | |
| L R1,RBPOS -> next available buffer byte | |
| LR R0,R1 Copy next available ptr v222 | |
| S R0,RBUFF Compute len used so far v222 | |
| AR R0,R3 Add len of next segment v222 | |
| CH R0,NEWDS+(DCBLRECL-IHADCB) will segment fit in buff?v222 | |
| BH XITNET24 No. record too large v222 | |
| BCTR R3,0 Adjust for execute | |
| EX R3,MVCSEG Move segment data | |
| LA R1,1(R3,R1) -> next available byte | |
| * | |
| TM TRECFM,X'C0' Using undefined format? | |
| BO LSTU100 Yes | |
| * | |
| L R3,RBUFF -> record start | |
| TM TRECFM,X'40' Variable records? | |
| BZ LST010 No | |
| * | |
| SR R1,R3 Compute record length | |
| LA R0,CODE9 Assume bad segment length v200 | |
| CH R1,NEWDS+(DCBLRECL-IHADCB) Chk RDW against LRECL v200 | |
| BH XITNET08 It was v200 | |
| * | |
| SLL R1,16 Make RDW = LLZZ | |
| STCM R1,15,0(R3) Plug in RDW | |
| SRL R1,16 Make length | |
| * | |
| LST010 EQU * | |
| B PDATA000 Go get some more | |
| * | |
| LSTU100 EQU * ** Here if RECFM=U only | |
| L R2,NEWBLK -> RECFM=U record build area | |
| SR R1,R2 Compute record length | |
| STH R1,NEWDS+(DCBLRECL-IHADCB) Set len of output recrd | |
| LR R3,R1 Copy length to write | |
| * | |
| PUT NEWDS Write prv buffer and get new one | |
| LR R0,R1 -> PUT buffer to R0 | |
| LR R1,R3 Length of record | |
| MVCL R0,R2 Move to PUT LOCATE buffer | |
| B PDATA000 Go get some more | |
| * | |
| *-- Control record encountered in data stream | |
| * | |
| PDATA100 EQU * | |
| SR R0,R0 NET00130 | |
| IC R0,0(,R1) Get segment length byte NET00140 | |
| S R0,=F'2' Less 2 we already retrieved NET00150 | |
| LR R3,R0 Copy length of segment NET00300 | |
| BAL R14,GETBYTES Get a segment NET00160 | |
| * | |
| CLC 0(6,R1),INMR06 Is it INMR06? NET00330 | |
| BNE PDATA000 Ignore other control records | |
| B XITNET00 Done | |
| * | |
| *-- Process FLAT FILE not in NETDATA format | |
| * | |
| *-- We've already read the first spool record, in REC. | |
| *-- PUN files: just write 80 byte records. | |
| *-- PRT files: write 133 bytes, always convert to ASA carriage ctl; | |
| *-- the raw data over NJE is always M carriage ctl for PRT. | |
| * | |
| *-- Writing out to DCB NEWDS using MACRF=PL | |
| * | |
| * | |
| * | |
| PFLAT000 EQU * | |
| LA R6,TAGDATA | |
| USING TAG,R6 | |
| LA R4,X'40' Assume CC of space 1 | |
| B PFLAT030 1st record is already in REC | |
| * | |
| * | |
| *-- Retrieve the spool file records | |
| * | |
| PFLAT010 EQU * | |
| BAL R14,GET000 Get a record | |
| C R15,=F'4' EOF? | |
| BE XITNET00 Yes, were done | |
| LTR R15,R15 Any errors? | |
| BNZ XITNET16 Yes, deal with them | |
| * | |
| PFLAT030 EQU * | |
| TM TAGINDEV,TYPPUN Is this punch data? | |
| BO PFLAT180 Yes | |
| * | |
| *-- Output PRT records with RECFM=A carriage control | |
| * | |
| TM REC,X'03' Immediate cmd CC in record? | |
| BNO PFLAT070 No, this one is the data | |
| * | |
| LA R4,C'0' Space 2 lines | |
| CLI REC,X'13' Is CC character space 2 immed? | |
| BE PFLAT010 Yes | |
| LA R4,C'1' Skip to channel 1 | |
| CLI REC,X'8B' Is CC character ch 1 immed? | |
| BE PFLAT010 Yes | |
| LA R4,C'-' Space 3 lines | |
| CLI REC,X'1B' Is CC character space 3 immed? | |
| BE PFLAT010 Yes | |
| LA R4,C'+' Suppress space | |
| CLI REC,X'01' Is CC character write sup imd? | |
| BE PFLAT010 Yes | |
| LA R4,X'40' Otherwise use space 1 | |
| B PFLAT010 | |
| * | |
| PFLAT070 EQU * | |
| PUT NEWDS Write a line | |
| LR R5,R1 Get new buffer addr | |
| * | |
| STC R4,0(,R5) Set the CC byte | |
| LH R1,NCB1+(NCBRECLN-NCB) Get length of spool record | |
| BCTR R1,0 Less one to skip CC byte | |
| ICM R1,8,BLANKS Set pad char | |
| LA R0,REC+1 -> spool input record skipping | |
| * the M carriage control | |
| LA R14,1(,R5) Where to build output record | |
| LH R15,NEWDS+(DCBLRECL-IHADCB) get len of output recrd area | |
| BCTR R15,0 Less one to skip CC byte | |
| MVCL R14,R0 Move record and pad excess | |
| B PFLAT010 Process another line | |
| * | |
| *-- PUN records | |
| * | |
| PFLAT180 EQU * | |
| PUT NEWDS Write a line | |
| LR R5,R1 Get new buffer addr | |
| * | |
| LH R1,NCB1+(NCBRECLN-NCB) Get length of spool record | |
| ICM R1,8,BLANKS Set pad char | |
| LA R0,REC -> spool input record | |
| LR R14,R5 Where to build output record | |
| LH R15,NEWDS+(DCBLRECL-IHADCB) get len of output recrd area | |
| MVCL R14,R0 Move record and pad excess | |
| B PFLAT010 Process another line | |
| * | |
| * | |
| * NET01580 | |
| * NET01580 | |
| * NET01580 | |
| *-- Request some more bytes of NETDATA formatted data NET01590 | |
| * NET01590 | |
| *-- Entry: R0 = # of bytes requested (1-255) NET01590 | |
| *-- Exit: R1 -> string of bytes obtained NET01590 | |
| * NET01660 | |
| *-- Uses R0-R1,R5-R8,R14-R15; the caller's values in these NET01660 | |
| *-- registers are not preserved across this call. | |
| * NET01660 | |
| GETBYTES EQU * NET01670 | |
| ST R14,SV14GB Save return addr NET01680 | |
| L R5,GBREM Get # bytes remaining in rec buf NET01690 | |
| LA R1,BUFF Point to getbytes buffer NET01700 | |
| ST R1,GBPOS Set starting position NET01710 | |
| * | |
| L R8,GBRBA Get RBA of current position | |
| ST R8,GBPBA Save prior RBA | |
| AR R8,R0 Compute next RBA | |
| ST R8,GBRBA Update RBA if successful | |
| * | |
| LR R8,R0 Requested amount to R8 NET01720 | |
| * NET01730 | |
| * NET01740 | |
| GB010 EQU * NET01750 | |
| LTR R5,R5 Any bytes left in phy record? NET01760 | |
| BP GB040 Yes, use them first NET01770 | |
| * NET01780 | |
| BAL R14,GET000 Get a NETDATA record | |
| LTR R15,R15 Any errors? | |
| BNZ GB090 Yes, deal with them | |
| * R0-> length of record read NET01850 | |
| LR R5,R0 Num bytes read NET01840 | |
| ST R1,GBRPS Reset start of record position NET01880 | |
| * NET01890 | |
| GB040 EQU * NET01900 | |
| LR R7,R8 Assume requested amt avail NET01910 | |
| LR R15,R8 Same NET01920 | |
| * NET01930 | |
| CR R5,R8 Have more than we need? NET01940 | |
| BH GB050 Yes, just move requested NET01950 | |
| LR R7,R5 Else move what we have NET01960 | |
| LR R15,R5 Same NET01970 | |
| * NET01980 | |
| GB050 EQU * NET01990 | |
| LR R0,R7 Save copy of length to move NET02000 | |
| L R14,GBPOS -> GB buffer position NET02010 | |
| L R6,GBRPS -> input record curr position NET02020 | |
| MVCL R14,R6 Move NET02030 | |
| * NET02040 | |
| ST R14,GBPOS New GB position NET02050 | |
| ST R6,GBRPS New phys record curr position NET02060 | |
| * NET02070 | |
| SR R5,R0 Reduce bytes left in phy record NET02080 | |
| SR R8,R0 Reduce requested amt NET02090 | |
| BP GB010 We need more, go get it NET02100 | |
| * NET02110 | |
| ST R5,GBREM Remember whats left in phy rec NET02120 | |
| * NET02130 | |
| LA R1,BUFF Point to the requested bytes NET02140 | |
| L R14,SV14GB Load return addr NET02150 | |
| BR R14 Return from getbytes NET02160 | |
| * NET01980 | |
| GB090 EQU * NET01990 | |
| C R15,=F'4' End of file? | |
| BE XITNET12 Yes | |
| B XITNET16 I/O error | |
| * | |
| *-- Exit NETDATA processing | |
| * | |
| XITNET00 EQU * | |
| SR R15,R15 RC=0; NETDATA info filled | |
| B XITNET | |
| * | |
| XITNET04 EQU * | |
| LA R15,4 RC=4; File doesnt lead off w/NETDATA | |
| B XITNET | |
| * | |
| *-- Here if unexpected or unrecognized NETDATA sequences are found | |
| * | |
| *-- There are 8 places that could branch here; they are numbered 1-8 | |
| *-- in R0 to indicate how we arrived here "detection code". Used | |
| *-- with the input NETDATA record and byte number this code can | |
| *-- help to locate the offending error. | |
| * | |
| *-- The detection CODEx equates below describe the 8 tests | |
| * | |
| CODE1 EQU 1 Control record not indicated | |
| CODE2 EQU 2 INMR02 record not detected | |
| CODE3 EQU 3 Control record not indicated | |
| CODE4 EQU 4 INMR02 record not detected | |
| CODE5 EQU 5 INMR03 ctl rec not indicated | |
| CODE6 EQU 6 INMR03 record not detected | |
| CODE7 EQU 7 Inv/unrecognized NETDATA key | |
| CODE8 EQU 8 Ctl rec segment not detected | |
| CODE9 EQU 9 Incorrect segment lengths v200 | |
| * | |
| *-- Format error msg (MSG003): | |
| * | |
| *Invalid or unsupported NETDATA detected; error code x, record y byte z | |
| * | |
| *-- Note for debugging: the record and byte number displayed point | |
| *-- to the position in the original input at the point of the GETBYTES | |
| *-- call. The error may be at that exact byte or following it for | |
| *-- some reasonable amount (up to 255 bytes). For error codes 1-6 and | |
| *-- code 8, the rec/byte shown is very close and usually exact. For | |
| *-- code 7 errors there is an invalid or unknown text unit key and | |
| *-- the invalid key is somewhere after the rec/byte shown in the | |
| *-- next 255 bytes. | |
| * | |
| *-- For code 9, the record segment lengths exceeded the LRECL v200 | |
| *-- (variable length records only). v200 | |
| * | |
| XITNET08 EQU * | |
| LR R6,R0 Detection code to R6 | |
| * | |
| L R1,GBPBA Get RBA of prior GETBYTES call | |
| SR R0,R0 Clear for divide | |
| D R0,=F'80' Compute input record number | |
| LA R2,1 Load 1 | |
| AR R1,R2 Make record number relative to 1 | |
| AR R0,R2 Make byte number relative to 1 | |
| CVD R1,DBLE Convert | |
| MVC LIST(4+L'MSG003T),MSG003 Build msg | |
| MVC TWRK(12),=X'402020206B2020206B202120' Edit mask | |
| LA R1,TWRK+11 Start of significance | |
| EDMK TWRK(12),DBLE+3 Edit record count | |
| LA R2,TWRK+11 -> last digit of edited number | |
| SR R2,R1 Compute display length | |
| EX R2,MVREC Move edited number to line | |
| LA R1,LIST+67(R2) -> next available byte in line | |
| MVC 0(8,R1),=C' byte xx' | |
| * | |
| CVD R0,DBLE Convert byte position | |
| UNPK 6(2,R1),DBLE Fill in byte # | |
| OI 7(R1),X'F0' Fix sign | |
| * | |
| STC R6,LIST+56 Store detection code | |
| OI LIST+56,X'F0' Add a sign to make display | |
| * | |
| LA R1,8(,R1) Compute end of msg text | |
| LA R2,LIST -> start of msg | |
| SR R1,R2 Compute msg length RDW | |
| STH R1,LIST Set RDW | |
| * | |
| BAL R14,PUTLINE Notify user | |
| LA R15,8 RC=8; Invalid NETDATA detected | |
| B XITNET | |
| * | |
| *-- EOF on NETDATA | |
| XITNET12 EQU * | |
| LA R15,12 RC=12 unexpected EOF | |
| B XITNET | |
| * | |
| *-- Read error on NETDATA | |
| XITNET16 EQU * | |
| LA R15,16 RC=16 Read i/o error | |
| B XITNET | |
| * | |
| *-- INMTERM text unit key detected and it is unsupported | |
| XITNET20 EQU * | |
| LA R15,20 RC=20 INMTERM detected | |
| B XITNET | |
| * | |
| *-- Segmented record pieces are too large for LRECL and exceed v222 | |
| *-- the PUT record buffer v222 | |
| XITNET24 EQU * v222 | |
| LA R15,24 RC=24 record too large v222 | |
| B XITNET v222 | |
| * | |
| XITNET EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| ST R15,16(,R13) Set RC | |
| LM R14,R12,12(R13) Reload callers regs | |
| BR R14 Return with RC | |
| * | |
| MVREC MVC LIST+66(0),0(R1) executed instr | |
| * | |
| LTORG | |
| * NET02190 | |
| * NET02190 | |
| *- Control records that we look for and process (others ignored). NET02190 | |
| INMR01 DC C'INMR01' Header Control record NET02200 | |
| INMR02 DC C'INMR02' File Utility Control record NET02210 | |
| INMR03 DC C'INMR03' Data Control record NET02210 | |
| INMR06 DC C'INMR06' Trailer Control record NET02210 | |
| * NET02220 | |
| *- Keys NET02230 | |
| INMKEYS DS 0H | |
| INMBLKSZ DC X'0030',AL4(BLK000) Block size | |
| INMCREAT DC X'1022',AL4(CRE000) Creation date | |
| INMDDNAM DC X'0001',AL4(DDN000) DDNAME for the file | |
| INMDIR DC X'000C',AL4(DIR000) Number of directory blocks | |
| INMDSNAM DC X'0002',AL4(DSN000) Name of the file | |
| INMDSORG DC X'003C',AL4(DSG000) File organization | |
| INMEATTR DC X'8028',AL4(ATR000) Extended attribute status | |
| INMERRCD DC X'1027',AL4(ECD000) RECEIVE command error code | |
| INMEXPDT DC X'0022',AL4(EXP000) Expiration date | |
| INMFACK DC X'1026',AL4(0) NO SPT--Originator requested notificat'n | |
| INMFFM DC X'102D',AL4(FFM000) Filemode number | |
| INMFNODE DC X'1011',AL4(FND000) Origin node name or node number | |
| INMFTIME DC X'1024',AL4(FTM000) Origin timestamp | |
| INMFUID DC X'1012',AL4(FUS000) Origin user ID | |
| INMFVERS DC X'1023',AL4(VER000) Origin version num of the data | |
| INMLCHG DC X'1021',AL4(LCH000) Date last changed | |
| INMLRECL DC X'0042',AL4(LRL000) Logical record length | |
| INMLREF DC X'1020',AL4(LRF000) Date last referenced | |
| INMLSIZE DC X'8018',AL4(LSZ000) Data set size in megabytes. | |
| INMMEMBR DC X'0003',AL4(0) NO SPT--Member name list | |
| INMNUMF DC X'102F',AL4(NMF000) Number of files transmitted | |
| INMRECCT DC X'102A',AL4(RCT000) Transmitted record count | |
| INMRECFM DC X'0049',AL4(RFM000) Record format | |
| INMSECND DC X'000B',AL4(SEC000) Secondary space quantity | |
| INMSIZE DC X'102C',AL4(FSZ000) File size in bytes | |
| INMTERM DC X'0028',AL4(TRM000) Data transmitted as a message | |
| INMTNODE DC X'1001',AL4(TND000) Target node name or node number | |
| INMTTIME DC X'1025',AL4(TTM000) Destination timestamp | |
| INMTUID DC X'1002',AL4(TUS000) Target user ID | |
| INMTYPE DC X'8012',AL4(TYP000) Data set type | |
| INMUSERP DC X'1029',AL4(0) NO SPT--User parameter string | |
| INMUTILN DC X'1028',AL4(UTL000) Name of utility program | |
| DC X'FFFF' End of table | |
| KEYLEN EQU 6 Length of key/adcon pair | |
| * | |
| *-- Target fields from INMRxx control records that we recognize: | |
| * | |
| *-- Missing from the list and unsupported: | |
| *-- INMFACK 1-64 bytes, notification string from transmit | |
| *-- INMTERM 0 bytes, data was transmitted as a message | |
| *-- INMUSERP 1-251 bytes, user PARM field string from TRANSMIT/RECEIVE | |
| * | |
| INMFIELD DSECT | |
| UTLNAME DS 0XL8,XL2,CL8 Utility name NET02490 | |
| FILESIZE DS 0XL8,XL2,XL8 File size in bytes NET02500 | |
| DIRBLKS DS 0XL8,XL2,XL8 #directory blocks NET02500 | |
| BLKSIZE DS 0XL8,XL2,XL8 BLKSIZE NET02510 | |
| LRECL DS 0XL8,XL2,XL8 LRECL NET02520 | |
| RECFM DS 0XL2,XL2,XL2 RECFM NET02530 | |
| DSORG DS 0XL2,XL2,XL2 DSORG NET02540 | |
| FFM DS 0XL1,XL2,CL1 File mode number NET02550 | |
| DSNAME DS 0XL44,XL2,CL44 DSNAME NET02580 | |
| FTIME DS 0XL20,XL2,CL20 Origin time stamp NET02580 | |
| FNODE DS 0XL8,XL2,CL8 Origin node NET02580 | |
| FUSER DS 0XL8,XL2,CL8 Origin userid NET02580 | |
| TNODE DS 0XL8,XL2,CL8 Dest node NET02580 | |
| TUSER DS 0XL8,XL2,CL8 Dest userid NET02580 | |
| TTIME DS 0XL16,XL2,CL16 Destination time stamp NET02580 | |
| FVERS DS 0XL8,XL2,XL8 Version NET02580 | |
| DDNAME DS 0XL8,XL2,CL8 DDNAME NET02580 | |
| CREATE DS 0XL16,XL2,CL16 Creation date NET02580 | |
| EATTR DS 0XL1,XL2,CL1 Extended attributes NET02550 | |
| ERRCD DS 0XL1,XL2,CL1 Receive error code NET02550 | |
| EXPDT DS 0XL16,XL2,CL16 Expiration date NET02580 | |
| LCHG DS 0XL16,XL2,CL16 Last Changed date NET02580 | |
| LREF DS 0XL16,XL2,CL16 Last Referenced date NET02580 | |
| LSIZE DS 0XL4,XL2,XL4 Size of file in MB NET02580 | |
| MEMBR DS 0XL8,XL2,CL8 Member name list (1 supported) NET02580 | |
| NUMF DS 0XL8,XL2,XL8 Number of files in transmission NET02520 | |
| RECCT DS 0XL8,XL2,XL8 Number of records transmitted NET02520 | |
| SECND DS 0XL3,XL2,XL3 secondary space qty NET02520 | |
| DSTYPE DS 0XL1,XL2,XL1 Data set type NET02520 | |
| DS 0H Force to halfword size | |
| INMFSZ EQU *-INMFIELD Size of DSECT | |
| * | |
| * NJE00250 | |
| ********************* | |
| * N J E P A R * NJEPAR calls IKJPARS to parse | |
| * * the TSO command line parameters. | |
| * TSO Command Line * | |
| * Parse * | |
| * * | |
| ********************* | |
| * | |
| * Entry: R0=0 Parse the command line parameters | |
| * | |
| * R0=4 Parse the prompt parameters (change dsname, etc) | |
| * R1 -> Prompt input buffer from PUTGET if R0 = 4. | |
| * | |
| * Exit: R15 = IKJPARS RC | |
| * | |
| NJEPAR CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEPAR' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| STM R14,R12,12(R13) Save Regs NJE00050 | |
| LR R12,R15 Base NJE00060 | |
| USING NJEPAR,R12 NJE00070 | |
| USING NJEWK,R10 | |
| ST R13,PARSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R2,PARSA -> my save area | |
| ST R2,8(,R13) Plug it into prior SA | |
| LR R13,R2 | |
| * | |
| * | |
| LR R7,R0 Copy entry action code | |
| LR R6,R1 Copy any passed ptr | |
| * | |
| L R1,CPARMS -> CPPL entry parms | |
| LM R2,R5,0(R1) Get TSO command entry parameters | |
| * R2 -> Command buffer | |
| * R3 -> UPT | |
| * R4 -> PSCB | |
| * R5 -> ECT | |
| * | |
| *-- Build the IKJPARS PPL | |
| * | |
| PARS000 EQU * | |
| LA R8,PPLSTG -> PPL | |
| USING PPL,R8 | |
| ST R3,PPLUPT Set UPT addr | |
| ST R5,PPLECT Set ECT addr | |
| LA R3,PARSECB -> parse ECB | |
| ST R3,PPLECB Set it | |
| LA R3,ANSWER -> IKJPARS "answer area" | |
| ST R3,PPLANS Set it | |
| ST R10,PPLUWA Set user work area addr | |
| C R7,=F'4' Process prompt parameters? | |
| BE PARS010 Yes | |
| * | |
| * ** Process command line | |
| ST R2,PPLCBUF Set TSO command buffer addr | |
| L R3,=A(PCLDEFS) -> command parms definitions | |
| ST R3,PPLPCL Set it | |
| B PARS020 | |
| * | |
| PARS010 EQU * ** Process prompt parameters | |
| ST R6,PPLCBUF Set PUTGET input buffer addr | |
| L R3,=A(PRMTOPS) -> prompt parms definitions | |
| ST R3,PPLPCL Set it | |
| * | |
| PARS020 EQU * | |
| CALLTSSR EP=IKJPARS,MF=(E,PPLSTG) Parse command line | |
| LTR R0,R15 Any parse errors? | |
| BNZ XITPAR12 Yes | |
| DROP R8 PPL | |
| * | |
| C R7,=F'4' Did we parse prompt parms? | |
| BE PARS200 Yes, examine those | |
| * | |
| *- Examine command line results | |
| L R4,ANSWER -> IKJPARS built PCEs | |
| USING PRDSECT,R4 | |
| * | |
| LA R2,FILEPCE -> File #### PCE data | |
| TM 6(R2),X'80' Was file #### specified? | |
| BZ PARS025 No | |
| * | |
| L R3,0(,R2) -> word containing file # | |
| MVC FILEID,0(R3) Save specified spool id # | |
| OI FLAGS3,F3FILEID Indicate file id valid | |
| * | |
| PARS025 EQU * | |
| LA R2,QTPCE -> QUIET PCE | |
| CLC 0(2,R2),=AL2(1) Was QUIET specified? | |
| BNE PARS030 No | |
| OI FLAGS3,F3QUIET+F3NPRMPT Indicate QUIET+NOPROMPT | |
| * | |
| PARS030 EQU * | |
| LA R2,PURPCE -> PURGE/NOPURGE PCE | |
| CLC 0(2,R2),=AL2(2) Was NOPURGE specified? | |
| BNE PARS035 No | |
| NI FLAGS3,255-F3PURGE Indicate no purge | |
| * | |
| PARS035 EQU * | |
| LA R2,PRMTPCE -> PROMPT/NOPROMPT PCE | |
| CLC 0(2,R2),=AL2(2) Was NOPROMPT specified? | |
| BNE PARS040 No | |
| OI FLAGS3,F3NPRMPT Indicate no prompts | |
| * | |
| PARS040 EQU * | |
| LA R2,VOLPCE -> VOLSER PCE | |
| TM 6(R2),X'80' Was VOLSER specified? | |
| BZ PARS050 No | |
| L R3,0(,R2) -> VOLSER string | |
| LH R1,4(,R2) Length of volser | |
| MVC USRVOL,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVVOL Move the volser | |
| OI FLAGS3,F3VOLSER Indicate volser valid | |
| * | |
| PARS050 EQU * | |
| LA R2,INDAPCE -> INDATASET PCE | |
| TM 6(R2),X'80' Was INDATASET specified? | |
| BZ PARS080 No | |
| MVC USRINDS,BLANKS Init receiving field | |
| LA R5,USRINDS -> where to place DSN | |
| * | |
| TM 6(R2),X'40' Was dataset name in quotes? | |
| BO PARS060 Y, don't insert prefix | |
| CLC PREFIX,BLANKS Is a prefix available? | |
| BE PARS060 All blank, dont use prefix | |
| * | |
| MVC USRINDS(8),PREFIX Add the prefix | |
| TRT USRINDS,BLANK Look for end of prefix | |
| MVI 0(R1),C'.' Set delim after prefix | |
| LA R5,1(,R1) -> place to put rest of dsn | |
| LA R2,INDAPCE -> INDATASET PCE | |
| * | |
| PARS060 EQU * | |
| L R3,0(,R2) -> INDATASET string | |
| LH R1,4(,R2) Length of DSN | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVINDS Move the DSN | |
| OI FLAGS3,F3INDS Indicate INDATASET valid | |
| * | |
| PARS070 EQU * | |
| TM 14(R2),X'80' Was INDATASET member specified? | |
| BZ PARS080 No | |
| L R3,8(,R2) -> INDATASET member name | |
| LH R1,12(,R2) Length of member name | |
| MVC USRMEM,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVINMEM Move the member name | |
| OI FLAGS3,F3INMEM Indicate INDATASET member valid | |
| * | |
| PARS080 EQU * | |
| LA R2,FDAPCE -> DATASET PCE | |
| TM 6(R2),X'80' Was DATASET specified? | |
| BZ PARS110 No | |
| MVC FINALDS,BLANKS Init receiving field | |
| LA R5,FINALDS -> where to place DSN | |
| * | |
| TM 6(R2),X'40' Was dataset name in quotes? | |
| BO PARS090 Y, don't insert prefix | |
| CLC PREFIX,BLANKS Is a prefix available? | |
| BE PARS090 All blank, dont use prefix | |
| * | |
| MVC FINALDS(8),PREFIX Add the prefix | |
| TRT FINALDS,BLANK Look for end of prefix | |
| MVI 0(R1),C'.' Set delim after prefix | |
| LA R5,1(,R1) -> place to put rest of dsn | |
| LA R2,FDAPCE -> DATASET PCE | |
| * | |
| PARS090 EQU * | |
| L R3,0(,R2) -> DATASET string | |
| LH R1,4(,R2) Length of DSN | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVINDS Move the DSN | |
| OI FLAGS3,F3DS Indicate DATASET valid | |
| * | |
| PARS100 EQU * | |
| TM 14(R2),X'80' Was DATASET member specified? | |
| BZ PARS110 No | |
| OI FLAGS4,F4MEMINV Indicate MEMBER specified | |
| * | |
| PARS110 EQU * v200 | |
| LA R2,UNIPCE -> UNIT PCE v200 | |
| TM 6(R2),X'80' Was UNIT specified? v200 | |
| BZ PARS120 No v200 | |
| L R3,0(,R2) -> UNIT string v200 | |
| LH R1,4(,R2) Length of unit name v200 | |
| MVC USRUNIT,BLANKS Init receiving field v200 | |
| BCTR R1,0 Adjust for execute v200 | |
| EX R1,MVUNIT Move the unit v200 | |
| OI FLAGS2,F2UNIT Indicate unit valid v200 | |
| * | |
| PARS120 EQU * v200 | |
| LA R2,DIRPCE -> # dir blocks PCE v200 | |
| TM 6(R2),X'80' Was DIR specified? v200 | |
| BZ PARS130 No v200 | |
| * | |
| L R3,0(,R2) -> word containing # blks v200 | |
| MVC USRDIR,0(R3) Save specified # v200 | |
| OI FLAGS2,F2DIR Indicate DIR valid v200 | |
| * | |
| PARS130 EQU * v200 | |
| B XITPAR00 All done | |
| DROP R4 PRDSECT | |
| * | |
| MVVOL MVC USRVOL(0),0(R3) executed instr | |
| MVUNIT MVC USRUNIT(0),0(R3) executed instr v200 | |
| MVINDS MVC 0(0,R5),0(R3) executed instr | |
| MVINMEM MVC USRMEM(0),0(R3) executed instr | |
| * | |
| * | |
| *- Examine prompt parameter results | |
| PARS200 EQU * | |
| L R4,ANSWER -> IKJPARS built PCEs | |
| USING PRMSECT,R4 | |
| * | |
| PARS220 EQU * | |
| LA R2,ACTPCE -> PURGE/END PCE | |
| CLC 0(2,R2),=AL2(1) Was PURGE specified? | |
| BNE PARS230 No | |
| OI FLAGS4,F4PURGE Indicate purge | |
| * | |
| PARS230 EQU * | |
| CLC 0(2,R2),=AL2(2) Was END specified? | |
| BNE PARS240 No | |
| OI FLAGS4,F4END Indicate END | |
| * | |
| PARS240 EQU * | |
| LA R2,VLPCE -> VOLSER PCE | |
| TM 6(R2),X'80' Was VOLSER specified? | |
| BZ PARS250 No | |
| L R3,0(,R2) -> VOLSER string | |
| LH R1,4(,R2) Length of volser | |
| MVC USRVOL,BLANKS Init receiving field | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVVOL Move the volser | |
| OI FLAGS4,F4VOLSER Indicate volser valid | |
| * | |
| PARS250 EQU * | |
| LA R2,DAPCE -> DATASET PCE | |
| TM 6(R2),X'80' Was DATASET specified? | |
| BZ PARS280 No | |
| MVC FINALDS,BLANKS Init receiving field | |
| LA R5,FINALDS -> where to place DSN | |
| * | |
| TM 6(R2),X'40' Was dataset name in quotes? | |
| BO PARS260 Y, don't insert prefix | |
| CLC PREFIX,BLANKS Is a prefix available? | |
| BE PARS260 All blank, dont use prefix | |
| * | |
| MVC FINALDS(8),PREFIX Add the prefix | |
| TRT FINALDS,BLANK Look for end of prefix | |
| MVI 0(R1),C'.' Set delim after prefix | |
| LA R5,1(,R1) -> place to put rest of dsn | |
| LA R2,DAPCE -> DATASET PCE | |
| * | |
| PARS260 EQU * | |
| L R3,0(,R2) -> DATASET string | |
| LH R1,4(,R2) Length of DSN | |
| BCTR R1,0 Adjust for execute | |
| EX R1,MVINDS Move the DSN | |
| OI FLAGS4,F4DS Indicate DATASET valid | |
| NI FLAGS3,255-F3DS DATASET from cmd line not valid | |
| * | |
| PARS270 EQU * | |
| TM 14(R2),X'80' Was DATASET member specified? | |
| BZ PARS280 No | |
| OI FLAGS4,F4MEMINV Indicate MEMBER specified | |
| * | |
| PARS280 EQU * | |
| LA R2,UNPCE -> UNIT PCE v200 | |
| TM 6(R2),X'80' Was UNIT specified? v200 | |
| BZ PARS290 No v200 | |
| L R3,0(,R2) -> UNIT string v200 | |
| LH R1,4(,R2) Length of unit name v200 | |
| MVC USRUNIT,BLANKS Init receiving field v200 | |
| BCTR R1,0 Adjust for execute v200 | |
| EX R1,MVUNIT Move the unit v200 | |
| OI FLAGS2,F2UNIT Indicate unit valid v200 | |
| * | |
| PARS290 EQU * v200 | |
| LA R2,DRPCE -> # dir blocks PCE v200 | |
| TM 6(R2),X'80' Was DIR specified? v200 | |
| BZ PARS300 No v200 | |
| * | |
| L R3,0(,R2) -> word containing # blks v200 | |
| MVC USRDIR,0(R3) Save specified # v200 | |
| OI FLAGS2,F2DIR Indicate DIR valid v200 | |
| * | |
| PARS300 EQU * v200 | |
| B XITPAR00 All done | |
| DROP R4 PRMSECT | |
| * | |
| *-- Exit | |
| * | |
| XITPAR00 EQU * | |
| LA R1,ANSWER -> IKJPARS "answer place" | |
| IKJRLSA (1) Release parsing storage | |
| * | |
| SR R0,R0 Set secondary RC=0; | |
| SR R15,R15 Set RC=0; | |
| B XITPAR | |
| * | |
| XITPAR12 EQU * | |
| LA R15,12 Set RC=12; R0 already set by IKJPARS | |
| B XITPAR | |
| * | |
| XITPAR EQU * | |
| L R13,4(,R13) -> prev s.a. | |
| L R14,12(,R13) Load r14 | |
| LM R1,R12,24(R13) Reload callers regs | |
| BR R14 Return with RCs in R0/R15 | |
| * | |
| LTORG | |
| * | |
| *-- IKJPARS Description Macros | |
| * | |
| *-- RECEIVE command parms: | |
| * | |
| * RECEIVE #### INDATASET(ddd) VOLSER(vvv) UNIT(uuu) DATASET(iii) | |
| * DIR(nnn) | |
| * PURGE | NOPURGE | |
| * PROMPT | NOPROMPT | |
| * QUIET | |
| * | |
| * Where: | |
| * | |
| * #### if specified must be the first parm, all numeric spool id | |
| * ddd is an optional dataset name to RECEIVE from | |
| * vvv is an optional VOLSER of where to allocate the RECEIVEd data | |
| * uuu is an optional UNIT of where to allocate the RECEIVEd data | |
| * iii is an optional DSNAME to RECEIVE into. | |
| * nnn is an optional number of directory blocks to assign | |
| * PURGE indicates the spool file is purged after RECEIVE (DEFAULT) | |
| * NOPURGE indicates the spool file is retained after RECEIVE | |
| * PROMPT indicates to prompt user for parameters (DEFAULT) | |
| * NOPROMPT no user prompts are issued | |
| * QUIET suppress all informational msgs | |
| * | |
| * | |
| PCLDEFS IKJPARM DSECT=PRDSECT | |
| * | |
| FILEPCE IKJIDENT 'FILE NUMBER', x | |
| MAXLNTH=4,FIRST=NUMERIC,OTHER=NUMERIC, x | |
| INTEG | |
| * | |
| PURPCE IKJKEYWD DEFAULT='PURGE' | |
| IKJNAME PURGE PCE value = 1 | |
| IKJNAME NOPURGE PCE value = 2 | |
| * | |
| PRMTPCE IKJKEYWD DEFAULT='PROMPT' | |
| IKJNAME PROMPT PCE value = 1 | |
| IKJNAME NOPROMPT PCE value = 2 | |
| * | |
| QTPCE IKJKEYWD | |
| IKJNAME QUIET PCE value = 1 | |
| * | |
| INDSPCE IKJKEYWD | |
| IKJNAME 'INDATASET',SUBFLD=INDSFLD,ALIAS='INDSNAME' | |
| * | |
| FDSPCE IKJKEYWD | |
| IKJNAME 'DATASET',SUBFLD=FDSFLD,ALIAS='DSNAME' | |
| * | |
| VSRPCE IKJKEYWD | |
| IKJNAME 'VOLSER',SUBFLD=VOLSFLD,ALIAS='VOLUME' | |
| * | |
| USRPCE IKJKEYWD , v200 | |
| IKJNAME 'UNIT',SUBFLD=UNISFLD,ALIAS=('U') v200 | |
| * | |
| DRBPCE IKJKEYWD , v200 | |
| IKJNAME 'DIR',SUBFLD=DBSFLD v200 | |
| * | |
| INDSFLD IKJSUBF | |
| INDAPCE IKJPOSIT DSNAME, x | |
| PROMPT='THE NAME OF THE DATA SET YOU WANT TO RECEIVE FROx | |
| M' | |
| * | |
| FDSFLD IKJSUBF | |
| FDAPCE IKJPOSIT DSNAME, x | |
| PROMPT='THE NAME OF THE DATA SET YOU WANT TO RECEIVE INTx | |
| O' | |
| * | |
| VOLSFLD IKJSUBF | |
| VOLPCE IKJPOSIT DSTHING,VOLSER, x | |
| PROMPT='THE VOLUME SERIAL OF THE VOLUME WHERE YOU WANT Tx | |
| HE DATASET ALLOCATED' | |
| * | |
| UNISFLD IKJSUBF , v200 | |
| UNIPCE IKJIDENT 'UNIT NAME',MAXLNTH=8,FIRST=ALPHANUM, v200x | |
| OTHER=ALPHANUM v200 | |
| * | |
| DBSFLD IKJSUBF , v200 | |
| DIRPCE IKJIDENT 'DIRECTORY BLOCKS', v200x | |
| MAXLNTH=5,FIRST=NUMERIC,OTHER=NUMERIC, v200x | |
| INTEG v200 | |
| * | |
| IKJENDP | |
| * | |
| *-- RECEIVE parameters from prompt: | |
| * | |
| * DATASET(ddd) VOLSER(vvv) UNIT(uuu) DIR(nnn) PURGE/END | |
| * | |
| * Where: | |
| * | |
| * ddd is an alternate dataset name to RECEIVE intp | |
| * vvv is an optional VOLSER of where to allocate the RECEIVEd data | |
| * uuu is an optional UNIT of where to allocate the RECEIVEd data | |
| * nnn is an optional number of directory blocks to assign | |
| * PURGE indicates the spool file is purged immediately and the | |
| * RECEIVE operation is aborted. | |
| * END indicates the RECEIVE operation is aborted with no action. | |
| * | |
| PRMTOPS IKJPARM DSECT=PRMSECT | |
| * | |
| ACTPCE IKJKEYWD DEFAULT= | |
| IKJNAME PURGE PCE value = 1 | |
| IKJNAME END PCE value = 2 | |
| * | |
| DSPCE IKJKEYWD | |
| IKJNAME 'DATASET',SUBFLD=DAFLD,ALIAS='DSNAME' | |
| * | |
| VSPCE IKJKEYWD | |
| IKJNAME 'VOLSER',SUBFLD=VLFLD,ALIAS='VOLUME' | |
| * | |
| USPCE IKJKEYWD , v200 | |
| IKJNAME 'UNIT',SUBFLD=UNFLD,ALIAS=('U') v200 | |
| * | |
| DBPCE IKJKEYWD , v200 | |
| IKJNAME 'DIR',SUBFLD=DRFLD v200 | |
| * | |
| DAFLD IKJSUBF | |
| DAPCE IKJPOSIT DSNAME, x | |
| PROMPT='THE NAME OF THE DATA SET YOU WANT TO RECEIVE INTx | |
| O' | |
| * | |
| VLFLD IKJSUBF | |
| VLPCE IKJPOSIT DSTHING,VOLSER, x | |
| PROMPT='THE VOLUME SERIAL OF THE VOLUME WHERE YOU WANT Tx | |
| HE DATASET ALLOCATED' | |
| * | |
| UNFLD IKJSUBF , v200 | |
| UNPCE IKJIDENT 'UNIT NAME',MAXLNTH=8,FIRST=ALPHANUM, v200x | |
| OTHER=ALPHANUM v200 | |
| * | |
| DRFLD IKJSUBF , v200 | |
| DRPCE IKJIDENT 'DIRECTORY BLOCKS', v200x | |
| MAXLNTH=5,FIRST=NUMERIC,OTHER=NUMERIC, v200x | |
| INTEG v200 | |
| * | |
| IKJENDP | |
| * | |
| * | |
| IKJPPL | |
| IKJPPLSZ EQU (*-PPL)/4 # words in PPL | |
| * | |
| LTORG | |
| * | |
| * * | |
| *********************************************************************** | |
| ** ** | |
| ** TASK ESTAE EXIT ** | |
| ** ** | |
| ** This csect handles all abends trapped by ESTAE during the normal ** | |
| ** execution of the subtask. This exit does not attempt ** | |
| ** any recovery other than to terminate processing. ** | |
| ** An SVC dump is taken on abends. ** | |
| ** ** | |
| ** On entry: R0=ESTAE provide entry code ** | |
| ** R1=SDWA address ** | |
| ** R2=parameter passed on ESTAE macro ** | |
| ** ** | |
| ** ** | |
| ** On exit: If SDWACLUP is 1, then no retry is allowed and this ** | |
| ** exit will allow percolation back to system routines ** | |
| ** to terminate the task. ** | |
| ** ** | |
| ** If SDWACLUP is 0, then retry is allowed. ** | |
| ** ** | |
| ** Security: N/A. ** | |
| ** ** | |
| ** Register usage: ** | |
| ** ** | |
| ** R1 = SDWA address ** | |
| ** R3 = SDWA address ** | |
| ** R10 = Dynamic storage area base ** | |
| ** R12 = This program base ** | |
| ** ** | |
| ** ** | |
| ** ** | |
| *********************************************************************** | |
| * | |
| NJEDMP CSECT | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDMP' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| * | |
| LR R12,R15 SET UP BASE REG | |
| USING NJEDMP,R12 ESTABLISH ADDRESSABILITY | |
| LR R8,R14 SAVE RETURN ADDRESS TO SYSTEM | |
| * | |
| L R10,0(,R1) GET VALUE PASSED TO US (WORKA) | |
| USING NJEWK,R10 | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| * | |
| LR R3,R1 SAVE R1 ENTRY CONTENTS | |
| USING SDWA,R3 | |
| LR R5,R0 Save R0 entry code | |
| * | |
| LTR R3,R3 Do we have an SDWA? | |
| BZ NOSDWA Exit if no SDWA | |
| LA R13,MVSSAVE Save area | |
| ESTAE 0 | |
| * | |
| MODESET MODE=SUP, Run this ESTAI exit privileged x | |
| KEY=ZERO to access PSW -> storage | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| L R6,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R6) -> TIOT | |
| MVC MACLIST+9(8),0(R5) Plug in job name | |
| MVC MACLIST+4(4),=C'USER' | |
| MVC MACLIST+19(7),=C'RECEIVE' Plug in command name | |
| * | |
| * | |
| LNK020 EQU * | |
| MVC MACLIST+29(5),=C'ABEND' | |
| L R5,SDWAABCC GET ABEND CODE INFO WORD | |
| N R5,=X'00FFF000' KEEP ONLY THE SYSTEM CODE | |
| BZ USERCDE NONE THERE, MUST BE A USER CODE | |
| SRL R5,12 Put sys code in low order v201 | |
| C R5,=X'00000222' Operator cancel, no dump? v201 | |
| BE SDUMP040 Yes, suppress dump | |
| CLM R5,1,=X'3E' Was it an x3E (DETACH) ? v201 | |
| BE SDUMP040 Yes, suppress dump v201 | |
| * | |
| MVI MACLIST+35,C'S' INDICATE SYSTEM CODE | |
| UNPK FWORK(5),SDWACMPC(3) GET SYSTEM CMP CODE | |
| TR FWORK(3),HEXTRAN-240 | |
| MVC FWORK+3(5),=CL5' ' CLEAR REST OF ABEND CODE | |
| B NOREAS | |
| * | |
| USERCDE EQU * | |
| MVI MACLIST+35,C'U' INDICATE USER ABEND CODE | |
| L R5,SDWAABCC GET ABEND CODE | |
| N R5,=X'00000FFF' KEEP USER ABEND CODE | |
| CVD R5,FSAVE CONVERT CODE TO DECIMAL | |
| UNPK FWORK(4),FSAVE UNPK THE CODE | |
| OI FWORK+3,X'F0' FIX SIGN | |
| MVC FWORK+4(2),=CL2' ' BLANKS AT END OF ABEND CODE | |
| * | |
| NOREAS EQU * | |
| MVC MACLIST+36(6),FWORK MOVE ABEND-REASON TO LINE | |
| MVC ABCODE,MACLIST+36 Save a copy of formatted abcode | |
| * | |
| WTO ,MF=(E,MACLIST) Write to console | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(3),=C'PSW' | |
| UNPK FSAVE(9),SDWAEC1(5) Add zones to PSW word 1 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+10(8),FSAVE | |
| UNPK FSAVE(9),SDWAEC1+4(5) Add zones to PSW word 2 | |
| TR FSAVE(8),HEXTRAN-240 | |
| MVC MACLIST+19(8),FSAVE | |
| * | |
| SR R5,R5 CLEAR FOR IC | |
| IC R5,SDWAILC1 GET THE ILC | |
| CVD R5,FWORK MAKE DECIMAL | |
| MVC MACLIST+29(3),=C'ILC' | |
| UNPK MACLIST+33(2),FWORK UNPK | |
| OI MACLIST+34,X'F0' FIX THE SIGN | |
| * | |
| MVC MACLIST+37(4),=C'INTC' | |
| UNPK FWORK(5),SDWAINC1(3) MAKE INTC DISPLAYABLE | |
| TR FWORK(4),HEXTRAN-240 | |
| MVC MACLIST+42(4),FWORK MOVE INTC TO LINE | |
| * | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(13),=C'DATA NEAR PSW' | |
| MVC MACLIST+19(8),=CL8'UNAVAIL' ASSUME WE CANT GET DATA | |
| L R4,SDWAEC1+4 Get PSW IA | |
| LA R4,0(,R4) Clear high bit | |
| C R4,=F'8' 1st 8 bytes of storage? | |
| BH LOC010 No, its higher than that | |
| SR R4,R4 Yes, just use 0 | |
| B LOC020 | |
| * | |
| LOC010 EQU * | |
| S R4,=F'8' BACK UP BEFORE INTERRUPT ADDR | |
| * | |
| LOC020 EQU * | |
| LRA R0,0(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| LRA R0,14(,R4) Do we have access? | |
| BNZ UNAVAIL No translation, better not | |
| * | |
| ST R4,FWORK SAVE FOR CONVERSION | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES TO ADDRESS | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+19(8),FSAVE MOVE DISPLAYABLE | |
| * | |
| MVC FWORK(4),0(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+29(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),4(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+38(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),8(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+47(8),FSAVE MOVE TO LINE | |
| * | |
| MVC FWORK(4),12(R4) MOVE 4 WORDS AT PSW | |
| UNPK FSAVE(9),FWORK(5) ADD ZONES | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC MACLIST+56(8),FSAVE MOVE TO LINE | |
| * | |
| UNAVAIL EQU * | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| *---- | |
| LA R4,4 4 ROWS OF REGISTERS | |
| LA R5,SDWAGR00 POINT TO ABEND REGS | |
| LA R6,REGLIST POINT TO REGISTER ID LITERALS | |
| * | |
| REG000 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(8),0(R6) MOVE REGISTERS ID | |
| LA R15,MACLIST+13 WHERE 1ST REG GOES ON LINE | |
| LA R14,4 4 REGS PER LINE | |
| * | |
| REG010 EQU * | |
| UNPK FSAVE(9),0(5,R5) UNPK A REGISTER | |
| TR FSAVE(8),HEXTRAN-240 MAKE DISPLAYABLE HEX | |
| MVC 0(8,R15),FSAVE MOVE TO THE LINE | |
| LA R15,10(,R15) NEXT SPOT ON PRINT LINE | |
| LA R5,4(,R5) NEXT REGISTER | |
| BCT R14,REG010 KEEP DOING REGS | |
| WTO ,MF=(E,MACLIST) | |
| LA R2,MACLIST | |
| BAL 14,PUTLINE Echo to TSO terminal | |
| LA R6,8(,R6) NEXT REGISTER ID | |
| BCT R4,REG000 GO DISPLAY THE NEXT ROW | |
| * | |
| * | |
| SDUMP000 EQU * | |
| L R5,SDWAABCC Get abend code info word | |
| N R5,=X'00FFF000' Keep only the system code | |
| SRL R5,12 Right justify the code | |
| C R5,=X'00000222' Operator cancel, no dump? | |
| BE SDUMP040 Yes, skip dump | |
| CLM R5,1,=X'37' x37 abend code? | |
| BE SDUMP040 Skip the dump | |
| * | |
| MVI DHDR,C' ' | |
| MVC DHDR+1(29),DHDR | |
| MVI DHDR,29 IBM length of header | |
| L R5,PSATOLD-PSA(0) -> my TCB | |
| L R5,TCBTIO-TCB(,R5) -> TIOT | |
| MVC DHDR+1(8),0(R5) Use jobname in description | |
| MVC DHDR+11(7),=C'RECEIVE' Use command name | |
| MVC DHDR+21(7),ABCODE | |
| * | |
| MVC MACLIST(SDUMPL),SDUMP MOVE SDUMP LIST TO WORK | |
| LA R1,MACLIST | |
| SDUMP HDRAD=DHDR, ISSUE SDUMP TO RECORD STATUS x | |
| BUFFER=NO, x | |
| QUIESCE=NO, x | |
| SDATA=(RGN,CSA,LPA,SUM), x | |
| MF=(E,(1)) | |
| * | |
| * | |
| SDUMP040 EQU * | |
| * | |
| SDUMP090 EQU * | |
| LR R1,R3 SDWA BACK TO R1 | |
| L R15,=A(NJERCV) Main csect addr | |
| ST R15,SDWASRSV+4*R12 Plug it to R12 | |
| L R15,=A(EXIT08) -> RECEIVE exit point | |
| * | |
| SETRP RC=4, Retry - try to shut down RECEIVE x | |
| DUMP=NO, Suppress any further dumps x | |
| FRESDWA=YES, Free the SDWA x | |
| RETREGS=YES, Restore original regs x | |
| RETADDR=(15) Return to Receive exit point | |
| * | |
| NOSDWA EQU * ** NO RETRY AVAILABLE (OR DESIRED) | |
| SR R15,R15 REQUEST PERCOLATION | |
| LR R14,R8 RESTORE RETURN ADDRESS | |
| BR R14 RETURN TO SYSTEM | |
| * | |
| LTORG | |
| * | |
| SDUMP SDUMP MF=L | |
| SDUMPL EQU *-SDUMP | |
| * | |
| REGLIST DC CL8'GR 0-3' | |
| DC CL8'GR 4-7' | |
| DC CL8'GR 8-11' | |
| DC CL8'GR 12-15' | |
| * | |
| WTOMSG WTO ' x | |
| ',MF=L | |
| WTOMSGL EQU *-WTOMSG | |
| * | |
| LTORG | |
| * | |
| * | |
| **** Main work area common NJE00290 | |
| **** to all NJExxx CSECTs. NJE00290 | |
| * NJE00290 | |
| NJEWK DSECT | |
| NJEEYE DS CL4'NJER' Eyecatcher | |
| NJEWKLEN DS F Getmain size of this area | |
| * | |
| DBLE DS D Work area NJE00310 | |
| TWRK DS 2D Work area | |
| LCLNODE DS CL8 Local node id | |
| DEFUSER DS CL8 Default 'no security' userid | |
| USERID DS CL8 TSO Userid | |
| PREFIX DS CL8 TSO PREFIX | |
| * | |
| * | |
| MACLIST DS CL96 Macro expansion area | |
| STAXLIST DS CL20 STAX parameter list | |
| * NET02360 | |
| CPARMS DS A -> input CPPL (entry parms) | |
| PUTECB DS F ECB for PUTLINE/PUTGET | |
| IOPLAREA DS 4A IOPL for PUTLINE/PUTGET | |
| DEVINFO DS A -> Entry selected from disks tbl | |
| SV14CTL DS A R14 save area NET02370 | |
| SV14GB DS A R14 save area NET02370 | |
| SV14GET DS A R14 save area NET02370 | |
| SV14LN DS A R14 save area NET02370 | |
| SV14PUR DS A R14 save area NET02370 | |
| SVR0CTL DS F R0 save of # value for a key NET02370 | |
| * | |
| GBREM DS F # bytes remaining in phys rec NET02380 | |
| GBPOS DS A -> current position in BUFF NET02390 | |
| GBRPS DS A -> current position in phys rec NET02400 | |
| GBRBA DS F for debug RBA of last GETBYTES call NET02400 | |
| GBPBA DS F for debug RBA of prior GETBYTES call NET02400 | |
| RBUFF DS A -> Record build area | |
| RBPOS DS A -> current position in RBUFF NET02390 | |
| * | |
| BLOCKLEN DS F Length of block buffer | |
| BLOCK DS A -> Block of physical records | |
| NEWLEN DS F Length of NEWDS RECFM=U buffer | |
| NEWBLK DS A -> NEWDS RECFM=U build buffer | |
| * | |
| OLD DS F For PUTGET, # segments | |
| OLDMSGAD DS A -> msg len/text | |
| * | |
| PARSECB DS F IKJPARS ECB | |
| ANSWER DS F IKJPARS Answer area | |
| PPLSTG DS (IKJPPLSZ)A Space for PPL | |
| FILEID DS F User specified spool id # | |
| USRDIR DS F User specified # of dir blks v200 | |
| USRVOL DS CL6 User specified VOLSER | |
| USRUNIT DS CL8 User specified UNIT name v200 | |
| USRINDS DS CL44 User specified INDATASET | |
| USRMEM DS CL8 User specified INDATASET member | |
| FINALDS DS CL44 Final dataset name | |
| * | |
| * | |
| FLAGS1 DS X Flag bits | |
| F1INMR01 EQU X'80' 1... .... INMR01 fields processed | |
| F1INMR2A EQU X'40' .1.. .... 1st INMR02 fields processed | |
| F1INMR2B EQU X'20' ..1. .... 2nd INMR02 fields processed | |
| F1INMR03 EQU X'10' ...1 .... INMR03 fields processed | |
| F1BATCH EQU X'08' .... 1... Running in BATCH TSO | |
| F1ACEE EQU X'04' .... .1.. Security is available on system | |
| F1AUSR EQU X'02' .... ..1. Special user | |
| F1APF EQU X'01' .... ...1 Authorized at invocation | |
| * | |
| FLAGS2 DS X Flag bits | |
| F2NETOPN EQU X'80' 1... .... NETDATA DCB open | |
| F2NCBOPN EQU X'40' .1.. .... NETSPOOL NCB open | |
| F2NEWOPN EQU X'20' ..1. .... NEWDS DCB open | |
| F2TERM EQU X'10' ...1 .... INMTERM text unit detected | |
| F2DIR EQU X'08' .... 1... DIR (CMD -OR- PROMPT) spec. v200 | |
| F2FLAT EQU X'04' .... .1.. Incoming file is a flat file | |
| F2UNIT EQU X'02' .... ..1. UNIT (CMD -OR- PROMPT) spec.v200 | |
| F2FEND EQU X'01' .... ...1 Force END in batch after 1st pmt | |
| * .... .... available bits | |
| * | |
| FLAGS3 DS X Flag bits from CMD line parse | |
| F3FILEID EQU X'80' 1... .... Spool file id specified | |
| F3PURGE EQU X'40' .1.. .... 1=PURGE, 0=NOPURGE | |
| F3VOLSER EQU X'20' ..1. .... VOLSER specified | |
| F3INDS EQU X'10' ...1 .... INDATASET specified | |
| F3INMEM EQU X'08' .... 1... INDATASET MEMBER specified | |
| F3DS EQU X'04' .... .1.. DATASET specified | |
| F3NPRMPT EQU X'02' .... ..1. NOPROMPT was specified | |
| F3QUIET EQU X'01' .... ...1 QUIET was specified | |
| * | |
| FLAGS4 DS X Flag bits from prompt parse | |
| F4MEMINV EQU X'80' 1... .... DATASET MEMBER specified (inval) | |
| F4PURGE EQU X'40' .1.. .... PURGE (delete spool file & exit) | |
| F4VOLSER EQU X'20' ..1. .... VOLSER specified | |
| F4DS EQU X'10' ...1 .... DATASET specified | |
| F4END EQU X'08' .... 1... END (take no action and exit) | |
| F4ATTN EQU X'01' .... ...1 User pressed ATTN key v201 | |
| * .... .xx. available bits | |
| * NET02470 | |
| INMF01 DS (INMFSZ)X Fields from INMR01 record | |
| INMF02A DS (INMFSZ)X Fields from 1st INMR02 record | |
| INMF02B DS (INMFSZ)X Fields from 2nd INMR02 record | |
| INMF03 DS (INMFSZ)X Fields from INMR03 record | |
| * NET02590 | |
| DS 0F | |
| BUFF DS CL256 GB buffer containing request data NET02600 | |
| LIST DS CL133 Print line v200 | |
| REC DS CL133 Physical record from spool | |
| * | |
| *---- | |
| LS99PTR DS A PTR TO S99RB | |
| LS99RB DS XL20 SPACE FOR S99RB | |
| * | |
| TXTPTRS DS 15A -> Text unit ptr list | |
| * | |
| DS 0H | |
| UTXT DS 0XL06,Y,AL2,AL2 DDNAME Unallocation | |
| UDDNAME DS CL8 DDNAME | |
| * | |
| DS 0H | |
| TXT01 DS 0XL06,Y,AL2,AL2 Return DDNAME | |
| TDDNAME DS CL8 DDNAME | |
| * | |
| DS 0H | |
| TXT02 DS 0XL06,Y,AL2,AL2 DSN= | |
| TDSNAME DS CL44 DSNAME | |
| * | |
| DS 0H | |
| TXT03 DS 0XL07,Y,AL2,AL2,X DISP=(NEW, | |
| * | |
| DS 0H | |
| TXT04 DS 0XL07,Y,AL2,AL2,X DISP=(,CATLG) | |
| * | |
| DS 0H | |
| TXT05 DS 0XL06,Y,AL2,AL2 SPACE BLOCK LEN | |
| TBLKLEN DS XL3 BLKLEN | |
| * | |
| DS 0H | |
| TXT06 DS 0XL06,Y,AL2,AL2 SPACE PRIMARY | |
| TPRIME DS XL3 Primary | |
| * | |
| DS 0H | |
| TXT07 DS 0XL06,Y,AL2,AL2 SPACE SECONDARY | |
| TSECND DS XL3 Secondary | |
| * | |
| DS 0H | |
| TXT08 DS 0XL06,Y,AL2,AL2 SPACE DIRECTORY BLOCKS | |
| TDIRBLKS DS XL3 DIR BLKS | |
| * | |
| DS 0H | |
| TXT09 DS 0XL06,Y,AL2,AL2 VOLUME | |
| TVOLSER DS CL6 VOLSER | |
| * | |
| DS 0H | |
| TXT10 DS 0XL14,Y,AL2,AL2 UNIT v200 | |
| TUNIT DS CL8 UNITNAME v200 | |
| * | |
| DS 0H | |
| TXT11 DS 0XL06,Y,AL2,AL2 EXPDT | |
| TEXPDT DS CL5 EXPDT=yyddd | |
| * | |
| DS 0H | |
| TXT12 DS 0XL06,Y,AL2,AL2 BLKSIZE | |
| TBLKSIZE DS XL2 BLKSIZE | |
| * | |
| DS 0H | |
| TXT13 DS 0XL06,Y,AL2,AL2 DSORG | |
| TDSORG DS XL2 DSORG | |
| * | |
| DS 0H | |
| TXT14 DS 0XL06,Y,AL2,AL2 LRECL | |
| TLRECL DS XL2 LRECL | |
| * | |
| DS 0H | |
| TXT15 DS 0XL06,Y,AL2,AL2 RECFM | |
| TRECFM DS XL1 RECFM | |
| * | |
| DS 0H | |
| TXT16 DS 0XL04,Y,AL2 DUMMY | |
| * | |
| DS 0H | |
| TXT17 DS 0XL04,Y,AL2 SYSOUT | |
| * | |
| DS 0H | |
| TXT18 DS 0XL04,Y,AL2 TERM | |
| * | |
| DS 0H | |
| TXT19 DS 0XL04,Y,AL2 CYLINDER | |
| * | |
| DS 0H | |
| TXT20 DS 0XL04,Y,AL2 FREE=CLOSE | |
| *--- | |
| * | |
| CTL DS X Segment descriptor byte | |
| * | |
| * | |
| DS 0F | |
| TAGDATA DS XL108 TAG data area | |
| TYPPRT EQU X'40' PRT dev | |
| TYPPUN EQU X'80' PUN dev | |
| * | |
| NCB1 DS XL48 NCB for Spool Access | |
| NETDATA DS (DMYNPSL)X NETDATA DCB | |
| NEWDS DS (DMYSEQL)X New dataset DCB | |
| DECB DS (READL)X DECB for NETDATA | |
| * | |
| CPYPLIST DS XL(COPYPRML) IEBCOPY PARM FIELD | |
| * | |
| DS 0H | |
| DDLISTL DS AL2(DDLISTSZ) DDNAME LIST LENGTH | |
| DDLIST DS 4XL8'00' FOUR DDNAMES UNDEFINED | |
| DDSYSIN DS CL8 DDNAME representing IEBCOPY's SYSIN | |
| DDSYSPR DS CL8 DDNAME representing IEBCOPY's SYSPRINT | |
| DS XL8'00' UNDEFINED DD | |
| DDSYSUT1 DS CL8 DDNAME of ds created by INMRCOPY INMR02 (SYSUT1) | |
| DDSYSUT2 DS CL8 DDNAME representing IEBCOPY's SYSUT2 | |
| DDSYSUT3 DS CL8 DDNAME representing IEBCOPY's SYSUT3 | |
| DS XL8'00' SYSUT4 UNUSED | |
| DDLISTSZ EQU *-DDLIST LENGTH OF DDLIST for IEBCOPY | |
| DDNETDAT DS XL8'00' INDATASET DDNAME | |
| DDNETSPL DS XL8'00' NETSPOOL DDNAME | |
| UNLISTSZ EQU *-DDLIST TOTAL of all DDs in list | |
| * | |
| *-- ESTAE exit used areas | |
| * | |
| FSAVE DS 2D | |
| FWORK DS D | |
| DHDR DS CL30 | |
| ABCODE DS CL7 | |
| MVSSAVE DS 18F ESTAE exit OS save | |
| *-- End of ESTAE area | |
| * | |
| * | |
| NJESA DS 18F NJERCV OS save area NJE00300 | |
| NETSA DS 18F NJENET OS save area NJE00300 | |
| DYNSA DS 18F NJEDYN OS save area NJE00300 | |
| PARSA DS 18F NJEPAR OS save area NJE00300 | |
| NOTSA DS 18F NJENOT OS save area NJE00300 | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEWK | |
| * NJE00930 | |
| CVT DSECT=YES,PREFIX=NO | |
| IEFZB4D0 | |
| IEFZB4D2 | |
| DCBD DSORG=PS,DEVD=DA | |
| * | |
| IEFUCBOB DSECT | |
| IEFUCBOB LIST=YES | |
| IHAPSA | |
| IKJTCB | |
| IHASDWA | |
| IEFTIOT DSECT | |
| IEFTIOT1 | |
| IHAASCB | |
| IHAASXB | |
| IKJUPT | |
| IKJCPPL | |
| IKJPGPB | |
| IKJIOPL | |
| * | |
| ACEE DSECT Maps a portion of ACEE in MVS3.8 | |
| ACEEEYE DS CL4'ACEE' | |
| DS 16X | |
| ACEEUSRL DS X Length of userid | |
| ACEEUSR DS CL8 Userid | |
| * | |
| COPY NETSPOOL NJE00940 | |
| COPY TAG | |
| * | |
| END NJERCV NJE01000 | |
| @@ | |
| //* | |
| //* These steps will assemble all components of NJE38 and link it | |
| //* into SYSGEN.NJE38.AUTHLIB | |
| //* | |
| //* All steps should receive COND CODE 0 | |
| //* | |
| //ASSEM PROC R=RENT,M= | |
| //ASSEMBLE EXEC PGM=IFOX00,REGION=4096K, | |
| // PARM=('XREF(FULL),OBJ,SYSPARM((ON,GEN,NODATA,YES,YES))', | |
| // 'NODECK,&R') | |
| //SYSLIB DD DSN=SYSGEN.NJE38.MACLIB,DISP=SHR,DCB=BLKSIZE=32720 | |
| // DD DSN=SYS1.SMPMTS,DISP=SHR | |
| // DD DSN=SYS1.SMPSTS,DISP=SHR | |
| // DD DSN=SYS1.MACLIB,DISP=SHR | |
| // DD DSN=SYS1.AMODGEN,DISP=SHR | |
| //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(1700,(5600,500)) | |
| //SYSUT2 DD DSN=&&SYSUT2,UNIT=SYSDA,SPACE=(1700,(1300,500)) | |
| //SYSUT3 DD DSN=&&SYSUT3,UNIT=SYSDA,SPACE=(1700,(1300,500)) | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSPUNCH DD SYSOUT=B | |
| //SYSGO DD DSN=&&NJE38OBJ(&M),DISP=(MOD,PASS), | |
| // SPACE=(800,(2000,1000,10)),UNIT=SYSDA | |
| //SYSIN DD DSN=SYSGEN.NJE38.ASMSRC(&M),DISP=SHR | |
| // PEND | |
| //* *********************************** | |
| //* EXEC ASSEM,M=NJEINIT,R=RENT | |
| //* EXEC ASSEM,M=NJECMX,R=RENT | |
| //* EXEC ASSEM,M=NJEDRV,R=RENT | |
| //* EXEC ASSEM,M=NJEFMT,R=RENT | |
| // EXEC ASSEM,M=NJERCV,R=RENT | |
| //* EXEC ASSEM,M=NJERLY,R=RENT | |
| //* EXEC ASSEM,M=NJESCN,R=RENT | |
| // EXEC ASSEM,M=NJESPOOL,R=RENT | |
| // EXEC ASSEM,M=NJESYS,R=RENT | |
| // EXEC ASSEM,M=NJETRN,R=RENT | |
| //* EXEC ASSEM,M=NJE38,R=RENT | |
| //* EXEC ASSEM,M=NJ38RECV,R=RENT | |
| //* EXEC ASSEM,M=NJ38XMIT,R=RENT | |
| //* EXEC ASSEM,M=DMTXJE,R=NORENT | |
| //* EXEC ASSEM,M=DMTMSG,R=RENT | |
| //* *********************************** | |
| //* | |
| //LKCMDLIB EXEC PGM=IEWL,PARM='XREF,LET,LIST,NCAL,RENT',COND=(4,LT) | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT1 DD DSN=&&SYSUT1,UNIT=SYSDA,SPACE=(1024,(50,20)) | |
| //SYSLMOD DD DSN=SYS2.CMDLIB,DISP=SHR | |
| //NJEOBJ DD DSN=&&NJE38OBJ,DISP=(OLD,PASS) | |
| //SYSLIN DD * | |
| ORDER NJERCV(P) | |
| INCLUDE NJEOBJ(NJERCV) | |
| INCLUDE NJEOBJ(NJESYS) | |
| INCLUDE NJEOBJ(NJESPOOL) | |
| ENTRY NJERCV | |
| SETCODE AC(1) | |
| ALIAS RECV | |
| NAME RECEIVE(R) | |
| ORDER NJETRN(P) | |
| INCLUDE NJEOBJ(NJETRN) | |
| INCLUDE NJEOBJ(NJESYS) | |
| INCLUDE NJEOBJ(NJESPOOL) | |
| ENTRY NJETRN | |
| SETCODE AC(1) | |
| ALIAS XMIT | |
| NAME TRANSMIT(R) | |
| //* | |
| //* Edit SYS1.UMODSRC(IKJEFTE2) Adding NJE38 programs | |
| //* that need auth | |
| //* | |
| //EDITUMOD EXEC PGM=IKJEFT01,REGION=1024K,DYNAMNBR=50 | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSTSPRT DD SYSOUT=* | |
| //SYSTERM DD SYSOUT=* | |
| //SYSTSIN DD * | |
| EDIT 'SYS1.UMODSRC(IKJEFTE2)' DATA | |
| LIST | |
| TOP | |
| FIND /TERMINATOR/ | |
| UP | |
| INSERT DC C'RECEIVE ' NJE38 RECEIVE | |
| INSERT DC C'RECV ' NJE38 RECEIVE Alias | |
| INSERT DC C'TRANSMIT' NJE38 TRANSMIT | |
| INSERT DC C'XMIT ' NJE38 TRANSMIT Alias | |
| LIST | |
| END SAVE | |
| /* | |
| //* | |
| //* Add Help files | |
| //* | |
| //HELP EXEC PGM=PDSLOAD | |
| //STEPLIB DD DSN=SYSC.LINKLIB,DISP=SHR | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT2 DD DSN=SYS2.HELP,DISP=SHR | |
| //SYSUT1 DD DATA,DLM=@@ | |
| ./ ADD NAME=TRANSMIT | |
| )F FUNCTION - NJE38 - TSO TRANSMIT used to create XMIT files | |
| )X SYNTAX - | |
| TRANSMIT DATASET('DSN') OUTDATASET('DSN') | |
| [VOLSER(PUB000)] [UNIT(3390)] [PDS]|[SEQ] [QUIET] | |
| REQUIRED - DATASET() OUTDATASET() | |
| DEFAULTS - VOLSER(PUBLIC) UNIT(SYSDA) SEQ | |
| ALIAS - XMIT | |
| EXAMPLE - a user is logged on to TSO with userid FRED: | |
| Encode dataset HERC02.COBOL.LISTING into FRED.NETLIB: | |
| TRANSMIT da('herc02.cobol.listing') out(netlib) | |
| )O OPERANDS - | |
| ))node.userid - optional. specifies the destination of the | |
| transmission | |
| DATASET( ) - specifies the dsname of the dataset to be | |
| transmitted. May optionally specify a member. | |
| OUTDATASET( ) - required. Specifies the encoded file is to be | |
| written to this dataset instead of being | |
| transmitted. 'node.userid' may be omitted if | |
| OUTDATASET is specified, but if it is present | |
| then the specified node and userid will be part | |
| of the encoded data instead of meaningless | |
| defaults. If OUTDATASET is specified, the | |
| named dataset will be used if it exists, other- | |
| wise it will be created. | |
| The contents of OUTDATASET can be input to a | |
| RECEIVE command by the use of RECEIVE INDATASET. | |
| ))VOLSER( ) - optional. Specifies a volume where OUTDATASET | |
| should be created. If not specified, a PUBLIC | |
| volume will be selected. | |
| ))UNIT( ) - optional. Specifies a unit name where OUTDATASET | |
| should be created. If not specified, SYSDA is | |
| the default unit name. | |
| ))PDS - If specified, indicates that the member name | |
| specified with DATASET is to be transmitted | |
| with IEBCOPY unload, thereby preserving the | |
| user directory data in the source PDS. | |
| ))SEQUENTIAL - DEFAULT. Indicates that any member name specified | |
| with DATASET is to be transmitted as a sequential | |
| file; no directory information is part of the | |
| transmission. SEQL must be specified or defaulted | |
| if the destination host is a VM system. | |
| ))QUIET - If specified, indicates that all informational | |
| messages from TRANSMIT are suppressed. Error | |
| messages will always be displayed. | |
| ./ ADD NAME=RECEIVE | |
| )F FUNCTION - NJE38 - TSO RECEIVE | |
| )X SYNTAX - | |
| RECEIVE DATASET('DSN') INDATASET('DSN') | |
| [VOLSER(PUB000)] [UNIT(3390)] | |
| [PURGE]|[NOPURGE] [PROMPT]|[NOPROMPT] [QUIET] | |
| REQUIRED - DATASET() INDATASET() | |
| DEFAULTS - VOLSER(PUBLIC) UNIT(SYSDA) PURGE PROMPT | |
| ALIAS - RECV | |
| EXAMPLE - a user is logged on to TSO with userid FRED: | |
| Decode dataset FRED.NETLIB to HERC02.COBOL.LISTING: | |
| RECEIVE INDATASET('herc02.cobol.listing') DATASET(netlib) | |
| )O OPERANDS - | |
| DATASET( ) - specifies the dsname of the dataset to be | |
| created; the received data will be placed within. | |
| If not specified, the dataset name will be | |
| derived from the incoming dataset name, with | |
| the first qualifer being replaced by the | |
| receiver's TSO userid. | |
| VOLSER( ) - specifies a volume where DATASET should be | |
| created. If not specified, a PUBLIC volume will | |
| be chosen based on the receiving dataset's | |
| attributes. | |
| UNIT( ) - specifies a unit name where DATASET should be | |
| created. If not specified, SYSDA is the default | |
| unit name. | |
| DIR( ) - specifies a number of directory blocks if | |
| incoming file was a PDSE. | |
| INDATASET( ) - optional. Specifies that the encoded named | |
| dataset is to be received. The encoded dataset | |
| was previously created by TRANSMIT using | |
| OUTDATASET. May optionally specify a membername. | |
| PURGE - DEFAULT. Indicates that RECEIVE is to purge | |
| the spool file after successful retrieval. Has | |
| no meaning if INDATASET is specified. | |
| NOPURGE - Indicates that RECEIVE is to retain the spool | |
| file. The file can be received again or must be | |
| removed from the spool by other means. Has | |
| no meaning if INDATASET is specified. | |
| PROMPT - DEFAULT. Indicates that RECEIVE is to prompt | |
| the TSO user to respecify DATASET or VOLSER | |
| after learning the incoming dataset name. The | |
| user can then choose to change the name or | |
| volume. | |
| NOPROMPT - Indicates that no prompts are to be issued. If | |
| errors are encountered, such as the incoming | |
| dataset name already existing, then RECEIVE is | |
| terminated without any opportunity to change | |
| the parameters. | |
| QUIET - If specified, indicates that all informational | |
| messages from RECEIVE are suppressed. Error | |
| messages will always be displayed. QUIET also | |
| forces on NOPROMPT. | |
| @@ | |
| /* | |
| //* | |
| //* Install NJE001 Usermod to IKJEFTE2 | |
| //* | |
| //NJSMPASM EXEC SMPASML,M=IKJEFTE2,COND=(0,NE) | |
| //* | |
| //NJERECV EXEC SMPAPP,COND=(0,NE),WORK=SYSALLDA | |
| //SMPPTFIN DD * | |
| ++USERMOD(NJE0001) | |
| . | |
| ++VER(Z038) | |
| FMID(EBB1102) | |
| PRE(JLM0003) | |
| . | |
| ++MOD(IKJEFTE2) | |
| DISTLIB(AOST4) | |
| LKLIB(UMODLIB) | |
| . | |
| /* | |
| //SMPCNTL DD * | |
| RECEIVE | |
| SELECT(NJE0001) | |
| . | |
| APPLY | |
| SELECT(NJE0001) | |
| DIS(WRITE) | |
| . | |
| /* | |
| //* | |
| // |
This file has been truncated, but you can view the full file.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| //NJE38 JOB (TSO), | |
| // 'Install NJE38', | |
| // CLASS=A, | |
| // MSGCLASS=H, | |
| // MSGLEVEL=(1,1), | |
| // USER=HERC01, | |
| // PASSWORD=CUL8TR | |
| /*JOBPARM LINES=1000 | |
| //* | |
| //* This JCL does 4 things: | |
| //* 1) Creates SYSGEN.NJE38.MACLIB and adds the NJE38 maclibs to it | |
| //* 2) Creates SYSGEN.NJE38.ASMSRC and adds the needed source files | |
| //* 3) Assembles the required and adds them to SYS2.CMDLIB | |
| //* 4) Updates and adds TRANSMIT/RECEIVE to SYS1.UMODSRC(IKJEFTE2) | |
| //* 5) Installs the IKJEFTE2 changes with SMP | |
| //* | |
| //* ******** | |
| //* ** | |
| //* ** You must Re-IPL with CLPA or you will get a TSO error | |
| //* ** | |
| //* ** This JCL is for TK4- ONLY | |
| //* ** | |
| //* ******** | |
| //* | |
| //* Type HELP TRANSMIT or HELP RECEIVE for information how to use | |
| //* these commands. | |
| //* | |
| //* ******************************************************************* | |
| //* | |
| //* Installs SYSGEN.NJE38.MACLIB | |
| //* | |
| //NJE38MAC EXEC PGM=PDSLOAD | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT2 DD DSN=SYSGEN.NJE38.MACLIB,DISP=(NEW,CATLG), | |
| // VOL=SER=PUB001, | |
| // UNIT=3375,SPACE=(CYL,(1,1,5)), | |
| // DCB=(BLKSIZE=3120,RECFM=FB,LRECL=80) | |
| //SYSUT1 DD DATA,DLM=@@ | |
| ./ ADD NAME=AUTHLIST | |
| AUTHLIST DSECT | |
| AUTHPTR DS A -> next AUTHLIST entry or 0 | |
| DS A Reserved | |
| AUTHUSER DS CL8 Authorized userid | |
| AUTHNODE DS CL8 Authorized node of above userid | |
| AUTHSIZE EQU *-AUTHLIST Length of an authlist entry | |
| ./ ADD NAME=LINKTABL | |
| LINKTABL DSECT | |
| * | |
| *** LINKTABL - LINK TABLE ENTRY | |
| * | |
| * 0 +-----------------------------------------------+ | |
| * | LINKID | | |
| * 8 +-----------------------+-----------------------+ | |
| * | LDEFTNME | LACTTNME | | |
| * 10 +-----------------------+-----------------------+ | |
| * | LDEFDRVR | | |
| * 18 +-----------------------------------------------+ | |
| * | LACTDRVR | | |
| * 20 +-----------+-----------+-----------------------+ | |
| * | LDEFLINE | LACTLINE | LDRVRVAR | | |
| * 28 +-----+-----+-----+-----+-----+-----+-----+-----+ | |
| * | L*1 | L*2 | L*3 | L*4 | L*5 | L*6 | L*7 | L*8 | | |
| * 30 +-----+-----+-----+-----+-----+-----+-----+-----+ | |
| * | L*9 |LFLAG| LBUFF | LPENDING | LTAKEN | | |
| * 38 +-----+-----+-----------+-----------+-----------+ | |
| * | LPOINTER | LMSGQ | | |
| * 40 +-----------+-----------+-----------+-----------+ | |
| * | LTRNSCNT | LERRCNT | LTOCNT | | |
| * 48 +-----------+-----------+-----------+-----------+ | |
| * | LNKCLOCK | | |
| * 50 +-----------------------------------------------+ | |
| * | |
| * | |
| *** LINKTABL - LINK TABLE ENTRY | |
| * | |
| LINKID DS CL8 EBCDIC LINK ID | |
| LDEFTNME DS CL4 DEFAULT TASK NAME | |
| LACTTNME DS CL4 ACTIVE TASK NAME | |
| LDEFUSER DS 0CL8 DEFAULT USERID IF NO SECURITY v130 | |
| LDEFDRVR DS CL8 DEFAULT DRIVER ID | |
| LACTDRVR DS CL8 ACTIVE DRIVER ID | |
| LDEFLINE DS XL2 DEFAULT VIRTUAL LINE ADDRESS *XJE | |
| LACTLINE DS XL2 ACTIVE VIRTUAL LINE ADDRESS *XJE | |
| LDRVRVAR DS 1F LINE DRIVER VARIABLE INFO | |
| LDEFCLS1 DS CL1 L*1 DEFAULT SPOOL FILE CLS 1 | |
| LDEFCLS2 DS CL1 L*2 DEFAULT SPOOL FILE CLS 2 | |
| LDEFCLS3 DS CL1 L*3 DEFAULT SPOOL FILE CLS 3 | |
| LDEFCLS4 DS CL1 L*4 DEFAULT SPOOL FILE CLS 4 | |
| LACTCLS1 DS CL1 L*5 ACTIVE SPOOL FILE CLS 1 | |
| LACTCLS2 DS CL1 L*6 ACTIVE SPOOL FILE CLS 2 | |
| LACTCLS3 DS CL1 L*7 ACTIVE SPOOL FILE CLS 3 | |
| LACTCLS4 DS CL1 L*8 ACTIVE SPOOL FILE CLS 4 | |
| LTIMEZON DS 1X L*9 2 COMP TIME ZONE DISP FROM GMT | |
| LFLAG DS 1X LINK FLAG BYTE | |
| LACTIVE EQU X'80' LINK ACTIVE | |
| *LALERT EQU X'40' ************AXS ALERT EXIT SET-not used in XJE | |
| LAUTO EQU X'40' LINK TO BE AUTOSTARTED *XJE | |
| LHOLD EQU X'20' LINK HOLD SET | |
| LDRAIN EQU X'10' LINK DRAIN IN PROGRESS | |
| LTRALL EQU X'08' LINK TRANSACTION TRACING (ALL) | |
| LTRERR EQU X'04' LINK TRANSACTION TRACING (ERROR) | |
| LCONNECT EQU X'02' Link successfully signed onHRC031DT | |
| LHALT EQU X'01' LINK TO BE FORCED INACTIVE | |
| LBUFF DS 1H Max buffer size for line *XJE | |
| LNEGO DS 1H Negotiated actual buffer size *XJE | |
| LTAKEN DS 1H COUNT OF TAG SLOTS IN USE | |
| LPOINTER DS 1F LINK QUEUE ADDR | |
| LMSGQ DS 1F MSG QUEUE POINTER | |
| LTRNSCNT DS 1H LINK TRANSACTION COUNT | |
| LERRCNT DS 1H ERROR COUNT | |
| LTOCNT DS 1H TIMEOUT COUNT | |
| LSPARE DS 1H SPARE HALF WORD | |
| LNKCLOCK DS 8X CLOCK COMP VALUE FOR THIS LINK @VA03349 | |
| * | |
| *- New fields for NJE/MVS use; below *XJE | |
| * | |
| LNEXT DS A -> next LINKTABL entry or 0 | |
| LTCBA DS A -> TCB for this link | |
| LTRMECB DS F Link subtask termination ECB | |
| LECB DS F ECB for main task notific'n to link | |
| LNJEW DS A -> local work area for this link | |
| DS F Available | |
| LWRESWAP DS 0D CDS swap doubleword | |
| LWREQIN DS A Incoming WREs Q chain anchor | |
| LWREQCT DS F Incoming synchronization count | |
| LINKLEN EQU *-LINKTABL LENGTH OF LINK TABLE ENTRY | |
| SPACE | |
| ./ ADD NAME=MSGX | |
| MACRO | |
| &LABEL MSGX &NUM,&VAR | |
| .* REENTERABLE FORM OF MSG MACRO | |
| LCLA &TOFF,&TVARS | |
| LCLC &COFF | |
| &LABEL MVC MSGXNUM,=AL2(&NUM) | |
| AIF (N'&SYSLIST(2) EQ 0).NOVAR | |
| &TOFF SETA N'&SYSLIST(2) | |
| &COFF SETC '&TOFF' | |
| .NOVAR ANOP | |
| AIF (N'&SYSLIST(2) EQ 0).NOVAR1 | |
| &TOFF SETA 0 | |
| &TVARS SETA 1 | |
| .MLOP ANOP | |
| &COFF SETC '&TOFF' | |
| MVC MSGXVAL+&COFF.(8),&SYSLIST(2,&TVARS) | |
| &TOFF SETA &TOFF+8 | |
| &TVARS SETA &TVARS+1 | |
| AIF (&TVARS LE N'&SYSLIST(2)).MLOP | |
| .NOVAR1 ANOP | |
| LA 1,MSGXNUM | |
| LA 0,&TOFF+4 | |
| BAL 14,MSG | |
| SPACE 1 | |
| MEND | |
| ./ ADD NAME=NETSPOOL | |
| * | |
| * Change log: | |
| * | |
| * 23 Jul 20 - Add NCBPCT to return spool file percentage v200 | |
| * 02 Jul 20 - Default userid to CSA in support of TRANSMIT/RECEOVE v200 | |
| * 21 May 20 - Add update directory entry funcation v120 | |
| * 04 May 20 - Show CONFIG assembly date and time on start up. v102 | |
| * | |
| * | |
| NCB DSECT NETSPOOL CONTROL BLOCK | |
| NCBEYE DS CL4'NCB' NCB id | |
| NCBTKN DS F Token identifier (caller unique) | |
| NCBFL1 DS X Flag bits | |
| NCBPRT EQU X'40' PRT type data | |
| NCBPUN EQU X'80' PUN type data | |
| NCBREQ DS X Request type | |
| NCBOPEN EQU X'01' Open NETSPOOL dataset | |
| NCBCLOSE EQU X'02' Close NETSPOOL dataset | |
| NCBPUT EQU X'03' Write a logical record | |
| NCBGET EQU X'04' Read a logical record | |
| NCBPURGE EQU X'05' Delete a file | |
| NCBLOC EQU X'06' Locate a file | |
| NCBCON EQU X'07' Get directory contents | |
| NCBUDIR EQU X'08' Update directory entry v120 | |
| NCBRTNCD DS X RC from VSAM macro (same as R15) | |
| NCBERRCD DS X Error code from VSAM macro | |
| NCBMACAD DS A Addr of failing VSAM macro | |
| NCBTAG DS A Addr of associated TAG block | |
| NCBEODAD DS A Addr of End of Data routine | |
| NCBAREAL DS F Length of record area | |
| NCBAREA DS A Addr of record area | |
| NCBRECLN DS AL2 Length of record | |
| NCBRECCT DS AL2 Record count | |
| NCBPCT DS 0AL2 Spool percentage full (NCBCON) v200 | |
| NCBFID DS AL2 File id # (avail on new file CLOSE) | |
| NCBRESV1 DS AL2 Available bytes | |
| NCBRESV2 DS A Available bytes | |
| DS 0D Force doubleword boundary | |
| NCBSZ EQU *-NCB Size of NCB | |
| * | |
| * | |
| NSDIR DSECT NETSPOOL directory entry | |
| NSLEN DS AL2(NSDIRLN) Length of this record incl len | |
| NSRESV1 DS AL2 Resv | |
| NSBLK DS AL4 Block number of file's ptr block | |
| NSINLOC DS CL8 Originating location | |
| NSLINK DS CL8 Next location for transmission | |
| NSINTOD DS CL8 Time of file origin | |
| NSINVM DS CL8 Originating virtual machine | |
| NSRECNM DS 1F Number of records in file | |
| NSRECLN DS 1H Maximum file data record length | |
| NSINDEV DS 1X Device code of originating dev | |
| NSCLASS DS CL1 File output class | |
| NSID DS 1H File number at origin location | |
| NSCOPY DS 1H Number of copies requested | |
| NSFLAG DS 1X VM/370 SFBLOK control flags | |
| NSFLAG2 DS 1X VM/370 SFBLOK control flags | |
| NSSPARE DS 1H Spare | |
| NSNAME DS CL12 File name | |
| NSTYPE DS CL12 File type | |
| NSDIST DS CL8 File distribution code | |
| NSTOLOC DS CL8 Destination location id | |
| NSTOVM DS CL8 Destination virtual machine id | |
| NSPRIOR DS 1H Transmission priority | |
| NSDEV DS 2X Active file's virt dev addr | |
| NSRESV2 DS AL4 Resv | |
| NSDIRLN EQU *-NSDIR | |
| * | |
| NJ38CSA DSECT NJE38 CSA STORAGE BLOCK | |
| NJ38NODE DS CL8 Node name of this NJE38 | |
| NJ38ASCB DS A ASCB address of NJE38 addr space | |
| NJ38ECB DS F NJE38 ECB for cross memory post | |
| NJ38SWAP DS 0D CDS swap doubleword | |
| NJ38WRIN DS A Incoming WREs Q chain anchor | |
| NJ38WRCT DS F Incoming synchronization count v200 | |
| NJ38DUSR DS CL8 Default 'no security' userid v200 | |
| NJ38CSAZ EQU *-NJ38CSA Size of CSA area | |
| * | |
| CMDBLOK DSECT Map cmd area used by DMTXJE | |
| CMDBLEN DS AL1 CMDBLOK length | |
| CMDBTYP DS AL1(0) Type 0 = CMDBLOK request | |
| DS AL1 | |
| DS AL1 | |
| CMDLINK DS CL8 LINKID | |
| CMDVMID DS CL8 VIRTUAL MACHINE ID | |
| CMDTEXT DS CL120' ' text of command | |
| CMDBLOKL EQU *-CMDBLOK Size of dsect | |
| * | |
| STACKMSG DSECT Stacked message format | |
| STKOWN DS A RQE owner | |
| STKNEXT DS A -> next STACKMSG or zero | |
| STKLEN DS AL1 Stacked msg length | |
| STKZERO DS AL1(0) Must be 0 | |
| STKNODE DS CL8 Node of receiver of this msg | |
| STKID DS CL8 userid of receiver of this msg | |
| STKMSG DS CL238 Area for msg text | |
| STKSZ EQU *-STACKMSG Total size should be 264=RQESZ | |
| * | |
| * | |
| * | |
| RQE DSECT | |
| RQEOWN DS A ->LINKTABL entry of owner (0=free) | |
| RQEDATA DS XL260 TANK or MSG data as used by DMTXJE | |
| RQESZ EQU *-RQE Size of RQE area | |
| * | |
| * | |
| ./ ADD NAME=NJE | |
| * | |
| * DSECTs defining NJE headers | |
| * | |
| * Prefix section common to all headers | |
| * | |
| NJEPDSEC DSECT NJE header prefix | |
| NJEPLEN DS AL2 NJE header segment length | |
| NJEPFLGS DS XL1 NJE header segment flags | |
| NJEPSEQ DS XL1 NJE header segment sequence | |
| NJEPSIZE EQU *-NJEPDSEC NJE header prefix size | |
| * | |
| * NJE job header general section | |
| * | |
| NJHGDSEC DSECT NJE job hdr general section | |
| NJHGLEN DS AL2 NJE job gen. sect. length | |
| NJHGTYPE DS XL1 NJE job gen. sect. type | |
| NJHGMOD DS XL1 NJE job gen. sect. modifier | |
| NJHGJID DS AL2 NJE job gen. sect. identif. | |
| NJHGJCLS DS CL1 NJE job gen. sect. class | |
| NJHGMCLS DS CL1 NJE job gen. sect. msg cls | |
| NJHGFLG1 DS XL1 NJE job gen. sect. flags | |
| NJHGPRIO DS XL1 NJE job gen. sect. priority | |
| NJHGORGQ DS XL1 NJE job gen. sect. qualifier | |
| NJHGJCPY DS XL1 NJE job gen. sect. copy | |
| NJHGLNCT DS XL1 NJE job gen. sect. lpp | |
| DS XL1 NJE job gen. sect. reserved | |
| NJHGHOPS DS AL2 NJE job gen. sect. hop count | |
| NJHGACCT DS CL8 NJE job gen. sect. acct | |
| NJHGJNAM DS CL8 NJE job gen. sect. name | |
| NJHGUSID DS CL8 NJE job gen. sect. userid | |
| NJHGPASS DS XL8 NJE job gen. sect. password | |
| NJHGNPAS DS XL8 NJE job gen. sect. new pass | |
| NJHGETS DS XL8 NJE job gen. sect. TOD time | |
| NJHGORGN DS CL8 NJE job gen. sect. org node | |
| NJHGORGR DS CL8 NJE job gen. sect. org user | |
| NJHGXEQN DS CL8 NJE job gen. sect. exe node | |
| NJHGXEQU DS CL8 NJE job gen. sect. exe user | |
| NJHGPRTN DS CL8 NJE job gen. sect. prt dest | |
| NJHGPRTR DS CL8 NJE job gen. sect. prt user | |
| NJHGPUNN DS CL8 NJE job gen. sect. pun dest | |
| NJHGPUNR DS CL8 NJE job gen. sect. pun user | |
| NJHGFORM DS CL8 NJE job gen. sect. form | |
| NJHGICRD DS XL4 NJE job gen. sect. inp cards | |
| NJHGETIM DS XL4 NJE job gen. sect. job time | |
| NJHGELIN DS XL4 NJE job gen. sect. prt lines | |
| NJHGECRD DS XL4 NJE job gen. sect. pun cards | |
| NJHGPRGN DS CL20 NJE job gen. sect. programmr | |
| NJHGROOM DS CL8 NJE job gen. sect. room no | |
| NJHGDEPT DS CL8 NJE job gen. sect. dept | |
| NJHGBLDG DS CL8 NJE job gen. sect. building | |
| NJHGNREC DS XL4 NJE job gen. sect. rec. cnt | |
| NJHGSIZE EQU *-NJHGDSEC NJE job gen. sect. size | |
| NJHSIZE EQU NJEPSIZE+NJHGSIZE NJE job header total size | |
| * | |
| * NJE data set header general section | |
| * | |
| NDHGDSEC DSECT NJE data set general sect. | |
| NDHGLEN DS AL2 NJE ds gen sect. length | |
| NDHGTYPE DS XL1 NJE ds gen sect. type | |
| NDHGMOD DS XL1 NJE ds gen sect. type modif | |
| NDHGNODE DS CL8 NJE ds gen sect. dest node | |
| NDHGRMT DS CL8 NJE ds gen sect. dest user | |
| NDHGPROC DS CL8 NJE ds gen sect. proc name | |
| NDHGSTEP DS CL8 NJE ds gen sect. step type | |
| NDHGDD DS CL8 NJE ds gen sect. ddname | |
| NDHGDSNO DS AL2 NJE ds gen sect. count | |
| DS XL1 Reserved | |
| NDHGCLAS DS CL1 NJE ds gen sect. class | |
| NDHGNREC DS XL4 NJE ds gen sect. Record cnt | |
| NDHGFLG1 DS XL1 NJE ds gen sect. flags | |
| NDHGRCFM DS XL1 NJE ds gen sect. record fmt | |
| NDHGLREC DS AL2 NJE ds gen sect. record len | |
| NDHGDSCT DS XL1 NJE ds gen sect. copy count | |
| NDHGFCBI DS XL1 NJE ds gen sect. print index | |
| NDHGLNCT DS XL1 NJE ds gen sect. lpp | |
| DS XL1 Reserved | |
| NDHGFORM DS CL8 NJE ds gen sect. form | |
| NDHGFCB DS CL8 NJE ds gen sect. FCB | |
| NDHGUCS DS CL8 Universal char set name | |
| NDHGXWTR DS CL8 Data set external writer | |
| NDHGNAME DS CL8 Data set name qualifier | |
| NDHGFLG2 DS XL1 Second flag byte | |
| NDHGUCSO DS XL1 NJE ds gen sect. UCS options | |
| DS XL2 Reserved | |
| NDHGPMDE DS CL8 NJE ds gen sect. proc mode | |
| NDHGSIZE EQU *-NDHGDSEC Ds hdr general section size | |
| * | |
| * NJE data set header RSCS section | |
| * | |
| NDHVDSEC DSECT Data set header RSCS sect. | |
| NDHVLEN DS AL2 Ds header RSCS sect. length | |
| NDHVTYPE DS AL1 Ds header RSCS sect. type | |
| NDHVMOD DS AL1 Ds header RSCS sec modifier | |
| NDHVFLG1 DS AL1 Ds header RSCS sect flags | |
| NDHVCLAS DS CL1 Ds header RSCS sect class | |
| NDHVIDEV DS AL1 Ds header RSCS sect dev typ | |
| NDHVPGLE DS AL1 Ds header RSCS 3800 page ln | |
| NDHVDIST DS CL8 Ds header RSCS dist code | |
| NDHVFNAM DS CL12 Ds header RSCS filename | |
| NDHVFTYP DS CL12 Ds header RSCS filetype | |
| NDHVPRIO DS AL2 Ds header RSCS trn priority | |
| NDHVVRSN DS AL1 Ds header RSCS version no | |
| NDHVRELN DS AL1 Ds header RSCS release no | |
| NDHVSIZE EQU *-NDHVDSEC Ds header RSCS section size | |
| NDHSIZE EQU NJEPSIZE+NDHGSIZE+NDHVSIZE Total ds header size | |
| * | |
| * NJE job trailer general section | |
| * | |
| NJTGDSEC DSECT Job trailer general section | |
| NJTGLEN DS AL2 Job trailer gen sect length | |
| NJTGTYPE DS AL1 Job trailer gen sect type | |
| NJTGMOD DS AL1 Job trailer gen sc modifier | |
| NJTGFLG1 DS AL1 Job trailer gen sect flags | |
| NJTGXCLS DS CL1 Job trailer execution class | |
| DS XL2 Reserved | |
| NJTGSTRT DS XL8 Job trailer job start TOD | |
| NJTGSTOP DS XL8 Job trailer job stop TOD | |
| DS XL4 Reserved | |
| NJTGALIN DS XL4 Job trailer print lines | |
| NJTGACRD DS XL4 Job trailer card images | |
| DS XL4 Reserved | |
| NJTGIXPR DS XL1 Job trailer init exec prior | |
| NJTGAXPR DS XL1 Job trailer actul exe prior | |
| NJTGIOPR DS XL1 Job trailer init job prior | |
| NJTGAOPR DS XL1 Job trailer actual job prio | |
| NJTGSIZE EQU *-NJTGDSEC Job trailer gen. sect. size | |
| NJTSIZE EQU NJEPSIZE+NJTGSIZE Job trailer total size | |
| * | |
| * NMR record | |
| * | |
| NMRDSECT DSECT | |
| NMRFLAG DS XL1 NMR flags | |
| NMRLVPR DS XL1 NMR level / priority | |
| NMRTYPE DS XL1 NMR type | |
| NMRML DS XL1 Length of contents of NMRMSG | |
| NMRTO DS 0XL9 Destination system | |
| NMRTONOD DS CL8 NMR destination node | |
| NMRTOQUL DS XL1 Destination node system identifier | |
| NMROUT DS CL8 Userid / remote id / console id | |
| NMRFM DS 0XL9 NMR originating system | |
| NMRFMNOD DS CL8 NMR originating node | |
| NMRFMQUL DS XL1 Originating node system identifier | |
| NMRHSIZE EQU *-NMRDSECT Size of NMR header only | |
| NMRECSID DS 0CL8 Message origination node | |
| NMRMSG DS CL148 NMR message / command | |
| NMRSIZE EQU *-NMRDSECT NMR size including message / command | |
| * | |
| * Fields in NMRFLAG | |
| * | |
| NMRFLAGC EQU X'80' NMR is a command | |
| NMRFLAGW EQU X'40' NMROUT has remote workstation id | |
| NMRFLAGT EQU X'20' NMROUT contains a userid | |
| NMRFLAGU EQU X'10' NMROUT contains console identifier | |
| NMRFLAGR EQU X'08' Console is remote-authorized only | |
| NMRFLAGJ EQU X'04' Console is not job-authorized | |
| NMRFLAGD EQU X'02' Console is not device-authorized | |
| NMRFLAGS EQU X'01' Console is not system-authorized | |
| * | |
| * Fields in NMRTYPE | |
| * | |
| NMRTYPE4 EQU X'08' Source userid embedded in NMRMSG | |
| NMRTYPET EQU X'04' Timestamp is not embedded in NMRMSG | |
| NMRTYPEF EQU X'02' NMR comtains a formatted command | |
| NMRTYPED EQU X'02' Contains a delete operator message | |
| * | |
| * SYSIN RCBs | |
| * | |
| RRCB1 EQU X'98' Stream 1 sysin records | |
| RRCB2 EQU X'A8' Stream 2 sysin records | |
| RRCB3 EQU X'B8' Stream 3 sysin records | |
| RRCB4 EQU X'C8' Stream 4 sysin records | |
| RRCB5 EQU X'D8' Stream 5 sysin records | |
| RRCB6 EQU X'E8' Stream 6 sysin records | |
| RRCB7 EQU X'F8' Stream 7 sysin records | |
| * | |
| * SYSOUT RCBs | |
| * | |
| PRCB1 EQU X'99' Stream 1 sysout records | |
| PRCB2 EQU X'A9' Stream 2 sysout records | |
| PRCB3 EQU X'B9' Stream 3 sysout records | |
| PRCB4 EQU X'C9' Stream 4 sysout records | |
| PRCB5 EQU X'D9' Stream 5 sysout records | |
| PRCB6 EQU X'E9' Stream 6 sysout records | |
| PRCB7 EQU X'F9' Stream 7 sysout records | |
| ./ ADD NAME=NJEPARMS | |
| MACRO | |
| &X NJEPARMS | |
| .* | |
| .* Change log: | |
| .* | |
| .* | |
| .* 04 Dec 20 - Expanded internal trace table support v212 | |
| .* 29 Nov 20 - Use text-based configuration; alternate routes v211 | |
| .* 29 Nov 20 - Initial creation. v211 | |
| .* | |
| *--this area mapped as INITPARM; passed to NJEDRV/NJECMX/NJESCN v211 | |
| DS 0D v211 | |
| INITPARM DS 0XL72 v220 | |
| * Offset Owner Area to be passed v211 | |
| * ------ ------- --------------------------------v211 | |
| LCLNODE DS CL8 0 NJEINIT Local node name v211 | |
| CPUID DS D 8 NJEINIT CPUID of this system v211 | |
| ANJECMX DS A 10 NJEINIT -> entry of NJECMX cmd processorv211 | |
| ANJESPL DS A 14 NJEINIT -> NJESPOOL interface v211 | |
| RQENUM DS F 18 NJEINIT # RQEs in stg area v211 | |
| ARQESTG DS A 1C NJEINIT -> RQE stg area v211 | |
| CSABLK DS A 20 NJEINIT -> CSA communication area v211 | |
| ALINKS DS A 24 NJEINIT -> LINKS (LINKTABL anchor) v211 | |
| AROUTES DS A 28 NJEINIT -> ROUTES (RTE list anchor) v211 | |
| AAUTHS DS A 2C NJEINIT -> AUTHS (AUTHLIST anchor) v211 | |
| ACMDBLOK DS A 30 NJEINIT -> CMDBLOK dsect (CMNDBLOK) v211 | |
| MSGQ DS A 34 NJEDRV Stacked msg Q anchor v211 | |
| XJELINK DS A 38 NJEDRV -> task's LINKTABL v211 | |
| ATRACE DS A 3C NJEINIT -> Trace table control v212 | |
| AREGUSER DS A 40 NJEINIT -> REGUSER (REGUSER anchor) v220 | |
| RESV1 DS F 44 Available word v220 | |
| * 48 Total length v220 | |
| INITPRML EQU *-INITPARM Length of this parm list v211 | |
| *--end of passed area v211 | |
| MEND | |
| ./ ADD NAME=NJEQUMSG | |
| MACRO | |
| &X NJEQUMSG | |
| .* | |
| .* Change log: | |
| .* | |
| .* 11 Dec 20 - Initial creation. v220 | |
| .* | |
| QUMSG DSECT Queued user message | |
| QUMNEXT DS A -> next QUMSG or 0 | |
| QUMOWNER DS A -> REGUSER that owns this msg | |
| QUMSGTXT DS CL120 Message text | |
| QUMSIZE EQU *-QUMSG Size of dsect | |
| MEND | |
| ./ ADD NAME=NJERUSER | |
| MACRO | |
| &X NJERUSER | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Initial creation. v220 | |
| .* | |
| * | |
| REGUSERB DSECT Registered userid block | |
| REGNEXT DS A -> next REGUSER or 0 | |
| REGEYE DS CL4'REGU' Eyecatcher | |
| REGWRE DS A -> user's registration WRE in CSA | |
| REGMSGQ DS A -> user's queued msgs WRE chain | |
| REGUSRID DS CL8 Userid | |
| REGSIZE EQU *-REGUSERB Size of dsect | |
| MEND | |
| ./ ADD NAME=NJETRACE | |
| MACRO | |
| &X NJETRACE &TYPE= | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Support for registered users and message queuing v220 | |
| .* 10 Dec 20 - Create NJETRACE macro from old in-line TRACE macro v220 | |
| .* | |
| AIF ('&TYPE' EQ 'DSECT').DSECT | |
| .* | |
| &X STM R15,R2,16(R13) R0-R2 restored by trace rtn | |
| L R2,ATRACE -> trace table | |
| L R15,TRCRTN-TRCCTL(,R2) -> trace routine | |
| BALR R14,R15 Go get a new trace entry | |
| L R15,16(,R13) Restore R15 | |
| MVI 0(R14),&TYPE Move in trace type code | |
| MEXIT | |
| .* | |
| .DSECT ANOP | |
| TRCCTL DSECT | |
| TRCEYE DS CL8'TRACETAB' Eyecatcher | |
| TRCRTN DS A -> Trace routine | |
| DS A Reserved | |
| TRCSTRT DS A -> Start of trace table | |
| TRCCURR DS A -> Current trace entry | |
| TRCEND DS A -> End of trace table | |
| DS A Reserved | |
| TRCSZ EQU 32 Size of each trace entry | |
| * | |
| *-- TRACE TABLE TYPES | |
| * | |
| TRCEXCP EQU X'01' EXCP operation | |
| TRCWAIT EQU X'02' Wait completed | |
| TRCDYNA EQU X'03' Dynamic Allocation | |
| TRCMSG EQU X'04' Message | |
| TRCRCMD EQU X'05' remote command | |
| TRCGET EQU X'06' Getmain | |
| TRCFREE EQU X'07' Freemain | |
| TRCOPNO EQU X'08' Open output request | |
| TRCCLSO EQU X'09' Close output request | |
| TRCOPNI EQU X'0A' Open input request | |
| TRCCONT EQU X'0B' Spool contents request | |
| TRCCLSI EQU X'0C' Close input request | |
| TRCPURG EQU X'0D' File Purge request | |
| TRC0E EQU X'0E' Available | |
| TRCGLQ EQU X'0F' GLINKREQ | |
| TRCGRQ EQU X'10' GROUTREQ | |
| TRCALQ EQU X'11' ALERTREQ | |
| TRCGMQM EQU X'12' GMSGREQ from MSGQ | |
| TRCGMQR EQU X'13' GMSGREQ from RQE | |
| TRCIWRE EQU X'14' Incoming WRE | |
| TRCOWRE EQU X'15' Outgoing WRE | |
| TRCGWRE EQU X'16' Getmain WRE | |
| TRCFWRE EQU X'17' Freemain WRE | |
| * | |
| MEND | |
| ./ ADD NAME=NJEVER | |
| MACRO | |
| NJEVER | |
| GBLC &VERS | |
| &VERS SETC 'v2.3.0' -> Current version | |
| B 34(,R15) | |
| DC AL1(29) | |
| DC CL9'&SYSECT' | |
| DC CL6'&VERS' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| MEND | |
| ./ ADD NAME=NJEWRE | |
| MACRO | |
| &X NJEWRE | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 Dec 20 - Support for registered users and message queuing v220 | |
| .* | |
| WRE DSECT | |
| WRENEXT DS A -> next WRE or 0 | |
| WRETYPE DS X WRE type | |
| WRENEW EQU X'04' New file added to NETSPOOL | |
| WRECMD EQU X'08' CMD type | |
| WREMSG EQU X'0C' MSG type | |
| WRESTAR EQU X'10' START type | |
| WREREG EQU X'14' Registration request v220 | |
| WREDREG EQU X'18' Deregistration request v220 | |
| WREQRM EQU X'1C' Queue registered user msg v220 | |
| WREDRM EQU X'20' Dequeue registered user msg v220 | |
| WRECODE DS X Command code for link driver | |
| WRETXTLN DS X CMD or MSG text length | |
| WRESP DS X Getmained subpool number v220 | |
| WRELINK DS CL8 Target link name for this WRE | |
| WREUSER DS CL8 Target user name for this WRE | |
| WREORIG DS 0CL8 Originating userid of MSG v220 | |
| WREASCB DS A Originating ASCB addr v220 | |
| WREECB DS F Originator ECB for CM POST v220 | |
| WRETXT DS CL120 Command or message text | |
| WRESIZE EQU *-WRE Size of WRE v220 | |
| * | |
| *- Error codes for registered user services (POST code in WREECB) v220 | |
| ERNOERR EQU 0 No errors v220 | |
| ERNOMSG EQU 4 No more messages v220 | |
| ERSTOP EQU 8 STOP command issued v220 | |
| ERINVREQ EQU 12 Invalid request v220 | |
| ERINACT EQU 16 NJE38 is not active v220 | |
| ERPOST EQU 20 CM POST to NJE38 failure v220 | |
| ERDUPUSR EQU 24 User already registered v220 | |
| ERUSERNF EQU 28 Userid is not registered v220 | |
| ERECBPST EQU 32 User ECB was posted v220 | |
| MEND | |
| ./ ADD NAME=NSIO | |
| MACRO MAC00010 | |
| &L NSIO &TYPE=, XMAC00020 | |
| &NCB=NCB, XMAC00030 | |
| &TAG=, XMAC00040 | |
| &EODAD=, XMAC00050 | |
| &AREALEN=, XMAC00060 | |
| &AREA=, XMAC00070 | |
| &RECLEN=, v210XMAC00080 | |
| &ENTRY= v210 MAC00080 | |
| .* | |
| .* Change log: | |
| .* | |
| .* 10 AUG 20 - Add alternate entry point via ENTRY= v210 | |
| .* 21 May 20 - Add update directory entry functionality v120 | |
| .* | |
| .* MAC00100 | |
| LCLA &OFFREQ MAC00110 | |
| LCLA &OFFTAG MAC00120 | |
| LCLA &OFFEOD MAC00130 | |
| LCLA &OFFARL MAC00140 | |
| LCLA &OFFARA MAC00150 | |
| LCLA &OFFRCL MAC00160 | |
| LCLA &NSIZE MAC00180 | |
| LCLA &REQ MAC00190 | |
| LCLC &W MAC00200 | |
| .* MAC00210 | |
| .* Offsets within NCB block MAC00220 | |
| &OFFREQ SETA 9 Offset of NCBREQ MAC00230 | |
| &OFFTAG SETA 16 Offset of NCBTAG MAC00240 | |
| &OFFEOD SETA 20 Offset of NCBEODAD MAC00250 | |
| &OFFARL SETA 24 Offset of NCBAREAL MAC00260 | |
| &OFFARA SETA 28 Offset of NCBAREA MAC00270 | |
| &OFFRCL SETA 32 Offset of NCBRECLN MAC00280 | |
| * MAC00300 | |
| .* Assembled size of NCB DSECT MAC00310 | |
| &NSIZE SETA 48 Size of an NCB MAC00320 | |
| .* MAC00330 | |
| AIF (T'&NCB NE 'O').NCB1 MAC00340 | |
| MNOTE 8,'NCB= PARAMETER REQUIRED' MAC00350 | |
| AGO .TYPE MAC00360 | |
| .* MAC00370 | |
| .NCB1 ANOP MAC00380 | |
| AIF ('&NCB'(1,1) EQ '(').NCB1R MAC00390 | |
| &L LA 1,&NCB -> NCB MAC00400 | |
| AGO .TYPE MAC00410 | |
| .NCB1R ANOP MAC00420 | |
| &W SETC '&NCB'(2,K'&NCB-2) MAC00430 | |
| &L LR 1,&W -> NCB MAC00440 | |
| .* MAC00450 | |
| .ISTYPE ANOP MAC00460 | |
| AIF (T'&TYPE NE 'O').TYPE MAC00470 | |
| MNOTE 8,'TYPE= PARAMETER REQUIRED' MAC00480 | |
| MEXIT MAC00490 | |
| .* MAC00500 | |
| .TYPE ANOP MAC00510 | |
| AIF ('&TYPE' EQ 'OPEN').OPEN MAC00520 | |
| AIF ('&TYPE' EQ 'CLOSE').CLOSE MAC00530 | |
| AIF ('&TYPE' EQ 'PUT').PUT MAC00540 | |
| AIF ('&TYPE' EQ 'GET').GET MAC00550 | |
| AIF ('&TYPE' EQ 'PURGE').PURGE MAC00560 | |
| AIF ('&TYPE' EQ 'FIND').FIND MAC00570 | |
| AIF ('&TYPE' EQ 'CONTENTS').CONTENT MAC00580 | |
| AIF ('&TYPE' EQ 'UDIR').UDIR v120 MAC00570 | |
| MNOTE 8,'TYPE=&TYPE IS NOT A VALID FUNCTION TYPE' MAC00590 | |
| MEXIT MAC00600 | |
| .* MAC00610 | |
| .OPEN ANOP MAC00620 | |
| &REQ SETA 1 MAC00630 | |
| XC 0(&NSIZE,1),0(1) Initialize NCB MAC00640 | |
| MVC 0(4,1),=CL4'NCB' Set NCB identifier MAC00650 | |
| AGO .SETREQ MAC00660 | |
| .* MAC00670 | |
| .CLOSE ANOP MAC00680 | |
| &REQ SETA 2 MAC00690 | |
| AGO .SETREQ MAC00700 | |
| .* MAC00710 | |
| .PUT ANOP MAC00720 | |
| &REQ SETA 3 MAC00730 | |
| AGO .SETREQ MAC00740 | |
| .* MAC00750 | |
| .GET ANOP MAC00760 | |
| &REQ SETA 4 MAC00770 | |
| AGO .SETREQ MAC00780 | |
| .* MAC00790 | |
| .PURGE ANOP MAC00800 | |
| &REQ SETA 5 MAC00810 | |
| AGO .SETREQ MAC00820 | |
| .* MAC00830 | |
| .FIND ANOP MAC00840 | |
| &REQ SETA 6 MAC00850 | |
| AGO .SETREQ MAC00860 | |
| .* MAC00870 | |
| .CONTENT ANOP MAC00880 | |
| &REQ SETA 7 MAC00890 | |
| AGO .SETREQ v120 MAC00860 | |
| .* MAC00830 | |
| .UDIR ANOP v120 MAC00840 | |
| &REQ SETA 8 v120 MAC00850 | |
| .* MAC00900 | |
| .SETREQ ANOP MAC00910 | |
| MVI &OFFREQ.(1),&REQ Set NCBREQ type MAC00920 | |
| .* MAC00930 | |
| .TAG ANOP MAC00940 | |
| AIF (T'&TAG EQ 'O').EODAD MAC00950 | |
| AIF ('&TAG'(1,1) EQ '(').TAG1R MAC00960 | |
| LA 0,&TAG -> TAG data MAC00970 | |
| ST 0,&OFFTAG.(,1) Store in NCB MAC00980 | |
| AGO .EODAD MAC00990 | |
| .TAG1R ANOP MAC01000 | |
| &W SETC '&TAG'(2,K'&TAG-2) MAC01010 | |
| ST &W,&OFFTAG.(,1) Store tag ptr in NCB MAC01020 | |
| .* MAC01030 | |
| .EODAD ANOP MAC01040 | |
| AIF (T'&EODAD EQ 'O').AREALEN MAC01050 | |
| AIF ('&EODAD'(1,1) EQ '(').EODAD1R MAC01060 | |
| LA 0,&EODAD -> End of data routine MAC01070 | |
| ST 0,&OFFEOD.(,1) Store in NCB MAC01080 | |
| AGO .AREALEN MAC01090 | |
| .EODAD1R ANOP MAC01100 | |
| &W SETC '&EODAD'(2,K'&EODAD-2) MAC01110 | |
| ST &W,&OFFEOD.(,1) Set EODAD address in NCB MAC01120 | |
| .* MAC01130 | |
| .AREALEN ANOP MAC01140 | |
| AIF (T'&AREALEN EQ 'O').AREA MAC01150 | |
| AIF ('&AREALEN'(1,1) EQ '(').AREAL1R MAC01160 | |
| MVC &OFFARL.(4,1),=A(&AREALEN) Set area length value in NCB MAC01170 | |
| AGO .AREA MAC01180 | |
| .AREAL1R ANOP MAC01190 | |
| &W SETC '&AREALEN'(2,K'&AREALEN-2) MAC01200 | |
| ST &W,&OFFARL.(,1) Set area length in NCB MAC01210 | |
| .* MAC01220 | |
| .AREA ANOP MAC01230 | |
| AIF (T'&AREA EQ 'O').RECLEN MAC01240 | |
| AIF ('&AREA'(1,1) EQ '(').AREA1R MAC01250 | |
| LA 0,&AREA -> Record buffer area MAC01260 | |
| ST 0,&OFFARA.(,1) Store in NCB MAC01270 | |
| AGO .RECLEN MAC01280 | |
| .AREA1R ANOP MAC01290 | |
| &W SETC '&AREA'(2,K'&AREA-2) MAC01300 | |
| ST &W,&OFFARA.(,1) Set area address in NCB MAC01310 | |
| .* MAC01320 | |
| .RECLEN ANOP MAC01330 | |
| AIF (T'&RECLEN EQ 'O').ENTRY v210 MAC01340 | |
| AIF ('&RECLEN'(1,1) EQ '(').REC1R MAC01350 | |
| MVC &OFFRCL.(2,1),=Y(&RECLEN) Set record length in NCB MAC01360 | |
| AGO .ENTRY v210 MAC01370 | |
| .REC1R ANOP MAC01380 | |
| &W SETC '&RECLEN'(2,K'&RECLEN-2) MAC01390 | |
| STH &W,&OFFRCL.(,1) Set record length in NCB MAC01400 | |
| .* MAC01500 | |
| .ENTRY ANOP MAC01510 | |
| AIF (T'&ENTRY EQ 'O').VCON v210 | |
| AIF ('&ENTRY'(1,1) EQ '(').ENT1R v210 MAC01350 | |
| L 15,&ENTRY Load NJESPOOL entry addr v210 | |
| AGO .LAUNCH v210 | |
| .* MAC01500 | |
| .ENT1R ANOP v210 MAC01510 | |
| &W SETC '&ENTRY'(2,K'&ENTRY-2) v210 MAC01390 | |
| AIF ('&W' EQ '15').LAUNCH v210 MAC01350 | |
| LR 15,&W Entry addr to R15 v210 MAC01400 | |
| AGO .LAUNCH v210 | |
| .* | |
| .VCON ANOP v210 | |
| L 15,=V(NJESPOOL) | |
| .* | |
| .LAUNCH ANOP v210 | |
| BALR 14,15 | |
| .* | |
| .MEND ANOP v210 MAC01510 | |
| MEND MAC01520 | |
| ./ ADD NAME=REGEQU | |
| MACRO REG00010 | |
| &X REGEQU REG00020 | |
| * DEFINES GENERAL REGISTERS REG00030 | |
| R0 EQU 0 REG00040 | |
| R1 EQU 1 REG00050 | |
| R2 EQU 2 REG00060 | |
| R3 EQU 3 REG00070 | |
| R4 EQU 4 REG00080 | |
| R5 EQU 5 REG00090 | |
| R6 EQU 6 REG00100 | |
| R7 EQU 7 REG00110 | |
| R8 EQU 8 REG00120 | |
| R9 EQU 9 REG00130 | |
| R10 EQU 10 REG00140 | |
| R11 EQU 11 REG00150 | |
| R12 EQU 12 REG00160 | |
| R13 EQU 13 REG00170 | |
| R14 EQU 14 REG00180 | |
| R15 EQU 15 REG00190 | |
| * DEFINES CONTROL REGISTERS REG00200 | |
| C0 EQU 0 REG00210 | |
| C1 EQU 1 REG00220 | |
| C2 EQU 2 REG00230 | |
| C3 EQU 3 REG00240 | |
| C4 EQU 4 REG00250 | |
| C5 EQU 5 REG00260 | |
| C6 EQU 6 REG00270 | |
| C7 EQU 7 REG00280 | |
| C8 EQU 8 REG00290 | |
| C9 EQU 9 REG00300 | |
| C10 EQU 10 REG00310 | |
| C11 EQU 11 REG00320 | |
| C12 EQU 12 REG00330 | |
| C13 EQU 13 REG00340 | |
| C14 EQU 14 REG00350 | |
| C15 EQU 15 REG00360 | |
| * DEFINES FLOATING PT REGISTERS REG00370 | |
| F0 EQU 0 REG00380 | |
| F2 EQU 2 REG00390 | |
| F4 EQU 4 REG00400 | |
| F6 EQU 6 REG00410 | |
| MEND REG00420 | |
| ./ ADD NAME=ROUTE | |
| MACRO | |
| &LABEL ROUTE &PARM1,&PARM2, X | |
| &TYPE=ENTRY | |
| GBLA &RTETOT | |
| AIF ('&TYPE' EQ 'FINAL').FINAL | |
| LCLC &DEST,&NEXT | |
| &RTETOT SETA &RTETOT+1 | |
| AIF (&RTETOT NE 1).NOT1 | |
| ROUTES DS 0D | |
| .NOT1 ANOP | |
| &DEST SETC ' ' | |
| &NEXT SETC ' ' | |
| AIF (T'&PARM1 EQ 'O').NOID | |
| &DEST SETC '&PARM1' | |
| AIF (T'&PARM2 EQ 'O').NOID | |
| &NEXT SETC '&PARM2' | |
| .NOID ANOP | |
| &LABEL DC CL8'&DEST',CL8'&NEXT' DESTINATION, NEXT LINK | |
| MEXIT | |
| .FINAL ANOP | |
| NUMRTES EQU &RTETOT | |
| AIF (&RTETOT NE 0).MEND | |
| ROUTES DS 0D | |
| .MEND ANOP | |
| MEND | |
| ./ ADD NAME=RSSEQU | |
| PUSH PRINT | |
| AIF ('&SYSPARM' NE 'SUP').RSS01 | |
| PRINT OFF,NOGEN | |
| .RSS01 ANOP | |
| * | |
| *** RSS EQUATE SYMBOLS - MACHINE USAGE | |
| * | |
| SPACE 1 | |
| * BITS DEFINED IN STANDARD/EXTENDED PSW | |
| EXTMODE EQU X'08' BIT 12 - EXTENDED MODE | |
| MCHEK EQU X'04' BIT 13 - MACHINE CHECK ENABLED | |
| WAIT EQU X'02' BIT 14 - WAIT STATE | |
| PROBMODE EQU X'01' BIT 15 - PROBLEM STATE | |
| SPACE 1 | |
| * BITS DEFINED IN CHANNEL STATUS WORD - CSW | |
| ATTN EQU X'80' BIT 32 - ATTENTION | |
| SM EQU X'40' BIT 33 - STATUS MODIFIER | |
| CUE EQU X'20' BIT 34 - CONTROL UNIT END | |
| BUSY EQU X'10' BIT 35 - BUSY | |
| CE EQU X'08' BIT 36 - CHANNEL END | |
| DE EQU X'04' BIT 37 - DEVICE END | |
| UC EQU X'02' BIT 38 - UNIT CHECK | |
| UE EQU X'01' BIT 39 - UNIT EXCEPTION | |
| * | |
| PCI EQU X'80' BIT 40 - PROGRAM-CONTROL INTERRUPT | |
| IL EQU X'40' BIT 41 - INCORRECT LENGTH | |
| PRGC EQU X'20' BIT 42 - PROGRAM CHECK | |
| PRTC EQU X'10' BIT 43 - PROTECTION CHECK | |
| CDC EQU X'08' BIT 44 - CHANNEL DATA CHECK | |
| CCC EQU X'04' BIT 45 - CHANNEL CONTROL CHECK | |
| IFCC EQU X'02' BIT 46 - INTERFACE CONTROL CHECK | |
| CHC EQU X'01' BIT 47 - CHAINING CHECK | |
| SPACE 1 | |
| * BITS DEFINED IN CHANNEL COMMAND WORD - CCW | |
| CD EQU X'80' BIT 32 - CHAIN DATA | |
| CC EQU X'40' BIT 33 - COMMAND CHAIN | |
| SILI EQU X'20' BIT 34 - SUPPRESS INCORRECT LENGTH IND. | |
| SKIP EQU X'10' BIT 35 - SUPPRESS DATA TRANSFER | |
| PCIF EQU X'08' BIT 36 - PROGRAM-CONTROL INTERRUPT FETCH | |
| IDA EQU X'04' BIT 37 - INDIRECT DATA ADDRESS | |
| SPACE 1 | |
| * BITS DEFINED IN SENSE BYTE 0 -- COMMON TO MOST DEVICES | |
| CMDREJ EQU X'80' BIT 0 - COMMAND REJECT | |
| INTREQ EQU X'40' BIT 1 - INTERVENTION REQUIRED | |
| BUSOUT EQU X'20' BIT 2 - BUS OUT | |
| EQCHK EQU X'10' BIT 3 - EQUIPMENT CHECK | |
| DATACHK EQU X'08' BIT 4 - DATA CHECK | |
| EJECT | |
| * | |
| *** CP370 EQUATE SYMBOLS - CP USAGE | |
| * | |
| * SYMBOLIC REGISTER EQUATES | |
| R0 EQU 0 | |
| R1 EQU 1 | |
| R2 EQU 2 | |
| R3 EQU 3 | |
| R4 EQU 4 | |
| R5 EQU 5 | |
| R6 EQU 6 | |
| R7 EQU 7 GENERAL | |
| R8 EQU 8 REGISTER | |
| R9 EQU 9 DEFINITIONS | |
| R10 EQU 10 | |
| R11 EQU 11 | |
| R12 EQU 12 | |
| R13 EQU 13 | |
| R14 EQU 14 | |
| R15 EQU 15 | |
| * | |
| Y0 EQU 0 FLOATING | |
| Y2 EQU 2 POINT | |
| Y4 EQU 4 REGISTER | |
| Y6 EQU 6 DEFINITIONS | |
| EJECT | |
| POP PRINT | |
| SPACE | |
| ./ ADD NAME=RTE | |
| RTE DSECT | |
| ROUTPTR DS A -> next RTE entry or 0 | |
| DS A Reserved | |
| ROUTNAME DS CL8 Route destination node | |
| ROUTNEXT DS CL8 Link id for indirect routing | |
| ROUTALT1 DS CL8 Alternate link id for indirect rt'g | |
| ROUTALT2 DS CL8 Alternate link id for indirect rt'g | |
| ROUTALT3 DS CL8 Alternate link id for indirect rt'g | |
| ROUTSIZE EQU *-RTE Length of a routing table entry | |
| ./ ADD NAME=TAG | |
| PUSH PRINT | |
| AIF ('&SYSPARM' NE 'SUP').TAG01 | |
| PRINT OFF,NOGEN | |
| .TAG01 ANOP | |
| TAG DSECT | |
| SPACE 1 | |
| *** TAG - FILE TAG | |
| * | |
| * 0 +-----------------------+-----------------------+ | |
| * | TAGNEXT | TAGBLOCK | | |
| * 8 +-----------------------+-----------------------+ | |
| * | TAGINLOC | | |
| * 10 +-----------------------------------------------+ | |
| * | TAGLINK | | |
| * 18 +-----------------------------------------------+ | |
| * | TAGINTOD | | |
| * 20 +-----------------------------------------------+ | |
| * | TAGINVM | | |
| * 28 +-----------------------+-----------+-----+-----+ | |
| * | TAGRECNM | TAGRECLN | T*1 | T*2 | | |
| * 30 +-----------+-----------+-----------+-----+-----+ | |
| * | TAGID | TAGCOPY | T*3 | T*4 | SPARE | | |
| * 38 +-----------+-----------+-----------------------+ | |
| * | TAGNAME | | |
| * 40 | +-----------------------+ | |
| * | | | | |
| * 48 +-----------------------+ | | |
| * | TAGTYPE | | |
| * 50 +-----------------------------------------------+ | |
| * | TAGDIST | | |
| * 58 +-----------------------------------------------+ | |
| * | TAGTOLOC | | |
| * 60 +-----------------------------------------------+ | |
| * | TAGTOVM | | |
| * 68 +-----------------------------------------------+ | |
| * | TAGPRIOR | TAGDEV | | |
| * 70 +-----------+-----------+ | |
| * | |
| *** TAG - FILE TAG | |
| SPACE 1 | |
| TAGNEXT DS 1F ADDR OF NEXT ACTIVE QUEUE ENTRY | |
| TAGBLOCK DS 1F ADDR OF ASSOCIATED I/O AREA | |
| SPACE | |
| TAGINLOC DS CL8 ORIGINATING LOCATION | |
| TAGLINK DS CL8 NEXT LOCATION FOR TRANSMISSION | |
| TAGINTOD DS CL8 TIME OF FILE ORIGIN | |
| TAGINVM DS CL8 ORIGINATING VIRTUAL MACHINE | |
| TAGRECNM DS 1F NUMBER OF RECORDS IN FILE | |
| TAGRECLN DS 1H MAXIMUM FILE DATA RECORD LENGTH | |
| TAGINDEV DS 1X T*1 DEVICE CODE OF ORIGINATING DEV | |
| TAGCLASS DS CL1 T*2 FILE OUTPUT CLASS | |
| TAGID DS 1H FILE NUMBER AT ORIGIN LOCATION | |
| TAGCOPY DS 1H NUMBER OF COPIES REQUESTED | |
| TAGFLAG DS 1X T*3 VM/370 SFBLOK CONTROL FLAGS | |
| TAGFLAG2 DS 1X T*4 VM/370 SFBLOK CONTROL FLAGS | |
| DS 1H SPARE | |
| TAGNAME DS CL12 FILE NAME | |
| TAGTYPE DS CL12 FILE TYPE | |
| TAGDIST DS CL8 FILE DISTRIBUTION CODE | |
| TAGTOLOC DS CL8 DESTINATION LOCATION ID | |
| TAGTOVM DS CL8 DESTINATION VIRTUAL MACHINE ID | |
| TAGPRIOR DS 1H TRANSMISSION PRIORITY | |
| TAGDEV DS 2X ACTIVE FILE'S VIRT DEV ADDR | |
| SPACE | |
| TAGUSELN EQU *-TAGINLOC USABLE TAG INFO LEN *XJE | |
| TAGLEN EQU *-TAGNEXT LENGTH OF THE FILE TAG | |
| EJECT | |
| POP PRINT | |
| SPACE | |
| @@ | |
| //* | |
| //* Installs SYSGEN.NJE38.ASMSRC | |
| //* | |
| //ASMSRC EXEC PGM=PDSLOAD | |
| //SYSPRINT DD SYSOUT=* | |
| //SYSUT2 DD DSN=SYSGEN.NJE38.ASMSRC,DISP=(NEW,CATLG), | |
| // VOL=SER=PUB001, | |
| // UNIT=3375,SPACE=(CYL,(2,1,10)), | |
| // DCB=(BLKSIZE=6160,LRECL=80,RECFM=FB) | |
| //SYSUT1 DD DATA,DLM=@@ | |
| ./ ADD NAME=NJESYS | |
| * | |
| * | |
| *-- NJE38 - Locate NJE38 information from an ENQ resource | |
| * | |
| * | |
| * Called by NJEINIT,NJERCV,NJETRN,NJE38,NJ38XMIT,NJ38RECV | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 01 Oct 20 - Initial creation v210 | |
| * | |
| * | |
| GBLC &VERS | |
| REGEQU | |
| NJESYS CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) Save regs | |
| LR R12,R15 | |
| USING NJESYS,R12 | |
| * | |
| *-- Determine if NJE38 is already active in another address space | |
| * | |
| CHK000 EQU * | |
| L R2,16 Get CVT ptr | |
| USING CVT,R2 | |
| LA R2,CVTFQCB -> ENQ QCB chain anchor | |
| USING QCB,R2 | |
| * | |
| CHK010 EQU * | |
| ICM R2,15,MAJNMAJ -> next major QCB | |
| BZ CHK080 Our guy not found | |
| CLC MAJNAME,NJE38Q Look for our QNAME "NJE38" | |
| BNE CHK010 Nope, go to next QCB | |
| * | |
| L R3,MAJFMIN -> first minor QCB | |
| USING MIN,R3 | |
| * | |
| CHK020 EQU * | |
| LA R4,MINNAME -> minor name | |
| CLC NJERCON,0(R4) Does minor name match? | |
| BE CHK030 Yes. NJE38 is active | |
| C R3,MAJLMIN Is this the last minor QCB? | |
| BE CHK080 Yes, we're done. NJE38 is not active | |
| ICM R3,15,MINNMIN -> next minor name | |
| BZR R14 Just in case no address | |
| B CHK020 Spin through the minor QCBs | |
| * | |
| CHK030 EQU * | |
| LTR R1,R1 Store spool DSN? | |
| BZ CHK040 No | |
| MVC 0(44,R1),12(R4) Save off NETSPOOL dsname | |
| * | |
| CHK040 EQU * | |
| L R1,8(,R4) Get CSABLK ptr from QCB minor | |
| SR R15,R15 RC=0, ENQ data was found | |
| B CHK090 | |
| * | |
| CHK080 EQU * | |
| LA R15,4 RC=4, no ENQ located | |
| * | |
| CHK090 EQU * | |
| ST R1,24(,R13) Return R1 value | |
| ST R15,16(,R13) Return R15 RC | |
| * | |
| LM R14,R12,12(R13) Reload regs | |
| BR R14 Return | |
| * | |
| DS 0D | |
| NJE38Q DC CL8'NJE38' | |
| NJERCON DC CL8'NJEINIT' | |
| * | |
| LTORG , | |
| * | |
| CVT DSECT=YES,PREFIX=NO | |
| IHAQCB | |
| * | |
| END | |
| ./ ADD NAME=NJESPOOL | |
| * | |
| * | |
| *-- NJE38 - "Spool" Services | |
| * | |
| * | |
| * Called by NJEINIT and NJEDRV for spool-like services | |
| * | |
| * | |
| * | |
| * Change log: | |
| * | |
| * 23 Jul 20 - Make CONTENTS return spool full percentage v200 | |
| * 21 Jul 20 - Only part of record buffer area was FREEMAINed v200 | |
| * 01 Jun 20 - Exclusive control error because ENDREQ not issued v130 | |
| * on CONTENTS function against an empty spool. v130 | |
| * 21 May 20 - Add update directory entry functionality v120 | |
| * 08 May 20 - RC 12 errors need error addr in NCBMACAD v110 | |
| * | |
| * | |
| * NJESPOOL - Provide a spooling mechanism "access method" for use by | |
| * NJE38 to hold data files queued for transmission, or to | |
| * hold data files that have been received via transmission | |
| * but not yet retrieved by the destination user. | |
| * | |
| * The main goal of NJESPOOL is to provide a simple way to read and | |
| * write files by the NJE line driver without the line driver having | |
| * to know the vagaries of i/o, record formats, directories, and so on. | |
| * NJESPOOL does the heavier lifting and spool management under the | |
| * covers and unknown to the line driver. | |
| * | |
| * The spool dataset, "NETSPOOL", is a VSAM RRDS-type dataset. All | |
| * blocks in the dataset are one control interval in size. The CI size | |
| * must be 4096, which gives a usable record size of 4089 bytes. The | |
| * NETSPOOL internal format is based on these sizes. | |
| * | |
| * NETSPOOL contains a directory which describes the data files | |
| * present within. There are two directories; one is the current | |
| * directory which describes the true state of NETSPOOL, the other is | |
| * the current-minus-1 diectory, which is the state of NETSPOOL just | |
| * prior to the very last directory update. When new data files are | |
| * added or removed from NETSPOOL, the current directory is copied onto | |
| * current-minus-1 and then the addition or deletion is applied. This | |
| * then becomes the current directory and the directory that was most | |
| * recently current becomes current-minus-1. Thus the directories | |
| * alternate back and forth. The first block of each directory are | |
| * blocks 2 and 3, respectively. If the directory size expands to | |
| * additional blocks, they can be anywhere in the dataset, but the | |
| * very first block of either directory is ALWAYS 2 or 3. | |
| * | |
| * Block #1 contains a fullword pointer that contains the block number | |
| * of whichever directory is current. Thus, it will contain a 2 or 3. | |
| * Alternating directories ensures that in the event of a failure while | |
| * adding or deleting a data file, the changes do not clobber the | |
| * current directory. Only when those updates complete successfully | |
| * is the block 1 pointer to the new current directory updated. | |
| * | |
| * | |
| * The format of the NETSPOOL dataset is very simple. | |
| * Block 1 - contains the block # of the current directory block and | |
| * a few other items. | |
| * Blocks 2-3 - contain the 1st directory block for the current | |
| * and current-minus-1 directories. | |
| * Blocks 4-7 - contains the free space bit map. | |
| * Blocks 8-n - data blocks available for data files or directory blks. | |
| * | |
| * The free space bitmap is simply a 4-block long (4089 * 4 = 16356 | |
| * bytes) string of bits that represent whether a given CI in the | |
| * dataset is used or available. Upon initial formatting, the blocks | |
| * 1-7 are marked as used. The rest of the data blocks are free until | |
| * the last block number that is physically present in the VSAM RRDS | |
| * dataset. The maximum number of blocks supported by this scheme is | |
| * 130,848. This is 873 cylinders of 3380 DASD space, for example. | |
| * For VSAM RRDS NETSPOOL sizes of fewer cylinders, blocks higher than | |
| * the highest available physical block number are marked as used out | |
| * to the end of the bitmap so they will never be allocated. | |
| * | |
| * | |
| * ACCESSING NETSPOOL VIA PROGRAMMING | |
| * | |
| * You may access the NETSPOOL dataset via programming the same way | |
| * that the NJE line driver and NJE38 utilities do: via a NETSPOOL | |
| * CONTROL BLOCK (NCB) and the NSIO macro. | |
| * | |
| * The NCB is a small control block that is something akin to a VSAM | |
| * RPL. It simply contains information about the file being read or | |
| * written and contains pointers to the user buffer, and file | |
| * attributes. | |
| * | |
| * The NSIO macro is used to open or close the NETSPOOL dataset. It is | |
| * also used to read or write data records, and obtain directory | |
| * information. | |
| * | |
| * The NCB and the NSIO macro are used together and provide the | |
| * functions for spool access: | |
| * | |
| * NSIO TYPE=OPEN - Opens the NETSPOOL dataset for i/o | |
| * CLOSE - Closes NETSPOOL and updates directory | |
| * PUT - Writes a single record to the spool | |
| * GET - Reads a single record from the spool | |
| * PURGE - Deletes a data file from the spool | |
| * FIND - Locates a data file by file number | |
| * CONTENTS - Returns the current directory contents | |
| * UDIR - Update a directory entry v120 | |
| * | |
| * All NSIO macros must specify the NCB that it is associated with. | |
| * The spool is not opened for "input" or for "output" in the | |
| * traditional sense. Rather, the first TYPE=GET or TYPE=PUT | |
| * issued establishes the mode. Once the mode is established you | |
| * may not change from PUT to GET, or GET to PUT, without first | |
| * closing the spool and re-opening. The PURGE, FIND, and CONTENTS | |
| * functions do not establish any mode, and can be used any time | |
| * the spool is open. | |
| * | |
| * If you need to open the spool file by two or more tasks or modes | |
| * simultaneously, use multiple NCBs. | |
| * | |
| * VSAM errors are returned via the NCBRTNCD and NCBERRCD fields which | |
| * are analagous to the VSAM RPLRTNCD and RPLERRCD fields. If an | |
| * actual VSAM error occurs, NCBRTNCD will be set to 8 and the NCBERRCD | |
| * field contains the actual VSAM RPLERRCD value. If NCBRTNCD is 12, | |
| * the error code value is an internal value used by NJESPOOL. These | |
| * are: | |
| * | |
| * NCBRTNCD=X'0C' Internal NJESPOOL error | |
| * NCBERRCD=X'01' Invalid function code (not open, close, get, etc). | |
| * X'02' VSAM RRDS ACB is not open | |
| * X'03' NETSPOOL dataset is full | |
| * X'04' File # not found in directory (TYPE=FIND/PURGE) | |
| * X'05' GET attempted in PUT mode, or, | |
| * PUT attempted in GET mode | |
| * X'06' No files in directory (TYPE=CONTENTS) | |
| * | |
| * Refer to the utilities NJ38XMIT and NJ38RECV for examples using | |
| * NCB and NSIO to access the spool. | |
| * | |
| PRINT GEN NJE00030 | |
| REGEQU REGISTER EQUATES NJE00040 | |
| * | |
| * NETSPOOL Internal values | |
| * | |
| ALLOCBLK EQU 4 Starting BLK# of allocation map | |
| ALLOCNUM EQU 4 Number of allocation map blocks | |
| * | |
| * | |
| NJESPOOL CSECT NJE00020 | |
| NJEVER | |
| STM R14,R12,12(R13) SAVE CMS REGS NJE00050 | |
| LR R12,R15 BASE NJE00060 | |
| USING NJESPOOL,R12 ADDRESS IT NJE00070 | |
| LTR R9,R1 NCB ptr to R9 | |
| BZ EXIT16 Exit if no ptr | |
| USING NCB,R9 | |
| CLC NCBEYE,=CL4'NCB' Is it an NCB? | |
| BNE EXIT16 Exit if not | |
| XC NCBRTNCD(2),NCBRTNCD Clear prior error codes | |
| CLI NCBREQ,NCBOPEN Is this an OPEN function? | |
| BE INIT000 Yes, ignore token | |
| L R10,NCBTKN Get caller token | |
| CLC 0(4,R10),=CL4'NSPL' Token point to NSPL work area? | |
| BE INIT010 Yes, looks good | |
| B EXIT16 Exit if token invalid | |
| * | |
| * | |
| INIT000 EQU * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| ST R10,NCBTKN Set area addr as token | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEWK,R10 | |
| MVC NJEEYE,=CL4'NSPL' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| * | |
| INIT010 EQU * | |
| USING NJEWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| L R11,=A(NJECMN) -> common csect | |
| ST R11,ANJECMN Save addr | |
| USING NJECMN,R11 | |
| * | |
| * | |
| INIT100 EQU * | |
| LA R14,* -> location of error source v110 | |
| SR R1,R1 Clear for IC | |
| IC R1,NCBREQ Get request type | |
| SLL R1,2 Multiply by 4 to make index | |
| C R1,=A(INIT120-INIT110) Size of branch table | |
| BH ERR1201 Exit if req type invalid | |
| B INIT110(R1) Branch to requested function | |
| * | |
| INIT110 B ERR1201 00 Invalid function | |
| B OPN000 01 Open NETSPOOL dataset | |
| B CLS000 02 Close NETSPOOL dataset | |
| B PUT000 03 Write a logical record | |
| B GET000 04 Read a logical record | |
| B PUR000 05 Purge a file from NETSPOOL | |
| B FID000 06 Locate a file by file id | |
| B CON000 07 Get a list of files in NETSPOOL | |
| B UDR000 08 Update directory entry v120 | |
| * | |
| INIT120 EQU * Must mark end of branch table | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * NJE00920 | |
| * OPEN DATASET * NJE00920 | |
| * NCBREQ = X'01' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| * | |
| *- Get storage for NETSPOOL block | |
| * | |
| OPN000 EQU * | |
| GETMAIN RU, Get stg for NETSPOOL blocks X | |
| LV=3*4096, X | |
| BNDRY=PAGE | |
| ST R1,BLOCK This is the VSAM AREA | |
| LR R3,R1 R3 for now | |
| LA R2,4089(,R1) -> end of BLOCK record size | |
| ST R2,BLOCKEND Save it | |
| A R1,=F'4096' -> 2nd page | |
| ST R1,PTRBUF This is an internal rec'd buffer | |
| ST R1,PTRPOS Save also as internal write pos | |
| LA R2,4084(,R1) -> end of ptr part of PTRBUF | |
| ST R2,PTRBUFEN Save it (bytes 4084-4089 special | |
| A R1,=F'4096' -> 2nd page | |
| ST R1,BUFF This is an internal rec'd buffer | |
| ST R1,PUTPOS Save also as internal write pos | |
| LA R1,4089(,R1) -> end of BUFF record size | |
| ST R1,BUFFEND Save it | |
| XC PTRBLK,PTRBLK Initialize | |
| XC NEWBLK,NEWBLK Initialize | |
| XC PUTCNT,PUTCNT Initialize (to be placed in TAG) | |
| XC GETCNT,GETCNT Initialize (only used for debug) | |
| * | |
| GENCB BLK=ACB, x | |
| DDNAME=NETSPOOL, x | |
| MACRF=(OUT,KEY,DIR), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,ACBL Save len, addr | |
| * | |
| LA R4,KEY -> block number argument | |
| GENCB BLK=RPL, x | |
| ACB=(*,ACB), x | |
| AREA=(R3), -> block area x | |
| AREALEN=4089, x | |
| RECLEN=4089, x | |
| ARG=(R4), x | |
| OPTCD=(KEY,DIR,MVE,UPD), x | |
| MF=(G,MACLIST) | |
| STM R0,R1,RPLL Save len, addr | |
| * | |
| BAL R14,ENQ000 Get exclusive control | |
| * | |
| L R7,ACB -> ACB | |
| MVC MACLIST(OPENL),OPEN Move macro model | |
| OPEN ((R7)), Open NETSPOOL x | |
| MF=(E,MACLIST) | |
| * | |
| BAL R14,CHKOC Check open/close result | |
| BNZ EXIT08 Exit with VSAM error | |
| OI NJFL1,NJF1OACB Indic ACB open | |
| * | |
| *-- Get NETSPOOL directory block ptr from block 1; determine if | |
| *-- NETSPOOL has been formatted. | |
| * | |
| OPN040 EQU * | |
| MVC KEY,=F'1' | |
| L R7,RPL | |
| GET RPL=(R7) | |
| BAL R14,CHKRPL Check RPL result | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| ENDREQ RPL=(R7) Cancel the update request | |
| BAL R14,CHKRPL Check RPL result | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| BAL R14,DEQ000 Release control | |
| B EXIT00 Otherwise OPEN is complete | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * NJE00920 | |
| * CLOSE DATASET * NJE00920 | |
| * NCBREQ = X'02' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| CLS000 EQU * | |
| SR R5,R5 Clear possible RC | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ CLS090 No | |
| BAL R14,ENQ000 Get exclusive control | |
| * | |
| TM NJFL1,NJF1PUT Processing PUTs against file? | |
| BZ CLS050 N, skip close related PUT funcs. | |
| * | |
| CLC NCBTAG,=A(0) Is tag data present? | |
| BE CLS050 0, Cant write a directory | |
| * | |
| TM NJFL1,NJF1WPND Is physical write pending? | |
| BZ CLS030 No | |
| NI NJFL1,255-NJF1WPND No physical write pending | |
| * | |
| MVC KEY,NEWBLK Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R3,PUTPOS -> logical record position | |
| LA R3,2(,R3) Account for FFFF EOF marker | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,BUFF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| * | |
| CLS030 EQU * | |
| NC PTRBLK,PTRBLK Is ptr block write pending? | |
| BZ CLS040 | |
| MVC KEY,PTRBLK Prep for update of blk to write | |
| XC PTRBLK,PTRBLK Clear block number for recursion | |
| OI NJFL1,NJF1DPND Indic directory add pending | |
| * | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R3,PTRPOS -> ptr record position | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,PTRBUF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| * | |
| CLS040 EQU * | |
| TM NJFL1,NJF1DPND Directory add pending? | |
| BZ CLS050 No | |
| NI NJFL1,255-NJF1DPND Remove directory add pending | |
| * | |
| L R1,NCBTAG -> tag data | |
| USING TAG,R1 | |
| MVC TAGRECNM,PUTCNT Save # records actually written | |
| DROP R1 | |
| * | |
| LA R0,DIRADD Add directory entry function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File to add is in NCB | |
| LR R5,R15 Any RC to R5 | |
| * | |
| CLS050 EQU * | |
| L R7,ACB -> ACB | |
| MVC MACLIST(CLOSEL),CLOSE Move close list | |
| CLOSE ((R7)), Close the ACB x | |
| MF=(E,MACLIST) | |
| * | |
| NI NJFL1,255-NJF1OACB ACB now closed | |
| BAL R14,DEQ000 Release control | |
| * | |
| CLS090 EQU * | |
| L R1,BLOCK -> NETSPOOL record areas | |
| FREEMAIN RU,LV=3*4096,A=(1) Release it v200 | |
| * | |
| LM R0,R1,RPLL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| LM R0,R1,ACBL | |
| FREEMAIN RU,LV=(0),A=(1) | |
| * | |
| XC NCBTKN,NCBTKN Clear token | |
| B QUIT000 Exit with RC in R5 | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Write a logical record (not a physical block) NJE00920 | |
| * PUT * NJE00920 | |
| * NCBREQ = X'03' * No ENQ is required when writing the physical NJE00920 | |
| * * blocks as these blocks are allocated exclusively NJE00920 | |
| ******************** to the calling task. NJE00920 | |
| * NJE00920 | |
| PUT000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| TM NJFL1,NJF1GET Processing GETs against file? | |
| BO ERR1205 Yes, cant do PUT now | |
| OI NJFL1,NJF1PUT Indicate PUT in progress | |
| * | |
| NC PTRBLK,PTRBLK Do we have a ptr block? | |
| BNZ PUT020 Yes | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,PTRBLK Save block number of ptr blk | |
| ST R0,INITBLK Save first block # used in PUT | |
| L R0,PTRBUF -> ptr block area | |
| LA R1,4089 Size of physical block | |
| LR R3,R1 Compute length to write out | |
| MVCL R0,R2 Clear the ptr block | |
| MVC PTRPOS,PTRBUF Set write position in block | |
| * | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,NEWBLK Save allocated blk # | |
| MVC PUTPOS,BUFF Set write position in block | |
| L R1,PTRPOS Get current ptr block position | |
| ST R0,0(,R1) Save new blk# in ptr block | |
| LA R1,4(,R1) Next ptr block slot | |
| ST R1,PTRPOS Update position | |
| * | |
| PUT020 EQU * | |
| L R3,PUTPOS Get current position | |
| L R1,BUFFEND -> end of buffer | |
| SR R1,R3 Determine remaining space in blk | |
| LH R4,NCBRECLN Get size of record to write | |
| LA R2,2+2(,R4) Add in overhead | |
| * +2 for length halfword | |
| * +2 for next block marker | |
| CR R1,R2 Is there room to add record? | |
| BL PUT100 No, better get another block | |
| * | |
| L R15,NCBAREA -> to logical record | |
| BCT R4,*+10 Adjust len for execute | |
| PUTREC MVC 2(0,R3),0(R15) | |
| EX R4,PUTREC Move record to block | |
| LA R4,1+2(,R4) Get record len + overhead | |
| * +1 to get back true length | |
| * +2 for length halfword itself | |
| STCM R4,3,0(R3) Store the length | |
| * | |
| TM NCBFL1,NCBPUN Is this PUN type data? | |
| BO PUT050 Y, no special action | |
| TM 2(R3),X'03' Is carriage ctl an immediate? | |
| BO PUT060 Y, Don't count these records | |
| * | |
| PUT050 EQU * | |
| L R1,PUTCNT Get count of records written | |
| LA R1,1(,R1) Bump it | |
| ST R1,PUTCNT Update count | |
| * | |
| PUT060 EQU * | |
| AR R3,R4 Compute next avail byte in blk | |
| MVC 0(2,R3),=X'FFFF' Set current EOF marker in case | |
| * we write no more records | |
| ST R3,PUTPOS Save write position for next | |
| * record; would overwrite the | |
| * FFFF marker on next PUT. | |
| OI NJFL1,NJF1WPND Indicate physical write req'd | |
| B EXIT00 | |
| * | |
| PUT100 EQU * | |
| L R5,NEWBLK Get current blk # we need to wrt | |
| BAL R14,GETBLK Allocate a new physical block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,NEWBLK Save newly allocated blk # | |
| MVC 0(2,R3),=X'FFFE' Insert ptr indic for next blk | |
| LA R3,2(,R3) -> next write position | |
| * | |
| ST R5,KEY Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,BUFF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| MVC PUTPOS,BUFF Reset write position in new blk | |
| NI NJFL1,255-NJF1WPND No physical write pending | |
| * | |
| *-- Now ensure newly allocated block is also pointed to by ptr block | |
| * | |
| L R3,PTRPOS Get current ptr block position | |
| MVC 0(4,R3),NEWBLK Save new blk# in ptr block | |
| LA R3,4(,R3) Next ptr block slot | |
| C R3,PTRBUFEN Is ptr block full? | |
| BNL PUT200 Yes | |
| ST R3,PTRPOS Update position | |
| B PUT020 Now retry to add next logical | |
| * | |
| *-- Here if we need another ptr block (chain them together) | |
| * | |
| PUT200 EQU * | |
| L R5,PTRBLK Get current blk # we need to wrt | |
| BAL R14,GETBLK Allocate a new phys ptr block | |
| BNZ EXIT08 Exit with VSAM error | |
| LTR R0,R0 Is there a block number? | |
| BZ ERR1203 NETSPOOL dataset full | |
| ST R0,PTRBLK Save newly allocated blk # | |
| ST R0,0(,R3) Insert ptr to next ptr blk in | |
| * full ptr block | |
| MVI 0(R3),X'FE' Indic "ptr to next ptr blk" and | |
| * not ptr to a data block | |
| LA R3,4(,R3) -> next write position | |
| * | |
| ST R5,KEY Prep for update of blk to write | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R2,PTRBUF -> buffer to write out | |
| SR R3,R2 Compute length to write out | |
| MVCL R0,R2 Move data and pad remaining | |
| * | |
| PUT RPL=(R7) Update the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R0,PTRBUF -> ptr block area | |
| LA R1,4089 Size of physical block | |
| LR R3,R1 Compute length to write out | |
| MVCL R0,R2 Clear the ptr block | |
| MVC PTRPOS,PTRBUF Reset ptr position in new blk | |
| B PUT020 Now retry to add next logical | |
| * NJE00200 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Read a logical record (not a physical block) NJE00920 | |
| * GET * NJE00920 | |
| * NCBREQ = X'04' * No ENQ is required when reading the physical NJE00920 | |
| * * blocks as these blocks are allocated exclusively NJE00920 | |
| ******************** to the calling task. The file id to read must NJE00920 | |
| * be in NSID in the tag data pointed to by NCBTAG | |
| * NJE00920 | |
| GET000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| TM NJFL1,NJF1PUT Processing PUTs against file? | |
| BO ERR1205 Yes, cant do GET now | |
| OI NJFL1,NJF1GET Indicate GET in progress | |
| * | |
| L R7,RPL -> RPL | |
| NC PTRBLK,PTRBLK Do we have a ptr block in prog? | |
| BNZ GET060 Yes, read next logical rec | |
| * | |
| LA R0,DIRLOC Locate file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File id is in tag field TAGID | |
| * | |
| LTR R15,R15 Was file found? | |
| BZ GET010 Yes | |
| C R15,=F'12' Errors processing directory? | |
| BL EXIT08 Exit here if 4 or 8=VSAM errors | |
| B EXIT12 All others Exit12 | |
| * | |
| GET010 EQU * | |
| MODCB RPL=(R7), x | |
| OPTCD=(KEY,DIR,MVE,NUP), No update needed on GETs x | |
| MF=(G,MACLIST) | |
| * | |
| L R3,NCBTAG -> tag data | |
| USING TAG,R3 | |
| MVC GETLIM,TAGRECNM Save off # of records in file | |
| DROP R3 | |
| * | |
| L R3,INITBLK Get 1st block # of file | |
| * | |
| GET020 EQU * ** Get a ptr block | |
| ST R3,KEY Set block retrieval key | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| ST R3,PTRBLK Save ptr blk # | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Put ptr data in ptrbuf | |
| * | |
| L R4,PTRBUF -> ptr block ptrs | |
| ST R4,PTRPOS Maintain ptr position | |
| * | |
| GET030 EQU * | |
| C R4,PTRBUFEN Out of ptrs this block? | |
| BL GET040 No | |
| * | |
| * ** Here if ptr block chains to | |
| * another ptr block | |
| CLI 0(R4),X'FE' ptr to ptrblk indicator? | |
| BNE GET200 EOF No, done with ptrs | |
| SR R3,R3 Clear for IC | |
| ICM R3,7,1(R4) Get ptr to next ptr block | |
| ST R3,KEY Set up for retrieval | |
| B GET020 Go get it | |
| * | |
| GET040 EQU * | |
| ICM R2,15,0(R4) Get a data block # | |
| BZ GET200 EOF Done with ptrs | |
| * | |
| ST R2,KEY Set block retrieval key | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ EXIT08 Exit with VSAM error | |
| * | |
| L R5,BLOCK -> VSAM i/o area | |
| ST R5,GETPOS Maintain read position | |
| * | |
| GET060 EQU * | |
| L R5,GETPOS -> next logical record to read | |
| CLC 0(2,R5),=X'FFFF' Is this end of file? | |
| BE GET200 Yes | |
| CLC 0(2,R5),=X'FFFE' Skip to next ptr indication? | |
| BE GET100 Yes | |
| * | |
| SR R14,R14 Clear for IC | |
| ICM R14,3,0(R5) Get the record length | |
| BCTR R14,0 Reduce length of length | |
| BCTR R14,0 Reduce length of length | |
| STH R14,NCBRECLN Return length to caller | |
| * | |
| L R15,NCBAREA -> to caller's record buffer | |
| BCT R14,*+10 Adjust len for execute | |
| GETREC MVC 0(0,R15),2(R5) | |
| EX R14,GETREC Move record to user area | |
| LA R5,1+2(R14,R5) Get record len + overhead | |
| * +1 to get back true length | |
| * +2 for length halfword itself | |
| ST R5,GETPOS Save read position | |
| L R1,GETCNT Get count of records read | |
| LA R1,1(,R1) Bump it | |
| ST R1,GETCNT Update count for debug purposes | |
| B EXIT00 Exit with record in NCBAREA | |
| * | |
| GET100 EQU * | |
| L R4,PTRPOS Get ptr position | |
| LA R4,4(,R4) -> next ptr field | |
| ST R4,PTRPOS Maintain ptr position | |
| B GET030 Go process next ptr | |
| * | |
| GET200 EQU * | |
| MVI NCBERRCD,X'04' Indicate EOF | |
| B EXIT08 | |
| * NJE00920 | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Delete a file from the NETSPOOL dataset NJE00920 | |
| * PURGE * NJE00920 | |
| * NCBREQ = X'05' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| PUR000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRDEL Del file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File to del is in NCB ??? | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Locate a file in the directory by file id NJE00920 | |
| * LOCATE * NJE00920 | |
| * NCBREQ = X'06' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| FID000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRLOC Locate file function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 File id is in tag field TAGID | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Return a list of files in NETSPOOL dataset NJE00920 | |
| * CONTENTS * NJE00920 | |
| * NCBREQ = X'07' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| CON000 EQU * | |
| LA R14,* -> location of error source v110 | |
| TM NJFL1,NJF1OACB Is ACB open? | |
| BZ ERR1202 No | |
| * | |
| LA R0,DIRLST List files function | |
| L R15,=A(NJEDIR) Call directory mgmt | |
| BALR R14,R15 | |
| LR R5,R15 Any RC to R5 | |
| B QUIT000 | |
| * | |
| * NJE00920 | |
| ******************** NJE00920 | |
| * * Update a directory entry by file id v120 NJE00920 | |
| * UDIR * NJE00920 | |
| * NCBREQ = X'08' * NJE00920 | |
| * * NJE00920 | |
| ******************** NJE00920 | |
| * NJE00920 | |
| UDR000 EQU * v120 | |
| LA R14,* -> location of error source v120 | |
| TM NJFL1,NJF1OACB Is ACB open? v120 | |
| BZ ERR1202 No v120 | |
| * v120 | |
| LA R0,DIRUPD Update dir function v120 | |
| L R15,=A(NJEDIR) Call directory mgmt v120 | |
| BALR R14,R15 v120 | |
| LR R5,R15 Any RC to R5 v120 | |
| B QUIT000 v120 | |
| * | |
| * | |
| ERR1201 EQU * Invalid NCBREQ function code | |
| MVI NCBERRCD,X'01' Set error code | |
| B EXIT12 | |
| * | |
| ERR1202 EQU * ACB is not open | |
| MVI NCBERRCD,X'02' Set error code | |
| B EXIT12 | |
| * | |
| ERR1203 EQU * NETSPOOL dataset is full | |
| MVI NCBERRCD,X'03' Set error code | |
| B EXIT12 | |
| * | |
| ERR1204 EQU * File # not found in directory | |
| MVI NCBERRCD,X'04' Set error code | |
| B EXIT12 | |
| * | |
| ERR1205 EQU * GET attempted in PUT mode, or, | |
| * PUT attempted in GET mode | |
| MVI NCBERRCD,X'05' Set error code | |
| B EXIT12 | |
| * | |
| ERR1206 EQU * No files in directory (NCBCON) | |
| MVI NCBERRCD,X'06' Set error code | |
| B EXIT12 | |
| * | |
| * NJE00200 | |
| * Exit points NJE00200 | |
| * NJE00200 | |
| * NJE00200 | |
| * NJE00200 | |
| EXIT00 EQU * NJE00210 | |
| SR R5,R5 Set RC=0 | |
| B QUIT000 | |
| * | |
| * Exit04 reasons: | |
| * All VSAM OPEN/CLOSE and RPL errors. | |
| * | |
| EXIT04 EQU * NJE00210 | |
| LA R5,4 Set RC=4 | |
| B QUIT000 | |
| * | |
| * Exit08 reasons: | |
| * All VSAM OPEN/CLOSE and RPL errors. | |
| * | |
| EXIT08 EQU * NJE00210 | |
| C R15,=F'4' Is is really RC 4? | |
| BE EXIT04 Reflect the truth | |
| LA R5,8 Set RC=8 | |
| B QUIT000 | |
| * | |
| * Exit12 reasons: | |
| * NETSPOOL dataset is full (no available blocks) | |
| * NCBREQ contains invalid/unsupported function code | |
| * File is not open | |
| * File # is not found in directory | |
| * GET issued during PUT activity | |
| * PUT issued during GET activity | |
| * | |
| EXIT12 EQU * NJE00210 | |
| ST R14,NCBMACAD Save error address v110 | |
| LA R5,12 Set RC=12 | |
| B QUIT000 | |
| * | |
| * Exit16 reasons: | |
| * R1 = zero on entry | |
| * R1 doesnt point to NCB ('NCB ' in 1st four bytes) | |
| * NCBTKN is zero but NCBREQ is not NCBOPEN | |
| * NCBTKN doesnt point to area containing 'NSPL' | |
| * | |
| EXIT16 EQU * NJE00210 | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| LA R5,16 Set RC=16 | |
| B QUIT090 | |
| * | |
| QUIT000 EQU * | |
| STC R5,NCBRTNCD Set R15 return code | |
| BAL R14,DEQ000 Remove any ENQ | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| CLC NCBREQ(3),=AL1(NCBGET,8,4) EOF on a NCBGET function? | |
| BNE QUIT020 No | |
| ICM R15,15,NCBEODAD Get EODAD address | |
| BZ QUIT020 If none, let 8,4 rtn cd pass | |
| ST R15,12(,R13) Set R14 return to EODAD address | |
| XC NCBRTNCD(2),NCBRTNCD Remove EOF error indicators | |
| SR R5,R5 Set RC=0 | |
| * | |
| QUIT020 EQU * | |
| CLI NCBREQ,NCBCLOSE Is this a close request? | |
| BNE QUIT090 No. Exit without free stgs | |
| * | |
| LR R1,R10 -> NJEWK main work area page | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| * | |
| QUIT090 EQU * | |
| ST R5,16(,R13) Set RC in R15 | |
| LM R14,R12,12(R13) Reload callers's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| * NJE00250 | |
| LTORG NJE00280 | |
| * | |
| * | |
| OPEN OPEN 0,MF=L | |
| OPENL EQU *-OPEN | |
| CLOSE CLOSE 0,MF=L | |
| CLOSEL EQU *-CLOSE | |
| * | |
| * | |
| DROP R12 | |
| * | |
| * NJE00920 | |
| ********************* NJE00920 | |
| * N J E C M N * NJECMN hosts small routines and NJE00920 | |
| * * frequently used constants NJE00920 | |
| * Common routines * NJE00920 | |
| * and constants * via base register 11 NJE00920 | |
| * * NJE00920 | |
| ********************* NJE00920 | |
| * NJE00920 | |
| NJECMN CSECT NJE00020 | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECMN' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECMN,R11 | |
| USING NJEWK,R10 | |
| * | |
| *-- Check result of VSAM OPEN or CLOSE macro | |
| * | |
| CHKOC EQU * | |
| LTR R15,R15 Did request succeed? | |
| BZR R14 Yes return | |
| ST R14,NCBMACAD Save addr of failing macro | |
| STC R15,NCBRTNCD Set return code | |
| MVC NCBERRCD,ACBERFLG-IFGACB(R7) error code | |
| BR R14 Return with VSAM error | |
| * | |
| *-- Check result of VSAM RPL macros | |
| * | |
| CHKRPL EQU * | |
| LTR R15,R15 Did request succeed? | |
| BZR R14 Yes return | |
| ST R14,NCBMACAD Save addr of failing macro | |
| STC R15,NCBRTNCD Set return code | |
| MVC NCBERRCD,RPLERRCD-IFGRPL(R7) error code | |
| BR R14 Return with VSAM error | |
| * | |
| * | |
| ENQ000 EQU * | |
| TM NJFL1,NJF1ENQ Is ENQ active? | |
| BOR R14 Return if so | |
| * | |
| ST R14,SV14 Save return addr | |
| ENQ (NJE38Q,NJEDSN,E,44,SYSTEM), X | |
| RET=NONE | |
| * | |
| OI NJFL1,NJF1ENQ ENQ active | |
| L R14,SV14 Reload return addr | |
| BR R14 Return | |
| * | |
| * | |
| DEQ000 EQU * | |
| TM NJFL1,NJF1ENQ Is ENQ active? | |
| BZR R14 Return if not | |
| * | |
| ST R14,SV14 Save return addr | |
| DEQ (NJE38Q,NJEDSN,44,SYSTEM), X | |
| RET=NONE | |
| NI NJFL1,255-NJF1ENQ ENQ off | |
| L R14,SV14 Reload return addr | |
| BR R14 Return | |
| * NJE00200 | |
| * NJE00200 | |
| *-- ADDBLK / GETBLK routines NJE00200 | |
| * NJE00200 | |
| *-- Allocate a new physical block. Scan the allocation map for a free NJE00200 | |
| *-- block and mark it as taken, and return the new block number to the NJE00200 | |
| *-- caller. | |
| * | |
| *-- ADDBLK and GETBLK are functionally identical except that ADDBLK | |
| *-- does not ENQ or DEQ on NETSPOOL; it is assumed that the caller | |
| *-- already has done that (the DIR functions). | |
| * | |
| *-- Uses R14-R4,R7. R1-R4 are preserved across call | |
| * NJE00200 | |
| *-- Entry: None NJE00200 | |
| * NJE00200 | |
| *-- Exit: R15 = 0 if ok, else RC from VSAM macro. NJE00200 | |
| * R0 = block # of new block. If R0=0, no blocks available. NJE00200 | |
| * NJE00200 | |
| ADDBLK EQU * | |
| ST R14,SV14GB Save return addr | |
| STM R1,R4,SVGB Save caller's regs | |
| BAL R14,GETB000 Go allocate the block | |
| LTR R15,R15 VSAM RC in R15, set CC | |
| LR R0,R4 Return block # in R0 | |
| LM R1,R4,SVGB Load caller's regs | |
| L R14,SV14GB Load return addr | |
| BR R14 Return | |
| * NJE00200 | |
| GETBLK EQU * | |
| ST R14,SV14GB Save return addr | |
| STM R1,R4,SVGB Save caller's regs | |
| BAL R14,ENQ000 Get exclusive control | |
| BAL R14,GETB000 Go allocate the block | |
| LR R3,R15 Save R15 across DEQ | |
| BAL R14,DEQ000 Release control | |
| LTR R15,R3 Return VSAM RC in R15, set CC | |
| LR R0,R4 Return block # in R0 | |
| LM R1,R4,SVGB Load caller's regs | |
| L R14,SV14GB Load return addr | |
| BR R14 Return | |
| * | |
| GETB000 EQU * | |
| ST R14,SV14B0 Save return addr | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| LA R4,1 Starting relative block # | |
| * | |
| GETB010 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ GETB090 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> allocation map | |
| LA R15,4089 # of entries in map | |
| L R1,=X'FF000000' Set pad char=X'FF' | |
| CLCL R14,R0 Look for a non-FF entry | |
| BE GETB030 all FFs: We're full up in this block | |
| * | |
| LR R1,R14 Copy ptr to map byte | |
| S R1,BLOCK Compute offset from start | |
| SLL R1,3 Each map byte is 8 records | |
| AR R4,R1 Adjust relative block number for | |
| * byte position we located | |
| ICM R1,8,0(R14) Get map byte with the free bit | |
| LA R2,X'80' Create possible opposing bit | |
| * | |
| GETB020 EQU * | |
| SR R0,R0 Clear for shift use | |
| SLDL R0,1 Shift off one bit into R0 | |
| LTR R0,R0 Is this the zero bit? | |
| BZ GETB040 Yes | |
| SRL R2,1 Next opposing bit position | |
| LA R4,1(,R4) Compute next rel blk # | |
| B GETB020 Find that 0 bit | |
| * | |
| GETB030 EQU * | |
| LA R4,4089(,R4) Incr starting relative block # | |
| LA R3,1(,R3) Next map block key | |
| BCT R2,GETB010 Read next map block | |
| * | |
| ENDREQ RPL=(R7) No update | |
| SR R4,R4 Return no block #: ALL FULL | |
| SR R15,R15 No VSAM errors | |
| B GETB090 Done | |
| * | |
| SETMAP OI 0(R14),X'00' Executed instr | |
| * | |
| GETB040 EQU * | |
| EX R2,SETMAP Set the bit in allocation map | |
| * | |
| PUT RPL=(R7) Update the allocation map | |
| BAL R14,CHKRPL Deal with errors | |
| * | |
| GETB090 EQU * | |
| L R14,SV14B0 Load return addr | |
| BR R14 Return | |
| * | |
| * | |
| LTORG | |
| * | |
| WTOMSG WTO ' x | |
| ',MF=L | |
| WTOMSGL EQU *-WTOMSG | |
| * | |
| ENQ ENQ (0),MF=L | |
| ENQL EQU *-ENQ | |
| * | |
| DEQ DEQ (0),MF=L | |
| DEQL EQU *-DEQ | |
| * | |
| DS 0D | |
| NJE38Q DC CL8'NJE38' | |
| NJEDSN DC CL44'NJE38.NETSPOOL' | |
| * | |
| BLANKS DC CL120' ' | |
| NONBLANK DC 64X'FF',X'00',191X'FF' TR Table to locate nonblank | |
| BLANK DC 64X'00',X'FF',100X'00' TR Table to locate blanks | |
| TRTAB$ DC 91X'00',X'FF',164X'00' TR Table to locate '$' | |
| HEXTRAN DC CL16'0123456789ABCDEF' Translate table | |
| * NJE00920 | |
| * NJE00920 | |
| ********************* NJE00920 | |
| * * NJE00920 | |
| * N J E D I R * NJE00920 | |
| * * NJE00920 | |
| * Directory * NJE00920 | |
| * Management * NJE00920 | |
| * * NJE00920 | |
| ********************* NJE00920 | |
| * NJE00920 | |
| * | |
| NJEDIR CSECT NJE00020 | |
| B 28(,R15) BRANCH AROUND EYECATCHERS | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJEDIR' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| STM R14,R12,12(R13) SAVE CMS REGS NJE00050 | |
| LR R12,R15 BASE NJE00060 | |
| USING NJEDIR,R12 ADDRESS IT NJE00070 | |
| USING NJEWK,R10 | |
| USING NCB,R9 | |
| * | |
| ST R13,NJEDIRSA+4 SAVE prv S.A. ADDR NJE00080 | |
| LA R1,NJEDIRSA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| L R11,=A(NJECMN) -> common csect | |
| ST R11,ANJECMN Save addr | |
| USING NJECMN,R11 | |
| * | |
| DIRADD EQU 0 Add new file to directory | |
| DIRDEL EQU 4 Purge a file from directory | |
| DIRLOC EQU 8 Locate a file by ID | |
| DIRLST EQU 12 List directory contents | |
| DIRUPD EQU 16 Update directory entry v120 | |
| * | |
| LR R2,R0 Copy entry code | |
| B *+4(R2) Branch into branch table | |
| B ADD000 0 Add a new directory entry | |
| B DEL000 4 Delete a directory entry | |
| B LOC000 8 Locate a file by ID | |
| B LST000 C List directory contents | |
| B UPD000 10 Update directory entry v120 | |
| * | |
| ADD000 EQU * | |
| LA R0,(10000/8)+1 Byte size of 10,000 bits | |
| ST R0,SPLIDLEN Save the length | |
| GETMAIN RU, Get stg for spool id bitmap x | |
| LV=(0) | |
| ST R1,SPLIDMAP Save stg addr | |
| LR R0,R1 Copy starting addr | |
| L R1,SPLIDLEN Get the length | |
| SR R15,R15 Set pad char | |
| MVCL R0,R14 Initialize the map | |
| * | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| MVC SPLID,SPLNUM Save the last assigned id # | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| * | |
| *-- R2 = starting block number of current directory | |
| *-- R3 = starting block number of replacement directory | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get a replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| *-- Copy all of the directory entries in the current directory over | |
| *-- to the (new) replacement directory (where we will eventually add | |
| *-- a new directory entry). Along the way, build a bit map of all | |
| *-- of the spool file numbers that are in use (they're in the | |
| *-- directory entries) so that we can assign a new unique file # to | |
| *-- the new file in its new directory entry. | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,BLOCK -> replacement directory | |
| L R8,NSRECNM-NSDIR(,R4) Get # directory entries current | |
| LA R1,1(,R8) +1 for new dir ent to be added | |
| ST R1,NSRECNM-NSDIR(,R4) Store (will get copied to repl) | |
| ST R3,NSBLK-NSDIR(,R4) Store starting blk of dir (will | |
| * get copied to replacement dir) | |
| * | |
| ADD050 EQU * | |
| CLC NSLEN-NSDIR(,R4),=X'FFFE' Ptr to next block? | |
| BE ADD100 yes | |
| MVC 0(NSDIRLN,R5),0(R4) Copy existing dir entry to repl | |
| * | |
| LH R7,NSID-NSDIR(,R4) Get file id # for this file | |
| SR R6,R6 Clear for divide | |
| D R6,=F'8' Get byte offset remainder bits | |
| * | |
| A R7,SPLIDMAP -> byte containing bit for | |
| * this file # | |
| LA R1,X'80' Create a bit | |
| SRL R1,0(R6) Adjust to bit for this file # | |
| EX R1,SPLSET Set the bit in the spool id map | |
| * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| LA R5,NSDIRLN(,R5) -> next replacement dir entry | |
| BCT R8,ADD050 Keep copying dir entries | |
| B ADD200 Go add the new dir entry | |
| * | |
| SPLSET OI 0(R7),X'00' Executed instr | |
| * | |
| * | |
| *-- Here if the directory continues onto another block. Get these | |
| *-- blocks, and continue processing individual entries. | |
| * | |
| ADD100 EQU * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update the replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| CLC NSLEN-NSDIR(,R5),=X'FFFE' Repl dir ptr to next block? | |
| BNE ADD190 No; we need to add a block | |
| * | |
| ADD120 EQU * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ICM R3,15,2(R5) Get ptr to next repl dir blk | |
| * | |
| ST R2,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get next replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,BLOCK -> replacement directory | |
| B ADD050 Continue processing | |
| * | |
| ADD190 EQU * | |
| L R3,KEY Get current blk # we just wrote | |
| * | |
| BAL R14,ADDBLK Allocate a new physical block | |
| BNZ ADD900 Exit with VSAM error | |
| LTR R6,R0 Is there a block number? | |
| BZ ADD910 No, NETSPOOL dataset full v130 | |
| * | |
| ST R3,KEY Gotta update blk again with ptr | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| MVC 0(2,R5),=X'FFFE' Insert ptr indic for next blk | |
| STCM R6,15,2(R5) Insert next block # | |
| B ADD100 Now go jump to next dir blks | |
| * | |
| *-- Here when all current directory entries have been copied to the | |
| *-- new (replacement) directory. Add the new directory entry for | |
| *-- the file just written out via PUT actions. | |
| * | |
| ADD200 EQU * | |
| L R1,BLOCKEND -> end of buffer | |
| SR R1,R5 Determine remaining space in blk | |
| LA R4,NSDIRLN Get size of directory entry | |
| LA R4,2+4(,R4) Add in overhead | |
| * +2 for n block marker | |
| * +4 for next block ptr | |
| CR R1,R4 Is there room to add entry? | |
| BL ADD300 No, better get another block | |
| * | |
| USING NSDIR,R5 | |
| XC NSDIR(NSDIRLN),NSDIR Init new entry | |
| MVC NSLEN,=Y(NSDIRLN) Set entry length | |
| MVC NSBLK,INITBLK Set starting blk# of the file | |
| L R6,NCBTAG -> TAG block for file | |
| USING TAG,R6 | |
| MVC NSINLOC(TAGUSELN),TAGINLOC Tag data to dir entry | |
| * | |
| L R1,SPLID Get last assigned file id # | |
| L R0,=F'10000' 10,000 possible spool ids | |
| * | |
| ADD250 EQU * | |
| LA R15,1(,R1) Choose next number | |
| C R15,=F'10000' At the limit? | |
| BL *+8 No | |
| LA R15,1 Reset to 1 | |
| LR R1,R15 Save next possible number | |
| * | |
| SR R14,R14 Clear for divide | |
| D R14,=F'8' Get byte offset remainder bits | |
| * | |
| A R15,SPLIDMAP -> byte containing bit for | |
| * this spool id # | |
| LA R7,X'80' Create a bit | |
| SRL R7,0(R14) Adjust to bit for this id # | |
| EX R7,TMBIT Check bit status in the bitmap | |
| BZ ADD260 Spool id not in use. take it | |
| BCT R0,ADD250 Else try next number | |
| SR R1,R1 Otherwise use id=0000 | |
| B ADD260 | |
| * | |
| TMBIT TM 0(R15),X'00' Executed instr | |
| * | |
| * | |
| * | |
| ADD260 EQU * | |
| ST R1,SPLID Save newly assigned spool id | |
| STCM R1,3,NSID Assign the file id # to file | |
| STCM R1,3,NCBFID Also put it in the NCB | |
| STCM R1,3,TAGID Also, put it in the tag data | |
| DROP R5,R6 NSDIR,TAG | |
| * | |
| LA R4,NSDIRLN(,R5) Skip past entry just added | |
| L R5,BLOCKEND -> end of block | |
| SR R5,R4 Compute length remaining in blk | |
| SR R15,R15 Set pad | |
| MVCL R4,R14 Clear to end of block | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update final replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| *-- Now update block 1 to activate the replacement directory | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R1,BLOCK -> blk #1 in stg | |
| USING BLKONE,R1 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| ST R3,DIRBLK Plug in alternate | |
| MVC SPLNUM,SPLID Save last assigned spool id | |
| DROP R1 | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update block 1 | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| B XITDIR Exit with RC=0 | |
| * | |
| *-- Here if there is no room in a directory block to add the new | |
| *-- file's directory entry. An additional block will be allocated and | |
| *-- chained to the directory entries. | |
| * | |
| ADD300 EQU * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Write back the dir block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| L R4,KEY Get current blk # we just wrote | |
| * | |
| BAL R14,ADDBLK Allocate a new physical block | |
| BNZ ADD900 Exit with VSAM error | |
| LTR R6,R0 Is there a block number? | |
| BZ ADD910 No, NETSPOOL dataset full v130 | |
| * | |
| ST R4,KEY Gotta update blk again with ptr | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| MVC 0(2,R5),=X'FFFE' Insert ptr indic for next blk | |
| STCM R6,15,2(R5) Insert next block # | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Write back the dir block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| ST R6,KEY Now point to newly obtained blk | |
| GET RPL=(R7) Get the physical block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ ADD900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| SR R3,R3 Pad | |
| MVCL R0,R2 Clear it | |
| * | |
| L R5,BLOCK -> new block stg | |
| B ADD200 Try again to add new dir entry | |
| * | |
| ADD900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| ADD910 EQU * No space in NETSPOOL | |
| MVC NCBRTNCD(2),=X'0C03' Set to 12,3 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Return that notice | |
| * | |
| * | |
| * | |
| * | |
| * | |
| DEL000 EQU * | |
| GETMAIN RU, Get stg for alloc bitmap x | |
| LV=16384 | |
| STM R0,R1,SPLIDLEN Save len,addr | |
| * | |
| L R7,RPL -> RPL | |
| MODCB RPL=(R7), x | |
| OPTCD=(KEY,DIR,MVE,UPD), Update mode x | |
| MF=(G,MACLIST) | |
| * | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| L R4,SPLIDMAP -> receiving stg area | |
| * | |
| DEL020 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> block just read | |
| LA R15,4089 # of bytes in block | |
| LR R5,R15 Copy len | |
| MVCL R4,R14 Move alloc bitmap to stg area | |
| * | |
| LA R3,1(,R3) Next block number of alloc map | |
| BCT R2,DEL020 Go read them all | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| DROP R2 | |
| * | |
| *-- R2 = starting block number of current directory | |
| *-- R3 = starting block number of replacement directory | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| ST R3,KEY Get a replacement dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| * | |
| *-- Current directory is in BUFF | |
| *-- Replacement directory will be in PTRBUF | |
| * | |
| * | |
| *-- Copy all of the directory entries in the current directory over | |
| *-- to the (new) replacement directory (where we will eventually delete | |
| *-- a directory entry). Along the way, look for the entry to be | |
| *-- purged. | |
| * | |
| L R4,BUFF -> current directory | |
| L R5,PTRBUF -> replacement directory | |
| L R8,NSRECNM-NSDIR(,R4) Get # directory entries current | |
| LR R1,R8 Copy count | |
| BCTR R1,0 Reduce for to-be-deleted file | |
| ST R1,NSRECNM-NSDIR(,R4) Store (will get copied to repl) | |
| ST R3,NSBLK-NSDIR(,R4) Store starting blk of dir (will | |
| * get copied to replacement dir) | |
| L R6,NCBTAG -> TAG data | |
| LH R6,TAGID-TAG(,R6) Get file id number | |
| XC INITBLK,INITBLK Clear file's starting blk # | |
| * | |
| DEL050 EQU * | |
| CLC NSLEN-NSDIR(,R4),=X'FFFE' Ptr to next block? | |
| BE DEL100 yes | |
| CH R6,NSID-NSDIR(,R4) Is this the file to be purged? | |
| BE DEL070 | |
| CLC NSLEN-NSDIR(,R5),=X'FFFE' Ptr to next block? | |
| BE DEL120 yes | |
| MVC 0(NSDIRLN,R5),0(R4) Copy existing dir entry to repl | |
| LA R5,NSDIRLN(,R5) -> next replacement dir entry | |
| * | |
| DEL060 EQU * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| BCT R8,DEL050 Keep copying dir entries | |
| B DEL200 Done with copy | |
| * | |
| DEL070 EQU * | |
| MVC INITBLK,NSBLK-NSDIR(R4) Save starting block # of file | |
| B DEL060 Continue copy | |
| * | |
| * | |
| *-- Get next current dir block (move it to BUFF) | |
| * | |
| DEL100 EQU * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| * | |
| ST R2,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,BUFF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| L R4,BUFF -> current directory | |
| B DEL050 Continue with copy | |
| * | |
| *-- Get next replacement dir block | |
| *-- 1. Write back the replacement we've been copying to (from PTRBUF) | |
| *-- 2. Get next block | |
| *-- 3. Move it to PTFBUF | |
| * | |
| DEL120 EQU * | |
| ST R3,KEY Set blk# of repl dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the block for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R0,R14 Move data to i/o buffer | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update the replacement block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| ICM R3,15,2(R5) Get ptr to next current dir blk | |
| * | |
| ST R3,KEY Get next current dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer to place block | |
| LR R15,R1 Copy length | |
| MVCL R14,R0 Move data | |
| L R5,PTRBUF -> replacement directory | |
| B DEL050 Continue with copy | |
| * | |
| *-- Fix up the last replacement dir block | |
| * | |
| DEL200 EQU * | |
| L R1,PTRBUF -> start of buffer | |
| LA R15,4088(,R1) -> end of that buffer - 1 | |
| * | |
| DEL210 EQU * | |
| CR R1,R15 Past end of buffer? | |
| BH DEL230 Y, done searching | |
| CLC 0(2,R1),=X'FFFE' Left over pointer indicator? | |
| BE DEL220 Yes | |
| LA R1,NSDIRLN(,R1) Next dir entry position | |
| B DEL210 | |
| * | |
| DEL220 EQU * | |
| ICM R7,15,2(R1) Pick up the left over block # | |
| BAL R14,FREBLK Go free the block in R7 | |
| * | |
| DEL230 EQU * | |
| LR R0,R5 -> end of used part of ptrbuf | |
| L R1,PTRBUF -> start of buffer | |
| LA R1,4089(,R1) -> end of that buffer | |
| SR R1,R5 Compute length to clear | |
| SR R15,R15 Compute length to write out | |
| MVCL R0,R14 Clear to end of block | |
| * | |
| ST R3,KEY Set blk# of repl dir block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Re-get for update | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R0,BLOCK -> VSAM i/o area | |
| LA R1,4089 Size of physical block | |
| L R14,PTRBUF -> buffer containing repl dir | |
| LR R15,R1 Copy length | |
| MVCL R0,R14 Move repl data to i/o buffer | |
| * | |
| PUT RPL=(R7) Update the last repl block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| *-- DEL300 is used to free all of the blocks used by the file itself | |
| * | |
| DEL300 EQU * | |
| ICM R7,15,INITBLK Get 1st block # of deleted file | |
| BZ DEL910 If 0, file # wasn't found | |
| * | |
| DEL310 EQU * | |
| ST R7,KEY Set block retreival key | |
| BAL R14,FREBLK Mark the block as free in bitmap | |
| * | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get the ptr block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R4,BLOCK -> ptr block ptrs | |
| LA R5,4084(,R4) -> end of ptr block ptrs | |
| * | |
| DEL330 EQU * | |
| ICM R7,15,0(R4) Get a block # | |
| BZ DEL350 Done with ptrs | |
| BAL R14,FREBLK Free the block | |
| LA R4,4(,R4) -> next ptr field | |
| CR R4,R5 At end of ptr block? | |
| BL DEL330 | |
| * ** Here if ptr block chains to | |
| * another ptr block | |
| CLI 0(R4),X'FE' Ptr to ptr blk indicator? | |
| BNE DEL350 No, we've processed last ptr | |
| SR R7,R7 Clear for IC | |
| ICM R7,7,1(R4) Get ptr to next ptr block | |
| B DEL310 | |
| * | |
| *-- Write back the allocation map | |
| * | |
| DEL350 EQU * | |
| LA R2,ALLOCNUM Get # of alloc map blocks | |
| LA R3,ALLOCBLK Get 1st alloc map block # | |
| L R4,SPLIDMAP -> map stg area | |
| * | |
| DEL360 EQU * | |
| ST R3,KEY Set retrieval key | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R14,BLOCK -> block just read | |
| LA R15,4089 # of bytes in block | |
| LR R5,R15 Copy len | |
| MVCL R14,R4 Move alloc bitmap to i/o buffer | |
| * | |
| PUT RPL=(R7) Put the map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| LA R3,1(,R3) Next block number of alloc map | |
| BCT R2,DEL360 Go read them all | |
| * | |
| *-- Now update block 1 to activate the replacement directory | |
| * | |
| DEL400 EQU * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| * | |
| L R1,BLOCK -> blk #1 in stg | |
| USING BLKONE,R1 | |
| L R2,DIRBLK Get blk# of current directory | |
| LA R3,1 Load XOR counterpart | |
| XR R3,R2 Compute alternate directry blk# | |
| ST R3,DIRBLK Plug in alternate | |
| DROP R1 | |
| * | |
| L R7,RPL -> RPL | |
| PUT RPL=(R7) Update block 1 | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ DEL900 Exit with VSAM error | |
| B XITDIR Exit with RC=0 | |
| * | |
| DEL900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| DEL910 EQU * ** Here if directry entry not found | |
| MVC NCBRTNCD(2),=X'0C04' Set to 12,4 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| *-- Free a block (mark it available in the allocation bitmap) | |
| * | |
| *-- Entry: R7 = block # | |
| * | |
| FREBLK EQU * | |
| BCTR R7,0 Make blk # relative to 0 | |
| SR R6,R6 Clear for divide | |
| D R6,=F'8' Get byte offset remainder bits | |
| * | |
| A R7,SPLIDMAP -> byte containing bit for | |
| * this block | |
| LA R1,X'80' Create a bit | |
| SRL R1,0(R6) Adjust to bit for this blk # | |
| LA R0,X'FF' Create AND mask | |
| XR R1,R0 Compute mask to turn a bit off | |
| EX R1,FREBIT Turn off the bit in the bitmap | |
| BR R14 Return | |
| * | |
| FREBIT NI 0(R7),X'00' Executed instr | |
| * | |
| * | |
| * | |
| * LOC000 - FIND a file by id in the directory. v120 | |
| * UPD000 - UDIR update a directory entry for a specific file. v120 | |
| * | |
| * | |
| *-- UDIR functionality only updates the destination node id and v120 | |
| *-- destination user id within the directory entry from v120 | |
| *-- the TAG data supplied by the caller. No other directory v120 | |
| *-- fields are altered. v120 | |
| * | |
| * | |
| LOC000 EQU * | |
| UPD000 EQU * v120 | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| * | |
| * | |
| ST R2,KEY Get a current dir block | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| * | |
| * | |
| L R4,BLOCK -> current directory | |
| USING NSDIR,R4 | |
| L R8,NSRECNM Get # directory entries current | |
| * | |
| L R6,NCBTAG -> TAG data | |
| USING TAG,R6 | |
| XC INITBLK,INITBLK Clear file's starting blk # | |
| * | |
| LOC050 EQU * | |
| CLC NSLEN,=X'FFFE' Ptr to next block? | |
| BNE LOC060 No | |
| * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ST R2,KEY Get next current dir block | |
| * | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LOC900 Exit with VSAM error | |
| L R4,BLOCK -> next directory block | |
| * | |
| LOC060 EQU * | |
| CLC TAGID,NSID Is this the file we need? | |
| BE LOC070 | |
| * | |
| LA R4,NSDIRLN(,R4) -> next current dir entry | |
| BCT R8,LOC050 Keep looking | |
| B LOC100 Done with search | |
| * | |
| LOC070 EQU * | |
| CLI NCBREQ,NCBUDIR Is this UDIR function? v120 | |
| BE UPD100 Yes v120 | |
| * | |
| MVC INITBLK,NSBLK Save starting block # of file | |
| MVC TAGINLOC(TAGUSELN),NSINLOC Return the tag data to callr | |
| * | |
| * | |
| LOC100 EQU * | |
| ENDREQ RPL=(R7) Release the get-for-update | |
| * | |
| NC INITBLK,INITBLK Did we find a file? | |
| BZ LOC910 No, exit with not found error | |
| SR R15,R15 Set RC to 0 | |
| B XITDIR | |
| * | |
| * | |
| UPD100 EQU * v120 | |
| MVC NSTOLOC,TAGTOLOC Update destination node id v120 | |
| MVC NSTOVM,TAGTOVM Update destination user id v120 | |
| MVC TAGINLOC(TAGUSELN),NSINLOC Rtrn tag data to caller v120 | |
| MVC INITBLK,NSBLK Save file's startinblock # v120 | |
| * | |
| PUT RPL=(R7) Update the directory v120 | |
| BAL R14,CHKRPL Deal with errors v120 | |
| BNZ LOC900 Exit if VSAM error v120 | |
| B XITDIR | |
| * | |
| DROP R6 TAG v120 | |
| DROP R4 NSDIR v120 | |
| * | |
| * | |
| LOC900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| B XITDIR Exit with RC in R15 | |
| * | |
| LOC910 EQU * ** Here if directry entry not found | |
| MVC NCBRTNCD(2),=X'0C04' Set to 12,4 code | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| LA R15,12 Set RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| * | |
| * | |
| * | |
| * | |
| LST000 EQU * | |
| XC LISTLEN,LISTLEN Ensure no stray len | |
| XC LISTADDR,LISTADDR Ensure no stray address | |
| BAL R14,ENQ000 Get exclusivity | |
| * | |
| MVC KEY,=F'1' Get the first block | |
| L R7,RPL -> RPL | |
| GET RPL=(R7) Get a map block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| * | |
| L R2,BLOCK -> blk #1 in stg | |
| USING BLKONE,R2 | |
| L R3,ALMBLK Get blk# of alloc map v200 | |
| L R8,MAXBLK Get blk# in dataset v200 | |
| L R2,DIRBLK Get blk# of current directory | |
| DROP R2 | |
| * | |
| *-- Compute spool percentage full from alloc map v200 | |
| * | |
| SR R5,R5 Init blks used counter v200 | |
| LR R6,R8 Copy max blocks in dataset v200 | |
| SRL R6,3 divide by 8 # map bytes represent'g blksv200 | |
| * | |
| LST010 EQU * v200 | |
| ST R3,KEY Get a block of map v200 | |
| L R7,RPL -> RPL v200 | |
| GET RPL=(R7) Get a map block v200 | |
| BAL R14,CHKRPL Deal with errors v200 | |
| BNZ LST900 Exit with VSAM error v200 | |
| * v200 | |
| SR R0,R0 Clear for IC work v200 | |
| L R15,BLOCK -> record v200 | |
| LA R14,4089 # bytes to process v200 | |
| * | |
| LST020 EQU * v200 | |
| CLI 0(R15),X'00' Map byte unallocated? v200 | |
| BE LST050 Dont count any v200 | |
| CLI 0(R15),X'FF' Map byte fully allocated? v200 | |
| BE LST060 Yes, count 8 blocks v200 | |
| LA R4,8 # bits in a byte v200 | |
| IC R0,0(,R15) Get a map byte v200 | |
| * | |
| LST030 EQU * v200 | |
| SR R1,R1 Clear for shift v200 | |
| SRDL R0,1 Move a bit into R1 v200 | |
| LTR R1,R1 Was the bit=1? v200 | |
| BZ LST040 No, dont count it v200 | |
| LA R5,1(,R5) Count the block bit v200 | |
| * | |
| LST040 EQU * v200 | |
| BCT R4,LST030 Scan whole byte v200 | |
| * | |
| LST050 EQU * v200 | |
| BCT R6,LST070 # map bytes remaining to scnv200 | |
| B LST080 Done counting v200 | |
| * | |
| LST060 EQU * v200 | |
| LA R5,8(,R5) All 8 blocks allocated v200 | |
| B LST050 Decr remaining and continue v200 | |
| * | |
| LST070 EQU * v200 | |
| LA R15,1(,R15) -> next map byte v200 | |
| BCT R14,LST020 Keep scanning v200 | |
| LA R3,1(,R3) Bump alloc map block number v200 | |
| B LST010 Get another map block v200 | |
| * | |
| LST080 EQU * v200 | |
| MH R5,=Y(100) Blocks used: prep for % calcv200 | |
| SR R4,R4 Clear for divide v200 | |
| DR R4,R8 Compute % full v200 | |
| AR R4,R4 Double remainder v200 | |
| CR R4,R8 Do we need to round up? v200 | |
| BL LST090 No v200 | |
| LA R5,1(,R5) Round up percent full v200 | |
| * | |
| LST090 EQU * v200 | |
| STH R5,NCBPCT Return % full in NCB v200 | |
| * | |
| *-- Retrieve directory contents v200 | |
| * | |
| LST100 EQU * | |
| ST R2,KEY Get a current dir block | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| * | |
| * | |
| L R4,BLOCK -> current directory | |
| USING NSDIR,R4 | |
| L R8,NSRECNM Get # directory entries | |
| BCTR R8,0 Less 1 for directory itself | |
| STCM R8,3,NCBRECCT Set entries count in NCB | |
| LTR R8,R8 Were there any entries? | |
| BZ LST910 No | |
| SR R0,R0 Clear for multiply | |
| LA R1,NSDIRLN Length of directory entry | |
| MR R0,R8 Compute size of area needed | |
| LR R0,R1 Copy size to r0 | |
| GETMAIN RU, Get stg area to hold entries x | |
| LV=(0) | |
| STM R0,R1,LISTLEN | |
| LR R5,R1 -> where to place entries | |
| LA R4,NSDIRLN(,R4) Skip over directory's own entry | |
| * | |
| * | |
| LST150 EQU * v200 | |
| CLC NSLEN,=X'FFFE' Ptr to next block? | |
| BNE LST160 No v200 | |
| * | |
| ICM R2,15,2(R4) Get ptr to next current dir blk | |
| ST R2,KEY Get next current dir block | |
| * | |
| GET RPL=(R7) Get a block | |
| BAL R14,CHKRPL Deal with errors | |
| BNZ LST900 Exit with VSAM error | |
| L R4,BLOCK -> next directory block | |
| * | |
| LST160 EQU * v200 | |
| MVC 0(NSDIRLN,R5),0(R4) Move directory entry to stg area | |
| LA R4,NSDIRLN(,R4) -> next dir entry | |
| LA R5,NSDIRLN(,R5) -> next stg area slot | |
| BCT R8,LST150 Keep loading v200 | |
| * | |
| DROP R4 NSDIR | |
| * | |
| * | |
| LST200 EQU * v200 | |
| ENDREQ RPL=(R7) Release the get-for-update | |
| * | |
| MVC NCBAREA,LISTADDR Return list stg addr | |
| MVC NCBAREAL,LISTLEN Return list stg len | |
| MVC NCBRECLN,=Y(NSDIRLN) Return size of each dir entry | |
| SR R15,R15 Set RC to 0 | |
| B XITDIR | |
| * | |
| * | |
| LST900 EQU * VSAM Error return | |
| * Error codes in NCB already | |
| LM R0,R1,LISTLEN Get stg area len, addr | |
| LTR R0,R0 Is there an area? | |
| BZ XITDIR No | |
| FREEMAIN RU,LV=(0),A=(1) Else free it | |
| SR R15,R15 Clear for RC | |
| IC R15,NCBRTNCD Reinsert RC | |
| B XITDIR Exit with RC in R15 | |
| * | |
| LST910 EQU * ** Here if no files queued | |
| ENDREQ RPL=(R7) Release the get-for-update v130 | |
| XC NCBAREA,NCBAREA No directory list obtained v110 | |
| MVC NCBRTNCD(2),=X'0C06' Set to 12,6 code | |
| LA R15,12 Set RC | |
| LA R14,* -> location of error source v110 | |
| ST R14,NCBMACAD Store into NCB v110 | |
| B XITDIR Exit with RC in R15 | |
| * | |
| * | |
| XITDIR EQU * | |
| LR R5,R15 Any RC value to R5 | |
| BAL R14,DEQ000 Release the ENQ | |
| * | |
| ICM R1,15,SPLIDMAP Get spool id bitmap stg addr | |
| BZ XITDIR10 Don't have a map | |
| L R0,SPLIDLEN Size of bitmap | |
| FREEMAIN RU,LV=(0),A=(1) Free the bitmap | |
| XC SPLIDMAP,SPLIDMAP Clear unsed ptr | |
| * | |
| XITDIR10 EQU * | |
| L R13,4(,R13) -> caller's sa NJE00210 | |
| * | |
| ST R5,16(,R13) Set RC in R15 | |
| LM R14,R12,12(R13) Reload callers's regs NJE00220 | |
| BR R14 Return NJE00240 | |
| * NJE00290 | |
| LTORG | |
| DROP R12 | |
| * NJE00290 | |
| **** Main work area common NJE00290 | |
| **** to all NJExxx CSECTs. NJE00290 | |
| * NJE00290 | |
| NJEWK DSECT | |
| NJEEYE DS CL4'NSPL' Eyecatcher | |
| NJEWKLEN DS F Getmain size of this area | |
| NSOWN DS A -> TCB of caller | |
| ANJECMN DS A -> NJECNM common csect NJE00320 | |
| * | |
| DBLE DS D Work area NJE00310 | |
| TWRK DS 2D Work area | |
| * | |
| MACLIST DS XL160 Macro expansion area | |
| * | |
| SV14 DS A R14 save area | |
| SV14GB DS A R14 save area | |
| SV14B0 DS A R14 save area | |
| SVGB DS 4F R1-R4 save area | |
| SPLIDLEN DS F Length of spool id bitmap stg | |
| SPLIDMAP DS A -> Spool file id bitmap | |
| SPLID DS F Last assigned spool id number | |
| LISTLEN DS F Length of contents stg area | |
| LISTADDR DS A -> directory contents stg area | |
| * | |
| BLOCK DS A -> buffer for NETSPOOL VSAM i/o | |
| BLOCKEND DS A -> end of BLOCK (BLOCK+4089) | |
| PTRBUF DS A -> buffer for NJESPOOL ptr use | |
| PTRBUFEN DS A -> end of PTRBUF (PTRBUF+4089) | |
| BUFF DS A -> buffer for NJESPOOL use | |
| BUFFEND DS A -> end of BUFF (BUFF+4089) | |
| * | |
| * | |
| INITBLK DS F Blk # of first block to be written | |
| * for a new file | |
| PTRBLK DS F Blk # of current phys record for | |
| * pointer block (NCBGET/NCTPUT) | |
| NEWBLK DS F Blk # of current phys record for | |
| * logical i/o (NCBGET/NCTPUT) | |
| PUTPOS DS A Current write position in BUFF (next | |
| * available write position) | |
| GETPOS DS A Current read position in BLOCK (next | |
| * available read position) | |
| PTRPOS DS A Current write position in PTRBUF | |
| * (next available write position) | |
| PUTCNT DS F Number of logical records written | |
| GETCNT DS F Number of logical records read | |
| GETLIM DS F Max logical records in GET file | |
| * | |
| KEY DS F Relative block number key | |
| ACBL DS F ACB length | |
| ACB DS A -> ACB | |
| RPLL DS F RPL length | |
| RPL DS A -> RPL | |
| * | |
| NJFL1 DS X Flag bits | |
| NJF1OACB EQU X'80' 1... .... NETSPOOL ACB is open | |
| NJF1ENQ EQU X'40' .1.. .... Exclusive control of NETSPOOL | |
| NJF1WPND EQU X'20' ..1. .... Physical write is pending | |
| NJF1DPND EQU X'10' ...1 .... Directory add is pending | |
| NJF1PUT EQU X'02' .... ..1. Processing PUTs to file | |
| NJF1GET EQU X'01' .... ...1 Processing GETs from file | |
| * .... xx.. Available | |
| * | |
| NJFL2 DS X Flag bits | |
| NJFL3 DS X Flag bits | |
| NJFL4 DS X Flag bits | |
| * | |
| * | |
| * | |
| * | |
| NJESA DS 18F NJESPOOL OS save area NJE00300 | |
| NJEDIRSA DS 18F NJEDIR OS save area NJE00300 | |
| * | |
| DS 0D Force doubleword size | |
| NJEWKSZ EQU *-NJEWK | |
| * NJE00930 | |
| * | |
| BLKONE DSECT ** Maps block #1 in NETSPOOL | |
| DIRBLK DS F Block number of current directry | |
| ALMBLK DS F Block number of allocation map | |
| MAXBLK DS F Highest block number in NETSPOOL | |
| SPLNUM DS F Last assigned spool file # | |
| BLKONESZ EQU *-BLKONE Size of dsect | |
| * NJE00930 | |
| * | |
| TYPPRT EQU X'40' PRT dev | |
| TYPPUN EQU X'80' PUN dev | |
| COPY NETSPOOL | |
| COPY TAG | |
| * | |
| IFGACB | |
| IFGRPL | |
| * | |
| END NJESPOOL NJE01000 | |
| ./ ADD NAME=NJEINIT | |
| * | |
| * | |
| *-- NJE38 - Initialization and start up | |
| * | |
| * | |
| * | |
| * Change log: | |
| * | |
| * | |
| * 03 Mar 22 - Avoid 0C4 if no links in CONFIG, APF check, F NJE. v230 | |
| * 10 Dec 20 - Support for registered users and message queuing v220 | |
| * 04 Dec 20 - Expanded internal trace table support v212 | |
| * 29 Nov 20 - Use text-based configuration; alternate routes v211 | |
| * 02 Oct 20 - Use actual length for MGCR SEND cmds v210 | |
| * 01 Oct 20 - Put ENQ existence check in common module v210 | |
| * 10 Aug 20 - Use single NJESPOOL load for all STC NJE38 modules. v210 | |
| * 22 Jul 20 - Make non-swappable to eliminate long-wait delays v200 | |
| * 21 Jul 20 - Slightly delay auto-start of links on start-up. v200 | |
| * 02 Jul 20 - Default userid to CSA in support of TRANSMIT/RECEOVE v200 | |
| * 20 May 20 - Dont pass new file WREs for local node to cmd proc'g v120 | |
| * 05 May 20 - Abend SD23 if SVC 34 parmlist >=130 bytes. v102 | |
| * 04 May 20 - Show CONFIG assembly date and time on start up. v102 | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| PRINT GEN | |
| REGEQU REGISTER EQUATES | |
| GBLC &VERS | |
| * | |
| * User abend codes | |
| * U0038 - Unsupported/unrecognized CIB | |
| * U0039 - VSAM error on NETSPOOL | |
| * | |
| * MSG numbers used: | |
| * | |
| * 0-34 used | |
| * 35 - 39 available | |
| * 42-79 used | |
| * 163 used | |
| * | |
| *-- Program limits | |
| * | |
| TRACESZ EQU 64 Size in K of trace table v212 | |
| RQELIM EQU 256 # of preallocated RQEs | |
| * | |
| * | |
| NJEINIT CSECT | |
| NJEVER | |
| STM R14,R12,12(R13) SAVE CMS REGS | |
| LR R12,R15 BASE | |
| USING NJEINIT,R12 ADDRESS IT | |
| * | |
| GETMAIN RU, Get local stg area X | |
| LV=4096, X | |
| BNDRY=PAGE | |
| LR R10,R1 | |
| LR R1,R0 Copy length | |
| LR R2,R0 Copy length | |
| LR R0,R10 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the page | |
| * | |
| USING NJEMWK,R10 | |
| ST R13,NJESA+4 SAVE prv S.A. ADDR | |
| LA R1,NJESA -> my save area | |
| ST R1,8(,R13) Plug it into prior SA | |
| LR R13,R1 | |
| * | |
| MVC NJEEYE,=CL4'NJEM' Work area eyecatcher | |
| ST R2,NJEWKLEN Save size of area in area | |
| * | |
| L R11,=A(NJECOM) -> common csect | |
| USING NJECOM,R11 | |
| ST R11,ANJECOM Save in main work area | |
| MVC CMDBLNK,BLANKS Init field | |
| MVC RELAYID,=CL8'RELAY' Set RELAY entity id v220 | |
| LA R1,LINKS -> LINKTABL anchor word v211 | |
| ST R1,ALINKS Plug it into param list v211 | |
| LA R1,ROUTES -> RTE anchor word v211 | |
| ST R1,AROUTES Plug it into param list v211 | |
| LA R1,AUTHS -> AUTHLIST anchor word v211 | |
| ST R1,AAUTHS Plug it into param list v211 | |
| LA R1,REGUSER -> REGUSER anchor word v220 | |
| ST R1,AREGUSER Plug it into param list v220 | |
| * | |
| INIT000 EQU * v200 | |
| SR R1,R1 Dont return spool DSN v210 | |
| L R15,=V(NJESYS) -> ENQ finder v210 | |
| BALR R14,R15 Check if NJE38 already act v210 | |
| LTR R15,R15 Look for RC=0=ENQ was found v210 | |
| BZ ERR999 Branch if NJE38 active v210 | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE000I),NJE000I NJE38 v xx.xx | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| TESTAUTH FCTN=1 Are we authorized on entry? v230 | |
| LTR R15,R15 Check result v230 | |
| BZ INIT005 Branch if authorized v230 | |
| WTO 'NJE034I NJE38 is not APF-authorized' v230 | |
| B QUIT000 v230 | |
| * | |
| INIT005 EQU * v230 | |
| SR R1,R1 v200 | |
| SYSEVENT TRANSWAP v200 | |
| CLM R1,1,=X'00' SYSEVENT RC=0? v200 | |
| BE INIT010 Yes v200 | |
| WTO 'NJE032I NJE38 could not enter non-swappable state' v200 | |
| B INIT020 v200 | |
| * | |
| INIT010 EQU * v200 | |
| WTO 'NJE031I NJE38 is non-swappable' v200 | |
| * | |
| INIT020 EQU * v200 | |
| MVC MACLIST(ESTAEL),ESTAE Move ESTAE parm list | |
| L R6,=A(NJEDMP) Point to local ESTAE rtn | |
| ESTAE (R6), Issue ESTAE X | |
| CT, X | |
| TERM=YES, X | |
| PARAM=(R10), PARAM is work area address X | |
| MF=(E,MACLIST) | |
| * | |
| *-- Scan the configuration and build control blocks | |
| * | |
| MODESET MODE=SUP | |
| SR R0,R0 R0=0 scan entire configuration | |
| LA R1,INITPARM -> parm list to pass to NJESCN | |
| L R15,=V(NJESCN) | |
| BALR R14,R15 | |
| LTR R15,R15 | |
| BNZ QUIT000 | |
| * | |
| L R1,LINKS Get LINKTABL anchor v210 | |
| USING LINKTABL,R1 | |
| MVC LCLNODE,LINKID Set LCLNODE in param list v210 | |
| DROP R1 | |
| * | |
| *-- Issue STIMER for keep alive to avoid S 522 abends | |
| * | |
| L R0,=A(NJETMR) -> Timer expiration exit | |
| L R1,=A(INTVL) -> interval | |
| STIMER REAL, Set timer X | |
| (0), X | |
| DINTVL=(1) | |
| * | |
| LOAD EP=NJESPOOL Load spool interface v210 | |
| ST R0,ANJESPL Store entry addr v210 | |
| * | |
| LOAD EP=NJECMX Load command processor | |
| ST R0,ANJECMX Store entry addr of processor | |
| * | |
| BAL R14,NET000 Check NETSPOOL status | |
| BNZ QUIT000 Exit if NETSPOOL is not ready | |
| * | |
| INIT030 EQU * | |
| MODESET MODE=SUP,KEY=ZERO | |
| L R1,PSATOLD-PSA(0) v230 | |
| L R1,TCBJSCB-TCB(,R1) v230 | |
| L R1,JSCBCSCB-IEZJSCB(,R1) v230 | |
| USING CSCB,R1 v230 | |
| MVC CHUNIT(3),=C'NJE' v230 | |
| DROP R1 v230 | |
| * | |
| STIDP CPUID Get the CPU ID | |
| * | |
| GETMAIN RU, Get CSA communication area x | |
| LV=NJ38CSAZ, x | |
| SP=241 | |
| * | |
| ST R1,CSABLK Save addr of CSA stg area | |
| USING NJ38CSA,R1 | |
| XC 0(NJ38CSAZ,R1),0(R1) Clear area | |
| MVC NJ38NODE,LCLNODE Local node name to CSA | |
| MVC NJ38DUSR,DEFUSER Default userid to CSA v200 | |
| MVC NJ38ASCB,PSAAOLD-PSA(0) Move ASCB addr of this space | |
| LA R2,NJ38ECB -> cross memory ECB | |
| ST R2,CSAECBAD Save address locally | |
| DROP R1 NJ38CSA | |
| * | |
| SPKA X'80' Back to user key | |
| * | |
| MVC NJERNAME(8),NJERCON Set rname constant | |
| MVC NJERNAME+8(4),CSABLK CSA stg addr to Rname | |
| * JFCB DSN should already be here | |
| LA R5,NJERNAME | |
| MVC MACLIST(ENQL),ENQ Move macro model | |
| * | |
| ENQ (NJE38Q,(5),E,56,SYSTEM), x | |
| RET=NONE, x | |
| MF=(E,MACLIST) | |
| OI NJFL1,NJF1ENQ Set NJE38 ENQ active | |
| * | |
| GETMAIN RU, Preallocate RQE storage x | |
| LV=RQESZ*RQELIM | |
| ST R1,ARQESTG Save the address | |
| LR R2,R1 Copy length | |
| LR R1,R0 Copy length | |
| LR R0,R2 -> new stg area | |
| SR R15,R15 set pad | |
| MVCL R0,R14 Clear the stg | |
| LA R0,RQELIM Get RQE limit | |
| ST R0,RQENUM Save the value | |
| * | |
| * | |
| *- Build trace table v212 | |
| * | |
| GETMAIN RU, Get stg for trace table v212X | |
| LV=TRACESZ*1024, v212X | |
| BNDRY=PAGE v212 | |
| ST R1,ATRACE Save ptr to trace table v212 | |
| MVC 0(5,R1),=CL5'TRACE' v212 | |
| MVI 5(R1),C'T' So eyecatcher TRACETAB v212 | |
| MVI 6(R1),C'A' wont show in a dump v212 | |
| MVI 7(R1),C'B' in this load module v212 | |
| USING TRCCTL,R1 v212 | |
| ST R1,TRCSTRT Set start v212 | |
| ST R1,TRCCURR Set current v212 | |
| AR R0,R1 -> end v212 | |
| ST R0,TRCEND Set end v212 | |
| L R15,=A(NJETRC) -> Trace CSECT v212 | |
| ST R15,TRCRTN Set trace routine EPA v212 | |
| DROP R1 v212 | |
| * | |
| * | |
| *-- Initialize console processing to allow MVS modify and stop | |
| *-- commands to control this address space | |
| * | |
| INIT040 EQU * | |
| MVC MACLIST(EXTRACTL),EXTRACT Move macro model | |
| LA R3,COMMAREA -> area to place comm area addr | |
| EXTRACT (3), Get ptr to comm area X | |
| FIELDS=COMM, X | |
| MF=(E,MACLIST) | |
| * | |
| L R3,COMMAREA -> ptrs to COMM CIB and ECB | |
| USING IEZCOM,R3 Map the communication area | |
| MVC COMMECBA,COMECBPT Save off addr of COMM ECB | |
| ICM R4,15,COMCIBPT Get addr of CIB ptr | |
| BZ INIT060 No CIB, go get one | |
| USING CIBNEXT,R4 Map the CIB | |
| * | |
| CLI CIBVERB,CIBSTART Is this a START CIB? | |
| BNE INIT060 No, set up CIB count | |
| * | |
| QEDIT ORIGIN=COMCIBPT, Free the CIB from the START cmd X | |
| BLOCK=(4) that started this space | |
| * | |
| INIT060 EQU * | |
| QEDIT ORIGIN=COMCIBPT, Set CIB limit to 1 X | |
| CIBCTR=1 | |
| DROP R4 IEZCIB | |
| DROP R3 IEZCOM | |
| * | |
| * | |
| * | |
| *- Initialization Completed | |
| * | |
| INIT090 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE001I),NJE001I Move msg text | |
| MVC MACLIST+51(8),LCLNODE | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| *- Start any auto-startable links | |
| * | |
| * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| ICM R2,15,LNEXT -> first remote link v22x | |
| BZ MAIN000 No auto if no links v22x | |
| * | |
| AUTO000 EQU * | |
| TM LFLAG,LAUTO Is link autostartable? | |
| BZ AUTO010 No | |
| BAL R14,SLNK000 Try to start the link | |
| * | |
| STIMER WAIT,DINTVL=ATTDLY Pause briefly v200 | |
| * | |
| AUTO010 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ AUTO000 Look for another link | |
| DROP R2 LINKTABL | |
| * | |
| * | |
| * | |
| MAIN000 EQU * | |
| BAL R14,BLDL000 Go build the ECB list | |
| BZ QUIT000 No ECBS in list; terminate | |
| * | |
| SPKA 0 Use key 0 for CSA ECB | |
| WAIT 1,ECBLIST=ECBLIST | |
| * | |
| *-- Identify the ECB that was posted | |
| * | |
| MAIN010 EQU * | |
| LA R1,ECBLIST -> our ECBLIST | |
| * | |
| MAIN050 EQU * | |
| ICM R2,15,0(R1) -> ECB v211 | |
| BZ MAIN055 Skip ECB if empty slot v211 | |
| TM 0(R2),X'40' Was this ECB posted? | |
| BO MAIN060 Yes | |
| * | |
| MAIN055 EQU * v211 | |
| TM 0(R1),X'80' Last ECB addr in list? | |
| BO MAIN000 Nothing to do, go WAIT | |
| LA R1,4(,R1) -> next ECB addr | |
| B MAIN050 Keep looking | |
| * | |
| * | |
| MAIN060 EQU * | |
| CLM R2,7,CSAECBAD+1 Was the WRE work ECB posted? | |
| BE WRK000 Hey! We have something to do | |
| * | |
| SPKA X'80' Back to user key for the rest | |
| CLM R2,7,COMMECBA+1 Was the COMM ECB posted? | |
| BE COMM000 Yes | |
| * | |
| *** L R3,0(,R2) Load the ECB content v211 | |
| XC 0(4,R2),0(R2) Clear the ECB | |
| LA R0,LTRMECB-LINKTABL Offset of ECB in LINKTABL v211 | |
| SR R2,R0 -> LINKTABL entry v211 | |
| USING LINKTABL,R2 | |
| *** CLM R3,7,=AL3(255) ECB post code 255? v211 | |
| *** BE MAIN080 Yes, LINKTABL entry delete v211 | |
| * | |
| DETACH LTCBA Detach the subtask | |
| XC LTCBA,LTCBA Mark task terminated | |
| MVI LFLAG,X'00' Clear status flags | |
| * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(L'NJE010I),NJE010I Line is drained | |
| UNPK DBLE(4),LACTLINE(3) Convert CUU of line | |
| TR DBLE(3),HEXTRAN-240 | |
| MVC MACLIST+17(3),DBLE | |
| WTO ,MF=(E,MACLIST) Line xxx is drained | |
| B MAIN010 Look for more work | |
| * | |
| *-- Here to delete a LINKTABL entry (from LINK OFF command) v211 | |
| *-- We arrive here from POST code 255. NJESCN LOFF000 does the POSTv211 | |
| * | |
| DROP R2 LINKTABL v211 | |
| * | |
| *-- Build a new ECBLIST before the wait | |
| * | |
| BLDL000 EQU * | |
| SR R1,R1 Init: no ECBs in list | |
| LA R15,ECBLIST-4 -> 0th ECB list entry | |
| TM NJFL1,NJF1STOP Is main task termination set? | |
| BO BLDL010 Yes, dont add COMM ECBs to list | |
| LA R15,4(,R15) -> next available ECB list slot | |
| L R1,COMMECBA -> COMM ECB | |
| ST R1,0(,R15) Set addr in ECB list | |
| LA R15,4(,R15) -> next available ECB list slot | |
| L R1,CSAECBAD -> WRE work ECB | |
| ST R1,0(,R15) Set addr in ECB list | |
| * | |
| BLDL010 EQU * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| BLDL020 EQU * | |
| CLC LTCBA,=A(0) Is task active for link? | |
| BE BLDL030 Zero, skip this one | |
| LA R15,4(,R15) -> next available ECB list slot | |
| LA R1,LTRMECB -> task's termination ECB | |
| ST R1,0(,R15) Set ECB addr in ECB list | |
| * | |
| BLDL030 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ BLDL020 Scan them all | |
| DROP R2 LINKTABL | |
| LTR R1,R1 Any ECB in the list? | |
| BZR R14 No, return with CC=0 set | |
| OI 0(R15),X'80' Mark end of list | |
| BR R14 Return with ECB list built | |
| * | |
| ********************************************************************** | |
| * * | |
| * WRE FLOWS * | |
| * * | |
| ********************************************************************** | |
| * | |
| * When WREs are created by out-of-address space tasks (such as by | |
| * modules NJE38 by TSO users, or NJ38XMIT by jobs) they are | |
| * created in CSA and chained off the NJE38 CSA block NJ38CSA. The | |
| * WRE ECB is posted via cross memory post. Any WRE posted in this | |
| * manner will first end up here, at WRK000 below. | |
| * | |
| * WRK000 will pull the entire chain of WREs and get it off that queue | |
| * so that these can be processed one at a time while outside tasks may | |
| * continue to add new WREs to the CSA chain. | |
| * | |
| * Each WRE is examined for its destination. If the WRE has a | |
| * destination link id in the LINKs table, or via a route that can be | |
| * forwarded via a destination link, the WRE will be requeued to that | |
| * particular link task at WRK120. | |
| * | |
| * When the link task gets the WRE, it will be processed by NJEDRV | |
| * label COMM000, which will dequeue it and flow continues to | |
| * label WRK000 in that same module. After processing the WRE stg | |
| * is freed. | |
| * | |
| * Back in NJEINIT, if the WRE is destined for the local link (at | |
| * WRK030) flow proceeds to WRK200 where the command processor NJECMD | |
| * is called to examine and process the action. Upon return, the | |
| * WRE storage is freed and the next WRE on the chain is examined, | |
| * if any. | |
| * | |
| * Notes: | |
| * 1. WREs are created in subpool 2 which is shared by other TCBs. | |
| * (Except for out-of-address-space WREs, which are in CSA). | |
| * 2. WREs are sometimes created internally: | |
| * a). in NJEINIT STOP000 to queue a WRE to each active link task | |
| * in order to stop the link. | |
| * b). in NJEINIT CCD000 in order to queue a command that was | |
| * input from the system console to a remote link task. | |
| * 3. Whether the WRE is created from an outside address space or | |
| * internally, they all flow the same way, via the post to the | |
| * ECB in NJ38CSA and being placed on the queue anchor in NJ38CSA. | |
| * | |
| * | |
| * | |
| * Summary: | |
| * | |
| * 1. WRE gets created and posted to CSA anchor | |
| * 2. NJEINIT WRK000 sees the WRE first | |
| * 3. WRE is requeued to a link or handled by NJEINIT/NJECMD | |
| * 4. WRE is freed. | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| * | |
| *-- WRE work ECB was posted | |
| * | |
| WRK000 EQU * | |
| SPKA 0 This routine must run key=0 | |
| XC 0(4,R2),0(R2) Reinit WRE work ECB | |
| L R2,CSABLK -> CSA communications area | |
| USING NJ38CSA,R2 | |
| * | |
| LM R6,R7,NJ38SWAP Get WRE anchor, sync count | |
| * | |
| WRK010 EQU * | |
| LTR R6,R6 Was WRE Q empty? | |
| BZ MAIN010 Yes, nothing else to do | |
| SR R14,R14 Zero out the WRE Q anchor | |
| LR R15,R7 Copy same sync count | |
| CDS R6,R14,NJ38SWAP Try to empty the WRE Q | |
| BC 7,WRK010 Can't yet, try again | |
| DROP R2 NJ38CSA | |
| * | |
| *-- Distribute the WREs to the various links | |
| * | |
| *-- R6 -> start of WRE chain we dequeued from WRE Q | |
| * | |
| USING WRE,R6 | |
| * | |
| * | |
| WRK030 EQU * | |
| NJETRACE TYPE=TRCIWRE Trace incoming WRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* -> here v220 | |
| ST R15,4(,R14) Save addr of trace request v220 | |
| ST R6,8(,R14) Trace WRE addr v220 | |
| MVC 12(4,R14),WRETYPE Trace type code,len,subpool v220 | |
| MVC 16(8,R14),WRELINK link dest v220 | |
| MVC 24(8,R14),WREUSER userid dest v220 | |
| NJETRACE TYPE=TRCIWRE Trace incoming WRE follow on v220 | |
| OI 0(R14),X'80' Indicate follow on v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 4(8,R14),WREORIG Originator userid v220 | |
| MVC 12(20,R14),WRETXT Trace WRE content v220 | |
| * | |
| CLC WRELINK,LCLNODE Is this WRE for the local node? | |
| BE WRK200 Yes, don't queue it to a link | |
| * | |
| WRK040 EQU * | |
| LA R1,WRELINK -> destination link of WRE | |
| BAL R14,FLNK000 Locate the LINKTABL entry | |
| BZ WRK050 No link found, check routes | |
| * | |
| USING LINKTABL,R2 | |
| TM LFLAG,LCONNECT Is link connected? | |
| BO WRK120 Yes, post the link task | |
| * | |
| *-- Otherwise, look at routes. R1-> WRELINK | |
| * | |
| WRK050 EQU * | |
| BAL R14,RLNK000 Find matching route | |
| BZ WRK150 No matching routes | |
| BAL R14,FLNK000 Locate the LINKTABL entry | |
| BZ WRK150 No link found for this WRE | |
| TM LFLAG,LCONNECT Is link connected? | |
| BZ WRK150 No, skip this WRE | |
| * | |
| * | |
| *-- Here to requeue the WRE to the link WRE chain | |
| * | |
| WRK120 EQU * | |
| NJETRACE TYPE=TRCOWRE Trace outgoing WRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* -> here v220 | |
| ST R15,4(,R14) Save addr of trace request v220 | |
| ST R6,8(,R14) Trace WRE addr v220 | |
| MVC 12(4,R14),WRETYPE Trace type code,len,subpool v220 | |
| MVC 16(8,R14),WRELINK link dest v220 | |
| MVC 24(8,R14),WREUSER userid dest v220 | |
| NJETRACE TYPE=TRCOWRE Trace outgoing WRE follow on v220 | |
| OI 0(R14),X'80' Indicate follow on v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 4(8,R14),WREORIG Originator userid v220 | |
| MVC 12(20,R14),WRETXT Trace WRE content v220 | |
| * | |
| L R8,WRENEXT -> next WRE in CSA chain | |
| * | |
| LM R0,R1,LWRESWAP Get first WRE ptr, sync count | |
| WRK130 EQU * | |
| ST R0,WRENEXT First WRE becomes next | |
| LR R4,R6 -> WRE to be added as first | |
| LA R5,1(,R1) Incr synchronization count | |
| CDS R0,R4,LWRESWAP Update LINK WRE anchor, sync | |
| BC 7,WRK130 Gotta try again | |
| * | |
| LA R1,LECB -> link task notification ECB | |
| POST (1) Tell task | |
| B WRK290 Go get another WRE | |
| * | |
| *-- Release WRE that we cant distribute to a link | |
| * | |
| WRK150 EQU * | |
| B WRK290 | |
| DROP R2 LINKTABL | |
| * | |
| *-- Here if WRE is intended for the local node | |
| * | |
| WRK200 EQU * | |
| SR R15,R15 Clear for IC v220 | |
| IC R15,WRETYPE Get WRE type code v220 | |
| CLM R15,1,=AL1(WRK210HI) Check against highest code v220 | |
| BH WRK280 Dispose of invalid WRE v220 | |
| B WRK210(R15) Branch into table v220 | |
| * | |
| WRK210 EQU * v220 | |
| B WRK280 X'00' Invalid; just delete WRE v220 | |
| B WRK280 X'04' WRENEW; ignore for LCL nodev220 | |
| B WRK215 X'08' WRECMD v220 | |
| B WRK220 X'0C' WREMSG v220 | |
| B WRK240 X'10' WRESTAR v220 | |
| B WRK300 X'14' WREREG v220 | |
| B WRK350 X'18' WREDREG v220 | |
| B WRK400 X'1C' WREQRM v220 | |
| B WRK450 X'20' WREDRM v220 | |
| WRK210HI EQU (*-WRK210-4) Highest code supported v220 | |
| * | |
| * | |
| WRK215 EQU * | |
| SPKA X'80' | |
| MVC CMDAREA,BLANKS Init receiving area | |
| SR R2,R2 Clear for IC | |
| IC R2,WRETXTLN Get cmd image length | |
| EX R2,MVTXT1 Move cmd image | |
| STC R2,CMNDBLEN IBM length of image to CMDBLOK | |
| MVC CMNDLINK,LCLNODE This node is the issuer | |
| MVC CMNDUSER,WREUSER Copy TSO id of issuer | |
| * | |
| L R15,=A(NJECMD) -> command processor | |
| BALR R14,R15 Go there | |
| SPKA X'00' | |
| B WRK280 | |
| * | |
| MVTXT1 MVC CMDAREA(0),WRETXT Executed instr | |
| * | |
| *-- Send the msg response to a local TSO user | |
| * | |
| WRK220 EQU * | |
| CLC WREUSER,=CL8'OP' Message destined for operator? | |
| BE WRK230 Yes | |
| LA R15,WREUSER -> userid to locate | |
| BAL R14,REG000 See if user registered v220 | |
| BNZ WRK280 Yes it was; we queued it v220 | |
| BAL R14,USR800 See if TSO user logged on | |
| BZ WRK280 Skip msg if not | |
| MVC MACLIST(80),BLANKS Init first part | |
| MVC MACLIST+4(9),=C'SE ''From ' | |
| MVC MACLIST+13(8),WREORIG | |
| TRT MACLIST+13(9),BLANK Look for end of orig userid | |
| MVI 0(R1),C':' | |
| LA R1,2(,R1) -> area for msg | |
| MVC 0(104,R1),WRETXT Move msg text v102 | |
| LA R2,MACLIST+111 -> last byte from MTEXT area v210 | |
| LA R0,32 # char to check backwards v210 | |
| * | |
| WRK223 EQU * Only look backwards to col 80 v210 | |
| CLI 0(R2),C' ' Try to find last non-blank v210 | |
| BNE WRK226 Found it v210 | |
| BCTR R2,0 -> prev char v210 | |
| BCT R0,WRK223 Keep scanning v210 | |
| * | |
| WRK226 EQU * v210 | |
| LA R2,1(,R2) -> first blank after last char v210 | |
| MVC 0(8,R2),=C''',USER=(' v210 | |
| MVC 8(12,R2),BLANKS Ensure trailer initted v210 | |
| MVC 8(7,R2),WREUSER Max for TSO userid is 7 v210 | |
| LA R1,8+7(,R2) -> max end of trt v210 | |
| TRT 8(7,R2),BLANK Look for end of userid v210 | |
| MVI 0(R1),C')' Move closing v210 | |
| MVI 1(R1),C' ' Plus 1 blank v210 | |
| LA R0,MACLIST -> start of msg area v210 | |
| SR R1,R0 Compute length of msg v210 | |
| LA R1,1(,R1) Account for blank at end v210 | |
| XC MACLIST(4),MACLIST Clear len, flags v210 | |
| STH R1,MACLIST Insert the msg length v210 | |
| * | |
| LA R1,MACLIST | |
| SR R0,R0 | |
| SVC 34 Issue MGCR SVC | |
| B WRK280 | |
| * | |
| *-- Send the msg response to the system operator | |
| * | |
| WRK230 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG | |
| MVC MACLIST+4(4),=C'From' | |
| MVC MACLIST+9(8),WREORIG Move originating userid | |
| TRT MACLIST+9(9),BLANK Look for end of orig userid | |
| MVI 0(R1),C':' | |
| LA R1,2(,R1) -> area for msg | |
| MVC 0(104,R1),WRETXT Move msg text v102 | |
| WTO ,MF=(E,MACLIST) | |
| B WRK280 | |
| * | |
| *-- Start a link (via a local or remote command) | |
| * | |
| WRK240 EQU * | |
| L R2,WREUSER -> LINKTABL entry of START cmd | |
| BAL R14,SLNK000 Attach the link driver | |
| B WRK280 | |
| * | |
| *-- Clean up spent WRE | |
| * | |
| WRK280 EQU * | |
| SPKA 0 In case WRE isin CSA v220 | |
| L R8,WRENEXT -> next WRE in chain | |
| SR R15,R15 Clear for IC v220 | |
| IC R15,WRESP Get subpool number v220 | |
| LA R0,WRESIZE Size of this WRE v220 | |
| * | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R2,* v220 | |
| STCM R2,7,5(R14) Addr of Freemain to trace v220 | |
| ST R0,8(,R14) Len to trace v220 | |
| ST R6,12(,R14) addr to trace v220 | |
| STC R15,8(,R14) Trace subspool v220 | |
| MVI WRESP,X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free the WRE x | |
| LV=(0), x | |
| A=(6), x | |
| SP=(15) v220 | |
| SPKA X'80' v220 | |
| * | |
| *-- Done processing a WRE; get another | |
| * | |
| WRK290 EQU * | |
| LTR R6,R8 Get next WRE to distribute | |
| BNZ WRK030 Yes have an addr v220 | |
| B MAIN010 All done with WREs | |
| * | |
| * | |
| * Registered User Service Support Notes v220 | |
| * | |
| * The registered user service allows an outside address space | |
| * operating in the same MVS system as NJE38, to 'register' or | |
| * establish a relationship with NJE38 where messages that would | |
| * ordinarily be sent to a user terminal are instead queued in | |
| * storage and presented to the outside address space upon request. | |
| * | |
| * Users wishing to use this service call the NJERLY interface which | |
| * is responsible for establishing the relationship with NJE38. This | |
| * is done using WREs and cross-memory POST. In this way, a batch, | |
| * TSO, or STC address space can capture message traffic destined | |
| * for it before it would arrive at a terminal, and thereby process | |
| * this message or display it in the manner of their choosing. | |
| * | |
| * WREs created by NJERLY are always in CSA. When they are used to | |
| * request service of NJE38, they place the WRE on the NJ38SWAP | |
| * compare and swap chain just like any other outside requester and | |
| * post NJEINIT's CSA ECB. NJEINIT then acts on the request. | |
| * | |
| * NJEINIT never frees the WRE created by NJERLY. That is NJERLY's | |
| * responsibility. | |
| * | |
| * For some functions of the service, the request is ignored if | |
| * important information is missing (unlikely) such as ASCB address | |
| * of NJERLY, or the WRE address. Ignoring the request is all that | |
| * can be done since without either of those pieces, NJEINIT cannot | |
| * issue CM POST back to the NJERLY space to let it know of the error. | |
| * | |
| * When a user joins the service, he registers. NJEINIT will create | |
| * a REGUSERB control block to establish the registration and hold | |
| * the NJERLY requester'e WRE and ASCB address. | |
| * | |
| * Once a user (userid) has registered, any message traffic inbound | |
| * destined for that user will be queued in NJE38 storage and chained | |
| * from REGUSERB, The user can then request a message be returned | |
| * one per request. A post code of 4 (ERNOMSG) is used to indicate | |
| * no messages are queued. | |
| * | |
| * When the user wants to stop using the service, it 'deregisters', | |
| * causing NJEINIT to freemain any queued messages for the user and | |
| * releasing the REGUSERB. Message traffic destined for that user | |
| * resumes being presented to the terminal as before. | |
| * | |
| * In the comments below, the 'registered user WRE' refers to the | |
| * WRE created by NJERLY in CSA by the user address space. | |
| * | |
| * | |
| * | |
| *- WREREG | |
| *- Register a user for queued message services | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Ensure userid is not already registered on REGUSERB chain. | |
| * 2. Create a new REGUSERB for this user | |
| * 3. Issue CM POST to registered user space, function complete. | |
| * | |
| * | |
| * Notes: - On entry, registered user WRE is in R6. | |
| * - Registered users WREs are not freemained; we are not the | |
| * owner. | |
| * - If the registered user WRE has no ASCB addr, we have no | |
| * choice but to ignore the request. | |
| * | |
| WRK300 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| CLC WREASCB,=A(0) Is ASCB present? v220 | |
| BE WRK810 No, invalid. Can't respond v220 | |
| * | |
| ICM R1,15,REGUSER -> first REGUSER v220 | |
| BZ WRK320 None, let's start a chain v220 | |
| USING REGUSERB,R1 v220 | |
| LA R0,ERDUPUSR Assume duplicate user error v220 | |
| * | |
| WRK310 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user already reg? v220 | |
| BE WRK800 Yes, post the error in R0 v220 | |
| ICM R1,15,REGNEXT Keep looking v220 | |
| BNZ WRK310 v220 | |
| * | |
| WRK320 EQU * v220 | |
| GETMAIN RU, Get storage for a REGUSER v220x | |
| LV=REGSIZE, v220x | |
| SP=2 v220 | |
| XC 0(REGSIZE,R1),0(R1) Init stg v220 | |
| MVC REGEYE,=CL4'REGU' Set eye v220 | |
| MVC REGUSRID,WREUSER Userid to be registered v220 | |
| ST R6,REGWRE Save ptr to registration WREv220 | |
| MVC REGNEXT,REGUSER Chain other REGUSERs to thisv220 | |
| ST R1,REGUSER This REGUSER is first v220 | |
| DROP R1 REGUSERB v220 | |
| SR R0,R0 Set RC=0 success v220 | |
| B WRK800 User successfully registeredv220 | |
| * | |
| *- WREDREG | |
| *- Deregister a user from queued message services | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. Get the chain anchor for queued message WREs, if any | |
| * 3. Freemain the REGUSERB. | |
| * 4. Freemain each queued message WRE | |
| * 5. Issue CM POST to registered user space, function complete. | |
| * | |
| * Notes: - On entry, registered user WRE is in R6. | |
| * - Registered users WREs are not freemained; we are not the | |
| * owner. | |
| * - If the registered user WRE has no ASCB addr, we have no | |
| * choice but to ignore the request. | |
| * | |
| WRK350 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| CLC WREASCB,=A(0) Is ASCB present? v220 | |
| BE WRK810 No, invalid. Can't respond v220 | |
| * | |
| LA R0,ERUSERNF Assume user not found v220 | |
| LA R2,REGUSER -> 0th REGUSER entry v220 | |
| ICM R1,15,REGUSER -> first REGUSER v220 | |
| BZ WRK800 None, user indeed isnt foundv220 | |
| USING REGUSERB,R1 v220 | |
| * | |
| WRK360 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user we want? v220 | |
| BE WRK370 Yes v220 | |
| LR R2,R1 Save this REGUSER ptr v220 | |
| ICM R1,15,REGNEXT Get next REGUSER and continuv220 | |
| BNZ WRK360 v220 | |
| B WRK800 Exit with user not found v220 | |
| * | |
| WRK370 EQU * v220 | |
| MVC REGNEXT-REGUSERB(,R2),REGNEXT unchain R1 REGUSER v220 | |
| L R2,REGMSGQ -> MSG WRE chain for user v220 | |
| DROP R1 REGUSERB v220 | |
| * | |
| FREEMAIN RU, Free storage for a REGUSERB v220x | |
| LV=REGSIZE, v220x | |
| A=(1), v220x | |
| SP=2 v220 | |
| * | |
| WRK380 EQU * v220 | |
| LTR R1,R2 Were any WREs chained? v220 | |
| BZ WRK390 No, we're done v220 | |
| L R2,WRENEXT-WRE(,R2) -> next WRE v220 | |
| LA R0,WRESIZE Get size of WRE v220 | |
| * | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* v220 | |
| STCM R15,7,5(R14) Addr of Freemain to trace v220 | |
| STM R0,R1,8(R14) Len, stg addr to trace v220 | |
| MVI 8(R14),2 Trace subspool v220 | |
| MVI WRESP-WRE(R1),X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free storage for a WRE v220x | |
| LV=(0), v220x | |
| A=(1), v220x | |
| SP=2 v220 | |
| B WRK380 Free entire chain v220 | |
| * | |
| WRK390 EQU * v220 | |
| SR R0,R0 Set RC=0 success v220 | |
| B WRK800 User successfully deregisterv220 | |
| * | |
| * | |
| *- WREQRM | |
| *- Queue a message destined for a registered user | |
| * | |
| *- Who requests this service: Internal by NJEINIT, NJECMX, NJEDRV | |
| * as message traffic arrives and needs to be queued. | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. If REGUSERB is not found, userid is not registered. Exit | |
| * with CC=0 and allow the message to go to the user terminal. | |
| * 3. Get the registration WRE address from REGUSERB, exit if none. | |
| * 4. Add this queued message WRE (in R6) to the queued message | |
| * chain REGMSGQ (in REGUSERB). Do not freemain this WRE! | |
| * 5. Issue CM POST to registered user space that message is avail. | |
| * | |
| * Notes: - On entry, a queued message WRE is in R6. | |
| * - The WREs are added to the start of the chain (REGMSGQ) | |
| * because they come to us in reverse order of issuance. | |
| * This puts them back in the right order | |
| * | |
| WRK400 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| ICM R3,15,REGUSER -> first REGUSER v220 | |
| BZ WRK810 No one registered v220 | |
| USING REGUSERB,R3 v220 | |
| * | |
| WRK410 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user the one? v220 | |
| BE WRK420 Yes v220 | |
| ICM R3,15,REGNEXT Keep looking v220 | |
| BNZ WRK410 v220 | |
| B WRK810 Can't find REGUSER v220 | |
| * | |
| WRK420 EQU * v220 | |
| ICM R4,15,REGWRE -> user's registration WRE v220 | |
| BZ WRK810 Ignore if not there v220 | |
| * | |
| MVC WRENEXT,REGMSGQ Add chain to new WRE v220 | |
| ST R6,REGMSGQ Add WRE to anchor v220 | |
| LR R6,R4 User registration WRE to R6 v220 | |
| SR R0,R0 Indicate success v220 | |
| B WRK800 Tell user msg pending v220 | |
| * v220 | |
| * v220 | |
| *- WREDRM | |
| *- Dequeue message for a registered user when they request it | |
| * | |
| *- Who requests this service: user address space via NJERLY | |
| * | |
| *- Steps: | |
| * 1. Locate the REGUSERB for the userid | |
| * 2. If REGUSERB is not found, userid is not registered. Issue | |
| * error to requester. | |
| * 3. Get the first queued message WRE from REGUSERB, issue | |
| * ERNOMSG error if nothing queued. | |
| * 4. Copy the message text from the queued message WRE into the | |
| * registered user WRE. | |
| * 5. Issue CM POST to registered user space, function complete. | |
| * | |
| * Notes: - On entry, the registered user WRE is in R6. | |
| * | |
| * | |
| WRK450 EQU * | |
| L R8,WRENEXT -> next WRE v220 | |
| XC WRENEXT,WRENEXT Clear next next ptr because v220 | |
| * this is a registration WRE v220 | |
| * and wont be freemained herev220 | |
| ICM R3,15,REGUSER -> first REGUSER v220 | |
| BZ WRK810 No one registered v220 | |
| USING REGUSERB,R3 v220 | |
| * | |
| WRK460 EQU * v220 | |
| CLC REGUSRID,WREUSER Is this user the one? v220 | |
| BE WRK470 Yes v220 | |
| ICM R3,15,REGNEXT Keep looking v220 | |
| BNZ WRK460 v220 | |
| B WRK810 Can't find REGUSER v220 | |
| * | |
| WRK470 EQU * v220 | |
| LA R0,ERNOMSG Assume no msgs queued v220 | |
| ICM R5,15,REGMSGQ -> first queued msg WRE v220 | |
| BZ WRK800 No msgs available v220 | |
| * | |
| MVC REGMSGQ,WRENEXT-WRE(R5) Remove 1st queued from chainv220 | |
| DROP R3 REGUSERB v220 | |
| * | |
| MVC WRETXT,WRETXT-WRE(R5) Copy queued msg text to v220 | |
| * registered user WRE v220 | |
| * | |
| LA R0,WRESIZE Get size of WRE v220 | |
| NJETRACE TYPE=TRCFWRE v220 | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| LA R15,* v220 | |
| STCM R15,7,5(R14) Addr of Freemain to trace v220 | |
| ST R0,8(,R14) Len to trace v220 | |
| MVI 8(R14),2 Trace subspool v220 | |
| ST R5,12(,R14) Addr to trace v220 | |
| MVI WRESP-WRE(R5),X'FF' Mark stg as freed v220 | |
| * | |
| FREEMAIN RU, Free Queued msg WRE v220x | |
| LV=(0), v220x | |
| A=(5), v220x | |
| SP=2 v220 | |
| * | |
| SR R0,R0 Indicate success v220 | |
| B WRK800 Tell user msg pending v220 | |
| * | |
| * | |
| WRK800 EQU * USING WRE,R6 v220 | |
| L R7,WREASCB -> ASCB of requestor v220 | |
| LA R1,WREECB -> WRE's ECB v220 | |
| * | |
| MVC MACLIST(POSTL),POST Move macro model v220 | |
| POST (1),(0), Post requestor's ECB v220x | |
| ASCB=(7), v220x | |
| ERRET=WRK810, v220x | |
| ECBKEY=0, v220x | |
| MF=(E,MACLIST) v220 | |
| * | |
| WRK810 EQU * v220 | |
| B WRK290 All done with WRE v220 | |
| DROP R6 WRE v220 | |
| * | |
| *-- Address space Communications ECB was posted | |
| * | |
| COMM000 EQU * | |
| L R4,COMMAREA -> Communications area | |
| USING IEZCOM,R4 | |
| L R5,COMCIBPT -> CIB | |
| USING CIBNEXT,R5 | |
| CLI CIBVERB,CIBMODFY Modify cmd? | |
| BE MOD000 Yes | |
| CLI CIBVERB,CIBSTOP Stop cmd? | |
| BE STOP000 Yes, let subtasks know | |
| U0038 ABEND 38,DUMP,STEP Shouldnt happen | |
| * | |
| MOD000 EQU * | |
| MVC CMDAREA,BLANKS Init receiving area | |
| LH R2,CIBDATLN Get cmd image length | |
| BCTR R2,0 Adjust for execute | |
| EX R2,MVMOD1 Move cmd image | |
| STC R2,CMNDBLEN IBM length of image to CMDBLOK | |
| * | |
| QEDIT ORIGIN=COMCIBPT,BLOCK=(5) Purge the CIB | |
| * | |
| MVC CMNDLINK,LCLNODE Console operator | |
| MVC CMNDUSER,=CL8'OP' should get any responses | |
| L R15,=A(NJECMD) -> command processor | |
| BALR R14,R15 Go there | |
| B MAIN010 | |
| * | |
| MVMOD1 MVC CMDAREA(0),CIBDATA Executed instr | |
| * | |
| * | |
| * | |
| STOP000 EQU * | |
| QEDIT ORIGIN=COMCIBPT,BLOCK=(5) Purge the CIB | |
| DROP R4 IEZCOM | |
| DROP R5 IEZCIB | |
| * | |
| STOP010 EQU * | |
| OI NJFL1,NJF1STOP Indicate STOP ordered | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| STOP020 EQU * | |
| CLC LTCBA,=A(0) Is task active for link? | |
| BE STOP030 Zero, skip this one | |
| * | |
| BAL R14,GTW000 Get a WRE | |
| LR R4,R1 -> WRE | |
| USING WRE,R4 | |
| MVI WRECODE,X'81' Code for drain link | |
| DROP R4 | |
| BAL R14,PST000 Queue the WRE to link | |
| * | |
| STOP030 EQU * | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BNZ STOP020 Scan them all | |
| DROP R2 LINKTABL | |
| * | |
| B MAIN010 | |
| * | |
| * | |
| *-- Open then Close NETSPOOL dataset to determine status | |
| * | |
| * NCBRTNCD/ERRCD after call to NCBOPEN | |
| * 0474 = dataset not closed properly (do verify) | |
| * 0874 = dataset not formatted | |
| * | |
| NET000 EQU * | |
| ST R14,SV14 Save return | |
| * | |
| MVC JFCBDCB(NSPOOLN),NSPOOL Move DCB for RDJFCB use | |
| LA R1,JFCB -> JFCB return area | |
| ST R1,JEXLST Set addr in exit list | |
| MVI JEXLST,X'87' Set exlst for JFCB return | |
| LA R1,JFCBDCB -> DCB | |
| USING IHADCB,R1 | |
| LA R0,JEXLST -> exit list | |
| STCM R0,7,DCBEXLSA Store it into DCB | |
| DROP R1 | |
| * | |
| MVC MACLIST(RDJFCBL),RDJFCB Move model | |
| RDJFCB JFCBDCB,MF=(E,MACLIST) Get NETSPOOL DSN | |
| * | |
| LA R3,NCB1 | |
| USING NCB,R3 | |
| * | |
| NSIO TYPE=OPEN, Open NETSPOOL x | |
| NCB=(R3), v210x | |
| ENTRY=ANJESPL v210 | |
| LTR R15,R15 | |
| BZ NET040 | |
| BAL R14,FMT000 | |
| * | |
| NET040 EQU * | |
| NSIO TYPE=CLOSE, x | |
| NCB=(R3), v210x | |
| ENTRY=ANJESPL v210 | |
| DROP R3 | |
| TM NJFL1,NJF1VSER Did VSAM error occur? | |
| BZ NET090 No | |
| CLC LASTRC(2),=X'0474' NETSPOOL needs verify? | |
| BE NET080 | |
| CLC LASTRC(2),=X'0874' NETSPOOL not formatted? | |
| BNE NET070 | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE007I),NJE007I Not formatted msg | |
| WTO ,MF=(E,MACLIST) | |
| B NET090 | |
| * | |
| NET070 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE006I),NJE006I Open failed | |
| WTO ,MF=(E,MACLIST) | |
| B NET090 | |
| * | |
| NET080 EQU * | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE008I),NJE008I Do verify | |
| WTO ,MF=(E,MACLIST) | |
| MVC MACLIST(WTOMSGL),WTOMSG Move macro model | |
| MVC MACLIST+4(L'NJE009I),NJE009I verify complete | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| NET090 EQU * | |
| TM NJFL1,NJF1VSER Set CC: Did VSAM error occur? | |
| L R14,SV14 Reload return | |
| BR R14 Return | |
| * | |
| ERR999 EQU * | |
| WTO 'NJE999I NJE38 is already active' | |
| * | |
| QUIT000 EQU * | |
| ESTAE 0 Turn off ESTAE | |
| * | |
| TTIMER CANCEL Cancel the timer | |
| * | |
| FREEMAIN RU,SP=1 Free all CONFIG related stg | |
| FREEMAIN RU,SP=2 Free all WRE related stg | |
| * | |
| QUIT020 EQU * | |
| DELETE EP=NJECMX Delete command processor | |
| DELETE EP=NJESPOOL Delete spool interface v210 | |
| * | |
| ICM R1,15,ARQESTG -> RQE stg area | |
| BZ QUIT030 Skip free if none v212 | |
| FREEMAIN RU, Free it x | |
| LV=RQESZ*RQELIM, x | |
| A=(1) | |
| * | |
| QUIT030 EQU * v212 | |
| ICM R1,15,ATRACE -> Trace table stg v212 | |
| BZ QUIT070 Skip free if none v212 | |
| FREEMAIN RU, Free it v212x | |
| LV=TRACESZ*1024, v212x | |
| A=(1) v212 | |
| * | |
| QUIT070 EQU * | |
| TM NJFL1,NJF1ENQ Is NJE38 ENQ active? | |
| BZ QUIT080 No | |
| LA R5,NJERNAME -> RNAME | |
| MVC MACLIST(ENQL),ENQ Move macro model | |
| DEQ (NJE38Q,(5),56,SYSTEM), x | |
| RET=NONE, x | |
| MF=(E,MACLIST) | |
| * | |
| QUIT080 EQU * | |
| ICM R5,15,CSABLK -> CSA stg area | |
| BZ QUIT090 Not present | |
| * | |
| SPKA 0 | |
| * | |
| FREEMAIN RU,LV=NJ38CSAZ,A=(5),SP=241 Free CSA area | |
| XC CSABLK,CSABLK | |
| * | |
| SPKA X'80' | |
| * | |
| QUIT090 EQU * | |
| LR R1,R10 -> NJEWK main work area page | |
| L R13,4(,R13) -> caller's sa | |
| FREEMAIN RU, x | |
| LV=4096, x | |
| A=(1) | |
| LM R14,R12,12(R13) Reload system's regs | |
| XR R15,R15 RC=0 | |
| BR R14 Return | |
| * | |
| U0039 EQU * | |
| STM R0,R1,DBLE Save regs across abend SVC | |
| ABEND 39,DUMP,STEP | |
| * | |
| LTORG | |
| * HHMMSSTH | |
| DS 0D v200 | |
| ATTDLY DC CL8'00000050' 1/2 sec | |
| * | |
| EXTRACT EXTRACT MF=L | |
| EXTRACTL EQU *-EXTRACT | |
| ESTAE ESTAE 0,MF=L | |
| ESTAEL EQU *-ESTAE | |
| * | |
| ENQ ENQ (0),MF=L | |
| ENQL EQU *-ENQ | |
| * | |
| DEQ DEQ (0),MF=L | |
| DEQL EQU *-DEQ | |
| * | |
| RDJFCB RDJFCB 0,MF=L | |
| RDJFCBL EQU *-RDJFCB | |
| * | |
| NJE38Q DC CL8'NJE38' | |
| NJERCON DC CL8'NJEINIT' | |
| * | |
| NSPOOL DCB DDNAME=NETSPOOL,DSORG=PS,MACRF=GL,EXLST=0 | |
| NSPOOLN EQU *-NSPOOL | |
| * | |
| * 456789012345678901234567890123456789012345678901 | |
| NJE000I DC C'NJE000I NJE38 &VERS' | |
| NJE001I DC C'NJE001I Initialization complete for local node' | |
| NJE006I DC C'NJE006I Open failed for DD NETSPOOL' | |
| NJE007I DC C'NJE007I NETSPOOL dataset has not been formatted' | |
| NJE008I DC C'NJE008I The NETSPOOL dataset required verification befx | |
| ore start-up' | |
| NJE009I DC C'NJE009I Verification complete. Please restart NJE38' | |
| NJE010I DC C'NJE010I Line xxx is drained' | |
| * | |
| DROP R12 | |
| * | |
| ********************* | |
| * N J E C O M * NJECOM hosts small routines and | |
| * * frequently used constants that | |
| * Common routines * are available to all NJExxx csects | |
| * and constants * via base register 11 | |
| * * | |
| ********************* | |
| * | |
| NJECOM CSECT | |
| DC A(0) No branch around constants | |
| DC AL1(23) LENGTH OF EYECATCHERS | |
| DC CL9'NJECOM' | |
| DC CL9'&SYSDATE' | |
| DC CL5'&SYSTIME' | |
| USING NJECOM,R11 | |
| USING NJEMWK,R10 | |
| * | |
| * FLNK000 - Locate a link table entry by link name | |
| * | |
| * Entry: R1 -> Link name to find (CL8 field padded with blanks) | |
| * Exit: CC=0 link was not found | |
| * CC<>0 link table entry address is in R2 | |
| * | |
| * | |
| * | |
| FLNK000 EQU * | |
| L R2,LINKS -> 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| L R2,LNEXT -> first remote link v211 | |
| * | |
| FLNK010 EQU * | |
| CLC LINKID,0(R1) Find the link entry by name | |
| BE FLNK020 Got it | |
| ICM R2,15,LNEXT -> next LINKTABL entry | |
| BZR R14 Exit CC=0 if not found | |
| B FLNK010 Keep searching | |
| DROP R2 LINKTABL | |
| * | |
| FLNK020 EQU * | |
| LTR R2,R2 Set CC non-zero | |
| BR R14 Return w/LINKTABL entry -> R2 | |
| * | |
| * RLNK000 - Locate a name in the route table | |
| * | |
| * Entry: R1 -> Routed name to find (CL8 field padded with blanks) | |
| * Exit: CC=0 link was not found | |
| * CC<>0 Associated link name address is in R1 | |
| * CC<>0 Named route address is in R15 | |
| * | |
| *-- First determine if the route name we are looking up is actually | |
| *-- a link name. | |
| * | |
| RLNK000 EQU * | |
| ICM R15,15,ROUTES -> RTE list v211 | |
| BZR R14 Exit CC=0 if no RTE list v211 | |
| USING RTE,R15 v211 | |
| * | |
| L R2,LINKS 1st entry (LOCAL entry) v211 | |
| USING LINKTABL,R2 | |
| ICM R2,15,LNEXT Skip over local entry v211 | |
| BZR R14 Fail the request if none v211 | |
| SR R0,R0 R0=0 assume name not a link v211 | |
| * | |
| RLNK010 EQU * v211 | |
| CLC LINKID,0(R1) Find the link entry by name v211 | |
| BE RLNK020 Got it v211 | |
| ICM R2,15,LNEXT -> next LINKTABL entry v211 | |
| BNZ RLNK010 Keep looking v211 | |
| B RLNK030 Didn't find a matching link v211 | |
| DROP R2 LINKTABL v211 | |
| * | |
| *-- Here if route we want is a link name too (dont use wildcards) v211 | |
| * | |
| RLNK020 EQU * v211 | |
| BCTR R0,0 Indic route is explicit link nm v211 | |
| * v211 | |
| *-- Search the RTEs for the route name v211 | |
| * v211 | |
| RLNK030 EQU * | |
| STM R4,R7,12(R13) Save work regs v211 | |
| * | |
| RLNK040 EQU * v211 | |
| LA R4,ROUTNAME -> name from route list v211 | |
| LA R5,8 max length v211 | |
| LR R6,R1 -> selected name to locate v211 | |
| LR R7,R5 copy length v211 | |
| CLCL R4,R6 Did we locate the name? v211 | |
| BE RLNK400 Yes, exact match v211 | |
| LTR R0,R0 Must be explicit link name? v211 | |
| BNZ RLNK050 Yes, no wildcard checking v211 | |
| CLI 0(R4),C'*' Wildcard was in the name? v211 | |
| BE RLNK400 Then we matched to that point v211 | |
| * | |
| RLNK050 EQU * | |
| ICM R15,15,ROUTPTR -> Next route entry v211 | |
| BNZ RLNK040 Keep looking v211 | |
| LM R4,R7,12(R13) Restore work regs v211 | |
| BR R14 No matching route v211 | |
| * | |
| *-- Found the RTE with a matching name, now determine what link v211 | |
| *-- to route to. v211 | |
| * | |
| RLNK400 EQU * v211 | |
| LM R4,R7,12(R13) Restore work regs v211 | |
| LA R0,4 # possible routed-to names v211 | |
| LA R1,ROUTNEXT -> first possible name v211 | |
| * | |
| RLNK410 EQU * v211 | |
| L R2,LINKS -> first LINKTABL entry v211 | |
| USING LINKTABL,R2 v211 | |
| ICM R2,15,LNEXT Skip over local entry v211 | |
| BZR R14 Fail the request if none v211 | |
| * | |
| RLNK420 EQU * v211 | |
| CLC 0(8,R1),BLANKS No route-to name? v211 | |
| BE RLNK499 Fail the request v211 | |
| CLC 0(8,R1),LINKID Look for destination link v211 | |
| BE RLNK440 Found it v211 | |
| ICM R2,15,LNEXT -> next LINKTABL entry v211 | |
| BNZ RLNK420 Keep searching v211 | |
| * | |
| RLNK430 EQU * v211 | |
| LA R1,8(,R1) Next alternate route-to v211 | |
| BCT R0,RLNK410 Rescan for matching link v211 | |
| B RLNK499 None found, fail the request v211 | |
| * | |
| RLNK440 EQU * v211 | |
| TM LFLAG,LCONNECT Is the link active? v211 | |
| BZ RLNK430 N, try next route-to link v211 | |
| DROP R2,R15 LINKTABL, RTE v211 | |
| * | |
| RLNK490 EQU * v211 | |
| CLI *,0 Set CC to non-zero v211 | |
| BR R14 Return with link name -> R1 v211 | |
| * | |
| RLNK499 EQU * v211 | |
| CLI *+1,0 Set CC to 0 v211 | |
| BR R14 No matching route/act link foundv211 | |
| * | |
| * SLNK000 - Start a link | |
| * | |
| * Entry: R2 -> LINKTABL entry to be started | |
| * Exit: CC=0 link was started | |
| * CC<>0 link was already started | |
| * | |
| * | |
| * | |
| USING LINKTABL,R2 | |
| SLNK000 EQU * | |
| STM R14,R9,BALRSAVE Save regs used | |
| CLC LTCBA,=A(0) Is link already started? | |
| BNE SLNK090 Exit w/ CC<>0 if addr present | |
| * | |
| XC LTRMECB,LTRMECB Clear from any prior use | |
| LA R1,INITPARM -> INITPARM mapping area | |
| ST R1,LPOINTER Pass addr of area to subtask | |
| L R5,=A(NJEDMP) -> ESTAI exit | |
| LA R9,LTRMECB | |
| LR R1,R2 LINKTABL entry is parameter | |
| * | |
| MVC MACLIST(ATTACHL),ATTACH Move macro model | |
| ATTACH EP=NJEDRV, Attach X | |
| SZERO=YES, Ok to share SP 0 X | |
| SHSPL=SPLIST, Shared subpool list v220X | |
| DPMOD=0, Run task same prty X | |
| SM=SUPV, Run task in Supervisor state X | |
| KEY=PROP, Run task in key 8 X | |
| ECB=(R9), Subtask termination ECB X | |
| ESTAI=((5),(10)), ESTAI exit, work area is param X | |
| SF=(E,MACLIST), Attach macro plist X | |
| MF=(E,(1)) Param plist area | |
| * | |
| ST R1,LTCBA Save attached TCB address | |
| SR R15,R15 Set CC=0 | |
| B SLNK090 Exit with task attached | |
| DROP R2 LINKTABL | |
| * | |
| SLNK090 EQU * | |
| LM R14,R9,BALRSAVE Restore caller regs | |
| BR R14 Exit with CC set | |
| * | |
| SPLIST DC X'02' Number of shared subpools v220 | |
| DC X'01' Share SP 1 v220 | |
| DC X'02' Share SP 2 v220 | |
| DS X Reserved v220 | |
| * | |
| *-- Get a new command type WRE | |
| * | |
| *-- Entry: None | |
| * Exit: R1 -> WRE | |
| * | |
| * | |
| GTW000 EQU * | |
| ST R14,SV14 Save return addr | |
| GETMAIN RU, Get CSA for WRE TYPE=WRECMD x | |
| LV=WRESIZE, v220x | |
| SP=2 v220 | |
| XC 0(WRESIZE,R1),0(R1) Clear stg area v220 | |
| USING WRE,R1 | |
| MVI WRESP,2 Save subpool v220 | |
| MVI WRETYPE,WRECMD CMD/MSG WRE | |
| * | |
| NJETRACE TYPE=TRCGWRE | |
| STCM R10,7,1(R14) Identify trace entry v220 | |
| MVC 5(3,R14),SV14+1 Addr of GTW000 caller v220 | |
| STM R0,R1,8(R14) Len, stg addr to trace v220 | |
| MVI 8(R14),2 Trace subpool # v220 | |
| DROP R1 | |
| L R14,SV14 Load return addr | |
| BR R14 | |
| * | |
| *-- Queue the WRE on the Link and post link's ECB | |
| *-- Caller must be PSW key 0 | |
| * | |
| *-- Entry: R2 -> LINKTABL entry | |
| *-- R4 -> WRE | |
| *-- Exit: None | |
| * | |
| PST000 EQU * | |
| USING LINKTABL,R2 | |
| USING WRE,R4 | |
| ST R14,SV14 Save return addr | |
| LM R0,R1,LWRESWAP Get first WRE ptr, sync count | |
| * | |
| PST020 EQU * | |
| ST R0,WRENEXT First WRE becomes next | |
| LA R5,1(,R1) Incr synchronization count | |
| CDS R0,R4,LWRESWAP Update LINK WRE anchor, sync | |
| BC 7,PST020 Gotta try again | |
| * | |
| LA R1,LECB -> link task notification ECB | |
| POST (1) Tell subtask WRE is queued | |
| L R14,SV14 Load return addr | |
| BR R14 | |
| * | |
| DROP R2 LINKTABL | |
| DROP R4 WRE | |
| * | |
| * | |
| *-- Message response to console or local TSO user | |
| * | |
| *=== NOTE === | |
| *=== At present this routine (RSP000) is not called or used, but | |
| *=== is retained here for possible future use. | |
| * | |
| * | |
| *-- Entry: Area "MACLIST" contains a WTO format msg | |
| * Area CMNDUSER=BLANKS send to console | |
| * Area CMNDUSER=userid send to that userid | |
| *-- Exit: None | |
| * | |
| * Area "CMDAREA" is used by this call. | |
| * | |
| * | |
| RSP000 EQU * | |
| ST R14,SV14 Save return addr | |
| CLC CMNDUSER,BLANKS Is there a userid? | |
| BE RSP010 No, respond to console | |
| CLC CMNDUSER,=CL8'OP' Respond to operator | |
| BE RSP010 Y | |
| * | |
| LA R15,CMNDUSER -> userid to locate | |
| BAL R14,USR800 See if TSO user logged on | |
| BZ RSP090 Skip msg if not | |
| MVC CMDAREA,MACLIST+4 Save message text | |
| MVC MACLIST+4(4),=C'SE ''' | |
| MVC MACLIST+8(104),CMDAREA v102 | |
| MVC MACLIST+112(8),=C''',USER=(' v102 | |
| MVC MACLIST+120(12),BLANKS Ensure trailer initted v102 | |
| MVC MACLIST+120(7),CMNDUSER Max for TSO userid is 7 v102 | |
| LA R1,MACLIST+127 v102 | |
| TRT MACLIST+120(7),BLANK v102 | |
| MVI 0(R1),C')' | |
| MVI 1(R1),C' ' | |
| MVC MACLIST(4),=AL2(129,0) max len + 4 overhead v102 | |
| * | |
| SPKA 0 | |
| LA R1,MACLIST | |
| SR R0,R0 | |
| SVC 34 Issue MGCR SVC | |
| SPKA X'80' | |
| B RSP090 | |
| * | |
| RSP010 EQU * | |
| WTO ,MF=(E,MACLIST) | |
| * | |
| RSP090 EQU * | |
| L R14,SV14 Reload return addr | |
| BR R14 | |
| * | |
| *-- Search CSCB chain to see if TSO user is logged on | |
| *-- Entry: R15->8-byte padded field containing TSO userid to find | |
| *-- Exit: CC=0 user was not logged on | |
| *-- CC<>0 user is logged on | |
| * | |
| USR800 EQU * | |
| CLC =CL8'OP',0(R15) Is the userid the operator? | |
| BE USR890 Yes, let it thru | |
| L R1,16 Get CVT ptr | |
| USING CVT,R1 | |
| L R1,CVTASCBH -> highest prty ASCB | |
| USING ASCB,R1 | |
| * | |
| USR810 EQU * | |
| L R2,ASCBCSCB -> CSCB | |
| USING CSCB,R2 | |
| LTR R2,R2 Is there a CSCB? | |
| BZ USR840 No, get next ASCB | |
| * | |
| USR820 EQU * | |
| CLC CHKEY,=XL8'00' Jobname zeroed? | |
| BE USR830 Y, skip this CSCB | |
| CLC CHKEY,=CL8' ' Jobname is blank? | |
| BE USR830 Y, skip this CSCB | |
| CLC CHKEY,0(R15) Is this the userid? | |
| BE USR890 Yes | |
| USR830 EQU * | |
| L R2,CHPTR -> next CSCB | |
| LA R2,0(,R2) Clear high order | |
| LTR R2,R2 Last CSCB? | |
| BNZ USR820 No | |
| BR R14 Return with CC=0 (not found) | |
| * | |
| USR840 EQU * | |
| L R1,ASCBFWDP -> next ASCB | |
| LTR R1,R1 last one? | |
| BNZ USR810 No | |
| BR R14 Return with CC=0 (not found) | |
| * | |
| USR890 EQU * | |
| LTR R14,R14 Set CC=non zero (userid found) | |
| BR R14 Return to caller | |
| * | |
| DROP R1 ASCB | |
| DROP R2 CSCB | |
| * | |
| *-- Special code to intercept messages destined for v220 | |
| *-- registered users v220 | |
| * | |
| * | |
| REG000 EQU * v220 | |
| L R2,AREGUSER -> registered user anchor word v220 | |
| ICM R2,15,0(R2) -> registered user queue v220 | |
| BZR R14 No registered users v220 | |
| * | |
| USING REGUSERB,R2 v220 | |
| REG010 EQU * v220 | |
| CLC REGUSRID,0(R15) Find a matching registered user v220 | |
| BE REG020 Found it v220 | |
| ICM R2,15,REGNEXT -> next REGUSER entry v220 | |
| BNZ REG010 Keep looking v220 | |
| BR R14 Userid was not registered v220 | |
| * | |
| REG020 EQU * v220 | |
| ST R14,SVR14R Save return addr v220 | |
| BAL R14,GTW000 Get a WRE v220 | |
| LR R4,R1 v220 | |
| USING WRE,R4 v220 | |
| MVI WRETYPE,WREQRM Queue registered msg WRE v220 | |
| * | |
| MVC WRELINK,LCLNODE Target WRE to local node task v220 | |
| MVC WREUSER,REGUSRID Dest= registered user id v220 | |
| MVC WREORIG,BLANKS No originating node v220 | |
| MVC WRETXT,BLANKS Init first part v220 | |
| MVC WRETXT(5),=C'From ' v220 | |
| MVC WRETXT+5(8),WREORIG-WRE(R6) From original msg v220 | |
| TRT WRETXT+5(9),BLANK Look for end of orig userid v220 | |
| MVI 0(R1),C':' v220 | |
| LA R1,2(,R1) -> area for msg v220 | |
| MVC 0(104,R1),WRETXT-WRE(R6) Copy msg text v220 | |
| MVI WRETXTLN,L'WRETXT Set the max possible len v220 | |
| * | |
| SPKA 0 v220 | |
| L R15,CSABLK -> NJE38 CSA block v220 | |
| USING NJ38CSA,R15 v220 | |
| LM R0,R1,NJ38SWAP Get first WRE ptr, sync count v220 | |
| * | |
| REG030 EQU * v220 | |
| ST R0,WRENEXT First WRE becomes next v220 | |
| LA R5,1(,R1) Incr synchronization count v220 | |
| CDS R0,R4,NJ38SWAP Update LINK WRE anchor, sync v220 | |
| BC 7,REG030 Gotta try again v220 | |
| * | |
| LA R1,NJ38ECB -> main task notification ECB v220 | |
| POST (1) Wake him up v220 | |
| * | |
| SPKA X'80' v220 | |
| * | |
| DROP R2,R4,R15 REGUSERB,WRE,NJ38CSA v220 | |
| * v220 | |
| REG090 EQU * v220 | |
| L R14,SVR14R Load return addr v220 | |
| LTR R14,R14 Set non-zero CC v220 | |
| BR R14 Ret w/CC non-zero (msg queued) v220 | |
| * | |
| * | |
| *-- Format and display VSAM errors | |
| * | |
| FMT000 EQU * | |
| STM R14,R2,BALRSAVE Save regs |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment